diff --git a/CSharp/BasicInputs/Bha/CStringConfiguration.f90 b/CSharp/BasicInputs/Bha/CStringConfiguration.f90 new file mode 100644 index 0000000..bcc792e --- /dev/null +++ b/CSharp/BasicInputs/Bha/CStringConfiguration.f90 @@ -0,0 +1,62 @@ +module CStringConfiguration + use CStringConfigurationVariables + implicit none + public + contains + + integer function SetStringConfigurations(count, array, bit) + !DEC$ ATTRIBUTES DLLEXPORT::SetStringConfigurations + !DEC$ ATTRIBUTES ALIAS: 'SetStringConfigurations' :: SetStringConfigurations + use CManifolds + implicit none + integer, intent(in) :: count + integer :: i, j + type(CStringItem), intent(inout), target :: array(count) + type(CBitInfo), intent(inout) :: bit + type(CStringItem), pointer :: item + BitDefinition%BitType = bit%BitType + BitDefinition%BitSize = bit%BitSize + BitDefinition%BitCodeHundreds = bit%BitCodeHundreds + BitDefinition%BitCodeTens = bit%BitCodeTens + BitDefinition%BitCodeOnes = bit%BitCodeOnes + BitDefinition%BitNozzleSize = bit%BitNozzleSize + BitDefinition%BitLength = bit%BitLength + BitDefinition%BitWeightPerLength = bit%BitWeightPerLength + BitDefinition%BitNozzleNo = bit%BitNozzleNo + BitDefinition%FloatValve = bit%FloatValve + StringConfigurationCount = count + + if(BitDefinition%FloatValve) then + call InstallFloatValve() + else + call RemoveFloatValve() + endif + + if(size(StringConfigurations) > 0) then + deallocate(StringConfigurations) + end if + if(count > 0) then + allocate(StringConfigurations(count)) + !j = count + do i = 1, count + item => array(i) + StringConfigurations(i)%ComponentType = item%ComponentType + StringConfigurations(i)%NumberOfJoint = item%NumberOfJoint + StringConfigurations(i)%LengthPerJoint = item%LengthPerJoint + StringConfigurations(i)%NominalOd = item%NominalOd + StringConfigurations(i)%NominalId = item%NominalId + StringConfigurations(i)%WeightPerLength = item%WeightPerLength + StringConfigurations(i)%ComponentLength = item%ComponentLength + StringConfigurations(i)%NominalToolJointOd = item%NominalToolJointOd + StringConfigurations(i)%Grade = item%Grade + !print*, 'type=', StringConfigurations(i)%ComponentType + !print*, 'NumberOfJoint=', StringConfigurations(i)%NumberOfJoint + !print*, '-----------------------------------------------------------' + !j = j - 1 + end do + end if + + SetStringConfigurations = 0 + end function SetStringConfigurations + +end module CStringConfiguration \ No newline at end of file diff --git a/CSharp/BasicInputs/Bha/CStringConfigurationVariables.f90 b/CSharp/BasicInputs/Bha/CStringConfigurationVariables.f90 new file mode 100644 index 0000000..556e250 --- /dev/null +++ b/CSharp/BasicInputs/Bha/CStringConfigurationVariables.f90 @@ -0,0 +1,54 @@ +module CStringConfigurationVariables + implicit none + public + + !constants + integer :: Bit_ComponentType = 0 + integer :: Stabilizer_ComponentType = 1 + integer :: Collar_ComponentType = 2 + integer :: DrillPipe_ComponentType = 3 + integer :: Heavyweight_ComponentType = 4 + + integer :: Cone_BitType = 0 + integer :: PDC_BitType = 1 + integer :: Rock_BitType = 2 + + + + ! types + ! Pipe Items in String Array + type, bind(c), public :: CStringItem + integer :: ComponentType + real(8) :: NumberOfJoint + real(8) :: LengthPerJoint + real(8) :: NominalOd + real(8) :: NominalId + real(8) :: WeightPerLength + real(8) :: ComponentLength + real(8) :: NominalToolJointOd + character(1) :: Grade + end type CStringItem + + ! types + ! Pipe Items in String Array + type, bind(c), public :: CBitInfo + integer :: BitType + real(8) :: BitSize + integer :: BitCodeHundreds + integer :: BitCodeTens + integer :: BitCodeOnes + real(8) :: BitNozzleSize + real(8) :: BitLength + real(8) :: BitWeightPerLength + integer :: BitNozzleNo + logical :: FloatValve + end type CBitInfo + + integer :: StringConfigurationCount = 0 + type(CStringItem), allocatable :: StringConfigurations(:) + type(CBitInfo) :: BitDefinition + + + + contains +end module CStringConfigurationVariables \ No newline at end of file diff --git a/CSharp/BasicInputs/Bha/cstringconfigurationvariables.mod b/CSharp/BasicInputs/Bha/cstringconfigurationvariables.mod new file mode 100644 index 0000000..3156bff Binary files /dev/null and b/CSharp/BasicInputs/Bha/cstringconfigurationvariables.mod differ diff --git a/CSharp/BasicInputs/CMudProperties.f90 b/CSharp/BasicInputs/CMudProperties.f90 new file mode 100644 index 0000000..1e13006 --- /dev/null +++ b/CSharp/BasicInputs/CMudProperties.f90 @@ -0,0 +1,237 @@ +module CMudProperties + use CMudPropertiesVariables + use CLog4 + implicit none + public + contains + subroutine SetActiveMudType(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetActiveMudType + !DEC$ ATTRIBUTES ALIAS: 'SetActiveMudType' :: SetActiveMudType + implicit none + integer, intent(in) :: v + ActiveMudType = v + end subroutine + + subroutine SetActiveRheologyModel(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetActiveRheologyModel + !DEC$ ATTRIBUTES ALIAS: 'SetActiveRheologyModel' :: SetActiveRheologyModel + implicit none + integer, intent(in) :: v + ActiveRheologyModel = v +#ifdef deb + call Log_4( '=====ActiveRheologyModel=', ActiveRheologyModel) +#endif + end subroutine + + subroutine SetActiveMudVolume(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetActiveMudVolume + !DEC$ ATTRIBUTES ALIAS: 'SetActiveMudVolume' :: SetActiveMudVolume + implicit none + real*8, intent(in) :: v + ActiveMudVolume = v + !call Log_5('ActiveDensity=', ActiveDensity) +#ifdef deb + print*, 'ActiveMudVolume=', ActiveMudVolume +#endif + ActiveMudVolumeGal = v * 42.0 + call OnActiveMudVolumeChange%RunAll(v * 42.0d0) + end subroutine + + subroutine SetActiveDensity(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetActiveDensity + !DEC$ ATTRIBUTES ALIAS: 'SetActiveDensity' :: SetActiveDensity + implicit none + real*8, intent(in) :: v + ActiveDensity = v + !call Log_5('ActiveDensity=', ActiveDensity) +#ifdef deb + print*, 'ActiveDensity=', ActiveDensity +#endif + call OnActiveDensityChange%RunAll(v) + end subroutine + + subroutine SetActiveThetaThreeHundred(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetActiveThetaThreeHundred + !DEC$ ATTRIBUTES ALIAS: 'SetActiveThetaThreeHundred' :: SetActiveThetaThreeHundred + implicit none + real*8, intent(in) :: v + ActiveThetaThreeHundred = v + end subroutine + + subroutine SetActiveThetaSixHundred(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetActiveThetaSixHundred + !DEC$ ATTRIBUTES ALIAS: 'SetActiveThetaSixHundred' :: SetActiveThetaSixHundred + implicit none + real*8, intent(in) :: v + ActiveThetaSixHundred = v + end subroutine + + + subroutine SetReserveMudType(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetReserveMudType + !DEC$ ATTRIBUTES ALIAS: 'SetReserveMudType' :: SetReserveMudType + implicit none + integer, intent(in) :: v + ReserveMudType = v + end subroutine + + subroutine SetReserveMudVolume(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetReserveMudVolume + !DEC$ ATTRIBUTES ALIAS: 'SetReserveMudVolume' :: SetReserveMudVolume + implicit none + real*8, intent(in) :: v + ReserveMudVolume = v + !call Log_5('ReserveMudVolume=', ReserveMudVolume) +#ifdef deb + print*, 'ReserveMudVolume=', ReserveMudVolume +#endif + + ReserveMudVolumeGal = v * 42.0 + call OnReserveMudVolumeChange%RunAll(v * 42.0d0) + end subroutine + + subroutine SetReserveDensity(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetReserveDensity + !DEC$ ATTRIBUTES ALIAS: 'SetReserveDensity' :: SetReserveDensity + implicit none + real*8, intent(in) :: v + ReserveDensity = v + !call Log_5('ReserveDensity=', ReserveDensity) +#ifdef deb + print*, 'ReserveDensity=', ReserveDensity +#endif + call OnReserveDensityChange%RunAll(v) + end subroutine + + subroutine SetReserveThetaThreeHundred(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetReserveThetaThreeHundred + !DEC$ ATTRIBUTES ALIAS: 'SetReserveThetaThreeHundred' :: SetReserveThetaThreeHundred + implicit none + real*8, intent(in) :: v + ReserveThetaThreeHundred = v + end subroutine + + subroutine SetReserveThetaSixHundred(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetReserveThetaSixHundred + !DEC$ ATTRIBUTES ALIAS: 'SetReserveThetaSixHundred' :: SetReserveThetaSixHundred + implicit none + real*8, intent(in) :: v + ReserveThetaSixHundred = v + end subroutine + + + subroutine SetActiveTotalTankCapacity(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetActiveTotalTankCapacity + !DEC$ ATTRIBUTES ALIAS: 'SetActiveTotalTankCapacity' :: SetActiveTotalTankCapacity + implicit none + real*8, intent(in) :: v + ActiveTotalTankCapacity = v + ActiveTotalTankCapacityGal = v * 42.0 +#ifdef deb + print*, 'ActiveTotalTankCapacity=', ActiveTotalTankCapacity +#endif + end subroutine + + subroutine SetActiveSettledContents(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetActiveSettledContents + !DEC$ ATTRIBUTES ALIAS: 'SetActiveSettledContents' :: SetActiveSettledContents + implicit none + real*8, intent(in) :: v + ActiveSettledContents = v + ActiveSettledContentsGal = v * 42.0 +#ifdef deb + print*, 'ActiveSettledContents=', ActiveSettledContents +#endif + end subroutine + + subroutine SetActiveTotalContents(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetActiveTotalContents + !DEC$ ATTRIBUTES ALIAS: 'SetActiveTotalContents' :: SetActiveTotalContents + implicit none + real*8, intent(in) :: v + ActiveTotalContents = v + ActiveTotalContentsGal = v * 42.0 +#ifdef deb + print*, 'ActiveTotalContents=', ActiveTotalContents +#endif + end subroutine + + subroutine SetActivePlasticViscosity(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetActivePlasticViscosity + !DEC$ ATTRIBUTES ALIAS: 'SetActivePlasticViscosity' :: SetActivePlasticViscosity + implicit none + real*8, intent(in) :: v + ActivePlasticViscosity = v +#ifdef deb + print*, 'ActivePlasticViscosity=', ActivePlasticViscosity +#endif + end subroutine + + subroutine SetActiveYieldPoint(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetActiveYieldPoint + !DEC$ ATTRIBUTES ALIAS: 'SetActiveYieldPoint' :: SetActiveYieldPoint + implicit none + real*8, intent(in) :: v + ActiveYieldPoint = v +#ifdef deb + print*, 'ActiveYieldPoint=', ActiveYieldPoint +#endif + end subroutine + + subroutine SetActiveAutoDensity(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetActiveAutoDensity + !DEC$ ATTRIBUTES ALIAS: 'SetActiveAutoDensity' :: SetActiveAutoDensity + implicit none + logical, intent(in) :: v + ActiveAutoDensity = v +#ifdef deb + print*, 'ActiveAutoDensity=', ActiveAutoDensity +#endif + end subroutine + + subroutine SetReservePlasticViscosity(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetReservePlasticViscosity + !DEC$ ATTRIBUTES ALIAS: 'SetReservePlasticViscosity' :: SetReservePlasticViscosity + implicit none + real*8, intent(in) :: v + ReservePlasticViscosity = v +#ifdef deb + print*, 'ReservePlasticViscosity=', ReservePlasticViscosity +#endif + end subroutine + + subroutine SetReserveYieldPoint(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetReserveYieldPoint + !DEC$ ATTRIBUTES ALIAS: 'SetReserveYieldPoint' :: SetReserveYieldPoint + implicit none + real*8, intent(in) :: v + ReserveYieldPoint = v +#ifdef deb + print*, 'ReserveYieldPoint=', ReserveYieldPoint +#endif + end subroutine + + subroutine SetInitialTripTankMudVolume(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetInitialTripTankMudVolume + !DEC$ ATTRIBUTES ALIAS: 'SetInitialTripTankMudVolume' :: SetInitialTripTankMudVolume + implicit none + real*8, intent(in) :: v + InitialTripTankMudVolume = v + InitialTripTankMudVolumeGal = v * 42.0 +#ifdef deb + print*, 'InitialTripTankMudVolume=', InitialTripTankMudVolume +#endif + end subroutine + + subroutine SetPedalFlowMeter(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetPedalFlowMeter + !DEC$ ATTRIBUTES ALIAS: 'SetPedalFlowMeter' :: SetPedalFlowMeter + implicit none + real*8, intent(in) :: v + PedalFlowMeter = v +#ifdef deb + print*, 'PedalFlowMeter=', PedalFlowMeter +#endif + end subroutine + +end module CMudProperties \ No newline at end of file diff --git a/CSharp/BasicInputs/CMudPropertiesVariables.f90 b/CSharp/BasicInputs/CMudPropertiesVariables.f90 new file mode 100644 index 0000000..e21796d --- /dev/null +++ b/CSharp/BasicInputs/CMudPropertiesVariables.f90 @@ -0,0 +1,140 @@ +module CMudPropertiesVariables + use CIActionReference + use CDoubleEventHandlerCollection + implicit none + public + + !pointers + procedure (ActionDouble), pointer :: ActiveMudVolumePtr + procedure (ActionDouble), pointer :: ActiveDensityPtr + procedure (ActionDouble), pointer :: ReserveMudVolumePtr + procedure (ActionDouble), pointer :: ReserveDensityPtr + + type(DoubleEventHandlerCollection) :: OnActiveMudVolumeChange + type(DoubleEventHandlerCollection) :: OnActiveDensityChange + type(DoubleEventHandlerCollection) :: OnReserveMudVolumeChange + type(DoubleEventHandlerCollection) :: OnReserveDensityChange + + !constants + integer, parameter :: WaterBase_MudType = 0 + integer, parameter :: OilBase_MudType = 1 + integer, parameter :: PowerLaw_RheologyModel = 0 + integer, parameter :: Bingham_RheologyModel = 1 + integer, parameter :: Newtonian_RheologyModel = 2 + INTEGER, PARAMETER :: Herschel_Bulkley_RheologyModel = 3 + + ! variables + integer :: ActiveMudType + integer :: ActiveRheologyModel + real(8) :: ActiveMudVolume + real(8) :: ActiveMudVolumeGal + real(8) :: ActiveDensity + real(8) :: ActivePlasticViscosity + real(8) :: ActiveYieldPoint + real(8) :: ActiveThetaThreeHundred + real(8) :: ActiveThetaSixHundred + + integer :: ReserveMudType + real(8) :: ReserveMudVolume + real(8) :: ReserveMudVolumeGal + real(8) :: ReserveDensity + real(8) :: ReservePlasticViscosity + real(8) :: ReserveYieldPoint + real(8) :: ReserveThetaThreeHundred + real(8) :: ReserveThetaSixHundred + + real(8) :: ActiveTotalTankCapacity + real(8) :: ActiveTotalTankCapacityGal + real(8) :: ActiveSettledContents + real(8) :: ActiveSettledContentsGal + real(8) :: ActiveTotalContents + real(8) :: ActiveTotalContentsGal + logical :: ActiveAutoDensity + !real(8) :: ReserveTotalTankCapacity + !real(8) :: ReserveTotalTankCapacityGal + !real(8) :: ReserveSettledContents + !real(8) :: ReserveSettledContentsGal + !real(8) :: ReserveTotalContents + !real(8) :: ReserveTotalContentsGal + real(8) :: InitialTripTankMudVolume + real(8) :: InitialTripTankMudVolumeGal + real(8) :: PedalFlowMeter + + contains + + + subroutine Set_ActiveMudVolume_StudentStation(v) + implicit none + real*8, intent(in) :: v +#ifdef ExcludeExtraChanges + if(ActiveMudVolume == v) return +#endif + ActiveMudVolume = v + if(associated(ActiveMudVolumePtr)) call ActiveMudVolumePtr(ActiveMudVolume) + end subroutine + + subroutine Set_ActiveDensity_StudentStation(v) + implicit none + real*8, intent(in) :: v +#ifdef ExcludeExtraChanges + if(ActiveDensity == v) return +#endif + ActiveDensity = v + if(associated(ActiveDensityPtr)) call ActiveDensityPtr(ActiveDensity) + end subroutine + + subroutine Set_ReserveMudVolume_StudentStation(v) + implicit none + real*8, intent(in) :: v +#ifdef ExcludeExtraChanges + if(ReserveMudVolume == v) return +#endif + ReserveMudVolume = v + if(associated(ReserveMudVolumePtr)) call ReserveMudVolumePtr(ReserveMudVolume) + end subroutine + + subroutine Set_ReserveDensity_StudentStation(v) + implicit none + real*8, intent(in) :: v +#ifdef ExcludeExtraChanges + if(ReserveDensity == v) return +#endif + ReserveDensity = v + if(associated(ReserveDensityPtr)) call ReserveDensityPtr(ReserveDensity) + end subroutine + + + + subroutine SubscribeActiveMudVolume(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeActiveMudVolume + !DEC$ ATTRIBUTES ALIAS: 'SubscribeActiveMudVolume' :: SubscribeActiveMudVolume + implicit none + procedure (ActionDouble) :: a + ActiveMudVolumePtr => a + end subroutine + + subroutine SubscribeActiveDensity(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeActiveDensity + !DEC$ ATTRIBUTES ALIAS: 'SubscribeActiveDensity' :: SubscribeActiveDensity + implicit none + procedure (ActionDouble) :: a + ActiveDensityPtr => a + end subroutine + + subroutine SubscribeReserveMudVolume(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeReserveMudVolume + !DEC$ ATTRIBUTES ALIAS: 'SubscribeReserveMudVolume' :: SubscribeReserveMudVolume + implicit none + procedure (ActionDouble) :: a + ReserveMudVolumePtr => a + end subroutine + + subroutine SubscribeReserveDensity(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeReserveDensity + !DEC$ ATTRIBUTES ALIAS: 'SubscribeReserveDensity' :: SubscribeReserveDensity + implicit none + procedure (ActionDouble) :: a + ReserveDensityPtr => a + end subroutine + +end module CMudPropertiesVariables \ No newline at end of file diff --git a/CSharp/BasicInputs/Geology/CFormation.f90 b/CSharp/BasicInputs/Geology/CFormation.f90 new file mode 100644 index 0000000..3f62502 --- /dev/null +++ b/CSharp/BasicInputs/Geology/CFormation.f90 @@ -0,0 +1,37 @@ +module CFormation + use CFormationVariables + implicit none + public + contains + integer function SetFormations(count, array) + !DEC$ ATTRIBUTES DLLEXPORT::SetFormations + !DEC$ ATTRIBUTES ALIAS: 'SetFormations' :: SetFormations + implicit none + integer, intent(in) :: count + integer :: i + type(CFormationItem), intent(inout), target :: array(count) + type(CFormationItem), pointer :: item + FormationCount = count + if(size(Formations) > 0) then + deallocate(Formations) + end if + if(count > 0) then + allocate(Formations(count)) + do i = 1, count + item => array(i) + Formations(i)%Top = item%Top + Formations(i)%Thickness = item%Thickness + Formations(i)%Drillablity = item%Drillablity + Formations(i)%Abrasiveness = item%Abrasiveness + Formations(i)%ThresholdWeight = item%ThresholdWeight + Formations(i)%PorePressureGradient = item%PorePressureGradient + !print*, "===========================" + !print*, "Formations(", i, ")%Top=", Formations(i)%Top + !print*, "Formations(",i,")%Thickness", Formations(i)%Thickness + !print*, "Formations(",i,")%Drillablity", Formations(i)%Drillablity + end do + end if + + SetFormations = 0 + end function SetFormations +end module CFormation \ No newline at end of file diff --git a/CSharp/BasicInputs/Geology/CFormationVariables.f90 b/CSharp/BasicInputs/Geology/CFormationVariables.f90 new file mode 100644 index 0000000..21fcf14 --- /dev/null +++ b/CSharp/BasicInputs/Geology/CFormationVariables.f90 @@ -0,0 +1,20 @@ +module CFormationVariables + implicit none + public + + ! types + ! Pipe Items in String Array + type, bind(c), public :: CFormationItem + real(8) :: Top + real(8) :: Thickness + real(8) :: Drillablity + real(8) :: Abrasiveness + real(8) :: ThresholdWeight + real(8) :: PorePressureGradient + end type CFormationItem + + integer :: FormationCount = 0 + type(CFormationItem), allocatable :: Formations(:) + + contains +end module CFormationVariables \ No newline at end of file diff --git a/CSharp/BasicInputs/Geology/CReservoir.f90 b/CSharp/BasicInputs/Geology/CReservoir.f90 new file mode 100644 index 0000000..9808aed --- /dev/null +++ b/CSharp/BasicInputs/Geology/CReservoir.f90 @@ -0,0 +1,114 @@ +module CReservoir + use CReservoirVariables + implicit none + public + contains + + subroutine SetReservoirFormationNo(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetReservoirFormationNo + !DEC$ ATTRIBUTES ALIAS: 'SetReservoirFormationNo' :: SetReservoirFormationNo + implicit none + integer, intent(in) :: v + FormationNo = v + end subroutine + + subroutine SetFormationTop(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetFormationTop + !DEC$ ATTRIBUTES ALIAS: 'SetFormationTop' :: SetFormationTop + implicit none + real*8, intent(in) :: v + FormationTop = v + end subroutine + + subroutine SetPressureGradient(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetPressureGradient + !DEC$ ATTRIBUTES ALIAS: 'SetPressureGradient' :: SetPressureGradient + implicit none + real*8, intent(in) :: v + PressureGradient = v + end subroutine + + subroutine SetFormationPermeability(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetFormationPermeability + !DEC$ ATTRIBUTES ALIAS: 'SetFormationPermeability' :: SetFormationPermeability + implicit none + real*8, intent(in) :: v + FormationPermeability = v + end subroutine + + subroutine SetGeothermalGradient(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetGeothermalGradient + !DEC$ ATTRIBUTES ALIAS: 'SetGeothermalGradient' :: SetGeothermalGradient + implicit none + real*8, intent(in) :: v + GeothermalGradient = v + end subroutine + + subroutine SetFluidType(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetFluidType + !DEC$ ATTRIBUTES ALIAS: 'SetFluidType' :: SetFluidType + implicit none + integer, intent(in) :: v + FluidType = v + end subroutine + + subroutine SetFluidGradient(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetFluidGradient + !DEC$ ATTRIBUTES ALIAS: 'SetFluidGradient' :: SetFluidGradient + implicit none + real*8, intent(in) :: v + FluidGradient = v + end subroutine + + subroutine SetFluidViscosity(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetFluidViscosity + !DEC$ ATTRIBUTES ALIAS: 'SetFluidViscosity' :: SetFluidViscosity + implicit none + real*8, intent(in) :: v + FluidViscosity = v + end subroutine + + subroutine SetInactiveInflux(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetInactiveInflux + !DEC$ ATTRIBUTES ALIAS: 'SetInactiveInflux' :: SetInactiveInflux + implicit none + logical, intent(in) :: v + InactiveInflux = v + end subroutine + + subroutine SetMakeKickSinglePacket(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMakeKickSinglePacket + !DEC$ ATTRIBUTES ALIAS: 'SetMakeKickSinglePacket' :: SetMakeKickSinglePacket + implicit none + logical, intent(in) :: v + MakeKickSinglePacket = v +#ifdef deb + print*, 'MakeKickSinglePacket=', MakeKickSinglePacket +#endif + end subroutine + + subroutine SetIsAutoMigrationRateSelected(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetIsAutoMigrationRateSelected + !DEC$ ATTRIBUTES ALIAS: 'SetIsAutoMigrationRateSelected' :: SetIsAutoMigrationRateSelected + implicit none + logical, intent(in) :: v + IsAutoMigrationRateSelected = v +#ifdef deb + print*, 'IsAutoMigrationRateSelected=', IsAutoMigrationRateSelected +#endif + end subroutine + + subroutine SetAutoMigrationRate(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAutoMigrationRate + !DEC$ ATTRIBUTES ALIAS: 'SetAutoMigrationRate' :: SetAutoMigrationRate + implicit none + real*8, intent(in) :: v + AutoMigrationRate = v +#ifdef deb + print*, 'AutoMigrationRate=', AutoMigrationRate +#endif + end subroutine + + + +end module CReservoir \ No newline at end of file diff --git a/CSharp/BasicInputs/Geology/CReservoirVariables.f90 b/CSharp/BasicInputs/Geology/CReservoirVariables.f90 new file mode 100644 index 0000000..43ae73f --- /dev/null +++ b/CSharp/BasicInputs/Geology/CReservoirVariables.f90 @@ -0,0 +1,25 @@ +module CReservoirVariables + implicit none + public + !constants + integer :: Gas_FluidType = 0 + integer :: Oil_FluidType = 1 + integer :: Water_FluidType = 2 + + ! variables + integer :: FormationNo + real(8) :: FormationTop + real(8) :: PressureGradient + real(8) :: FormationPermeability + real(8) :: GeothermalGradient + integer :: FluidType + real(8) :: FluidGradient + real(8) :: FluidViscosity + logical :: InactiveInflux + logical :: IsAutoMigrationRateSelected + real(8) :: AutoMigrationRate + + logical :: MakeKickSinglePacket + + contains +end module CReservoirVariables \ No newline at end of file diff --git a/CSharp/BasicInputs/Geology/CShoe.f90 b/CSharp/BasicInputs/Geology/CShoe.f90 new file mode 100644 index 0000000..20af03b --- /dev/null +++ b/CSharp/BasicInputs/Geology/CShoe.f90 @@ -0,0 +1,55 @@ +module CShoe + use CShoeVariables + implicit none + public + contains + + subroutine SetShoeFormationNo(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetShoeFormationNo + !DEC$ ATTRIBUTES ALIAS: 'SetShoeFormationNo' :: SetShoeFormationNo + implicit none + integer, intent(in) :: v + FormationNo = v + end subroutine + + subroutine SetShoeDepth(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetShoeDepth + !DEC$ ATTRIBUTES ALIAS: 'SetShoeDepth' :: SetShoeDepth + implicit none + real*8, intent(in) :: v + ShoeDepth = v + end subroutine + + subroutine SetLeakOff(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLeakOff + !DEC$ ATTRIBUTES ALIAS: 'SetLeakOff' :: SetLeakOff + implicit none + real*8, intent(in) :: v + LeakOff = v + end subroutine + + subroutine SetBreakdown(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetBreakdown + !DEC$ ATTRIBUTES ALIAS: 'SetBreakdown' :: SetBreakdown + implicit none + real*8, intent(in) :: v + Breakdown = v + end subroutine + + subroutine SetFracturePropagation(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetFracturePropagation + !DEC$ ATTRIBUTES ALIAS: 'SetFracturePropagation' :: SetFracturePropagation + implicit none + real*8, intent(in) :: v + FracturePropagation = v + end subroutine + + subroutine SetInactiveFracture(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetInactiveFracture + !DEC$ ATTRIBUTES ALIAS: 'SetInactiveFracture' :: SetInactiveFracture + implicit none + logical, intent(in) :: v + InactiveFracture = v + end subroutine + +end module CShoe \ No newline at end of file diff --git a/CSharp/BasicInputs/Geology/CShoeVariables.f90 b/CSharp/BasicInputs/Geology/CShoeVariables.f90 new file mode 100644 index 0000000..88047bd --- /dev/null +++ b/CSharp/BasicInputs/Geology/CShoeVariables.f90 @@ -0,0 +1,12 @@ +module CShoeVariables + implicit none + public + ! variables + integer :: FormationNo + real(8) :: ShoeDepth + real(8) :: LeakOff + real(8) :: Breakdown + real(8) :: FracturePropagation + logical :: InactiveFracture + contains +end module CShoeVariables \ No newline at end of file diff --git a/CSharp/BasicInputs/Geology/cformationvariables.mod b/CSharp/BasicInputs/Geology/cformationvariables.mod new file mode 100644 index 0000000..258b0d3 Binary files /dev/null and b/CSharp/BasicInputs/Geology/cformationvariables.mod differ diff --git a/CSharp/BasicInputs/Geology/creservoirvariables.mod b/CSharp/BasicInputs/Geology/creservoirvariables.mod new file mode 100644 index 0000000..25e4892 Binary files /dev/null and b/CSharp/BasicInputs/Geology/creservoirvariables.mod differ diff --git a/CSharp/BasicInputs/RigSpecifications/CAccumulator.f90 b/CSharp/BasicInputs/RigSpecifications/CAccumulator.f90 new file mode 100644 index 0000000..fbcdef3 --- /dev/null +++ b/CSharp/BasicInputs/RigSpecifications/CAccumulator.f90 @@ -0,0 +1,95 @@ +module CAccumulator + use CAccumulatorVariables + implicit none + public + contains + + subroutine SetNumberOfBottels(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetNumberOfBottels + !DEC$ ATTRIBUTES ALIAS: 'SetNumberOfBottels' :: SetNumberOfBottels + implicit none + integer, intent(in) :: v + NumberOfBottels = v + end subroutine + + subroutine SetAccumulatorSystemSize(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAccumulatorSystemSize + !DEC$ ATTRIBUTES ALIAS: 'SetAccumulatorSystemSize' :: SetAccumulatorSystemSize + implicit none + real*8, intent(in) :: v + AccumulatorSystemSize = v + end subroutine + + subroutine SetOilTankVolume(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetOilTankVolume + !DEC$ ATTRIBUTES ALIAS: 'SetOilTankVolume' :: SetOilTankVolume + implicit none + real*8, intent(in) :: v + OilTankVolume = v + end subroutine + + subroutine SetPrechargePressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetPrechargePressure + !DEC$ ATTRIBUTES ALIAS: 'SetPrechargePressure' :: SetPrechargePressure + implicit none + real*8, intent(in) :: v + PrechargePressure = v + end subroutine + + subroutine SetAccumulatorMinimumOperatingPressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAccumulatorMinimumOperatingPressure + !DEC$ ATTRIBUTES ALIAS: 'SetAccumulatorMinimumOperatingPressure' :: SetAccumulatorMinimumOperatingPressure + implicit none + real*8, intent(in) :: v + AccumulatorMinimumOperatingPressure = v + end subroutine + + subroutine SetElectricPumpOutput(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetElectricPumpOutput + !DEC$ ATTRIBUTES ALIAS: 'SetElectricPumpOutput' :: SetElectricPumpOutput + implicit none + real*8, intent(in) :: v + ElectricPumpOutput = v + end subroutine + + subroutine SetStartPressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStartPressure + !DEC$ ATTRIBUTES ALIAS: 'SetStartPressure' :: SetStartPressure + implicit none + real*8, intent(in) :: v + StartPressure = v + end subroutine + + subroutine SetStopPressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStopPressure + !DEC$ ATTRIBUTES ALIAS: 'SetStopPressure' :: SetStopPressure + implicit none + real*8, intent(in) :: v + StopPressure = v + end subroutine + + subroutine SetAirPlungerPumpOutput(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAirPlungerPumpOutput + !DEC$ ATTRIBUTES ALIAS: 'SetAirPlungerPumpOutput' :: SetAirPlungerPumpOutput + implicit none + real*8, intent(in) :: v + AirPlungerPumpOutput = v + end subroutine + + subroutine SetStartPressure2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStartPressure2 + !DEC$ ATTRIBUTES ALIAS: 'SetStartPressure2' :: SetStartPressure2 + implicit none + real*8, intent(in) :: v + StartPressure2 = v + end subroutine + + subroutine SetStopPressure2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStopPressure2 + !DEC$ ATTRIBUTES ALIAS: 'SetStopPressure2' :: SetStopPressure2 + implicit none + real*8, intent(in) :: v + StopPressure2 = v + end subroutine + +end module CAccumulator \ No newline at end of file diff --git a/CSharp/BasicInputs/RigSpecifications/CAccumulatorVariables.f90 b/CSharp/BasicInputs/RigSpecifications/CAccumulatorVariables.f90 new file mode 100644 index 0000000..f669f54 --- /dev/null +++ b/CSharp/BasicInputs/RigSpecifications/CAccumulatorVariables.f90 @@ -0,0 +1,18 @@ +module CAccumulatorVariables + implicit none + public + + integer :: NumberOfBottels + real(8) :: AccumulatorSystemSize + real(8) :: OilTankVolume + real(8) :: PrechargePressure + real(8) :: AccumulatorMinimumOperatingPressure + real(8) :: ElectricPumpOutput + real(8) :: StartPressure + real(8) :: StopPressure + real(8) :: AirPlungerPumpOutput + real(8) :: StartPressure2 + real(8) :: StopPressure2 + + contains +end module CAccumulatorVariables \ No newline at end of file diff --git a/CSharp/BasicInputs/RigSpecifications/CBopStack.f90 b/CSharp/BasicInputs/RigSpecifications/CBopStack.f90 new file mode 100644 index 0000000..09016e6 --- /dev/null +++ b/CSharp/BasicInputs/RigSpecifications/CBopStack.f90 @@ -0,0 +1,201 @@ +module CBopStack + use CBopStackVariables + use CLog4 + implicit none + public + contains + + subroutine SetAboveAnnularHeight(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAboveAnnularHeight + !DEC$ ATTRIBUTES ALIAS: 'SetAboveAnnularHeight' :: SetAboveAnnularHeight + implicit none + real*8, intent(in) :: v + !AboveAnnularHeight = v + !call Log_4('AboveAnnularHeight=', AboveAnnularHeight) + end subroutine + + subroutine SetAnnularPreventerHeight(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAnnularPreventerHeight + !DEC$ ATTRIBUTES ALIAS: 'SetAnnularPreventerHeight' :: SetAnnularPreventerHeight + implicit none + real*8, intent(in) :: v + !AnnularPreventerHeight = v + !call Log_4('AnnularPreventerHeight=', AnnularPreventerHeight) + end subroutine + + subroutine SetUpperRamHeight(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetUpperRamHeight + !DEC$ ATTRIBUTES ALIAS: 'SetUpperRamHeight' :: SetUpperRamHeight + implicit none + real*8, intent(in) :: v + !UpperRamHeight = v + !call Log_4('UpperRamHeight=', UpperRamHeight) + end subroutine + + subroutine SetLowerRamHeight(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLowerRamHeight + !DEC$ ATTRIBUTES ALIAS: 'SetLowerRamHeight' :: SetLowerRamHeight + implicit none + real*8, intent(in) :: v + !LowerRamHeight = v + !call Log_4('LowerRamHeight=', LowerRamHeight) + end subroutine + + subroutine SetBlindRamHeight(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetBlindRamHeight + !DEC$ ATTRIBUTES ALIAS: 'SetBlindRamHeight' :: SetBlindRamHeight + implicit none + real*8, intent(in) :: v + !BlindRamHeight = v + !call Log_4('BlindRamHeight=', BlindRamHeight) + end subroutine + + subroutine SetKillHeight(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetKillHeight + !DEC$ ATTRIBUTES ALIAS: 'SetKillHeight' :: SetKillHeight + implicit none + real*8, intent(in) :: v + !KillHeight = v + !call Log_4('KillHeight=', KillHeight) + end subroutine + + subroutine SetKillOpen(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetKillOpen + !DEC$ ATTRIBUTES ALIAS: 'SetKillOpen' :: SetKillOpen + implicit none + real*8, intent(in) :: v + !KillOpen = v + !call Log_4('KillOpen=', KillOpen) + end subroutine + + subroutine SetKillClose(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetKillClose + !DEC$ ATTRIBUTES ALIAS: 'SetKillClose' :: SetKillClose + implicit none + real*8, intent(in) :: v + !KillClose = v + !call Log_4('KillClose=', KillClose) + end subroutine + + subroutine SetGroundLevel(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetGroundLevel + !DEC$ ATTRIBUTES ALIAS: 'SetGroundLevel' :: SetGroundLevel + implicit none + real*8, intent(in) :: v + !GroundLevel = v + !call Log_4('GroundLevel=', GroundLevel) + end subroutine + + subroutine SetLowerRamOpen(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLowerRamOpen + !DEC$ ATTRIBUTES ALIAS: 'SetLowerRamOpen' :: SetLowerRamOpen + implicit none + real*8, intent(in) :: v + LowerRamOpen = v + end subroutine + + subroutine SetLowerRamClose(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLowerRamClose + !DEC$ ATTRIBUTES ALIAS: 'SetLowerRamClose' :: SetLowerRamClose + implicit none + real*8, intent(in) :: v + LowerRamClose = v + end subroutine + + subroutine SetChokeOpen(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeOpen + !DEC$ ATTRIBUTES ALIAS: 'SetChokeOpen' :: SetChokeOpen + implicit none + real*8, intent(in) :: v + ChokeOpen = v + end subroutine + + subroutine SetChokeClose(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeClose + !DEC$ ATTRIBUTES ALIAS: 'SetChokeClose' :: SetChokeClose + implicit none + real*8, intent(in) :: v + ChokeClose = v + end subroutine + + subroutine SetBlindRamOpen(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetBlindRamOpen + !DEC$ ATTRIBUTES ALIAS: 'SetBlindRamOpen' :: SetBlindRamOpen + implicit none + real*8, intent(in) :: v + BlindRamOpen = v + end subroutine + + subroutine SetBlindRamClose(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetBlindRamClose + !DEC$ ATTRIBUTES ALIAS: 'SetBlindRamClose' :: SetBlindRamClose + implicit none + real*8, intent(in) :: v + BlindRamClose = v + end subroutine + + subroutine SetUpperRamOpen(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetUpperRamOpen + !DEC$ ATTRIBUTES ALIAS: 'SetUpperRamOpen' :: SetUpperRamOpen + implicit none + real*8, intent(in) :: v + UpperRamOpen = v + end subroutine + + subroutine SetUpperRamClose(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetUpperRamClose + !DEC$ ATTRIBUTES ALIAS: 'SetUpperRamClose' :: SetUpperRamClose + implicit none + real*8, intent(in) :: v + UpperRamClose = v + end subroutine + + subroutine SetAnnularPreventerOpen(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAnnularPreventerOpen + !DEC$ ATTRIBUTES ALIAS: 'SetAnnularPreventerOpen' :: SetAnnularPreventerOpen + implicit none + real*8, intent(in) :: v + AnnularPreventerOpen = v + end subroutine + + subroutine SetAnnularPreventerClose(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAnnularPreventerClose + !DEC$ ATTRIBUTES ALIAS: 'SetAnnularPreventerClose' :: SetAnnularPreventerClose + implicit none + real*8, intent(in) :: v + AnnularPreventerClose = v + end subroutine + + subroutine SetRamStringDrag(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRamStringDrag + !DEC$ ATTRIBUTES ALIAS: 'SetRamStringDrag' :: SetRamStringDrag + implicit none + real*8, intent(in) :: v + RamStringDrag = v + end subroutine + + subroutine SetAnnularStringDrag(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAnnularStringDrag + !DEC$ ATTRIBUTES ALIAS: 'SetAnnularStringDrag' :: SetAnnularStringDrag + implicit none + real*8, intent(in) :: v + AnnularStringDrag = v + end subroutine + + subroutine SetChokeLineLength(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeLineLength + !DEC$ ATTRIBUTES ALIAS: 'SetChokeLineLength' :: SetChokeLineLength + implicit none + real*8, intent(in) :: v + ChokeLineLength = v + end subroutine + + subroutine SetChokeLineId(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeLineId + !DEC$ ATTRIBUTES ALIAS: 'SetChokeLineId' :: SetChokeLineId + implicit none + real*8, intent(in) :: v + ChokeLineId = v + end subroutine + +end module CBopStack \ No newline at end of file diff --git a/CSharp/BasicInputs/RigSpecifications/CBopStackVariables.f90 b/CSharp/BasicInputs/RigSpecifications/CBopStackVariables.f90 new file mode 100644 index 0000000..598d586 --- /dev/null +++ b/CSharp/BasicInputs/RigSpecifications/CBopStackVariables.f90 @@ -0,0 +1,31 @@ +module CBopStackVariables + implicit none + public + + real(8) :: AboveAnnularHeight = 10.0d0 + real(8) :: AnnularPreventerHeight = 10.2d0 + real(8) :: UpperRamHeight = 14.632d0 + real(8) :: LowerRamHeight = 21.35d0 + real(8) :: BlindRamHeight = 16.24d0 + real(8) :: KillHeight = 18.8d0 + real(8) :: KillOpen = 1.5d0 + real(8) :: KillClose = 1.5d0 + real(8) :: GroundLevel = 30.0d0 + real(8) :: LowerRamOpen + real(8) :: LowerRamClose + real(8) :: ChokeOpen + real(8) :: ChokeClose + real(8) :: BlindRamOpen + real(8) :: BlindRamClose + real(8) :: UpperRamOpen + real(8) :: UpperRamClose + real(8) :: AnnularPreventerOpen + real(8) :: AnnularPreventerClose + real(8) :: RamStringDrag + real(8) :: AnnularStringDrag + + real(8) :: ChokeLineLength + real(8) :: ChokeLineId + + contains +end module CBopStackVariables \ No newline at end of file diff --git a/CSharp/BasicInputs/RigSpecifications/CHoisting.f90 b/CSharp/BasicInputs/RigSpecifications/CHoisting.f90 new file mode 100644 index 0000000..8151be3 --- /dev/null +++ b/CSharp/BasicInputs/RigSpecifications/CHoisting.f90 @@ -0,0 +1,76 @@ +module CHoisting + use CHoistingVariables + implicit none + public + contains + subroutine SetDriveType(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetDriveType + !DEC$ ATTRIBUTES ALIAS: 'SetDriveType' :: SetDriveType + use CManifolds + use CIrSafetyValveLedNotificationVariables, only: Set_IrSafetyValveLed + implicit none + integer, intent(in) :: v + DriveType = v +#ifdef deb + print*, 'DriveType=', DriveType +#endif + if(v == TopDrive_DriveType) then ! top drive mode + call RemoveKellyCock() + call InstallTopDriveIBop() + + call RemoveSafetyValve_TripMode() + call RemoveSafetyValve_KellyMode() + call Set_IrSafetyValveLed(.false.) + + endif + + if(v == Kelly_DriveType) then ! kelly mode + call RemoveTopDriveIBop() + call InstallKellyCock() + endif + + end subroutine + + subroutine SetTravelingBlockWeight(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTravelingBlockWeight + !DEC$ ATTRIBUTES ALIAS: 'SetTravelingBlockWeight' :: SetTravelingBlockWeight + implicit none + real*8, intent(in) :: v + TravelingBlockWeight = v + end subroutine + + subroutine SetTopDriveWeight(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTopDriveWeight + !DEC$ ATTRIBUTES ALIAS: 'SetTopDriveWeight' :: SetTopDriveWeight + implicit none + real*8, intent(in) :: v + TopDriveWeight = v + end subroutine + + subroutine SetKellyWeight(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetKellyWeight + !DEC$ ATTRIBUTES ALIAS: 'SetKellyWeight' :: SetKellyWeight + implicit none + real*8, intent(in) :: v + KellyWeight = v + end subroutine + + subroutine SetNumberOfLine(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetNumberOfLine + !DEC$ ATTRIBUTES ALIAS: 'SetNumberOfLine' :: SetNumberOfLine + implicit none + integer, intent(in) :: v + NumberOfLine = v +#ifdef deb + print*, 'NumberOfLine=', NumberOfLine +#endif + end subroutine + + subroutine SetDrillingLineBreakingLoad(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetDrillingLineBreakingLoad + !DEC$ ATTRIBUTES ALIAS: 'SetDrillingLineBreakingLoad' :: SetDrillingLineBreakingLoad + implicit none + real*8, intent(in) :: v + DrillingLineBreakingLoad = v + end subroutine +end module CHoisting \ No newline at end of file diff --git a/CSharp/BasicInputs/RigSpecifications/CHoistingVariables.f90 b/CSharp/BasicInputs/RigSpecifications/CHoistingVariables.f90 new file mode 100644 index 0000000..2ee1f38 --- /dev/null +++ b/CSharp/BasicInputs/RigSpecifications/CHoistingVariables.f90 @@ -0,0 +1,16 @@ +module CHoistingVariables + implicit none + public + !constants + integer :: TopDrive_DriveType = 0 + integer :: Kelly_DriveType = 1 + + ! variables + integer :: DriveType + real(8) :: TravelingBlockWeight + real(8) :: TopDriveWeight + real(8) :: KellyWeight + integer :: NumberOfLine + real(8) :: DrillingLineBreakingLoad + contains +end module CHoistingVariables \ No newline at end of file diff --git a/CSharp/BasicInputs/RigSpecifications/CPower.f90 b/CSharp/BasicInputs/RigSpecifications/CPower.f90 new file mode 100644 index 0000000..bfbb7b2 --- /dev/null +++ b/CSharp/BasicInputs/RigSpecifications/CPower.f90 @@ -0,0 +1,71 @@ +module CPower + use CPowerVariables + implicit none + public + contains + + subroutine SetNumberOfgenerators(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetNumberOfgenerators + !DEC$ ATTRIBUTES ALIAS: 'SetNumberOfgenerators' :: SetNumberOfgenerators + implicit none + integer, intent(in) :: v + NumberOfgenerators = v + end subroutine + + subroutine SetGeneratorPowerRating(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetGeneratorPowerRating + !DEC$ ATTRIBUTES ALIAS: 'SetGeneratorPowerRating' :: SetGeneratorPowerRating + implicit none + real*8, intent(in) :: v + GeneratorPowerRating = v + end subroutine + + subroutine SetMudPump1(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump1 + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump1' :: SetMudPump1 + implicit none + real*8, intent(in) :: v + MudPump1 = v + end subroutine + + subroutine SetMudPump2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump2 + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump2' :: SetMudPump2 + implicit none + real*8, intent(in) :: v + MudPump2 = v + end subroutine + + subroutine SetCementPump(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCementPump + !DEC$ ATTRIBUTES ALIAS: 'SetCementPump' :: SetCementPump + implicit none + real*8, intent(in) :: v + CementPump = v + end subroutine + + subroutine SetRotaryTable(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRotaryTable + !DEC$ ATTRIBUTES ALIAS: 'SetRotaryTable' :: SetRotaryTable + implicit none + real*8, intent(in) :: v + RotaryTable = v + end subroutine + + subroutine SetDrawworks(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetDrawworks + !DEC$ ATTRIBUTES ALIAS: 'SetDrawworks' :: SetDrawworks + implicit none + real*8, intent(in) :: v + Drawworks = v + end subroutine + + subroutine SetTopDrive(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTopDrive + !DEC$ ATTRIBUTES ALIAS: 'SetTopDrive' :: SetTopDrive + implicit none + real*8, intent(in) :: v + TopDrive = v + end subroutine + +end module CPower \ No newline at end of file diff --git a/CSharp/BasicInputs/RigSpecifications/CPowerVariables.f90 b/CSharp/BasicInputs/RigSpecifications/CPowerVariables.f90 new file mode 100644 index 0000000..33b3796 --- /dev/null +++ b/CSharp/BasicInputs/RigSpecifications/CPowerVariables.f90 @@ -0,0 +1,14 @@ +module CPowerVariables + implicit none + public + ! variables + integer :: NumberOfgenerators + real(8) :: GeneratorPowerRating + real(8) :: MudPump1 + real(8) :: MudPump2 + real(8) :: CementPump + real(8) :: RotaryTable + real(8) :: Drawworks + real(8) :: TopDrive + contains +end module CPowerVariables \ No newline at end of file diff --git a/CSharp/BasicInputs/RigSpecifications/CPumps.f90 b/CSharp/BasicInputs/RigSpecifications/CPumps.f90 new file mode 100644 index 0000000..605bf84 --- /dev/null +++ b/CSharp/BasicInputs/RigSpecifications/CPumps.f90 @@ -0,0 +1,381 @@ +module CPumps + use CPumpsVariables + use CManifolds + use CLog4 + implicit none + public + contains + subroutine SetMudPump1LinerDiameter(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump1LinerDiameter + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump1LinerDiameter' :: SetMudPump1LinerDiameter + implicit none + real*8, intent(in) :: v + MudPump1LinerDiameter = v + call CalcPump1OutputBblStroke() +#ifdef deb + call Log_4( 'MudPump1LinerDiameter=', MudPump1LinerDiameter) +#endif + end subroutine + + subroutine SetMudPump1Stroke(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump1Stroke + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump1Stroke' :: SetMudPump1Stroke + implicit none + real*8, intent(in) :: v + MudPump1Stroke = v + !call CalcMudPump1LinerDiameter() + call CalcPump1OutputBblStroke() +#ifdef deb + call Log_4( 'MudPump1Stroke=', v) +#endif + end subroutine + + subroutine SetMudPump1MechanicalEfficiency(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump1MechanicalEfficiency + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump1MechanicalEfficiency' :: SetMudPump1MechanicalEfficiency + implicit none + real*8, intent(in) :: v + MudPump1MechanicalEfficiency = v + end subroutine + + subroutine SetMudPump1VolumetricEfficiency(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump1VolumetricEfficiency + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump1VolumetricEfficiency' :: SetMudPump1VolumetricEfficiency + implicit none + real*8, intent(in) :: v + MudPump1VolumetricEfficiency = v + !call CalcMudPump1LinerDiameter() + call CalcPump1OutputBblStroke() +#ifdef deb + call Log_4( 'MudPump1VolumetricEfficiency=', MudPump1VolumetricEfficiency) +#endif + end subroutine + + subroutine SetMudPump1Output(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump1Output + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump1Output' :: SetMudPump1Output + implicit none + real*8, intent(in) :: v + MudPump1Output = v +#ifdef deb + print*, 'MudPump1Output=', MudPump1Output +#endif + end subroutine + + subroutine SetMudPump1OutputBblStroke(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump1OutputBblStroke + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump1OutputBblStroke' :: SetMudPump1OutputBblStroke + implicit none + real*8, intent(in) :: v + MudPump1OutputBblStroke = v + call CalcMudPump1LinerDiameter() +#ifdef deb + print*, 'MudPump1OutputBblStroke=', MudPump1OutputBblStroke +#endif + end subroutine + + subroutine SetMudPump1Maximum(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump1Maximum + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump1Maximum' :: SetMudPump1Maximum + implicit none + real*8, intent(in) :: v + MudPump1Maximum = v + end subroutine + + subroutine SetMudPump1ReliefValvePressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump1ReliefValvePressure + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump1ReliefValvePressure' :: SetMudPump1ReliefValvePressure + implicit none + real*8, intent(in) :: v + MudPump1ReliefValvePressure = v + end subroutine + + + + subroutine SetMudPump2LinerDiameter(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump2LinerDiameter + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump2LinerDiameter' :: SetMudPump2LinerDiameter + implicit none + real*8, intent(in) :: v + MudPump2LinerDiameter = v + call CalcPump2OutputBblStroke() +#ifdef deb + call Log_4( 'MudPump2LinerDiameter=', MudPump2LinerDiameter) +#endif + end subroutine + + subroutine SetMudPump2Stroke(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump2Stroke + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump2Stroke' :: SetMudPump2Stroke + implicit none + real*8, intent(in) :: v + MudPump2Stroke = v + !call CalcMudPump2LinerDiameter() + call CalcPump2OutputBblStroke() +#ifdef deb + call Log_4( 'MudPump2Stroke=', MudPump2Stroke) +#endif + end subroutine + + subroutine SetMudPump2MechanicalEfficiency(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump2MechanicalEfficiency + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump2MechanicalEfficiency' :: SetMudPump2MechanicalEfficiency + implicit none + real*8, intent(in) :: v + MudPump2MechanicalEfficiency = v + end subroutine + + subroutine SetMudPump2VolumetricEfficiency(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump2VolumetricEfficiency + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump2VolumetricEfficiency' :: SetMudPump2VolumetricEfficiency + implicit none + real*8, intent(in) :: v + MudPump2VolumetricEfficiency = v + !call CalcMudPump2LinerDiameter() + call CalcPump2OutputBblStroke() +#ifdef deb + call Log_4( 'MudPump2VolumetricEfficiency=', MudPump2VolumetricEfficiency) +#endif + end subroutine + + subroutine SetMudPump2Output(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump2Output + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump2Output' :: SetMudPump2Output + implicit none + real*8, intent(in) :: v + MudPump2Output = v +#ifdef deb + print*, 'MudPump2Output=', MudPump2Output +#endif + end subroutine + + subroutine SetMudPump2OutputBblStroke(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump2OutputBblStroke + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump2OutputBblStroke' :: SetMudPump2OutputBblStroke + implicit none + real*8, intent(in) :: v + MudPump2OutputBblStroke = v + call CalcMudPump2LinerDiameter() +#ifdef deb + print*, 'MudPump2OutputBblStroke=', MudPump2OutputBblStroke +#endif + end subroutine + + subroutine SetMudPump2Maximum(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump2Maximum + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump2Maximum' :: SetMudPump2Maximum + implicit none + real*8, intent(in) :: v + MudPump2Maximum = v + end subroutine + + subroutine SetMudPump2ReliefValvePressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump2ReliefValvePressure + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump2ReliefValvePressure' :: SetMudPump2ReliefValvePressure + implicit none + real*8, intent(in) :: v + MudPump2ReliefValvePressure = v + end subroutine + + + + subroutine SetCementPumpLinerDiameter(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCementPumpLinerDiameter + !DEC$ ATTRIBUTES ALIAS: 'SetCementPumpLinerDiameter' :: SetCementPumpLinerDiameter + implicit none + real*8, intent(in) :: v + CementPumpLinerDiameter = v + call CalcPump3OutputBblStroke() +#ifdef deb + call Log_4( 'CementPumpLinerDiameter=', CementPumpLinerDiameter) +#endif + end subroutine + + subroutine SetCementPumpStroke(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCementPumpStroke + !DEC$ ATTRIBUTES ALIAS: 'SetCementPumpStroke' :: SetCementPumpStroke + implicit none + real*8, intent(in) :: v + CementPumpStroke = v + !call CalcMudPump3LinerDiameter() + call CalcPump3OutputBblStroke() +#ifdef deb + call Log_4( 'CementPumpStroke=', CementPumpStroke) +#endif + end subroutine + + subroutine SetCementPumpMechanicalEfficiency(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCementPumpMechanicalEfficiency + !DEC$ ATTRIBUTES ALIAS: 'SetCementPumpMechanicalEfficiency' :: SetCementPumpMechanicalEfficiency + implicit none + real*8, intent(in) :: v + CementPumpMechanicalEfficiency = v + end subroutine + + subroutine SetCementPumpVolumetricEfficiency(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCementPumpVolumetricEfficiency + !DEC$ ATTRIBUTES ALIAS: 'SetCementPumpVolumetricEfficiency' :: SetCementPumpVolumetricEfficiency + implicit none + real*8, intent(in) :: v + CementPumpVolumetricEfficiency = v + !call CalcMudPump3LinerDiameter() + call CalcPump3OutputBblStroke() +#ifdef deb + call Log_4( 'CementPumpVolumetricEfficiency=', CementPumpVolumetricEfficiency) +#endif + end subroutine + + subroutine SetCementPumpOutput(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCementPumpOutput + !DEC$ ATTRIBUTES ALIAS: 'SetCementPumpOutput' :: SetCementPumpOutput + implicit none + real*8, intent(in) :: v + CementPumpOutput = v +#ifdef deb + print*, 'CementPumpOutput=', CementPumpOutput +#endif + end subroutine + + subroutine SetCementPumpOutputBblStroke(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCementPumpOutputBblStroke + !DEC$ ATTRIBUTES ALIAS: 'SetCementPumpOutputBblStroke' :: SetCementPumpOutputBblStroke + implicit none + real*8, intent(in) :: v + CementPumpOutputBblStroke = v + call CalcMudPump3LinerDiameter() +#ifdef deb + print*, 'CementPumpOutputBblStroke=', CementPumpOutputBblStroke +#endif + end subroutine + + subroutine SetCementPumpMaximum(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCementPumpMaximum + !DEC$ ATTRIBUTES ALIAS: 'SetCementPumpMaximum' :: SetCementPumpMaximum + implicit none + real*8, intent(in) :: v + CementPumpMaximum = v + end subroutine + + subroutine SetCementPumpReliefValvePressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCementPumpReliefValvePressure + !DEC$ ATTRIBUTES ALIAS: 'SetCementPumpReliefValvePressure' :: SetCementPumpReliefValvePressure + implicit none + real*8, intent(in) :: v + CementPumpReliefValvePressure = v + end subroutine + + subroutine SetMudPump1ReliefValveIsSet(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump1ReliefValveIsSet + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump1ReliefValveIsSet' :: SetMudPump1ReliefValveIsSet + implicit none + logical, intent(in) :: v + if (MudPump1ReliefValveIsSet == v) return + MudPump1ReliefValveIsSet = v +#ifdef deb + print*, 'MudPump1ReliefValveIsSet=', MudPump1ReliefValveIsSet +#endif + end subroutine + + subroutine SetMudPump2ReliefValveIsSet(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudPump2ReliefValveIsSet + !DEC$ ATTRIBUTES ALIAS: 'SetMudPump2ReliefValveIsSet' :: SetMudPump2ReliefValveIsSet + implicit none + logical, intent(in) :: v + if (MudPump2ReliefValveIsSet == v) return + MudPump2ReliefValveIsSet = v +#ifdef deb + print*, 'MudPump2ReliefValveIsSet=', MudPump2ReliefValveIsSet +#endif + end subroutine + + subroutine SetCementPumpReliefValveIsSet(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCementPumpReliefValveIsSet + !DEC$ ATTRIBUTES ALIAS: 'SetCementPumpReliefValveIsSet' :: SetCementPumpReliefValveIsSet + implicit none + logical, intent(in) :: v + if (CementPumpReliefValveIsSet == v) return + CementPumpReliefValveIsSet = v +#ifdef deb + print*, 'CementPumpReliefValveIsSet=', CementPumpReliefValveIsSet +#endif + end subroutine + + + + + + + subroutine SetManualPumpPower(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetManualPumpPower + !DEC$ ATTRIBUTES ALIAS: 'SetManualPumpPower' :: SetManualPumpPower + implicit none + logical, intent(in) :: v + ManualPumpPower = v + call ChangeValve(23, v) +#ifdef deb + print*, 'ManualPumpPower=', ManualPumpPower +#endif + end subroutine + + subroutine SetValve1(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetValve1 + !DEC$ ATTRIBUTES ALIAS: 'SetValve1' :: SetValve1 + implicit none + logical, intent(in) :: v + Valve1 = v + call ChangeValve(22, v) +#ifdef deb + print*, 'Valve1=', Valve1 +#endif + end subroutine + + subroutine SetValve2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetValve2 + !DEC$ ATTRIBUTES ALIAS: 'SetValve2' :: SetValve2 + implicit none + logical, intent(in) :: v + Valve2 = v + call ChangeValve(19, v) +#ifdef deb + print*, 'Valve2=', Valve2 +#endif + end subroutine + + subroutine SetValve3(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetValve3 + !DEC$ ATTRIBUTES ALIAS: 'SetValve3' :: SetValve3 + implicit none + logical, intent(in) :: v + Valve3 = v + call ChangeValve(21, v) +#ifdef deb + print*, 'Valve3=', Valve3 +#endif + end subroutine + + subroutine SetValve4(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetValve4 + !DEC$ ATTRIBUTES ALIAS: 'SetValve4' :: SetValve4 + implicit none + logical, intent(in) :: v + Valve4 = v + call ChangeValve(20, v) +#ifdef deb + print*, 'Valve4=', Valve4 +#endif + end subroutine + + subroutine SetValve5(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetValve5 + !DEC$ ATTRIBUTES ALIAS: 'SetValve5' :: SetValve5 + implicit none + logical, intent(in) :: v + Valve5 = v + call ChangeValve(24, v) +#ifdef deb + print*, 'Valve5=', Valve5 +#endif + end subroutine + + +end module CPumps \ No newline at end of file diff --git a/CSharp/BasicInputs/RigSpecifications/CPumpsVariables.f90 b/CSharp/BasicInputs/RigSpecifications/CPumpsVariables.f90 new file mode 100644 index 0000000..34dd64e --- /dev/null +++ b/CSharp/BasicInputs/RigSpecifications/CPumpsVariables.f90 @@ -0,0 +1,260 @@ +module CPumpsVariables + use CIActionReference + implicit none + public + + + ! Pumps Specifications + real(8) :: MudPump1LinerDiameter + real(8) :: MudPump1Stroke + real(8) :: MudPump1MechanicalEfficiency + real(8) :: MudPump1VolumetricEfficiency + real(8) :: MudPump1Output + real(8) :: MudPump1OutputBblStroke + real(8) :: MudPump1Maximum + real(8) :: MudPump1ReliefValvePressure + + real(8) :: MudPump2LinerDiameter + real(8) :: MudPump2Stroke + real(8) :: MudPump2MechanicalEfficiency + real(8) :: MudPump2VolumetricEfficiency + real(8) :: MudPump2Output + real(8) :: MudPump2OutputBblStroke + real(8) :: MudPump2Maximum + real(8) :: MudPump2ReliefValvePressure + + real(8) :: CementPumpLinerDiameter + real(8) :: CementPumpStroke + real(8) :: CementPumpMechanicalEfficiency + real(8) :: CementPumpVolumetricEfficiency + real(8) :: CementPumpOutput + real(8) :: CementPumpOutputBblStroke + real(8) :: CementPumpMaximum + real(8) :: CementPumpReliefValvePressure + + logical :: MudPump1ReliefValveIsSet + logical :: MudPump2ReliefValveIsSet + logical :: CementPumpReliefValveIsSet + + logical :: ManualPumpPower + logical :: Valve1 + logical :: Valve2 + logical :: Valve3 + logical :: Valve4 + logical :: Valve5 + + procedure (ActionDouble), pointer :: MudPump1LinerDiameterPtr + procedure (ActionDouble), pointer :: MudPump2LinerDiameterPtr + procedure (ActionDouble), pointer :: MudPump3LinerDiameterPtr + procedure (ActionDouble), pointer :: MudPump1OutputBblStrokePtr + procedure (ActionDouble), pointer :: MudPump2OutputBblStrokePtr + procedure (ActionDouble), pointer :: MudPump3OutputBblStrokePtr + + + real(8) :: MathPI = 3.14159265358979d0 + + contains + + + subroutine OpenPump1() + use CManifolds + implicit none + call ChangeValve(16, .true.) + end subroutine + + subroutine ClosePump1() + use CManifolds + implicit none + call ChangeValve(16, .false.) + end subroutine + + subroutine OpenPump2() + use CManifolds + implicit none + call ChangeValve(17, .true.) + end subroutine + + subroutine ClosePump2() + use CManifolds + implicit none + call ChangeValve(17, .false.) + end subroutine + + + subroutine OpenCementPump() + use CManifolds + implicit none + call ChangeValve(18, .true.) + end subroutine + + subroutine CloseCementPump() + use CManifolds + implicit none + call ChangeValve(18, .false.) + end subroutine + + + + + + + + + + subroutine SubscribeMudPump1LinerDiameter(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeMudPump1LinerDiameter + !DEC$ ATTRIBUTES ALIAS: 'SubscribeMudPump1LinerDiameter' :: SubscribeMudPump1LinerDiameter + implicit none + procedure (ActionDouble) :: a + MudPump1LinerDiameterPtr => a + end subroutine + + subroutine SubscribeMudPump2LinerDiameter(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeMudPump2LinerDiameter + !DEC$ ATTRIBUTES ALIAS: 'SubscribeMudPump2LinerDiameter' :: SubscribeMudPump2LinerDiameter + implicit none + procedure (ActionDouble) :: a + MudPump2LinerDiameterPtr => a + end subroutine + + subroutine SubscribeMudPump3LinerDiameter(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeMudPump3LinerDiameter + !DEC$ ATTRIBUTES ALIAS: 'SubscribeMudPump3LinerDiameter' :: SubscribeMudPump3LinerDiameter + implicit none + procedure (ActionDouble) :: a + MudPump3LinerDiameterPtr => a + end subroutine + + + + subroutine SubscribeMudPump1OutputBblStroke(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeMudPump1OutputBblStroke + !DEC$ ATTRIBUTES ALIAS: 'SubscribeMudPump1OutputBblStroke' :: SubscribeMudPump1OutputBblStroke + implicit none + procedure (ActionDouble) :: a + MudPump1OutputBblStrokePtr => a + end subroutine + + subroutine SubscribeMudPump2OutputBblStroke(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeMudPump2OutputBblStroke + !DEC$ ATTRIBUTES ALIAS: 'SubscribeMudPump2OutputBblStroke' :: SubscribeMudPump2OutputBblStroke + implicit none + procedure (ActionDouble) :: a + MudPump2OutputBblStrokePtr => a + end subroutine + + subroutine SubscribeMudPump3OutputBblStroke(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeMudPump3OutputBblStroke + !DEC$ ATTRIBUTES ALIAS: 'SubscribeMudPump3OutputBblStroke' :: SubscribeMudPump3OutputBblStroke + implicit none + procedure (ActionDouble) :: a + MudPump3OutputBblStrokePtr => a + end subroutine + + + + + subroutine SetMudPump1LinerDiameterN(a) + implicit none + real(8) :: a + if(associated(MudPump1LinerDiameterPtr)) call MudPump1LinerDiameterPtr(a) + end subroutine + + subroutine SetMudPump2LinerDiameterN(a) + implicit none + real(8) :: a + if(associated(MudPump2LinerDiameterPtr)) call MudPump2LinerDiameterPtr(a) + end subroutine + + subroutine SetMudPump3LinerDiameterN(a) + implicit none + real(8) :: a + if(associated(MudPump3LinerDiameterPtr)) call MudPump3LinerDiameterPtr(a) + end subroutine + + + + subroutine SetMudPump1OutputBblStrokeN(a) + implicit none + real(8) :: a + if(associated(MudPump1OutputBblStrokePtr)) call MudPump1OutputBblStrokePtr(a) + end subroutine + + subroutine SetMudPump2OutputBblStrokeN(a) + implicit none + real(8) :: a + if(associated(MudPump2OutputBblStrokePtr)) call MudPump2OutputBblStrokePtr(a) + end subroutine + + subroutine SetMudPump3OutputBblStrokeN(a) + implicit none + real(8) :: a + if(associated(MudPump3OutputBblStrokePtr)) call MudPump3OutputBblStrokePtr(a) + end subroutine + + + + + subroutine CalcMudPump1LinerDiameter() + use, intrinsic :: IEEE_ARITHMETIC + implicit none + real(8) :: a + a = (MathPI / 4.d0) * MudPump1Stroke * 3.0d0 * MudPump1VolumetricEfficiency / 9702.03d0 + a = dsqrt(MudPump1OutputBblStroke / a) + if (.not.IEEE_IS_FINITE(a) .or. IEEE_IS_NAN(a)) then + MudPump1LinerDiameter = 0.0 + else + MudPump1LinerDiameter = a + endif + call SetMudPump1LinerDiameterN(MudPump1LinerDiameter) + end subroutine + + subroutine CalcMudPump2LinerDiameter() + use, intrinsic :: IEEE_ARITHMETIC + implicit none + real(8) :: a + a = (MathPI / 4.d0) * MudPump2Stroke * 3.0d0 * MudPump2VolumetricEfficiency / 9702.03d0 + a = dsqrt(MudPump2OutputBblStroke / a) + if (.not.IEEE_IS_FINITE(a) .or. IEEE_IS_NAN(a)) then + MudPump2LinerDiameter = 0.0 + else + MudPump2LinerDiameter = a + endif + call SetMudPump2LinerDiameterN(MudPump2LinerDiameter) + end subroutine + + subroutine CalcMudPump3LinerDiameter() + use, intrinsic :: IEEE_ARITHMETIC + implicit none + real(8) :: a + a = (MathPI / 4.d0) * CementPumpStroke * 3.0d0 * CementPumpVolumetricEfficiency / 9702.03d0 + a = dsqrt(CementPumpOutputBblStroke / a) + if (.not.IEEE_IS_FINITE(a) .or. IEEE_IS_NAN(a)) then + CementPumpLinerDiameter = 0.0 + else + CementPumpLinerDiameter = a + endif + call SetMudPump3LinerDiameterN(CementPumpLinerDiameter) + end subroutine + + + + subroutine CalcPump1OutputBblStroke() + implicit none + MudPump1OutputBblStroke = (MathPI / 4.d0) * (MudPump1LinerDiameter**2) * MudPump1Stroke * 3.0d0 * MudPump1VolumetricEfficiency / 9702.03d0 + call SetMudPump1OutputBblStrokeN(MudPump1OutputBblStroke) + end subroutine + + subroutine CalcPump2OutputBblStroke() + implicit none + MudPump2OutputBblStroke = (MathPI / 4.d0) * (MudPump2LinerDiameter**2) * MudPump2Stroke * 3.0d0 * MudPump2VolumetricEfficiency / 9702.03d0 + call SetMudPump2OutputBblStrokeN(MudPump2OutputBblStroke) + end subroutine + + subroutine CalcPump3OutputBblStroke() + implicit none + CementPumpOutputBblStroke = (MathPI / 4.d0) * (CementPumpLinerDiameter**2) * CementPumpStroke * 3.0d0 * CementPumpVolumetricEfficiency / 9702.03d0 + call SetMudPump3OutputBblStrokeN(CementPumpOutputBblStroke) + end subroutine + +end module CPumpsVariables \ No newline at end of file diff --git a/CSharp/BasicInputs/RigSpecifications/CRigSize.f90 b/CSharp/BasicInputs/RigSpecifications/CRigSize.f90 new file mode 100644 index 0000000..e10dff3 --- /dev/null +++ b/CSharp/BasicInputs/RigSpecifications/CRigSize.f90 @@ -0,0 +1,37 @@ +module CRigSize + use CRigSizeVariables + implicit none + public + contains + subroutine SetRigType(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRigType + !DEC$ ATTRIBUTES ALIAS: 'SetRigType' :: SetRigType + implicit none + integer, intent(in) :: v + RigType = v + end subroutine + + subroutine SetCrownHeight(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCrownHeight + !DEC$ ATTRIBUTES ALIAS: 'SetCrownHeight' :: SetCrownHeight + implicit none + real*8, intent(in) :: v + CrownHeight = v + end subroutine + + subroutine SetMonkeyBoandHeight(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMonkeyBoandHeight + !DEC$ ATTRIBUTES ALIAS: 'SetMonkeyBoandHeight' :: SetMonkeyBoandHeight + implicit none + real*8, intent(in) :: v + MonkeyBoandHeight = v + end subroutine + + subroutine SetRigFloorHeight(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRigFloorHeight + !DEC$ ATTRIBUTES ALIAS: 'SetRigFloorHeight' :: SetRigFloorHeight + implicit none + real*8, intent(in) :: v + RigFloorHeight = v + end subroutine +end module CRigSize \ No newline at end of file diff --git a/CSharp/BasicInputs/RigSpecifications/CRigSizeVariables.f90 b/CSharp/BasicInputs/RigSpecifications/CRigSizeVariables.f90 new file mode 100644 index 0000000..647bf16 --- /dev/null +++ b/CSharp/BasicInputs/RigSpecifications/CRigSizeVariables.f90 @@ -0,0 +1,13 @@ +module CRigSizeVariables + implicit none + public + !constants + integer :: Convensional_RigSize = 0 + + ! variables + integer :: RigType + real(8) :: CrownHeight + real(8) :: MonkeyBoandHeight + real(8) :: RigFloorHeight + contains +end module CRigSizeVariables \ No newline at end of file diff --git a/CSharp/BasicInputs/RigSpecifications/caccumulatorvariables.mod b/CSharp/BasicInputs/RigSpecifications/caccumulatorvariables.mod new file mode 100644 index 0000000..b01733b Binary files /dev/null and b/CSharp/BasicInputs/RigSpecifications/caccumulatorvariables.mod differ diff --git a/CSharp/BasicInputs/RigSpecifications/cbopstackvariables.mod b/CSharp/BasicInputs/RigSpecifications/cbopstackvariables.mod new file mode 100644 index 0000000..cc48d2c Binary files /dev/null and b/CSharp/BasicInputs/RigSpecifications/cbopstackvariables.mod differ diff --git a/CSharp/BasicInputs/WellProfile/CCasingLinerChoke.f90 b/CSharp/BasicInputs/WellProfile/CCasingLinerChoke.f90 new file mode 100644 index 0000000..cfcaeb3 --- /dev/null +++ b/CSharp/BasicInputs/WellProfile/CCasingLinerChoke.f90 @@ -0,0 +1,145 @@ +module CCasingLinerChoke + use CCasingLinerChokeVariables + implicit none + public + contains + + subroutine SetCasingDepth(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCasingDepth + !DEC$ ATTRIBUTES ALIAS: 'SetCasingDepth' :: SetCasingDepth + implicit none + real*8, intent(in) :: v + CasingDepth = v + end subroutine + + subroutine SetCasingId(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCasingId + !DEC$ ATTRIBUTES ALIAS: 'SetCasingId' :: SetCasingId + implicit none + real*8, intent(in) :: v + CasingId = v + end subroutine + + subroutine SetCasingOd(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCasingOd + !DEC$ ATTRIBUTES ALIAS: 'SetCasingOd' :: SetCasingOd + implicit none + real*8, intent(in) :: v + CasingOd = v + end subroutine + + subroutine SetCasingWeight(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCasingWeight + !DEC$ ATTRIBUTES ALIAS: 'SetCasingWeight' :: SetCasingWeight + implicit none + real*8, intent(in) :: v + CasingWeight = v + end subroutine + + subroutine SetCasingCollapsePressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCasingCollapsePressure + !DEC$ ATTRIBUTES ALIAS: 'SetCasingCollapsePressure' :: SetCasingCollapsePressure + implicit none + real*8, intent(in) :: v + CasingCollapsePressure = v + end subroutine + + subroutine SetCasingTensileStrength(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCasingTensileStrength + !DEC$ ATTRIBUTES ALIAS: 'SetCasingTensileStrength' :: SetCasingTensileStrength + implicit none + real*8, intent(in) :: v + CasingTensileStrength = v + end subroutine + + + + + + + + + subroutine SetLinerTopDepth(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLinerTopDepth + !DEC$ ATTRIBUTES ALIAS: 'SetLinerTopDepth' :: SetLinerTopDepth + implicit none + real*8, intent(in) :: v + LinerTopDepth = v + end subroutine + + subroutine SetLinerLength(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLinerLength + !DEC$ ATTRIBUTES ALIAS: 'SetLinerLength' :: SetLinerLength + implicit none + real*8, intent(in) :: v + LinerLength = v + end subroutine + + subroutine SetLinerId(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLinerId + !DEC$ ATTRIBUTES ALIAS: 'SetLinerId' :: SetLinerId + implicit none + real*8, intent(in) :: v + LinerId = v + end subroutine + + subroutine SetLinerOd(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLinerOd + !DEC$ ATTRIBUTES ALIAS: 'SetLinerOd' :: SetLinerOd + implicit none + real*8, intent(in) :: v + LinerOd = v + end subroutine + + subroutine SetLinerWeight(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLinerWeight + !DEC$ ATTRIBUTES ALIAS: 'SetLinerWeight' :: SetLinerWeight + implicit none + real*8, intent(in) :: v + LinerWeight = v + end subroutine + + subroutine SetLinerCollapsePressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLinerCollapsePressure + !DEC$ ATTRIBUTES ALIAS: 'SetLinerCollapsePressure' :: SetLinerCollapsePressure + implicit none + real*8, intent(in) :: v + LinerCollapsePressure = v + end subroutine + + subroutine SetLinerTensileStrength(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLinerTensileStrength + !DEC$ ATTRIBUTES ALIAS: 'SetLinerTensileStrength' :: SetLinerTensileStrength + implicit none + real*8, intent(in) :: v + LinerTensileStrength = v + end subroutine + + + + subroutine SetOpenHoleId(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetOpenHoleId + !DEC$ ATTRIBUTES ALIAS: 'SetOpenHoleId' :: SetOpenHoleId + implicit none + real*8, intent(in) :: v + OpenHoleId = v +#ifdef deb + print*, 'OpenHoleId=', OpenHoleId +#endif + end subroutine + + subroutine SetOpenHoleLength(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetOpenHoleLength + !DEC$ ATTRIBUTES ALIAS: 'SetOpenHoleLength' :: SetOpenHoleLength + implicit none + real*8, intent(in) :: v + OpenHoleLength = v +#ifdef deb + print*, 'OpenHoleLength=', OpenHoleLength +#endif + end subroutine + + + + +end module CCasingLinerChoke \ No newline at end of file diff --git a/CSharp/BasicInputs/WellProfile/CCasingLinerChokeVariables.f90 b/CSharp/BasicInputs/WellProfile/CCasingLinerChokeVariables.f90 new file mode 100644 index 0000000..605f5d6 --- /dev/null +++ b/CSharp/BasicInputs/WellProfile/CCasingLinerChokeVariables.f90 @@ -0,0 +1,24 @@ +module CCasingLinerChokeVariables + implicit none + public + ! variables + real(8) :: CasingDepth + real(8) :: CasingId + real(8) :: CasingOd + real(8) :: CasingWeight + real(8) :: CasingCollapsePressure + real(8) :: CasingTensileStrength + + real(8) :: LinerTopDepth + real(8) :: LinerLength + real(8) :: LinerId + real(8) :: LinerOd + real(8) :: LinerWeight + real(8) :: LinerCollapsePressure + real(8) :: LinerTensileStrength + + real(8) :: OpenHoleId + real(8) :: OpenHoleLength + + contains +end module CCasingLinerChokeVariables \ No newline at end of file diff --git a/CSharp/BasicInputs/WellProfile/CPathGeneration.f90 b/CSharp/BasicInputs/WellProfile/CPathGeneration.f90 new file mode 100644 index 0000000..862a383 --- /dev/null +++ b/CSharp/BasicInputs/WellProfile/CPathGeneration.f90 @@ -0,0 +1,59 @@ +module CPathGeneration + use CPathGenerationVariables + implicit none + public + contains + integer function SetPathGeneration(count, array) + !DEC$ ATTRIBUTES DLLEXPORT::SetPathGeneration + !DEC$ ATTRIBUTES ALIAS: 'SetPathGeneration' :: SetPathGeneration + implicit none + integer, intent(in) :: count + integer :: i + type(CPathGenerationItem), intent(inout), target :: array(count) + type(CPathGenerationItem), pointer :: item + PathGenerationCount = count + if(size(PathGenerations) > 0) then + deallocate(PathGenerations) + end if + if(count > 0) then + allocate(PathGenerations(count)) + do i = 1, count + item => array(i) + PathGenerations(i)%HoleType = item%HoleType + PathGenerations(i)%Angle = item%Angle + PathGenerations(i)%Length = item%Length + PathGenerations(i)%FinalAngle = item%FinalAngle + PathGenerations(i)%TotalLength = item%TotalLength + PathGenerations(i)%MeasuredDepth = item%MeasuredDepth + PathGenerations(i)%TotalVerticalDepth = item%TotalVerticalDepth + end do + end if + + SetPathGeneration = 0 + end function SetPathGeneration + + + integer function SetPathGenerationDataPoints(count, array) + !DEC$ ATTRIBUTES DLLEXPORT::SetPathGenerationDataPoints + !DEC$ ATTRIBUTES ALIAS: 'SetPathGenerationDataPoints' :: SetPathGenerationDataPoints + implicit none + integer, intent(in) :: count + integer :: i + type(CDataPointItem), intent(inout), target :: array(count) + type(CDataPointItem), pointer :: item + PathGenerationDataPointsCount = count + if(size(PathGenerationDataPoints) > 0) then + deallocate(PathGenerationDataPoints) + end if + if(count > 0) then + allocate(PathGenerationDataPoints(count)) + do i = 1, count + item => array(i) + PathGenerationDataPoints(i)%X = item%X + PathGenerationDataPoints(i)%Y = item%Y + end do + end if + + SetPathGenerationDataPoints = 0 + end function SetPathGenerationDataPoints +end module CPathGeneration \ No newline at end of file diff --git a/CSharp/BasicInputs/WellProfile/CPathGenerationVariables.f90 b/CSharp/BasicInputs/WellProfile/CPathGenerationVariables.f90 new file mode 100644 index 0000000..5b70248 --- /dev/null +++ b/CSharp/BasicInputs/WellProfile/CPathGenerationVariables.f90 @@ -0,0 +1,28 @@ +module CPathGenerationVariables + implicit none + public + + ! types + type, bind(c), public :: CPathGenerationItem + integer :: HoleType + real(8) :: Angle + real(8) :: Length + real(8) :: FinalAngle + real(8) :: TotalLength + real(8) :: MeasuredDepth + real(8) :: TotalVerticalDepth + end type CPathGenerationItem + + type, bind(c), public :: CDataPointItem + real(8) :: X + real(8) :: Y + end type CDataPointItem + + integer :: PathGenerationCount = 0 + type(CPathGenerationItem), allocatable :: PathGenerations(:) + + integer :: PathGenerationDataPointsCount = 0 + type(CDataPointItem), allocatable :: PathGenerationDataPoints(:) + + contains +end module CPathGenerationVariables \ No newline at end of file diff --git a/CSharp/BasicInputs/WellProfile/CWellSurveyData.f90 b/CSharp/BasicInputs/WellProfile/CWellSurveyData.f90 new file mode 100644 index 0000000..3678afe --- /dev/null +++ b/CSharp/BasicInputs/WellProfile/CWellSurveyData.f90 @@ -0,0 +1,34 @@ +module CWellSurveyData + use CWellSurveyDataVariables + implicit none + public + contains + integer function SetSurveyData(count, array) + !DEC$ ATTRIBUTES DLLEXPORT::SetSurveyData + !DEC$ ATTRIBUTES ALIAS: 'SetSurveyData' :: SetSurveyData + implicit none + integer, intent(in) :: count + integer :: i + type(CSurveyDataItem), intent(inout), target :: array(count) + type(CSurveyDataItem), pointer :: item + SurveyDataCount = count + if(size(WellSurveyData) > 0) then + deallocate(WellSurveyData) + end if + if(count > 0) then + allocate(WellSurveyData(count)) + do i = 1, count + item => array(i) + WellSurveyData(i)%MeasuredDepth = item%MeasuredDepth + WellSurveyData(i)%Inclination = item%Inclination + WellSurveyData(i)%Azimoth = item%Azimoth + WellSurveyData(i)%TotalVerticalDepth = item%TotalVerticalDepth + WellSurveyData(i)%X = item%X + WellSurveyData(i)%Y = item%Y + WellSurveyData(i)%Z = item%Z + end do + end if + + SetSurveyData = 0 + end function SetSurveyData +end module CWellSurveyData \ No newline at end of file diff --git a/CSharp/BasicInputs/WellProfile/CWellSurveyDataVariables.f90 b/CSharp/BasicInputs/WellProfile/CWellSurveyDataVariables.f90 new file mode 100644 index 0000000..3a998fe --- /dev/null +++ b/CSharp/BasicInputs/WellProfile/CWellSurveyDataVariables.f90 @@ -0,0 +1,20 @@ +module CWellSurveyDataVariables + implicit none + public + + ! types + type, bind(c), public :: CSurveyDataItem + real(8) :: MeasuredDepth + real(8) :: Inclination + real(8) :: Azimoth + real(8) :: TotalVerticalDepth + real(8) :: X + real(8) :: Y + real(8) :: Z + end type CSurveyDataItem + + integer :: SurveyDataCount = 0 + type(CSurveyDataItem), allocatable :: WellSurveyData(:) + + contains +end module CWellSurveyDataVariables \ No newline at end of file diff --git a/CSharp/BasicInputs/WellProfile/cpathgenerationvariables.mod b/CSharp/BasicInputs/WellProfile/cpathgenerationvariables.mod new file mode 100644 index 0000000..b24e01b Binary files /dev/null and b/CSharp/BasicInputs/WellProfile/cpathgenerationvariables.mod differ diff --git a/CSharp/Common/CCommon.f90 b/CSharp/Common/CCommon.f90 new file mode 100644 index 0000000..b5d74e6 --- /dev/null +++ b/CSharp/Common/CCommon.f90 @@ -0,0 +1,53 @@ +module CCommon + use CCommonVariables + implicit none + public + contains + + ! Input routines + subroutine SetStandRack(v) + implicit none + integer, intent(in) :: v + if(StandRack == v) return + StandRack = v + call OnStandRackChange%Run(v) +#ifdef deb + print*, 'StandRack=', StandRack +#endif + end subroutine + + + subroutine SetStandRack_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandRack_WN + !DEC$ ATTRIBUTES ALIAS: 'SetStandRack_WN' :: SetStandRack_WN + implicit none + integer, intent(in) :: v + call SetStandRack(v) + end subroutine + + + + ! Output routines + logical function GetDrillWatchOperationMode() + !DEC$ ATTRIBUTES DLLEXPORT :: GetDrillWatchOperationMode + !DEC$ ATTRIBUTES ALIAS: 'GetDrillWatchOperationMode' :: GetDrillWatchOperationMode + implicit none + GetDrillWatchOperationMode = DrillWatchOperationMode + end function + + integer function GetStandRack() + implicit none + GetStandRack = StandRack + end function + + integer function GetStandRack_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: GetStandRack_WN + !DEC$ ATTRIBUTES ALIAS: 'GetStandRack_WN' :: GetStandRack_WN + implicit none + GetStandRack_WN = StandRack + end function + + + + +end module CCommon \ No newline at end of file diff --git a/CSharp/Common/CCommonVariables.f90 b/CSharp/Common/CCommonVariables.f90 new file mode 100644 index 0000000..c898e63 --- /dev/null +++ b/CSharp/Common/CCommonVariables.f90 @@ -0,0 +1,15 @@ +module CCommonVariables + use CIntegerEventHandler + implicit none + public + + ! Input vars + integer :: StandRack + type(IntegerEventHandler) :: OnStandRackChange + + + ! Output vars + logical :: DrillWatchOperationMode + + contains +end module CCommonVariables \ No newline at end of file diff --git a/CSharp/Common/CIActionReference.f90 b/CSharp/Common/CIActionReference.f90 new file mode 100644 index 0000000..6d06572 --- /dev/null +++ b/CSharp/Common/CIActionReference.f90 @@ -0,0 +1,55 @@ +module CIActionReference + implicit none + abstract interface + subroutine ActionVoid() + end subroutine + + subroutine ActionBool(i) + logical, intent (in) :: i + end subroutine + + subroutine ActionInteger(i) + integer, intent (in) :: i + end subroutine + + subroutine ActionIntegerArray(arr) + integer, allocatable, intent (in) :: arr(:) + end subroutine + + subroutine ActionReal(i) + real, intent (in) :: i + end subroutine + + subroutine ActionDouble(i) + real(8), intent (in) :: i + end subroutine + + subroutine ActionDualDouble(a, b) + real(8), intent (in) :: a, b + end subroutine + + subroutine ActionString(c) + character(len=*), intent(in) :: c + end subroutine + + subroutine ActionStringInt(c, i) + character(len=*), intent(in) :: c + integer, intent (in) :: i + end subroutine + + subroutine ActionStringFloat(c, f) + character(len=*), intent(in) :: c + real, intent (in) :: f + end subroutine + + subroutine ActionStringDouble(c, d) + character(len=*), intent(in) :: c + real(8), intent (in) :: d + end subroutine + + subroutine ActionStringBool(c, b) + character(len=*), intent(in) :: c + logical, intent (in) :: b + end subroutine + end interface +end module CIActionReference \ No newline at end of file diff --git a/CSharp/Common/CLesson.f90 b/CSharp/Common/CLesson.f90 new file mode 100644 index 0000000..c7209fe --- /dev/null +++ b/CSharp/Common/CLesson.f90 @@ -0,0 +1,15 @@ +module CLesson + use CLessonVariables + implicit none + public + contains + subroutine SetWellProfileApproach(path, survey) + !DEC$ ATTRIBUTES DLLEXPORT :: SetWellProfileApproach + !DEC$ ATTRIBUTES ALIAS: 'SetWellProfileApproach' :: SetWellProfileApproach + implicit none + logical, intent(in) :: path + logical, intent(in) :: survey + IsPathGeneration = path + IsWellSurveyData = survey + end subroutine +end module CLesson \ No newline at end of file diff --git a/CSharp/Common/CLessonVariables.f90 b/CSharp/Common/CLessonVariables.f90 new file mode 100644 index 0000000..53065e6 --- /dev/null +++ b/CSharp/Common/CLessonVariables.f90 @@ -0,0 +1,9 @@ +module CLessonVariables + implicit none + public + + logical :: IsPathGeneration + logical :: IsWellSurveyData + + contains +end module CLessonVariables \ No newline at end of file diff --git a/CSharp/Common/CQuery.f90 b/CSharp/Common/CQuery.f90 new file mode 100644 index 0000000..34f5d6d --- /dev/null +++ b/CSharp/Common/CQuery.f90 @@ -0,0 +1,17 @@ +module CQuery + implicit none + public GetCurrentProcessorNumber + + interface + + function GetCurrentProcessorNumber() bind(C,Name='GetCurrentProcessorNumber') + use ifwinty + implicit none + !DEC$ ATTRIBUTES STDCALL :: GetCurrentProcessorNumber + integer(DWORD) :: GetCurrentProcessorNumber + end function GetCurrentProcessorNumber + + end interface + + contains +end module CQuery \ No newline at end of file diff --git a/CSharp/Common/CScaleRange.f90 b/CSharp/Common/CScaleRange.f90 new file mode 100644 index 0000000..cd08edf --- /dev/null +++ b/CSharp/Common/CScaleRange.f90 @@ -0,0 +1,16 @@ +module CScaleRange + implicit none + public + contains + + real function ScaleRange(x, toMin, toMax, fromMin, fromMax) + implicit none + real, intent(in) :: x + real, intent(in) :: toMin + real, intent(in) :: toMax + real, intent(in) :: fromMin + real, intent(in) :: fromMax + ScaleRange = ((toMax - toMin)*(x - fromMin)/(fromMax - fromMin)) + toMin + end function + +end module CScaleRange diff --git a/CSharp/Common/CTimer.f90 b/CSharp/Common/CTimer.f90 new file mode 100644 index 0000000..6c29943 --- /dev/null +++ b/CSharp/Common/CTimer.f90 @@ -0,0 +1,54 @@ +module CTimer + use ifwin, only: QueryPerformanceFrequency, QueryPerformanceCounter, T_LARGE_INTEGER + use ISO_C_BINDING + use ISO_FORTRAN_ENV + implicit none + public + type, public :: Timer + type(T_LARGE_INTEGER) :: StartTime + type(T_LARGE_INTEGER) :: EndTime + contains + procedure :: Start => Start + procedure :: Finish => Finish + procedure :: ElapsedTimeMs => ElapsedTime + end type Timer + contains + subroutine Start(this) + implicit none + class(Timer), intent(inout) :: this + integer :: ApiResult + ApiResult = QueryPerformanceCounter(this%StartTime) + end subroutine + subroutine Finish(this) + implicit none + class(Timer), intent(inout) :: this + integer :: ApiResult + ApiResult = QueryPerformanceCounter(this%EndTime) + end subroutine + integer function ElapsedTime(this) + implicit none + class(Timer), intent(inout) :: this + real(kind=REAL128) :: time + time = CalcTime(this%StartTime, this%EndTime) + ElapsedTime = int(time * 1000.0) + end function + real(kind=REAL128) function CalcTime(start, finish) + implicit none + type(T_LARGE_INTEGER), intent(in) :: start + type(T_LARGE_INTEGER), intent(in) :: finish + type(T_LARGE_INTEGER) :: freq + integer :: ApiResult + integer(kind=INT64) :: freq_64 + integer(kind=INT64) :: start_64 + integer(kind=INT64) :: finish_64 + start_64 = Make64(start) + finish_64 = Make64(finish) + ApiResult = QueryPerformanceFrequency(freq) + freq_64 = Make64( freq) + CalcTime = real(finish_64-start_64,kind=REAL128) / real(freq_64,kind=REAL128) + end function + integer(kind=INT64) function Make64(bit64_int) + type(T_LARGE_INTEGER), intent(in) :: bit64_int + Make64 = transfer(bit64_int, 0_INT64) + end function +end module CTimer \ No newline at end of file diff --git a/CSharp/Common/CTimerLegacy.f90 b/CSharp/Common/CTimerLegacy.f90 new file mode 100644 index 0000000..02cdcc9 --- /dev/null +++ b/CSharp/Common/CTimerLegacy.f90 @@ -0,0 +1,28 @@ +module CTimerLegacy + implicit none + public + type, public :: TimerLegacy + integer, dimension(8) :: StartTime + integer, dimension(8) :: EndTime + contains + procedure :: Start => Start + procedure :: Finish => Finish + procedure :: ElapsedTimeMs => ElapsedTime + end type TimerLegacy + contains + subroutine Start(this) + implicit none + class(TimerLegacy), intent(inout) :: this + call date_and_time(values=this%StartTime) + end subroutine + subroutine Finish(this) + implicit none + class(TimerLegacy), intent(inout) :: this + call date_and_time(values=this%EndTime) + end subroutine + integer function ElapsedTime(this) + implicit none + class(TimerLegacy), intent(inout) :: this + ElapsedTime = (this%EndTime(6)*60000+this%EndTime(7)*1000+this%EndTime(8)) - (this%StartTime(6)*60000+this%StartTime(7)*1000+this%StartTime(8)) + end function +end module CTimerLegacy \ No newline at end of file diff --git a/CSharp/Common/EventHandlers/CBoolEventHandler.f90 b/CSharp/Common/EventHandlers/CBoolEventHandler.f90 new file mode 100644 index 0000000..cdd2b1a --- /dev/null +++ b/CSharp/Common/EventHandlers/CBoolEventHandler.f90 @@ -0,0 +1,44 @@ +module CBoolEventHandler + use CIActionReference + implicit none + public + + type :: BoolEventHandler + procedure(ActionBool), pointer, nopass :: Delegate => null() + contains + procedure :: AssignTo => AssignTo + procedure :: MakeNull => MakeNull + procedure :: IsNull => IsNull + procedure :: Run => Run + end type BoolEventHandler + + contains + + subroutine AssignTo(this, proc) + implicit none + class(BoolEventHandler), intent(inout) :: this + procedure (ActionBool), pointer, intent(in) :: proc + this%Delegate => proc + end subroutine + + subroutine MakeNull(this) + implicit none + class(BoolEventHandler), intent(inout) :: this + this%Delegate => null() + end subroutine + + logical function IsNull(this) + implicit none + class(BoolEventHandler), intent(in) :: this + IsNull = .not.associated(this%Delegate) + end function + + subroutine Run(this, arg) + implicit none + class(BoolEventHandler), intent(inout) :: this + logical, intent(in) :: arg + !if(.not.this%IsNull()) + call this%Delegate(arg) + end subroutine + +end module CBoolEventHandler \ No newline at end of file diff --git a/CSharp/Common/EventHandlers/CBoolEventHandlerCollection.f90 b/CSharp/Common/EventHandlers/CBoolEventHandlerCollection.f90 new file mode 100644 index 0000000..92e0b14 --- /dev/null +++ b/CSharp/Common/EventHandlers/CBoolEventHandlerCollection.f90 @@ -0,0 +1,103 @@ +module CBoolEventHandlerCollection + use CBoolEventHandler + implicit none + public + type, public :: BoolEventHandlerCollection + type(BoolEventHandler), allocatable :: Delegates(:) + contains + procedure :: Length => Length + procedure :: Add => Add + procedure :: Remove => Remove + procedure :: Empty => Empty + procedure :: IsEmpty => IsEmpty + procedure :: RunAll => RunAll + end type BoolEventHandlerCollection + + contains + + integer function Length(this) + implicit none + class(BoolEventHandlerCollection), intent(in) :: this + if(allocated(this%Delegates)) then + Length = size(this%Delegates) + return + end if + Length = 0 + end function + + subroutine Add(this, proc) + implicit none + class(BoolEventHandlerCollection), intent(inout) :: this + type(BoolEventHandler), allocatable :: tempArr(:) + procedure (ActionBool), pointer, intent(in) :: proc + integer :: i, isize + + if(allocated(this%Delegates)) then + isize = size(this%Delegates) + allocate(tempArr(isize+1)) + do i=1,isize + tempArr(i) = this%Delegates(i) + end do + call tempArr(isize+1)%MakeNull() + call tempArr(isize+1)%AssignTo(proc) + deallocate(this%Delegates) + call move_alloc(tempArr, this%Delegates) + else + allocate(this%Delegates(1)) + call this%Delegates(1)%MakeNull() + call this%Delegates(1)%AssignTo(proc) + end if + + end subroutine + + subroutine Remove(this, index) + implicit none + class(BoolEventHandlerCollection), intent(inout) :: this + integer, intent(in) :: index + type(BoolEventHandler), allocatable :: tempArr(:) + integer :: i + logical :: found + + if(index <= 0 .or. index > size(this%Delegates)) return + if(.not.allocated(this%Delegates))return + allocate(tempArr(size(this%Delegates)-1)) + found = .false. + do i=1, size(this%Delegates) + if(i==index) then + found = .true. + cycle + end if + if(found) then + tempArr(i-1) = this%Delegates(i) + else + tempArr(i) = this%Delegates(i) + endif + end do + deallocate(this%Delegates) + call move_alloc(tempArr, this%Delegates) + end subroutine + + + subroutine Empty(this) + implicit none + class(BoolEventHandlerCollection), intent(inout) :: this + if(allocated(this%Delegates)) deallocate(this%Delegates) + end subroutine + + logical function IsEmpty(this) + implicit none + class(BoolEventHandlerCollection), intent(in) :: this + IsEmpty = .not.allocated(this%Delegates) + end function + + subroutine RunAll(this, arg) + implicit none + class(BoolEventHandlerCollection), intent(inout) :: this + logical, intent(in) :: arg + integer :: i + do i=1, size(this%Delegates) + call this%Delegates(i)%Run(arg) + end do + end subroutine + +end module CBoolEventHandlerCollection \ No newline at end of file diff --git a/CSharp/Common/EventHandlers/CDoubleEventHandler.f90 b/CSharp/Common/EventHandlers/CDoubleEventHandler.f90 new file mode 100644 index 0000000..620e2a8 --- /dev/null +++ b/CSharp/Common/EventHandlers/CDoubleEventHandler.f90 @@ -0,0 +1,43 @@ +module CDoubleEventHandler + use CIActionReference + implicit none + public + + type :: DoubleEventHandler + procedure(ActionDouble), pointer, nopass :: Delegate => null() + contains + procedure :: AssignTo => AssignTo + procedure :: MakeNull => MakeNull + procedure :: IsNull => IsNull + procedure :: Run => Run + end type DoubleEventHandler + + contains + + subroutine AssignTo(this, proc) + implicit none + class(DoubleEventHandler), intent(inout) :: this + procedure (ActionDouble), pointer, intent(in) :: proc + this%Delegate => proc + end subroutine + + subroutine MakeNull(this) + implicit none + class(DoubleEventHandler), intent(inout) :: this + this%Delegate => null() + end subroutine + + logical function IsNull(this) + implicit none + class(DoubleEventHandler), intent(in) :: this + IsNull = .not.associated(this%Delegate) + end function + + subroutine Run(this, arg) + implicit none + class(DoubleEventHandler), intent(inout) :: this + real(8), intent(in) :: arg + if(.not.this%IsNull()) call this%Delegate(arg) + end subroutine + +end module CDoubleEventHandler \ No newline at end of file diff --git a/CSharp/Common/EventHandlers/CDoubleEventHandlerCollection.f90 b/CSharp/Common/EventHandlers/CDoubleEventHandlerCollection.f90 new file mode 100644 index 0000000..c9fb123 --- /dev/null +++ b/CSharp/Common/EventHandlers/CDoubleEventHandlerCollection.f90 @@ -0,0 +1,103 @@ +module CDoubleEventHandlerCollection + use CDoubleEventHandler + implicit none + public + type, public :: DoubleEventHandlerCollection + type(DoubleEventHandler), allocatable :: Delegates(:) + contains + procedure :: Length => Length + procedure :: Add => Add + procedure :: Remove => Remove + procedure :: Empty => Empty + procedure :: IsEmpty => IsEmpty + procedure :: RunAll => RunAll + end type DoubleEventHandlerCollection + + contains + + integer function Length(this) + implicit none + class(DoubleEventHandlerCollection), intent(in) :: this + if(allocated(this%Delegates)) then + Length = size(this%Delegates) + return + end if + Length = 0 + end function + + subroutine Add(this, proc) + implicit none + class(DoubleEventHandlerCollection), intent(inout) :: this + type(DoubleEventHandler), allocatable :: tempArr(:) + procedure (ActionDouble), pointer, intent(in) :: proc + integer :: i, isize + + if(allocated(this%Delegates)) then + isize = size(this%Delegates) + allocate(tempArr(isize+1)) + do i=1,isize + tempArr(i) = this%Delegates(i) + end do + call tempArr(isize+1)%MakeNull() + call tempArr(isize+1)%AssignTo(proc) + deallocate(this%Delegates) + call move_alloc(tempArr, this%Delegates) + else + allocate(this%Delegates(1)) + call this%Delegates(1)%MakeNull() + call this%Delegates(1)%AssignTo(proc) + end if + + end subroutine + + subroutine Remove(this, index) + implicit none + class(DoubleEventHandlerCollection), intent(inout) :: this + integer, intent(in) :: index + type(DoubleEventHandler), allocatable :: tempArr(:) + integer :: i + logical :: found + + if(index <= 0 .or. index > size(this%Delegates)) return + if(.not.allocated(this%Delegates))return + allocate(tempArr(size(this%Delegates)-1)) + found = .false. + do i=1, size(this%Delegates) + if(i==index) then + found = .true. + cycle + end if + if(found) then + tempArr(i-1) = this%Delegates(i) + else + tempArr(i) = this%Delegates(i) + endif + end do + deallocate(this%Delegates) + call move_alloc(tempArr, this%Delegates) + end subroutine + + + subroutine Empty(this) + implicit none + class(DoubleEventHandlerCollection), intent(inout) :: this + if(allocated(this%Delegates)) deallocate(this%Delegates) + end subroutine + + logical function IsEmpty(this) + implicit none + class(DoubleEventHandlerCollection), intent(in) :: this + IsEmpty = .not.allocated(this%Delegates) + end function + + subroutine RunAll(this, arg) + implicit none + class(DoubleEventHandlerCollection), intent(inout) :: this + real(8), intent(in) :: arg + integer :: i + do i=1, size(this%Delegates) + call this%Delegates(i)%Run(arg) + end do + end subroutine + +end module CDoubleEventHandlerCollection \ No newline at end of file diff --git a/CSharp/Common/EventHandlers/CIntegerArrayEventHandler.f90 b/CSharp/Common/EventHandlers/CIntegerArrayEventHandler.f90 new file mode 100644 index 0000000..f300bc1 --- /dev/null +++ b/CSharp/Common/EventHandlers/CIntegerArrayEventHandler.f90 @@ -0,0 +1,44 @@ +module CIntegerArrayEventHandler + use CIActionReference + implicit none + public + + type :: IntegerArrayEventHandler + procedure(ActionIntegerArray), pointer, nopass :: Delegate => null() + contains + procedure :: AssignTo => AssignTo + procedure :: MakeNull => MakeNull + procedure :: IsNull => IsNull + procedure :: Run => Run + end type IntegerArrayEventHandler + + contains + + subroutine AssignTo(this, proc) + implicit none + class(IntegerArrayEventHandler), intent(inout) :: this + procedure (ActionIntegerArray), pointer, intent(in) :: proc + this%Delegate => proc + end subroutine + + subroutine MakeNull(this) + implicit none + class(IntegerArrayEventHandler), intent(inout) :: this + this%Delegate => null() + end subroutine + + logical function IsNull(this) + implicit none + class(IntegerArrayEventHandler), intent(in) :: this + IsNull = .not.associated(this%Delegate) + end function + + subroutine Run(this, arg) + implicit none + class(IntegerArrayEventHandler), intent(inout) :: this + integer, allocatable, intent (in) :: arg(:) + !if(.not.this%IsNull()) + call this%Delegate(arg) + end subroutine + +end module CIntegerArrayEventHandler \ No newline at end of file diff --git a/CSharp/Common/EventHandlers/CIntegerArrayEventHandlerCollection.f90 b/CSharp/Common/EventHandlers/CIntegerArrayEventHandlerCollection.f90 new file mode 100644 index 0000000..952aaf2 --- /dev/null +++ b/CSharp/Common/EventHandlers/CIntegerArrayEventHandlerCollection.f90 @@ -0,0 +1,103 @@ +module CIntegerArrayEventHandlerCollection + use CIntegerArrayEventHandler + implicit none + public + type, public :: IntegerArrayEventHandlerCollection + type(IntegerArrayEventHandler), allocatable :: Delegates(:) + contains + procedure :: Length => Length + procedure :: Add => Add + procedure :: Remove => Remove + procedure :: Empty => Empty + procedure :: IsEmpty => IsEmpty + procedure :: RunAll => RunAll_ + end type IntegerArrayEventHandlerCollection + + contains + + integer function Length(this) + implicit none + class(IntegerArrayEventHandlerCollection), intent(in) :: this + if(allocated(this%Delegates)) then + Length = size(this%Delegates) + return + end if + Length = 0 + end function + + subroutine Add(this, proc) + implicit none + class(IntegerArrayEventHandlerCollection), intent(inout) :: this + type(IntegerArrayEventHandler), allocatable :: tempArr(:) + procedure (ActionIntegerArray), pointer, intent(in) :: proc + integer :: i, isize + + if(allocated(this%Delegates)) then + isize = size(this%Delegates) + allocate(tempArr(isize+1)) + do i=1,isize + tempArr(i) = this%Delegates(i) + end do + call tempArr(isize+1)%MakeNull() + call tempArr(isize+1)%AssignTo(proc) + deallocate(this%Delegates) + call move_alloc(tempArr, this%Delegates) + else + allocate(this%Delegates(1)) + call this%Delegates(1)%MakeNull() + call this%Delegates(1)%AssignTo(proc) + end if + + end subroutine + + subroutine Remove(this, index) + implicit none + class(IntegerArrayEventHandlerCollection), intent(inout) :: this + integer, intent(in) :: index + type(IntegerArrayEventHandler), allocatable :: tempArr(:) + integer :: i + logical :: found + + if(index <= 0 .or. index > size(this%Delegates)) return + if(.not.allocated(this%Delegates))return + allocate(tempArr(size(this%Delegates)-1)) + found = .false. + do i=1, size(this%Delegates) + if(i==index) then + found = .true. + cycle + end if + if(found) then + tempArr(i-1) = this%Delegates(i) + else + tempArr(i) = this%Delegates(i) + endif + end do + deallocate(this%Delegates) + call move_alloc(tempArr, this%Delegates) + end subroutine + + + subroutine Empty(this) + implicit none + class(IntegerArrayEventHandlerCollection), intent(inout) :: this + if(allocated(this%Delegates)) deallocate(this%Delegates) + end subroutine + + logical function IsEmpty(this) + implicit none + class(IntegerArrayEventHandlerCollection), intent(in) :: this + IsEmpty = .not.allocated(this%Delegates) + end function + + subroutine RunAll_(this, arg) + implicit none + class(IntegerArrayEventHandlerCollection), intent(inout) :: this + integer, allocatable, intent (in) :: arg(:) + integer :: i + do i=1, size(this%Delegates) + call this%Delegates(i)%Run(arg) + end do + end subroutine + +end module CIntegerArrayEventHandlerCollection \ No newline at end of file diff --git a/CSharp/Common/EventHandlers/CIntegerEventHandler.f90 b/CSharp/Common/EventHandlers/CIntegerEventHandler.f90 new file mode 100644 index 0000000..bfe607d --- /dev/null +++ b/CSharp/Common/EventHandlers/CIntegerEventHandler.f90 @@ -0,0 +1,44 @@ +module CIntegerEventHandler + use CIActionReference + implicit none + public + + type :: IntegerEventHandler + procedure(ActionInteger), pointer, nopass :: Delegate => null() + contains + procedure :: AssignTo => AssignTo + procedure :: MakeNull => MakeNull + procedure :: IsNull => IsNull + procedure :: Run => Run + end type IntegerEventHandler + + contains + + subroutine AssignTo(this, proc) + implicit none + class(IntegerEventHandler), intent(inout) :: this + procedure (ActionInteger), pointer, intent(in) :: proc + this%Delegate => proc + end subroutine + + subroutine MakeNull(this) + implicit none + class(IntegerEventHandler), intent(inout) :: this + this%Delegate => null() + end subroutine + + logical function IsNull(this) + implicit none + class(IntegerEventHandler), intent(in) :: this + IsNull = .not.associated(this%Delegate) + end function + + subroutine Run(this, arg) + implicit none + class(IntegerEventHandler), intent(inout) :: this + integer, intent(in) :: arg + !if(.not.this%IsNull()) + call this%Delegate(arg) + end subroutine + +end module CIntegerEventHandler \ No newline at end of file diff --git a/CSharp/Common/EventHandlers/CIntegerEventHandlerCollection.f90 b/CSharp/Common/EventHandlers/CIntegerEventHandlerCollection.f90 new file mode 100644 index 0000000..7444525 --- /dev/null +++ b/CSharp/Common/EventHandlers/CIntegerEventHandlerCollection.f90 @@ -0,0 +1,103 @@ +module CIntegerEventHandlerCollection + use CIntegerEventHandler + implicit none + public + type, public :: IntegerEventHandlerCollection + type(IntegerEventHandler), allocatable :: Delegates(:) + contains + procedure :: Length => Length + procedure :: Add => Add + procedure :: Remove => Remove + procedure :: Empty => Empty + procedure :: IsEmpty => IsEmpty + procedure :: RunAll => RunAll + end type IntegerEventHandlerCollection + + contains + + integer function Length(this) + implicit none + class(IntegerEventHandlerCollection), intent(in) :: this + if(allocated(this%Delegates)) then + Length = size(this%Delegates) + return + end if + Length = 0 + end function + + subroutine Add(this, proc) + implicit none + class(IntegerEventHandlerCollection), intent(inout) :: this + type(IntegerEventHandler), allocatable :: tempArr(:) + procedure (ActionInteger), pointer, intent(in) :: proc + integer :: i, isize + + if(allocated(this%Delegates)) then + isize = size(this%Delegates) + allocate(tempArr(isize+1)) + do i=1,isize + tempArr(i) = this%Delegates(i) + end do + call tempArr(isize+1)%MakeNull() + call tempArr(isize+1)%AssignTo(proc) + deallocate(this%Delegates) + call move_alloc(tempArr, this%Delegates) + else + allocate(this%Delegates(1)) + call this%Delegates(1)%MakeNull() + call this%Delegates(1)%AssignTo(proc) + end if + + end subroutine + + subroutine Remove(this, index) + implicit none + class(IntegerEventHandlerCollection), intent(inout) :: this + integer, intent(in) :: index + type(IntegerEventHandler), allocatable :: tempArr(:) + integer :: i + logical :: found + + if(index <= 0 .or. index > size(this%Delegates)) return + if(.not.allocated(this%Delegates))return + allocate(tempArr(size(this%Delegates)-1)) + found = .false. + do i=1, size(this%Delegates) + if(i==index) then + found = .true. + cycle + end if + if(found) then + tempArr(i-1) = this%Delegates(i) + else + tempArr(i) = this%Delegates(i) + endif + end do + deallocate(this%Delegates) + call move_alloc(tempArr, this%Delegates) + end subroutine + + + subroutine Empty(this) + implicit none + class(IntegerEventHandlerCollection), intent(inout) :: this + if(allocated(this%Delegates)) deallocate(this%Delegates) + end subroutine + + logical function IsEmpty(this) + implicit none + class(IntegerEventHandlerCollection), intent(in) :: this + IsEmpty = .not.allocated(this%Delegates) + end function + + subroutine RunAll(this, arg) + implicit none + class(IntegerEventHandlerCollection), intent(inout) :: this + integer, intent(in) :: arg + integer :: i + do i=1, size(this%Delegates) + call this%Delegates(i)%Run(arg) + end do + end subroutine + +end module CIntegerEventHandlerCollection \ No newline at end of file diff --git a/CSharp/Common/EventHandlers/CRealEventHandler.f90 b/CSharp/Common/EventHandlers/CRealEventHandler.f90 new file mode 100644 index 0000000..b9625cd --- /dev/null +++ b/CSharp/Common/EventHandlers/CRealEventHandler.f90 @@ -0,0 +1,44 @@ +module CRealEventHandler + use CIActionReference + implicit none + public + + type :: RealEventHandler + procedure(ActionReal), pointer, nopass :: Delegate => null() + contains + procedure :: AssignTo => AssignTo + procedure :: MakeNull => MakeNull + procedure :: IsNull => IsNull + procedure :: Run => Run + end type RealEventHandler + + contains + + subroutine AssignTo(this, proc) + implicit none + class(RealEventHandler), intent(inout) :: this + procedure (ActionReal), pointer, intent(in) :: proc + this%Delegate => proc + end subroutine + + subroutine MakeNull(this) + implicit none + class(RealEventHandler), intent(inout) :: this + this%Delegate => null() + end subroutine + + logical function IsNull(this) + implicit none + class(RealEventHandler), intent(in) :: this + IsNull = .not.associated(this%Delegate) + end function + + subroutine Run(this, arg) + implicit none + class(RealEventHandler), intent(inout) :: this + real, intent(in) :: arg + !if(.not.this%IsNull()) + call this%Delegate(arg) + end subroutine + +end module CRealEventHandler \ No newline at end of file diff --git a/CSharp/Common/EventHandlers/CRealEventHandlerCollection.f90 b/CSharp/Common/EventHandlers/CRealEventHandlerCollection.f90 new file mode 100644 index 0000000..2e19aa6 --- /dev/null +++ b/CSharp/Common/EventHandlers/CRealEventHandlerCollection.f90 @@ -0,0 +1,103 @@ +module CRealEventHandlerCollection + use CRealEventHandler + implicit none + public + type, public :: RealEventHandlerCollection + type(RealEventHandler), allocatable :: Delegates(:) + contains + procedure :: Length => Length + procedure :: Add => Add + procedure :: Remove => Remove + procedure :: Empty => Empty + procedure :: IsEmpty => IsEmpty + procedure :: RunAll => RunAll + end type RealEventHandlerCollection + + contains + + integer function Length(this) + implicit none + class(RealEventHandlerCollection), intent(in) :: this + if(allocated(this%Delegates)) then + Length = size(this%Delegates) + return + end if + Length = 0 + end function + + subroutine Add(this, proc) + implicit none + class(RealEventHandlerCollection), intent(inout) :: this + type(RealEventHandler), allocatable :: tempArr(:) + procedure (ActionReal), pointer, intent(in) :: proc + integer :: i, isize + + if(allocated(this%Delegates)) then + isize = size(this%Delegates) + allocate(tempArr(isize+1)) + do i=1,isize + tempArr(i) = this%Delegates(i) + end do + call tempArr(isize+1)%MakeNull() + call tempArr(isize+1)%AssignTo(proc) + deallocate(this%Delegates) + call move_alloc(tempArr, this%Delegates) + else + allocate(this%Delegates(1)) + call this%Delegates(1)%MakeNull() + call this%Delegates(1)%AssignTo(proc) + end if + + end subroutine + + subroutine Remove(this, index) + implicit none + class(RealEventHandlerCollection), intent(inout) :: this + integer, intent(in) :: index + type(RealEventHandler), allocatable :: tempArr(:) + integer :: i + logical :: found + + if(index <= 0 .or. index > size(this%Delegates)) return + if(.not.allocated(this%Delegates))return + allocate(tempArr(size(this%Delegates)-1)) + found = .false. + do i=1, size(this%Delegates) + if(i==index) then + found = .true. + cycle + end if + if(found) then + tempArr(i-1) = this%Delegates(i) + else + tempArr(i) = this%Delegates(i) + endif + end do + deallocate(this%Delegates) + call move_alloc(tempArr, this%Delegates) + end subroutine + + + subroutine Empty(this) + implicit none + class(RealEventHandlerCollection), intent(inout) :: this + if(allocated(this%Delegates)) deallocate(this%Delegates) + end subroutine + + logical function IsEmpty(this) + implicit none + class(RealEventHandlerCollection), intent(in) :: this + IsEmpty = .not.allocated(this%Delegates) + end function + + subroutine RunAll(this, arg) + implicit none + class(RealEventHandlerCollection), intent(inout) :: this + real, intent(in) :: arg + integer :: i + do i=1, size(this%Delegates) + call this%Delegates(i)%Run(arg) + end do + end subroutine + +end module CRealEventHandlerCollection \ No newline at end of file diff --git a/CSharp/Common/EventHandlers/CVoidEventHandler.f90 b/CSharp/Common/EventHandlers/CVoidEventHandler.f90 new file mode 100644 index 0000000..cbe829b --- /dev/null +++ b/CSharp/Common/EventHandlers/CVoidEventHandler.f90 @@ -0,0 +1,44 @@ +module CVoidEventHandler + use CIActionReference + implicit none + public + + type :: VoidEventHandler + procedure(ActionVoid), pointer, nopass :: Delegate => null() + contains + procedure :: AssignTo => AssignTo + procedure :: MakeNull => MakeNull + procedure :: IsNull => IsNull + procedure :: Run => Run + end type VoidEventHandler + + contains + + subroutine AssignTo(this, proc) + implicit none + class(VoidEventHandler), intent(inout) :: this + procedure (ActionVoid), pointer, intent(in) :: proc + this%Delegate => proc + end subroutine + + subroutine MakeNull(this) + implicit none + class(VoidEventHandler), intent(inout) :: this + this%Delegate => null() + end subroutine + + logical function IsNull(this) + implicit none + class(VoidEventHandler), intent(in) :: this + IsNull = .not.associated(this%Delegate) + end function + + subroutine Run(this) + implicit none + class(VoidEventHandler), intent(inout) :: this + !if(.not.this%IsNull()) then + call this%Delegate() + !endif + end subroutine + +end module CVoidEventHandler \ No newline at end of file diff --git a/CSharp/Common/EventHandlers/CVoidEventHandlerCollection.f90 b/CSharp/Common/EventHandlers/CVoidEventHandlerCollection.f90 new file mode 100644 index 0000000..8cee66d --- /dev/null +++ b/CSharp/Common/EventHandlers/CVoidEventHandlerCollection.f90 @@ -0,0 +1,102 @@ +module CVoidEventHandlerCollection + use CVoidEventHandler + implicit none + public + type, public :: VoidEventHandlerCollection + type(VoidEventHandler), allocatable :: Delegates(:) + contains + procedure :: Length => Length + procedure :: Add => Add + procedure :: Remove => Remove + procedure :: Empty => Empty + procedure :: IsEmpty => IsEmpty + procedure :: RunAll => RunAll + end type VoidEventHandlerCollection + + contains + + integer function Length(this) + implicit none + class(VoidEventHandlerCollection), intent(in) :: this + if(allocated(this%Delegates)) then + Length = size(this%Delegates) + return + end if + Length = 0 + end function + + subroutine Add(this, proc) + implicit none + class(VoidEventHandlerCollection), intent(inout) :: this + type(VoidEventHandler), allocatable :: tempArr(:) + procedure (ActionVoid), pointer, intent(in) :: proc + integer :: i, isize + + if(allocated(this%Delegates)) then + isize = size(this%Delegates) + allocate(tempArr(isize+1)) + do i=1,isize + tempArr(i) = this%Delegates(i) + end do + call tempArr(isize+1)%MakeNull() + call tempArr(isize+1)%AssignTo(proc) + deallocate(this%Delegates) + call move_alloc(tempArr, this%Delegates) + else + allocate(this%Delegates(1)) + call this%Delegates(1)%MakeNull() + call this%Delegates(1)%AssignTo(proc) + end if + + end subroutine + + subroutine Remove(this, index) + implicit none + class(VoidEventHandlerCollection), intent(inout) :: this + integer, intent(in) :: index + type(VoidEventHandler), allocatable :: tempArr(:) + integer :: i + logical :: found + + if(index <= 0 .or. index > size(this%Delegates)) return + if(.not.allocated(this%Delegates))return + allocate(tempArr(size(this%Delegates)-1)) + found = .false. + do i=1, size(this%Delegates) + if(i==index) then + found = .true. + cycle + end if + if(found) then + tempArr(i-1) = this%Delegates(i) + else + tempArr(i) = this%Delegates(i) + endif + end do + deallocate(this%Delegates) + call move_alloc(tempArr, this%Delegates) + end subroutine + + + subroutine Empty(this) + implicit none + class(VoidEventHandlerCollection), intent(inout) :: this + if(allocated(this%Delegates)) deallocate(this%Delegates) + end subroutine + + logical function IsEmpty(this) + implicit none + class(VoidEventHandlerCollection), intent(in) :: this + IsEmpty = .not.allocated(this%Delegates) + end function + + subroutine RunAll(this) + implicit none + class(VoidEventHandlerCollection), intent(inout) :: this + integer :: i + do i=1, size(this%Delegates) + call this%Delegates(i)%Run() + end do + end subroutine + +end module CVoidEventHandlerCollection \ No newline at end of file diff --git a/CSharp/DownHole/CDownHole.f90 b/CSharp/DownHole/CDownHole.f90 new file mode 100644 index 0000000..b8cc7a8 --- /dev/null +++ b/CSharp/DownHole/CDownHole.f90 @@ -0,0 +1,278 @@ +module CDownHole + use CDownHoleVariables + implicit none + public + + !abstract interface + ! subroutine ActionFluid(array) + ! use CDownHoleVariables + ! type(CFluid), intent(inout), target :: array + ! end subroutine + !end interface + + contains + + + subroutine AnnalusDrillMud + !DEC$ ATTRIBUTES DLLEXPORT::AnnalusDrillMud + !DEC$ ATTRIBUTES ALIAS: 'AnnalusDrillMud' :: AnnalusDrillMud + implicit none + AnnDrillMud = .true. + end subroutine AnnalusDrillMud + + subroutine AnnalusCirculateMud + !DEC$ ATTRIBUTES DLLEXPORT::AnnalusCirculateMud + !DEC$ ATTRIBUTES ALIAS: 'AnnalusCirculateMud' :: AnnalusCirculateMud + implicit none + AnnCirculateMud = .true. + end subroutine AnnalusCirculateMud + + + !type(CFluid) function ActionFluid() !(array) + ! !use CDownHoleVariables + ! !integer, intent(in) :: count + ! !type(CFluid), intent(inout), target :: array !(count) + ! end function + + + integer function GetAnnalusFluidsCount() + !DEC$ ATTRIBUTES DLLEXPORT::GetAnnalusFluidsCount + !DEC$ ATTRIBUTES ALIAS: 'GetAnnalusFluidsCount' :: GetAnnalusFluidsCount + implicit none + GetAnnalusFluidsCount = size(AnnalusFluids) + !GetAnnalusFluidsCount = AnnalusFluidsCount + end function GetAnnalusFluidsCount + + subroutine GetAnnalusFluids(count, array) + !DEC$ ATTRIBUTES DLLEXPORT::GetAnnalusFluids + !DEC$ ATTRIBUTES ALIAS: 'GetAnnalusFluids' :: GetAnnalusFluids + implicit none + integer :: i + integer, intent(in) :: count + type(CFluid), intent(inout), target :: array(count) + type(CFluid), pointer :: item + if(.not.allocated(AnnalusFluids)) return + do i = 1, count + item => array(i) + item%StartMd = AnnalusFluids(i)%StartMd + item%EndMd = AnnalusFluids(i)%EndMd + item%Density = AnnalusFluids(i)%Density + item%MudType = AnnalusFluids(i)%MudType + end do + end subroutine GetAnnalusFluids + + + integer function GetStringFluidsCount() + !DEC$ ATTRIBUTES DLLEXPORT::GetStringFluidsCount + !DEC$ ATTRIBUTES ALIAS: 'GetStringFluidsCount' :: GetStringFluidsCount + implicit none + !GetStringFluidsCount = StringFluidsCount + GetStringFluidsCount = size(StringFluids) + end function GetStringFluidsCount + + subroutine GetStringFluids(count, array) + !DEC$ ATTRIBUTES DLLEXPORT::GetStringFluids + !DEC$ ATTRIBUTES ALIAS: 'GetStringFluids' :: GetStringFluids + implicit none + integer :: i + integer, intent(in) :: count + type(CFluid), intent(inout), target :: array(count) + type(CFluid), pointer :: item + if(.not.allocated(StringFluids)) return + do i = 1, count + item => array(i) + item%StartMd = StringFluids(i)%StartMd + item%EndMd = StringFluids(i)%EndMd + item%Density = StringFluids(i)%Density + item%MudType = StringFluids(i)%MudType + end do + end subroutine GetStringFluids + + + integer function GetStringCount() + !DEC$ ATTRIBUTES DLLEXPORT::GetStringCount + !DEC$ ATTRIBUTES ALIAS: 'GetStringCount' :: GetStringCount + implicit none + GetStringCount = StringCount + !GetStringCount = 4 + end function GetStringCount + + subroutine GetString(count, array) + !DEC$ ATTRIBUTES DLLEXPORT::GetString + !DEC$ ATTRIBUTES ALIAS: 'GetString' :: GetString + implicit none + integer :: i + integer, intent(in) :: count + type(CStringComponent), intent(inout), target :: array(count) + type(CStringComponent), pointer :: item + !do i = 1, count + ! item => array(i) + ! item%Length = String(i)%Length + ! item%TopDepth = String(i)%TopDepth + ! item%DownDepth = String(i)%DownDepth + ! item%Od = String(i)%Od + ! item%Id = String(i)%Id + ! item%ComponentType = String(i)%ComponentType + !end do + end subroutine GetString + + + + + + subroutine GetDownhole() + !DEC$ ATTRIBUTES DLLEXPORT::GetDownhole + !DEC$ ATTRIBUTES ALIAS: 'GetDownhole' :: GetDownhole + implicit none + + !BopElement + if(associated(BopElementsPtr)) call BopElementsPtr(BopElements) + + + !Annalus + if(associated(AnnalusMudCountPtr)) call AnnalusMudCountPtr(AnnalusFluidsCount) + if(associated(AnnalusMudArrayPtr)) call AnnalusMudArrayPtr(AnnalusFluids) + + + !string + if(associated(StringMudCountPtr)) call StringMudCountPtr(StringFluidsCount) + if(associated(StringMudArrayPtr)) call StringMudArrayPtr(StringFluids) + + + !components + if(associated(StringComponentCountPtr)) call StringComponentCountPtr(StringCount) + if(associated(StringComponentArrayPtr)) call StringComponentArrayPtr(String) + + + end subroutine GetDownhole + + + + + + + + + + + + + + + real(8) function GetDrillPipePressureH() + !DEC$ ATTRIBUTES DLLEXPORT :: GetDrillPipePressureH + !DEC$ ATTRIBUTES ALIAS: 'GetDrillPipePressureH' :: GetDrillPipePressureH + use PressureDisplayVARIABLES + implicit none + GetDrillPipePressureH = DrillPipePressure !real(PressureGauges(1), 8) ! + end function + + real(8) function GetCasingPressureH() + !DEC$ ATTRIBUTES DLLEXPORT :: GetCasingPressureH + !DEC$ ATTRIBUTES ALIAS: 'GetCasingPressureH' :: GetCasingPressureH + use FricPressDropVars + implicit none + !if (allocated(FinalFlowEl)) then + ! if(size(FinalFlowEl) > 0) then + ! CasingPressure = real(int(FinalFlowEl(AnnulusLastEl)%EndPress), 8) !CasingPressure + ! endif + !endif + GetCasingPressureH = CasingPressure + end function + + real(8) function GetShoePressure() + !DEC$ ATTRIBUTES DLLEXPORT :: GetShoePressure + !DEC$ ATTRIBUTES ALIAS: 'GetShoePressure' :: GetShoePressure + use PressureDisplayVARIABLES + implicit none + GetShoePressure = ShoePressure !real(PressureGauges(5), 8) ! + end function + + real(8) function GetBottomHolePressure() + !DEC$ ATTRIBUTES DLLEXPORT :: GetBottomHolePressure + !DEC$ ATTRIBUTES ALIAS: 'GetBottomHolePressure' :: GetBottomHolePressure + use PressureDisplayVARIABLES + implicit none + GetBottomHolePressure = BottomHolePressure !real(PressureGauges(3), 8) ! + end function + + real(8) function GetFormationPressure() + !DEC$ ATTRIBUTES DLLEXPORT :: GetFormationPressure + !DEC$ ATTRIBUTES ALIAS: 'GetFormationPressure' :: GetFormationPressure + implicit none + GetFormationPressure = FormationPressure + end function + + real function GetInfluxRate() + !DEC$ ATTRIBUTES DLLEXPORT :: GetInfluxRate + !DEC$ ATTRIBUTES ALIAS: 'GetInfluxRate' :: GetInfluxRate + implicit none + GetInfluxRate = InfluxRate + end function + + real function GetKickVolume() + !DEC$ ATTRIBUTES DLLEXPORT :: GetKickVolume + !DEC$ ATTRIBUTES ALIAS: 'GetKickVolume' :: GetKickVolume + implicit none + + !KickVolume = KickVolume + 1 + + GetKickVolume = KickVolume + end function + + real function GetSecondKickVolume() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSecondKickVolume + !DEC$ ATTRIBUTES ALIAS: 'GetSecondKickVolume' :: GetSecondKickVolume + implicit none + + !SecondKickVolume = SecondKickVolume + 1 + + GetSecondKickVolume = SecondKickVolume + end function + + real function GetPermeabilityExposedHeight() + !DEC$ ATTRIBUTES DLLEXPORT :: GetPermeabilityExposedHeight + !DEC$ ATTRIBUTES ALIAS: 'GetPermeabilityExposedHeight' :: GetPermeabilityExposedHeight + implicit none + GetPermeabilityExposedHeight = PermeabilityExposedHeight + end function + + + + real(8) function GetDensityH() + !DEC$ ATTRIBUTES DLLEXPORT :: GetDensityH + !DEC$ ATTRIBUTES ALIAS: 'GetDensityH' :: GetDensityH + implicit none + GetDensityH = Density + end function + + real(8) function GetPressureH() + !DEC$ ATTRIBUTES DLLEXPORT :: GetPressureH + !DEC$ ATTRIBUTES ALIAS: 'GetPressureH' :: GetPressureH + implicit none + GetPressureH = Pressure + end function + + real(8) function GetTemperatureH() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTemperatureH + !DEC$ ATTRIBUTES ALIAS: 'GetTemperatureH' :: GetTemperatureH + implicit none + GetTemperatureH = Temperature + end function + + + real(8) function GetHeightH() + !DEC$ ATTRIBUTES DLLEXPORT :: GetHeightH + !DEC$ ATTRIBUTES ALIAS: 'GetHeightH' :: GetHeightH + implicit none + GetHeightH = Height + end function + + real(8) function GetVolumeH() + !DEC$ ATTRIBUTES DLLEXPORT :: GetVolumeH + !DEC$ ATTRIBUTES ALIAS: 'GetVolumeH' :: GetVolumeH + implicit none + GetVolumeH = Volume + end function + +end module CDownHole \ No newline at end of file diff --git a/CSharp/DownHole/CDownHoleActions.f90 b/CSharp/DownHole/CDownHoleActions.f90 new file mode 100644 index 0000000..e9063b7 --- /dev/null +++ b/CSharp/DownHole/CDownHoleActions.f90 @@ -0,0 +1,105 @@ +module CDownHoleActions + use CIActionReference + implicit none + public + + abstract interface + subroutine ActionFluid(array) + use CDownHoleTypes + type(CFluid), allocatable, intent(in), target :: array(:) + end subroutine + + subroutine ActionComponent(array) + use CDownHoleTypes + type(CStringComponent), allocatable, intent(in), target :: array(:) + end subroutine + + subroutine ActionBopElement(array) + use CDownHoleTypes + type(CBopElement), allocatable, intent(in), target :: array(:) + end subroutine + end interface + + procedure (ActionInteger), pointer :: AnnalusMudCountPtr + procedure (ActionFluid), pointer :: AnnalusMudArrayPtr + + procedure (ActionInteger), pointer :: StringMudCountPtr + procedure (ActionFluid), pointer :: StringMudArrayPtr + + procedure (ActionInteger), pointer :: StringComponentCountPtr + procedure (ActionComponent), pointer :: StringComponentArrayPtr + + procedure (ActionBopElement), pointer :: BopElementsPtr + + contains + + subroutine SubscribeAnnalusMudCount(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeAnnalusMudCount + !DEC$ ATTRIBUTES ALIAS: 'SubscribeAnnalusMudCount' :: SubscribeAnnalusMudCount + implicit none + procedure (ActionInteger) :: a + AnnalusMudCountPtr => a + end subroutine + + subroutine SubscribeAnnalusMudArray(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeAnnalusMudArray + !DEC$ ATTRIBUTES ALIAS: 'SubscribeAnnalusMudArray' :: SubscribeAnnalusMudArray + implicit none + procedure (ActionFluid) :: a + AnnalusMudArrayPtr => a + end subroutine + + + + + + + + + subroutine SubscribeStringMudCount(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeStringMudCount + !DEC$ ATTRIBUTES ALIAS: 'SubscribeStringMudCount' :: SubscribeStringMudCount + implicit none + procedure (ActionInteger) :: a + StringMudCountPtr => a + end subroutine + + subroutine SubscribeStringMudArray(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeStringMudArray + !DEC$ ATTRIBUTES ALIAS: 'SubscribeStringMudArray' :: SubscribeStringMudArray + implicit none + procedure (ActionFluid) :: a + StringMudArrayPtr => a + end subroutine + + + + + + + subroutine SubscribeStringComponentCount(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeStringComponentCount + !DEC$ ATTRIBUTES ALIAS: 'SubscribeStringComponentCount' :: SubscribeStringComponentCount + implicit none + procedure (ActionInteger) :: a + StringComponentCountPtr => a + end subroutine + + subroutine SubscribeStringComponentArray(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeStringComponentArray + !DEC$ ATTRIBUTES ALIAS: 'SubscribeStringComponentArray' :: SubscribeStringComponentArray + implicit none + procedure (ActionComponent) :: a + StringComponentArrayPtr => a + end subroutine + + + subroutine SubscribeBopElements(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeBopElements + !DEC$ ATTRIBUTES ALIAS: 'SubscribeBopElements' :: SubscribeBopElements + implicit none + procedure (ActionBopElement) :: a + BopElementsPtr => a + end subroutine + +end module CDownHoleActions \ No newline at end of file diff --git a/CSharp/DownHole/CDownHoleTypes.f90 b/CSharp/DownHole/CDownHoleTypes.f90 new file mode 100644 index 0000000..078b046 --- /dev/null +++ b/CSharp/DownHole/CDownHoleTypes.f90 @@ -0,0 +1,52 @@ +module CDownHoleTypes + implicit none + public + + !enums + enum, bind(c) + enumerator STRING_BIT !0 + enumerator STRING_STABILIZER !1 + enumerator STRING_COLLAR !2 + enumerator STRING_DRILLPIPE !3 + enumerator STRING_HEAVYWEIGHT !4 + end enum + + enum, bind(c) + enumerator FLUID_NORMAL_MUD !0 + enumerator FLUID_GAS_KICK !1 + enumerator FLUID_WATER_KICK !2 + enumerator FLUID_OIL_KICK !3 + enumerator FLUID_NO_MUD !4 + end enum + + ! new types + type, bind(c), public :: CFluid + real(8) :: StartMd + real(8) :: EndMd + real(8) :: Density + integer :: MudType + end type CFluid + + type, bind(c), public :: CStringComponents + real(8) :: Length + real(8) :: TopDepth + real(8) :: DownDepth + real(8) :: Od + real(8) :: Id + integer :: ComponentType + end type CStringComponents + + type, bind(c), public :: CStringComponent + real(8) :: StartMd + real(8) :: EndMd + integer :: ComponentType + end type CStringComponent + + type, bind(c), public :: CBopElement + integer :: ElementType + real :: ElementStart + real :: ElementEnd + end type CBopElement + + contains +end module CDownHoleTypes \ No newline at end of file diff --git a/CSharp/DownHole/CDownHoleVariables.f90 b/CSharp/DownHole/CDownHoleVariables.f90 new file mode 100644 index 0000000..fd16d14 --- /dev/null +++ b/CSharp/DownHole/CDownHoleVariables.f90 @@ -0,0 +1,292 @@ +module CDownHoleVariables + use CDownHoleTypes + use CStringConfigurationVariables + use CDownHoleActions + use CLog4 + implicit none + public + + logical :: AnnDrillMud + logical :: AnnCirculateMud + + integer :: AnnalusFluidsCount = 0 + integer :: StringFluidsCount = 0 + type(CFluid), allocatable, target :: AnnalusFluids(:) + type(CFluid), allocatable :: StringFluids(:) + + integer :: StringCount = 0 + type(CStringComponent), allocatable :: String(:) + + type(CBopElement), allocatable :: BopElements(:) + + real(8) :: DrillPipePressure + real(8) :: CasingPressure + real(8) :: ShoePressure + real(8) :: BottomHolePressure + real(8) :: FormationPressure + real :: InfluxRate + real :: KickVolume + real :: SecondKickVolume + real :: PermeabilityExposedHeight + + real(8) :: Density + real(8) :: Pressure + real(8) :: Temperature + real(8) :: Height + real(8) :: Volume + + contains + + subroutine SetAnnalusFluids(count, array) + implicit none + integer, intent(in) :: count + integer :: i, offset + type(CFluid), intent(inout), target :: array(count) + type(CFluid), pointer :: item + AnnalusFluidsCount = count + print*, 'AnnalusFluidsCount = ', count + if(size(AnnalusFluids) > 0) then + deallocate(AnnalusFluids) + end if + if(count > 0) then + offset = 0; + item => array(1) + if(item%StartMd > 0) then + AnnalusFluidsCount = AnnalusFluidsCount + 1 + offset = 1; + allocate(AnnalusFluids(AnnalusFluidsCount)) + AnnalusFluids(1)%StartMd = 0 + AnnalusFluids(1)%EndMd = item%StartMd + AnnalusFluids(1)%Density = 0 + AnnalusFluids(1)%MudType = FLUID_NO_MUD + endif + + !if(associated(AnnalusMudCountPtr)) then + ! call AnnalusMudCountPtr(AnnalusFluidsCount) + !end if + if(.not.allocated(AnnalusFluids))allocate(AnnalusFluids(AnnalusFluidsCount)) + !print*, '============START-AN============' + if(item%StartMd < 0) AnnalusFluids(1)%StartMd = 0 + do i = 1, count + item => array(i) + AnnalusFluids(i + offset)%StartMd = item%StartMd + if(i==1) AnnalusFluids(i)%StartMd = 0 + !print*, 'AnnalusFluids(',i,')%StartMd=', AnnalusFluids(i)%StartMd + AnnalusFluids(i + offset)%EndMd = item%EndMd + !print*, 'AnnalusFluids(',i,')%EndMd=', AnnalusFluids(i)%EndMd + AnnalusFluids(i + offset)%Density = item%Density + !print*, 'AnnalusFluids(',i,')%Density=', AnnalusFluids(i)%Density + AnnalusFluids(i + offset)%MudType = item%MudType + !print*, 'AnnalusFluids(',i,')%MudType=', AnnalusFluids(i)%MudType + !print*, '----------------------------' + end do + !print*, '============END-AN============' + !if(associated(AnnalusMudArrayPtr)) then + ! !AnnalusFluidsPtr => AnnalusFluids + ! call AnnalusMudArrayPtr(AnnalusFluids) + !end if + end if + end subroutine SetAnnalusFluids + + subroutine SetStringFluids(count, array) + implicit none + integer, intent(in) :: count + integer :: i, offset !, startArr + type(CFluid), intent(inout), target :: array(count) + type(CFluid), pointer :: item + StringFluidsCount = count + print*, 'StringFluidsCount = ', count + if(size(StringFluids) > 0) then + deallocate(StringFluids) + end if + + !startArr = 1 + + if(count > 0) then + offset = 0; + item => array(1) + ! + !if(item%StartMd <= 0 .and. item%EndMd <= 0) then + ! StringFluidsCount = StringFluidsCount - 1 + ! count = count - 1 + ! offset = offset + 1 + ! startArr = startArr + 1 + !endif + ! + !if(count <= 0) return + + if(item%StartMd > 0) then + StringFluidsCount = StringFluidsCount + 1 + offset = offset + 1 + allocate(StringFluids(StringFluidsCount)) + StringFluids(1)%StartMd = 0 + StringFluids(1)%EndMd = item%StartMd + StringFluids(1)%Density = 0 + StringFluids(1)%MudType = FLUID_NO_MUD + endif + + !if(associated(StringMudCountPtr)) then + ! call StringMudCountPtr(count) + !end if + if(.not.allocated(StringFluids))allocate(StringFluids(StringFluidsCount)) + !print*, '============START-ST============' + !print*, 'count=', count + do i = 1, count + item => array(i) + StringFluids(i + offset)%StartMd = item%StartMd + if(i==1) StringFluids(i)%StartMd = 0 + !print*, 'StringFluids(i)%StartMd=', StringFluids(i)%StartMd + StringFluids(i + offset)%EndMd = item%EndMd + !print*, 'StringFluids(i)%EndMd=', StringFluids(i)%EndMd + StringFluids(i + offset)%Density = item%Density + StringFluids(i + offset)%MudType = item%MudType + !print*, '----------------------------' + end do + !!if(item%StartMd < 0) StringFluids(1)%StartMd = 0 + !!print*, '============END-ST============' + !if(associated(StringMudArrayPtr)) then + ! call StringMudArrayPtr(StringFluids) + !end if + end if + end subroutine SetStringFluids + + subroutine SetString(count, array) + use CLog3 + implicit none + integer, intent(in) :: count + integer :: i !, j + type(CStringComponents), intent(inout), target :: array(count) + type(CStringComponents), pointer :: item + StringCount = count + if(size(String) > 0) then + deallocate(String) + end if + if(count > 0) then + !if(associated(StringComponentCountPtr)) then + ! call StringComponentCountPtr(count) + !end if + allocate(String(count)) + !j = 0 + !print*, '============CMP-ST============' + !call Log_3( '============CMP-ST============') + !do i = count, 1, -1 + do i = 1, count + item => array(i) + !String(i)%Length = item%Length + !String(i)%TopDepth = item%TopDepth + !String(i)%DownDepth = item%DownDepth + !String(i)%Od = item%Od + !String(i)%Id = item%Id + String(i)%ComponentType= item%ComponentType + !j = j + 1 + String(i)%StartMd = item%TopDepth + String(i)%EndMd = item%DownDepth + + String(i)%ComponentType=0 + !if(item%ComponentType > 4 ) then + ! String(i)%ComponentType=0 + ! String(i)%StartMd = 0 + !endif + if(item%ComponentType == 3) String(i)%ComponentType=0 + if(item%ComponentType == 4) String(i)%ComponentType=1 + if(item%ComponentType == 2) String(i)%ComponentType=2 + if(item%ComponentType == 1) String(i)%ComponentType=3 + !print*, 'item%ComponentType=', item%ComponentType + !print*, 'String(i)%ComponentType=', String(i)%ComponentType + !print*, 'String(i)%StartMd=', String(i)%StartMd + !print*, 'String(i)%EndMd=', String(i)%EndMd + !print*, '----------------------------' + + !call Log_3( 'item%ComponentType=', item%ComponentType) + !call Log_3( 'String(i)%ComponentType=', String(i)%ComponentType) + !call Log_3( 'String(i)%StartMd=', String(i)%StartMd) + !call Log_3( 'String(i)%EndMd=', String(i)%EndMd) + !call Log_3( '----------------------------') + + end do + !!print*, '============CMP-ST============' + !!call Log_3( '============CMP-ST============') + !if(associated(StringComponentArrayPtr)) then + ! call StringComponentArrayPtr(String) + !end if + end if + end subroutine SetString + + subroutine SetBopElements(array) + use CLog4 + implicit none + integer, parameter :: count = 4 + integer :: i = 1 !, j + type(CBopElement), intent(inout), target :: array(count) + type(CBopElement), pointer :: item + if(size(BopElements) > 0) deallocate(BopElements) + allocate(BopElements(count)) + + do i = 1, count + item => array(i) + !call Log_4('item%ElementStart', item%ElementStart) + !call Log_4('item%ElementEnd', item%ElementEnd) + !call Log_4('item%ElementType', item%ElementType) + !call Log_4('=====================================================') + + BopElements(i)%ElementStart = item%ElementStart + BopElements(i)%ElementEnd = item%ElementEnd + BopElements(i)%ElementType = item%ElementType + end do + + !if(associated(BopElementsPtr)) call BopElementsPtr(BopElements) + end subroutine SetBopElements + + subroutine GetAnnalusFluidInfo(md) + !DEC$ ATTRIBUTES DLLEXPORT::GetAnnalusFluidInfo + !DEC$ ATTRIBUTES ALIAS: 'GetAnnalusFluidInfo' :: GetAnnalusFluidInfo + !use ElementFinderVars + implicit none + integer, intent(in) :: md + + call AnnulusPropertyCalculator(md, Density, Pressure, Temperature) + + !ObservationPoint(2)%MeasureDepth = md + + !Density = md + Density - 10 + !Pressure = md + Pressure - 20 + !Temperature = md + Temperature - 30 + !Height = Height * 100.0 + !Volume = Volume * 200.0 + ! + !call Log_4('GetAnnalusFluidInfo=', md) + !call Log_4('A_Height=', Height) + !call Log_4('A_Volume=', Volume) + +#ifdef deb + print*, 'GetAnnalusFluidInfo=', md +#endif + + end subroutine GetAnnalusFluidInfo + + subroutine GetStringFluidInfo(md) + !DEC$ ATTRIBUTES DLLEXPORT::GetStringFluidInfo + !DEC$ ATTRIBUTES ALIAS: 'GetStringFluidInfo' :: GetStringFluidInfo + implicit none + integer, intent(in) :: md + + call StringPropertyCalculator(md, Density, Pressure, Temperature) + + !ObservationPoint(1)%MeasureDepth = md + + !Density = md + Density + 100 + !Pressure = md + Pressure + 200 + !Temperature = md + Temperature + 300 + !Height = Height * 100.0 + !Volume = Volume * 200.0 + ! + !call Log_4('GetStringFluidInfo=', md) + !call Log_4('S_Height=', Height) + !call Log_4('S_Volume=', Volume) + +#ifdef deb + print*, 'GetStringFluidInfo=', md +#endif + end subroutine GetStringFluidInfo + +end module CDownHoleVariables \ No newline at end of file diff --git a/CSharp/Equipments/ControlPanels/CBopControlPanel.f90 b/CSharp/Equipments/ControlPanels/CBopControlPanel.f90 new file mode 100644 index 0000000..56077c2 --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CBopControlPanel.f90 @@ -0,0 +1,250 @@ +module CBopControlPanel + use CBopControlPanelVariables + implicit none + public + contains + + ! Input routines + subroutine SetAnnularRegulatorSetControl(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAnnularRegulatorSetControl + !DEC$ ATTRIBUTES ALIAS: 'SetAnnularRegulatorSetControl' :: SetAnnularRegulatorSetControl + implicit none + real*8, intent(in) :: v + AnnularRegulatorSetControl = v +#ifdef deb + print*, 'AnnularRegulatorSetControl=', AnnularRegulatorSetControl +#endif + end subroutine + + subroutine SetAirMasterValve(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAirMasterValve + !DEC$ ATTRIBUTES ALIAS: 'SetAirMasterValve' :: SetAirMasterValve + implicit none + real*8, intent(in) :: v + AirMasterValve = v +#ifdef deb + print*, 'AirMasterValve=', AirMasterValve +#endif + end subroutine + + subroutine SetByePassValve(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetByePassValve + !DEC$ ATTRIBUTES ALIAS: 'SetByePassValve' :: SetByePassValve + implicit none + real*8, intent(in) :: v + ByePassValve = v +#ifdef deb + print*, 'ByePassValve=', ByePassValve +#endif + end subroutine + + subroutine SetAnnularValve(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAnnularValve + !DEC$ ATTRIBUTES ALIAS: 'SetAnnularValve' :: SetAnnularValve + implicit none + real*8, intent(in) :: v + AnnularValve = v +#ifdef deb + print*, 'AnnularValve=', AnnularValve +#endif + end subroutine + + subroutine SetUpperRamsValve(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetUpperRamsValve + !DEC$ ATTRIBUTES ALIAS: 'SetUpperRamsValve' :: SetUpperRamsValve + implicit none + real*8, intent(in) :: v + UpperRamsValve = v +#ifdef deb + print*, 'UpperRamsValve=', UpperRamsValve +#endif + end subroutine + + subroutine SetMiddleRamsValve(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMiddleRamsValve + !DEC$ ATTRIBUTES ALIAS: 'SetMiddleRamsValve' :: SetMiddleRamsValve + implicit none + real*8, intent(in) :: v + MiddleRamsValve = v +#ifdef deb + print*, 'MiddleRamsValve=', MiddleRamsValve +#endif + end subroutine + + subroutine SetKillLineValve(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetKillLineValve + !DEC$ ATTRIBUTES ALIAS: 'SetKillLineValve' :: SetKillLineValve + implicit none + real*8, intent(in) :: v + KillLineValve = v +#ifdef deb + print*, 'KillLineValve=', KillLineValve +#endif + end subroutine + + subroutine SetChokeLineValve(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeLineValve + !DEC$ ATTRIBUTES ALIAS: 'SetChokeLineValve' :: SetChokeLineValve + implicit none + real*8, intent(in) :: v + ChokeLineValve = v +#ifdef deb + print*, 'ChokeLineValve=', ChokeLineValve +#endif + end subroutine + + subroutine SetLowerRamsValve(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLowerRamsValve + !DEC$ ATTRIBUTES ALIAS: 'SetLowerRamsValve' :: SetLowerRamsValve + implicit none + real*8, intent(in) :: v + LowerRamsValve = v +#ifdef deb + print*, 'LowerRamsValve=', LowerRamsValve +#endif + end subroutine + + + ! Output routines + real(8) function GetManifoldPressureGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetManifoldPressureGauge + !DEC$ ATTRIBUTES ALIAS: 'GetManifoldPressureGauge' :: GetManifoldPressureGauge + implicit none + GetManifoldPressureGauge = ManifoldPressureGauge + end function + + real(8) function GetAirSupplyPressureGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetAirSupplyPressureGauge + !DEC$ ATTRIBUTES ALIAS: 'GetAirSupplyPressureGauge' :: GetAirSupplyPressureGauge + implicit none + GetAirSupplyPressureGauge = AirSupplyPressureGauge + end function + + real(8) function GetAccumulatorPressureGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetAccumulatorPressureGauge + !DEC$ ATTRIBUTES ALIAS: 'GetAccumulatorPressureGauge' :: GetAccumulatorPressureGauge + implicit none + GetAccumulatorPressureGauge = AccumulatorPressureGauge + !GetAccumulatorPressureGauge = 2000.0d0 + end function + + real(8) function GetAnnularPressureGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetAnnularPressureGauge + !DEC$ ATTRIBUTES ALIAS: 'GetAnnularPressureGauge' :: GetAnnularPressureGauge + implicit none + GetAnnularPressureGauge = AnnularPressureGauge + end function + + integer function GetAnnularOpenLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetAnnularOpenLED + !DEC$ ATTRIBUTES ALIAS: 'GetAnnularOpenLED' :: GetAnnularOpenLED + implicit none + GetAnnularOpenLED = AnnularOpenLED + end function + + integer function GetAnnularCloseLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetAnnularCloseLED + !DEC$ ATTRIBUTES ALIAS: 'GetAnnularCloseLED' :: GetAnnularCloseLED + implicit none + GetAnnularCloseLED = AnnularCloseLED + end function + + integer function GetUpperRamsOpenLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetUpperRamsOpenLED + !DEC$ ATTRIBUTES ALIAS: 'GetUpperRamsOpenLED' :: GetUpperRamsOpenLED + implicit none + GetUpperRamsOpenLED = UpperRamsOpenLED + end function + + integer function GetUpperRamsCloseLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetUpperRamsCloseLED + !DEC$ ATTRIBUTES ALIAS: 'GetUpperRamsCloseLED' :: GetUpperRamsCloseLED + implicit none + GetUpperRamsCloseLED = UpperRamsCloseLED + end function + + integer function GetMiddleRamsOpenLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMiddleRamsOpenLED + !DEC$ ATTRIBUTES ALIAS: 'GetMiddleRamsOpenLED' :: GetMiddleRamsOpenLED + implicit none + GetMiddleRamsOpenLED = MiddleRamsOpenLED + end function + + integer function GetMiddleRamsCloseLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMiddleRamsCloseLED + !DEC$ ATTRIBUTES ALIAS: 'GetMiddleRamsCloseLED' :: GetMiddleRamsCloseLED + implicit none + GetMiddleRamsCloseLED = MiddleRamsCloseLED + end function + + integer function GetKillLineOpenLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetKillLineOpenLED + !DEC$ ATTRIBUTES ALIAS: 'GetKillLineOpenLED' :: GetKillLineOpenLED + implicit none + GetKillLineOpenLED = KillLineOpenLED + end function + + integer function GetKillLineCloseLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetKillLineCloseLED + !DEC$ ATTRIBUTES ALIAS: 'GetKillLineCloseLED' :: GetKillLineCloseLED + implicit none + GetKillLineCloseLED = KillLineCloseLED + end function + + integer function GetChokeLineOpenLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetChokeLineOpenLED + !DEC$ ATTRIBUTES ALIAS: 'GetChokeLineOpenLED' :: GetChokeLineOpenLED + implicit none + GetChokeLineOpenLED = ChokeLineOpenLED + end function + + integer function GetChokeLineCloseLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetChokeLineCloseLED + !DEC$ ATTRIBUTES ALIAS: 'GetChokeLineCloseLED' :: GetChokeLineCloseLED + implicit none + GetChokeLineCloseLED = ChokeLineCloseLED + end function + + integer function GetLowerRamsOpenLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetLowerRamsOpenLED + !DEC$ ATTRIBUTES ALIAS: 'GetLowerRamsOpenLED' :: GetLowerRamsOpenLED + implicit none + GetLowerRamsOpenLED = LowerRamsOpenLED + end function + + integer function GetLowerRamsCloseLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetLowerRamsCloseLED + !DEC$ ATTRIBUTES ALIAS: 'GetLowerRamsCloseLED' :: GetLowerRamsCloseLED + implicit none + GetLowerRamsCloseLED = LowerRamsCloseLED + end function + + real(8) function GetAnnularStatus() + !DEC$ ATTRIBUTES DLLEXPORT :: GetAnnularStatus + !DEC$ ATTRIBUTES ALIAS: 'GetAnnularStatus' :: GetAnnularStatus + implicit none + GetAnnularStatus = AnnularStatus + end function + + real(8) function GetUpperRamsStatus() + !DEC$ ATTRIBUTES DLLEXPORT :: GetUpperRamsStatus + !DEC$ ATTRIBUTES ALIAS: 'GetUpperRamsStatus' :: GetUpperRamsStatus + implicit none + GetUpperRamsStatus = UpperRamsStatus + end function + + real(8) function GetMiddleRamsStatus() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMiddleRamsStatus + !DEC$ ATTRIBUTES ALIAS: 'GetMiddleRamsStatus' :: GetMiddleRamsStatus + implicit none + GetMiddleRamsStatus = MiddleRamsStatus + end function + + real(8) function GetLowerRamsStatus() + !DEC$ ATTRIBUTES DLLEXPORT :: GetLowerRamsStatus + !DEC$ ATTRIBUTES ALIAS: 'GetLowerRamsStatus' :: GetLowerRamsStatus + implicit none + GetLowerRamsStatus = LowerRamsStatus + end function + + end module CBopControlPanel diff --git a/CSharp/Equipments/ControlPanels/CBopControlPanelVariables.f90 b/CSharp/Equipments/ControlPanels/CBopControlPanelVariables.f90 new file mode 100644 index 0000000..e1d2ef9 --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CBopControlPanelVariables.f90 @@ -0,0 +1,116 @@ +module CBopControlPanelVariables + implicit none + public + + ! Input vars + real(8) :: AnnularRegulatorSetControl + real(8) :: AirMasterValve + real(8) :: ByePassValve + real(8) :: AnnularValve + real(8) :: UpperRamsValve + real(8) :: MiddleRamsValve + real(8) :: KillLineValve + real(8) :: ChokeLineValve + real(8) :: LowerRamsValve + + ! Output vars + real(8) :: ManifoldPressureGauge + real(8) :: AirSupplyPressureGauge + real(8) :: AccumulatorPressureGauge + real(8) :: AnnularPressureGauge + integer :: AnnularOpenLED + integer :: AnnularCloseLED + integer :: UpperRamsOpenLED + integer :: UpperRamsCloseLED + integer :: MiddleRamsOpenLED + integer :: MiddleRamsCloseLED + integer :: KillLineOpenLED + integer :: KillLineCloseLED + integer :: ChokeLineOpenLED + integer :: ChokeLineCloseLED + integer :: LowerRamsOpenLED + integer :: LowerRamsCloseLED + real(8) :: AnnularStatus + real(8) :: UpperRamsStatus + real(8) :: MiddleRamsStatus + real(8) :: LowerRamsStatus + + contains + + subroutine OpenAnnular() + use CManifolds + implicit none + call ChangeValve(52, .true.) + end subroutine + + subroutine CloseAnnular() + use CManifolds + implicit none + call ChangeValve(52, .false.) + end subroutine + + subroutine OpenUpperRams() + use CManifolds + implicit none + call ChangeValve(51, .true.) + end subroutine + + subroutine CloseUpperRams() + use CManifolds + implicit none + call ChangeValve(51, .false.) + end subroutine + + subroutine OpenMiddleRams() + use CManifolds + implicit none + call ToggleMiddleRams(.true.) + end subroutine + + subroutine CloseMiddleRams() + use CManifolds + implicit none + call ToggleMiddleRams(.false.) + end subroutine + + subroutine OpenKillLine() + use CManifolds + implicit none + call ChangeValve(46, .true.) + end subroutine + + subroutine CloseKillLine() + use CManifolds + implicit none + call ChangeValve(46, .false.) + end subroutine + + subroutine OpenChokeLine() + use CManifolds + implicit none + call ChangeValve(47, .true.) + !WRITE (*,*) ' valve 47 true ' + end subroutine + + subroutine CloseChokeLine() + use CManifolds + implicit none + call ChangeValve(47, .false.) + !WRITE (*,*) ' valve 47 false ' + end subroutine + + subroutine OpenLowerRams() + use CManifolds + implicit none + call ChangeValve(49, .true.) + !WRITE (*,*) ' valve 49 true ' + end subroutine + + subroutine CloseLowerRams() + use CManifolds + implicit none + call ChangeValve(49, .false.) + !WRITE (*,*) ' valve 49 false ' + end subroutine + +end module CBopControlPanelVariables diff --git a/CSharp/Equipments/ControlPanels/CChokeControlPanel.f90 b/CSharp/Equipments/ControlPanels/CChokeControlPanel.f90 new file mode 100644 index 0000000..3238dc0 --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CChokeControlPanel.f90 @@ -0,0 +1,161 @@ +module CChokeControlPanel + use CChokeControlPanelVariables + implicit none + public + contains + + ! Input routines + subroutine SetChokePanelPumpSelectorSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokePanelPumpSelectorSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetChokePanelPumpSelectorSwitch' :: SetChokePanelPumpSelectorSwitch + implicit none + integer, intent(in) :: v + ChokePanelPumpSelectorSwitch = v +#ifdef deb + print*, 'ChokePanelPumpSelectorSwitch=', ChokePanelPumpSelectorSwitch +#endif + end subroutine + + subroutine SetChokePanelStrokeResetSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokePanelStrokeResetSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetChokePanelStrokeResetSwitch' :: SetChokePanelStrokeResetSwitch + implicit none + logical, intent(in) :: v + ChokePanelStrokeResetSwitch = v +#ifdef deb + print*, 'ChokePanelStrokeResetSwitch=', ChokePanelStrokeResetSwitch +#endif + end subroutine + + subroutine SetChokeSelectorSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeSelectorSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetChokeSelectorSwitch' :: SetChokeSelectorSwitch + implicit none + logical, intent(in) :: v + ChokeSelectorSwitch = v +#ifdef deb + print*, 'ChokeSelectorSwitch=', ChokeSelectorSwitch +#endif + end subroutine + + subroutine SetChokeRateControlKnob(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeRateControlKnob + !DEC$ ATTRIBUTES ALIAS: 'SetChokeRateControlKnob' :: SetChokeRateControlKnob + implicit none + real*8, intent(in) :: v + + !character(8) :: date + !character(10) :: time + !character(5) :: zone + !integer,dimension(8) :: values + + ChokeRateControlKnob = v +#ifdef deb + !call date_and_time(date,time,zone,values) + !!print '(a,2x,a,2x,a)', date, time, zone + !print '(8i5)', values + print*, 'ChokeRateControlKnob=', ChokeRateControlKnob +#endif + end subroutine + + subroutine SetChokeControlLever(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeControlLever + !DEC$ ATTRIBUTES ALIAS: 'SetChokeControlLever' :: SetChokeControlLever + implicit none + real*8, intent(in) :: v + ChokeControlLever = v +#ifdef deb + print*, 'ChokeControlLever=', ChokeControlLever +#endif + end subroutine + + subroutine SetChokePanelRigAirSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokePanelRigAirSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetChokePanelRigAirSwitch' :: SetChokePanelRigAirSwitch + implicit none + logical, intent(in) :: v + ChokePanelRigAirSwitch = v +#ifdef deb + print*, 'ChokePanelRigAirSwitch=', ChokePanelRigAirSwitch +#endif + end subroutine + + + subroutine SetEnableAutoChoke(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetEnableAutoChoke + !DEC$ ATTRIBUTES ALIAS: 'SetEnableAutoChoke' :: SetEnableAutoChoke + implicit none + logical, intent(in) :: v + EnableAutoChoke = v +#ifdef deb + print*, 'EnableAutoChoke=', EnableAutoChoke +#endif + end subroutine + + + + + + + + + + + + + ! Output routines + real(8) function GetStandPipePressure() + !DEC$ ATTRIBUTES DLLEXPORT :: GetStandPipePressure + !DEC$ ATTRIBUTES ALIAS: 'GetStandPipePressure' :: GetStandPipePressure + implicit none + GetStandPipePressure = StandPipePressure + end function + + real(8) function GetCasingPressure() + !DEC$ ATTRIBUTES DLLEXPORT :: GetCasingPressure + !DEC$ ATTRIBUTES ALIAS: 'GetCasingPressure' :: GetCasingPressure + implicit none + GetCasingPressure = CasingPressure + end function + + real(8) function GetChokePosition() + !DEC$ ATTRIBUTES DLLEXPORT :: GetChokePosition + !DEC$ ATTRIBUTES ALIAS: 'GetChokePosition' :: GetChokePosition + implicit none + GetChokePosition = ChokePosition + end function + + real(8) function GetChokePanelSPMCounter() + !DEC$ ATTRIBUTES DLLEXPORT :: GetChokePanelSPMCounter + !DEC$ ATTRIBUTES ALIAS: 'GetChokePanelSPMCounter' :: GetChokePanelSPMCounter + implicit none + !GetChokePanelSPMCounter = 0 + GetChokePanelSPMCounter = ChokePanelSPMCounter + end function + + real(8) function GetChokePanelTotalStrokeCounter() + !DEC$ ATTRIBUTES DLLEXPORT :: GetChokePanelTotalStrokeCounter + !DEC$ ATTRIBUTES ALIAS: 'GetChokePanelTotalStrokeCounter' :: GetChokePanelTotalStrokeCounter + implicit none + !GetChokePanelTotalStrokeCounter = 0 + GetChokePanelTotalStrokeCounter = ChokePanelTotalStrokeCounter + end function + + integer function GetChoke1LED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetChoke1LED + !DEC$ ATTRIBUTES ALIAS: 'GetChoke1LED' :: GetChoke1LED + implicit none + GetChoke1LED = Choke1LED + end function + + integer function GetChoke2LED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetChoke2LED + !DEC$ ATTRIBUTES ALIAS: 'GetChoke2LED' :: GetChoke2LED + implicit none + GetChoke2LED = Choke2LED + end function + + + + +end module CChokeControlPanel \ No newline at end of file diff --git a/CSharp/Equipments/ControlPanels/CChokeControlPanelVariables.f90 b/CSharp/Equipments/ControlPanels/CChokeControlPanelVariables.f90 new file mode 100644 index 0000000..9f60359 --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CChokeControlPanelVariables.f90 @@ -0,0 +1,25 @@ +module CChokeControlPanelVariables + implicit none + public + + ! Input vars + integer :: ChokePanelPumpSelectorSwitch + logical :: ChokePanelStrokeResetSwitch + logical :: ChokeSelectorSwitch + real(8) :: ChokeRateControlKnob + real(8) :: ChokeControlLever + logical :: ChokePanelRigAirSwitch + + logical :: EnableAutoChoke + + ! Output vars + real(8) :: StandPipePressure + real(8) :: CasingPressure + real(8) :: ChokePosition + real(8) :: ChokePanelSPMCounter + real(8) :: ChokePanelTotalStrokeCounter + integer :: Choke1LED + integer :: Choke2LED + + contains +end module CChokeControlPanelVariables \ No newline at end of file diff --git a/CSharp/Equipments/ControlPanels/CChokeManifold.f90 b/CSharp/Equipments/ControlPanels/CChokeManifold.f90 new file mode 100644 index 0000000..0c4bd3a --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CChokeManifold.f90 @@ -0,0 +1,212 @@ +module CChokeManifold + use CChokeManifoldVariables + use CLog2 + implicit none + public + contains + + ! Input routines + subroutine SetChokeManifoldValve1(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeManifoldValve1 + !DEC$ ATTRIBUTES ALIAS: 'SetChokeManifoldValve1' :: SetChokeManifoldValve1 + implicit none + logical, intent(in) :: v + ChokeManifoldValve1 = v + call ChangeValve(61, v) +#ifdef deb + !print*, 'ChokeManifoldValve1=', ChokeManifoldValve1 +#endif + end subroutine + + subroutine SetChokeManifoldValve2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeManifoldValve2 + !DEC$ ATTRIBUTES ALIAS: 'SetChokeManifoldValve2' :: SetChokeManifoldValve2 + implicit none + logical, intent(in) :: v + ChokeManifoldValve2 = v + call ChangeValve(64, v) +#ifdef deb + !print*, 'ChokeManifoldValve2=', ChokeManifoldValve2 +#endif + end subroutine + + subroutine SetLeftManualChoke(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLeftManualChoke + !DEC$ ATTRIBUTES ALIAS: 'SetLeftManualChoke' :: SetLeftManualChoke + implicit none + real*8, intent(in) :: v + !LeftManualChoke = abs(v-100) + LeftManualChoke = v + if(LeftManChokeOnProblem) then + call ChangeValve(32, .true.) + else + if(LeftManualChoke > 99.9) then + !call Log_2( 'valve 32 is closed=', LeftManualChoke) + call ChangeValve(32, .false.) + else + !call Log_2( 'valve 32 is open=', LeftManualChoke) + call ChangeValve(32, .true.) + endif + endif +#ifdef deb + !print*, 'LeftManualChoke=', LeftManualChoke +#endif + end subroutine + + subroutine SetChokeManifoldValve4(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeManifoldValve4 + !DEC$ ATTRIBUTES ALIAS: 'SetChokeManifoldValve4' :: SetChokeManifoldValve4 + implicit none + logical, intent(in) :: v + ChokeManifoldValve4 = v + call ChangeValve(62, v) + !WRITE (*,*) ' valve 62 ', v +#ifdef deb + !print*, 'ChokeManifoldValve4=', ChokeManifoldValve4 +#endif + end subroutine + + subroutine SetChokeManifoldValve5(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeManifoldValve5 + !DEC$ ATTRIBUTES ALIAS: 'SetChokeManifoldValve5' :: SetChokeManifoldValve5 + implicit none + logical, intent(in) :: v + ChokeManifoldValve5 = v + call ChangeValve(63, v) + !WRITE (*,*) ' valve 63 ', v +#ifdef deb + !print*, 'ChokeManifoldValve5=', ChokeManifoldValve5 +#endif + end subroutine + + subroutine SetRightManualChoke(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRightManualChoke + !DEC$ ATTRIBUTES ALIAS: 'SetRightManualChoke' :: SetRightManualChoke + implicit none + real*8, intent(in) :: v + !RightManualChoke = abs(v -100) + RightManualChoke = v + if(RightManChokeOnProblem) then + call ChangeValve(35, .true.) + else + if(RightManualChoke > 99.9) then + !call Log_2( 'valve 35 is closed=', RightManualChoke) + call ChangeValve(35, .false.) + else + !call Log_2( 'valve 35 is open=', RightManualChoke) + call ChangeValve(35, .true.) + endif + endif +#ifdef deb + !print*, 'RightManualChoke=', RightManualChoke +#endif + end subroutine + + subroutine SetChokeManifoldValve7(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeManifoldValve7 + !DEC$ ATTRIBUTES ALIAS: 'SetChokeManifoldValve7' :: SetChokeManifoldValve7 + implicit none + logical, intent(in) :: v + ChokeManifoldValve7 = v + call ChangeValve(27, v) +#ifdef deb + !print*, 'ChokeManifoldValve7=', ChokeManifoldValve7 +#endif + end subroutine + + subroutine SetChokeManifoldValve8(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeManifoldValve8 + !DEC$ ATTRIBUTES ALIAS: 'SetChokeManifoldValve8' :: SetChokeManifoldValve8 + implicit none + logical, intent(in) :: v + ChokeManifoldValve8 = v + call ChangeValve(28, v) + !WRITE (*,*) ' valve 28 ', v +#ifdef deb + !print*, 'ChokeManifoldValve8=', ChokeManifoldValve8 +#endif + end subroutine + + subroutine SetChokeManifoldValve9(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeManifoldValve9 + !DEC$ ATTRIBUTES ALIAS: 'SetChokeManifoldValve9' :: SetChokeManifoldValve9 + implicit none + logical, intent(in) :: v + ChokeManifoldValve9 = v + call ChangeValve(29, v) +#ifdef deb + !print*, 'ChokeManifoldValve9=', ChokeManifoldValve9 +#endif + end subroutine + + subroutine SetChokeManifoldValve10(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeManifoldValve10 + !DEC$ ATTRIBUTES ALIAS: 'SetChokeManifoldValve10' :: SetChokeManifoldValve10 + implicit none + logical, intent(in) :: v + ChokeManifoldValve10 = v + call ChangeValve(30, v) + !WRITE (*,*) ' valve 30 ', v +#ifdef deb + !print*, 'ChokeManifoldValve10=', ChokeManifoldValve10 +#endif + end subroutine + + subroutine SetChokeManifoldValve11(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeManifoldValve11 + !DEC$ ATTRIBUTES ALIAS: 'SetChokeManifoldValve11' :: SetChokeManifoldValve11 + implicit none + logical, intent(in) :: v + ChokeManifoldValve11 = v + call ChangeValve(31, v) +#ifdef deb + !print*, 'ChokeManifoldValve11=', ChokeManifoldValve11 +#endif + end subroutine + + subroutine SetChokeManifoldValve12(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeManifoldValve12 + !DEC$ ATTRIBUTES ALIAS: 'SetChokeManifoldValve12' :: SetChokeManifoldValve12 + implicit none + logical, intent(in) :: v + ChokeManifoldValve12 = v + call ChangeValve(25, v) +#ifdef deb + !print*, 'ChokeManifoldValve12=', ChokeManifoldValve12 +#endif + end subroutine + + subroutine SetChokeManifoldValve13(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokeManifoldValve13 + !DEC$ ATTRIBUTES ALIAS: 'SetChokeManifoldValve13' :: SetChokeManifoldValve13 + implicit none + logical, intent(in) :: v + ChokeManifoldValve13 = v + call ChangeValve(26, v) + !WRITE (*,*) ' valve 26 ', v +#ifdef deb + !print*, 'ChokeManifoldValve13=', ChokeManifoldValve13 +#endif + end subroutine + + + ! Output routines + + integer function GetHydraulicChock1() + !DEC$ ATTRIBUTES DLLEXPORT :: GetHydraulicChock1 + !DEC$ ATTRIBUTES ALIAS: 'GetHydraulicChock1' :: GetHydraulicChock1 + implicit none + GetHydraulicChock1 = HydraulicChock1 + !GetHydraulicChock1 = 23 + end function + + integer function GetHydraulicChock2() + !DEC$ ATTRIBUTES DLLEXPORT :: GetHydraulicChock2 + !DEC$ ATTRIBUTES ALIAS: 'GetHydraulicChock2' :: GetHydraulicChock2 + implicit none + GetHydraulicChock2 = HydraulicChock2 + !GetHydraulicChock2 = 54 + end function + + +end module CChokeManifold \ No newline at end of file diff --git a/CSharp/Equipments/ControlPanels/CChokeManifoldVariables.f90 b/CSharp/Equipments/ControlPanels/CChokeManifoldVariables.f90 new file mode 100644 index 0000000..21c9baa --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CChokeManifoldVariables.f90 @@ -0,0 +1,65 @@ +module CChokeManifoldVariables + use CManifolds + implicit none + public + + ! Input vars + logical :: ChokeManifoldValve1 + logical :: ChokeManifoldValve2 + real(8) :: LeftManualChoke + logical :: ChokeManifoldValve4 + logical :: ChokeManifoldValve5 + real(8) :: RightManualChoke + logical :: ChokeManifoldValve7 + logical :: ChokeManifoldValve8 + logical :: ChokeManifoldValve9 + logical :: ChokeManifoldValve10 + logical :: ChokeManifoldValve11 + logical :: ChokeManifoldValve12 + logical :: ChokeManifoldValve13 + + ! Output vars + integer :: HydraulicChock1 + integer :: HydraulicChock2 + + ! Control vars + logical :: HyChock1OnProblem = .false. + logical :: HyChock2OnProblem = .false. + logical :: LeftManChokeOnProblem = .false. + logical :: RightManChokeOnProblem = .false. + + contains + + subroutine SetHydraulicChock1(v) + implicit none + integer, intent(in) :: v + HydraulicChock1 = v + if(HyChock1OnProblem) then + call ChangeValve(33, .true.) + else + if(v == 100) then + if(Valve(33)%Status) call ChangeValve(33, .false.) + else + if(.not.Valve(33)%Status) call ChangeValve(33, .true.) + endif + endif + !WRITE (*,*) ' valve 33 ', Valve(33)%Status, ' arg ', v + end subroutine + + subroutine SetHydraulicChock2(v) + implicit none + integer, intent(in) :: v + HydraulicChock2 = v + if(HyChock2OnProblem) then + call ChangeValve(34, .true.) + else + if(v==100) then + if(Valve(34)%Status) call ChangeValve(34, .false.) + else + if(.not.Valve(34)%Status) call ChangeValve(34, .true.) + endif + endif + !WRITE (*,*) ' valve 34 ', Valve(34)%Status, ' arg ', v + end subroutine + +endmodule CChokeManifoldVariables \ No newline at end of file diff --git a/CSharp/Equipments/ControlPanels/CDataDisplayConsole.f90 b/CSharp/Equipments/ControlPanels/CDataDisplayConsole.f90 new file mode 100644 index 0000000..d3eea8b --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CDataDisplayConsole.f90 @@ -0,0 +1,798 @@ +module CDataDisplayConsole + use CDataDisplayConsoleVariables + implicit none + public + contains + + + + !Portable + subroutine SetTripAlarmLow(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTripAlarmLow + !DEC$ ATTRIBUTES ALIAS: 'SetTripAlarmLow' :: SetTripAlarmLow + !use MudSystemVARIABLES, only: TripTank_MinVol_Allowded + implicit none + real*8, intent(in) :: v + TripAlarmLow = v + !TripTank_MinVol_Allowded = v +#ifdef deb + print*, 'TripAlarmLow=', TripAlarmLow +#endif + end subroutine + + subroutine SetTripAlarmHigh(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTripAlarmHigh + !DEC$ ATTRIBUTES ALIAS: 'SetTripAlarmHigh' :: SetTripAlarmHigh + !use MudSystemVARIABLES, only: TripTank_MaxVol_Allowded + implicit none + real*8, intent(in) :: v + TripAlarmHigh = v + !TripTank_MaxVol_Allowded = v +#ifdef deb + print*, 'TripAlarmHigh=', TripAlarmHigh +#endif + end subroutine + + + subroutine SetRetFlowAlarmLow(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRetFlowAlarmLow + !DEC$ ATTRIBUTES ALIAS: 'SetRetFlowAlarmLow' :: SetRetFlowAlarmLow + !use MudSystemVARIABLES, only: MFFI_MinPercent_Allowded + implicit none + real*8, intent(in) :: v + RetFlowAlarmLow = v + !MFFI_MinPercent_Allowded = v +#ifdef deb + print*, 'RetFlowAlarmLow=', RetFlowAlarmLow +#endif + end subroutine + + subroutine SetRetFlowAlarmHigh(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRetFlowAlarmHigh + !DEC$ ATTRIBUTES ALIAS: 'SetRetFlowAlarmHigh' :: SetRetFlowAlarmHigh + !use MudSystemVARIABLES, only: MFFI_MaxPercent_Allowded + implicit none + real*8, intent(in) :: v + RetFlowAlarmHigh = v + !MFFI_MaxPercent_Allowded = v +#ifdef deb + print*, 'RetFlowAlarmHigh=', RetFlowAlarmHigh +#endif + end subroutine + + + subroutine SetPitAlarmLow(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetPitAlarmLow + !DEC$ ATTRIBUTES ALIAS: 'SetPitAlarmLow' :: SetPitAlarmLow + implicit none + real*8, intent(in) :: v + PitAlarmLow = v + !call Log_4('PitAlarmLow=', PitAlarmLow) +#ifdef deb + print*, 'PitAlarmLow=', PitAlarmLow +#endif + end subroutine + + subroutine SetPitAlarmHigh(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetPitAlarmHigh + !DEC$ ATTRIBUTES ALIAS: 'SetPitAlarmHigh' :: SetPitAlarmHigh + implicit none + real*8, intent(in) :: v + PitAlarmHigh = v + !call Log_4('PitAlarmHigh=', PitAlarmHigh) +#ifdef deb + print*, 'PitAlarmHigh=', PitAlarmHigh +#endif + end subroutine + + + + + + + + + + + + + + + + + ! Input routines + subroutine SetTripTankSetAlarmLow(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTripTankSetAlarmLow + !DEC$ ATTRIBUTES ALIAS: 'SetTripTankSetAlarmLow' :: SetTripTankSetAlarmLow + implicit none + real*8, intent(in) :: v + TripTankSetAlarmLow = v +#ifdef deb + print*, 'TripTankSetAlarmLow=', TripTankSetAlarmLow +#endif + end subroutine + + subroutine SetTripTankSetAlarmHigh(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTripTankSetAlarmHigh + !DEC$ ATTRIBUTES ALIAS: 'SetTripTankSetAlarmHigh' :: SetTripTankSetAlarmHigh + implicit none + real*8, intent(in) :: v + TripTankSetAlarmHigh = v +#ifdef deb + print*, 'TripTankSetAlarmHigh=', TripTankSetAlarmHigh +#endif + end subroutine + + subroutine SetTripTankSetAlarmSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTripTankSetAlarmSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetTripTankSetAlarmSwitch' :: SetTripTankSetAlarmSwitch + implicit none + integer, intent(in) :: v + TripTankSetAlarmSwitch = v +#ifdef deb + print*, 'TripTankSetAlarmSwitch=', TripTankSetAlarmSwitch +#endif + end subroutine + + subroutine SetTripTankPowerSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTripTankPowerSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetTripTankPowerSwitch' :: SetTripTankPowerSwitch + use CTanksVariables, only: Set_ManualPumpPower + implicit none + logical, intent(in) :: v + TripTankPowerSwitch = v + if(TripTankPowerSwitch) call Set_ManualPumpPower(TripTankPumpSwitch) +#ifdef deb + print*, 'TripTankPowerSwitch=', TripTankPowerSwitch +#endif + end subroutine + + subroutine SetTripTankPumpSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTripTankPumpSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetTripTankPumpSwitch' :: SetTripTankPumpSwitch + use CTanksVariables, only: Set_ManualPumpPower + implicit none + logical, intent(in) :: v + TripTankPumpSwitch = v + if(TripTankPowerSwitch) call Set_ManualPumpPower(TripTankPumpSwitch) +#ifdef deb + print*, 'TripTankPumpSwitch=', TripTankPumpSwitch +#endif + end subroutine + + subroutine SetTripTankHornSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTripTankHornSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetTripTankHornSwitch' :: SetTripTankHornSwitch + implicit none + logical, intent(in) :: v + TripTankHornSwitch = v +#ifdef deb + print*, 'TripTankHornSwitch=', TripTankHornSwitch +#endif + end subroutine + + subroutine SetAcidGasDetectionHornSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAcidGasDetectionHornSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetAcidGasDetectionHornSwitch' :: SetAcidGasDetectionHornSwitch + implicit none + logical, intent(in) :: v + AcidGasDetectionHornSwitch = v +#ifdef deb + print*, 'AcidGasDetectionHornSwitch=', AcidGasDetectionHornSwitch +#endif + end subroutine + + subroutine SetTotalStrokeCounterResetSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTotalStrokeCounterResetSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetTotalStrokeCounterResetSwitch' :: SetTotalStrokeCounterResetSwitch + implicit none + logical, intent(in) :: v + TotalStrokeCounterResetSwitch = v +#ifdef deb + print*, 'TotalStrokeCounterResetSwitch=', TotalStrokeCounterResetSwitch +#endif + end subroutine + + subroutine SetDrillingTrippingSelectorSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetDrillingTrippingSelectorSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetDrillingTrippingSelectorSwitch' :: SetDrillingTrippingSelectorSwitch + use CCommonVariables + implicit none + logical, intent(in) :: v + DrillingTrippingSelectorSwitch = v + DrillWatchOperationMode = v +#ifdef deb + print*, 'DrillingTrippingSelectorSwitch=', DrillingTrippingSelectorSwitch +#endif + end subroutine + + subroutine SetMVTSetAlarmLowKnob(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMVTSetAlarmLowKnob + !DEC$ ATTRIBUTES ALIAS: 'SetMVTSetAlarmLowKnob' :: SetMVTSetAlarmLowKnob + implicit none + real*8, intent(in) :: v + MVTSetAlarmLowKnob = v +#ifdef deb + print*, 'MVTSetAlarmLowKnob=', MVTSetAlarmLowKnob +#endif + end subroutine + + subroutine SetMVTSetAlarmHighKnob(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMVTSetAlarmHighKnob + !DEC$ ATTRIBUTES ALIAS: 'SetMVTSetAlarmHighKnob' :: SetMVTSetAlarmHighKnob + implicit none + real*8, intent(in) :: v + MVTSetAlarmHighKnob = v +#ifdef deb + print*, 'MVTSetAlarmHighKnob=', MVTSetAlarmHighKnob +#endif + end subroutine + + subroutine SetMVTSetAlarmSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMVTSetAlarmSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetMVTSetAlarmSwitch' :: SetMVTSetAlarmSwitch + implicit none + integer, intent(in) :: v + MVTSetAlarmSwitch = v +#ifdef deb + print*, 'MVTSetAlarmSwitch=', MVTSetAlarmSwitch +#endif + end subroutine + + subroutine SetMudTank1Switch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudTank1Switch + !DEC$ ATTRIBUTES ALIAS: 'SetMudTank1Switch' :: SetMudTank1Switch + implicit none + logical, intent(in) :: v + MudTank1Switch = v +#ifdef deb + print*, 'MudTank1Switch=', MudTank1Switch +#endif + end subroutine + + subroutine SetMudTank2Switch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudTank2Switch + !DEC$ ATTRIBUTES ALIAS: 'SetMudTank2Switch' :: SetMudTank2Switch + implicit none + logical, intent(in) :: v + MudTank2Switch = v +#ifdef deb + print*, 'MudTank2Switch=', MudTank2Switch +#endif + end subroutine + + subroutine SetMudTank3Switch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudTank3Switch + !DEC$ ATTRIBUTES ALIAS: 'SetMudTank3Switch' :: SetMudTank3Switch + implicit none + logical, intent(in) :: v + MudTank3Switch = v +#ifdef deb + print*, 'MudTank3Switch=', MudTank3Switch +#endif + end subroutine + + subroutine SetMudTank4Switch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudTank4Switch + !DEC$ ATTRIBUTES ALIAS: 'SetMudTank4Switch' :: SetMudTank4Switch + implicit none + logical, intent(in) :: v + MudTank4Switch = v +#ifdef deb + print*, 'MudTank4Switch=', MudTank4Switch +#endif + end subroutine + + subroutine SetMVTFineKnob(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMVTFineKnob + !DEC$ ATTRIBUTES ALIAS: 'SetMVTFineKnob' :: SetMVTFineKnob + implicit none + real*8, intent(in) :: v + MVTFineKnob = v +#ifdef deb + print*, 'MVTFineKnob=', MVTFineKnob +#endif + end subroutine + + subroutine SetMVTCoarseKnob(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMVTCoarseKnob + !DEC$ ATTRIBUTES ALIAS: 'SetMVTCoarseKnob' :: SetMVTCoarseKnob + implicit none + real*8, intent(in) :: v + MVTCoarseKnob = v +#ifdef deb + print*, 'MVTCoarseKnob=', MVTCoarseKnob +#endif + end subroutine + + subroutine SetMVTHornSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMVTHornSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetMVTHornSwitch' :: SetMVTHornSwitch + implicit none + logical, intent(in) :: v + MVTHornSwitch = v +#ifdef deb + print*, 'MVTHornSwitch=', MVTHornSwitch +#endif + end subroutine + + subroutine SetMVTDeviationTripSelectionSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMVTDeviationTripSelectionSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetMVTDeviationTripSelectionSwitch' :: SetMVTDeviationTripSelectionSwitch + implicit none + logical, intent(in) :: v + MVTDeviationTripSelectionSwitch = v +#ifdef deb + print*, 'MVTDeviationTripSelectionSwitch=', MVTDeviationTripSelectionSwitch +#endif + end subroutine + + subroutine SetMVTPowerSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMVTPowerSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetMVTPowerSwitch' :: SetMVTPowerSwitch + implicit none + logical, intent(in) :: v + MVTPowerSwitch = v +#ifdef deb + print*, 'MVTPowerSwitch=', MVTPowerSwitch +#endif + end subroutine + + subroutine SetMFFIResetTotalStrokes(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMFFIResetTotalStrokes + !DEC$ ATTRIBUTES ALIAS: 'SetMFFIResetTotalStrokes' :: SetMFFIResetTotalStrokes + implicit none + logical, intent(in) :: v + MFFIResetTotalStrokes = v +#ifdef deb + print*, 'MFFIResetTotalStrokes=', MFFIResetTotalStrokes +#endif + end subroutine + + subroutine SetMFFIResetFillCounter(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMFFIResetFillCounter + !DEC$ ATTRIBUTES ALIAS: 'SetMFFIResetFillCounter' :: SetMFFIResetFillCounter + implicit none + logical, intent(in) :: v + MFFIResetFillCounter = v +#ifdef deb + print*, 'MFFIResetFillCounter=', MFFIResetFillCounter +#endif + end subroutine + + subroutine SetMFFIPumpSelectorSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMFFIPumpSelectorSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetMFFIPumpSelectorSwitch' :: SetMFFIPumpSelectorSwitch + implicit none + integer, intent(in) :: v + MFFIPumpSelectorSwitch = v +#ifdef deb + print*, 'MFFIPumpSelectorSwitch=', MFFIPumpSelectorSwitch +#endif + end subroutine + + subroutine SetMFFIFillSPMSelectorSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMFFIFillSPMSelectorSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetMFFIFillSPMSelectorSwitch' :: SetMFFIFillSPMSelectorSwitch + implicit none + logical, intent(in) :: v + MFFIFillSPMSelectorSwitch = v +#ifdef deb + print*, 'MFFIFillSPMSelectorSwitch=', MFFIFillSPMSelectorSwitch +#endif + end subroutine + + subroutine SetMFFISetAlarmLowKnob(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMFFISetAlarmLowKnob + !DEC$ ATTRIBUTES ALIAS: 'SetMFFISetAlarmLowKnob' :: SetMFFISetAlarmLowKnob + implicit none + real*8, intent(in) :: v + MFFISetAlarmLowKnob = v +#ifdef deb + print*, 'MFFISetAlarmLowKnob=', MFFISetAlarmLowKnob +#endif + end subroutine + + subroutine SetMFFISetAlarmHighKnob(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMFFISetAlarmHighKnob + !DEC$ ATTRIBUTES ALIAS: 'SetMFFISetAlarmHighKnob' :: SetMFFISetAlarmHighKnob + implicit none + real*8, intent(in) :: v + MFFISetAlarmHighKnob = v +#ifdef deb + print*, 'MFFISetAlarmHighKnob=', MFFISetAlarmHighKnob +#endif + end subroutine + + subroutine SetMFFISetAlarmSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMFFISetAlarmSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetMFFISetAlarmSwitch' :: SetMFFISetAlarmSwitch + implicit none + integer, intent(in) :: v + MFFISetAlarmSwitch = v +#ifdef deb + print*, 'MFFISetAlarmSwitch=', MFFISetAlarmSwitch +#endif + end subroutine + + subroutine SetMFFIPowerSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMFFIPowerSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetMFFIPowerSwitch' :: SetMFFIPowerSwitch + implicit none + logical, intent(in) :: v + MFFIPowerSwitch = v +#ifdef deb + print*, 'MFFIPowerSwitch=', MFFIPowerSwitch +#endif + end subroutine + + subroutine SetMFFIHornSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMFFIHornSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetMFFIHornSwitch' :: SetMFFIHornSwitch + implicit none + logical, intent(in) :: v + MFFIHornSwitch = v +#ifdef deb + print*, 'MFFIHornSwitch=', MFFIHornSwitch +#endif + end subroutine + + subroutine SetTotalWellDepth(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTotalWellDepth + !DEC$ ATTRIBUTES ALIAS: 'SetTotalWellDepth' :: SetTotalWellDepth + implicit none + real(8), intent(in) :: v + call Set_TotalDepth(v) +#ifdef deb + print*, 'TotalWellDepth=', v +#endif + end subroutine + + subroutine SetResetWob(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetResetWob + !DEC$ ATTRIBUTES ALIAS: 'SetResetWob' :: SetResetWob + implicit none + logical, intent(in) :: v + ResetWob = v +#ifdef deb + print*, 'ResetWob=', ResetWob +#endif + end subroutine + + subroutine SetClutch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetClutch + !DEC$ ATTRIBUTES ALIAS: 'SetClutch' :: SetClutch + implicit none + logical, intent(in) :: v + Clutch = v +#ifdef deb + print*, 'Clutch=', Clutch +#endif + end subroutine + + + ! Output routines + real(8) function GetWOBPointer() + !DEC$ ATTRIBUTES DLLEXPORT :: GetWOBPointer + !DEC$ ATTRIBUTES ALIAS: 'GetWOBPointer' :: GetWOBPointer + implicit none + GetWOBPointer = WOBPointer + end function + + real(8) function GetHookLoadPointer() + !DEC$ ATTRIBUTES DLLEXPORT :: GetHookLoadPointer + !DEC$ ATTRIBUTES ALIAS: 'GetHookLoadPointer' :: GetHookLoadPointer + implicit none + GetHookLoadPointer = HookLoadPointer + end function + + real(8) function GetTripTankGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTripTankGauge + !DEC$ ATTRIBUTES ALIAS: 'GetTripTankGauge' :: GetTripTankGauge + implicit none + GetTripTankGauge = TripTankGauge / 42.0 + !GetTripTankGauge = 23 + end function + + integer function GetTripTankAlarmLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTripTankAlarmLED + !DEC$ ATTRIBUTES ALIAS: 'GetTripTankAlarmLED' :: GetTripTankAlarmLED + implicit none + GetTripTankAlarmLED = TripTankAlarmLED + !GetTripTankAlarmLED = 1 + end function + + integer function GetTripTankPumpLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTripTankPumpLED + !DEC$ ATTRIBUTES ALIAS: 'GetTripTankPumpLED' :: GetTripTankPumpLED + implicit none + GetTripTankPumpLED = TripTankPumpLED + end function + + real(8) function GetStandPipePressureGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetStandPipePressureGauge + !DEC$ ATTRIBUTES ALIAS: 'GetStandPipePressureGauge' :: GetStandPipePressureGauge + implicit none + GetStandPipePressureGauge = StandPipePressureGauge + end function + + real(8) function GetCasingPressureGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetCasingPressureGauge + !DEC$ ATTRIBUTES ALIAS: 'GetCasingPressureGauge' :: GetCasingPressureGauge + implicit none + GetCasingPressureGauge = CasingPressureGauge + end function + + real(8) function GetMP1SPMGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMP1SPMGauge + !DEC$ ATTRIBUTES ALIAS: 'GetMP1SPMGauge' :: GetMP1SPMGauge + implicit none + GetMP1SPMGauge = MP1SPMGauge + end function + + real(8) function GetMP2SPMGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMP2SPMGauge + !DEC$ ATTRIBUTES ALIAS: 'GetMP2SPMGauge' :: GetMP2SPMGauge + implicit none + GetMP2SPMGauge = MP2SPMGauge + end function + + real(8) function GetReturnLineTempGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetReturnLineTempGauge + !DEC$ ATTRIBUTES ALIAS: 'GetReturnLineTempGauge' :: GetReturnLineTempGauge + implicit none + GetReturnLineTempGauge = ReturnLineTempGauge + end function + + real(8) function GetRotaryTorqueGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetRotaryTorqueGauge + !DEC$ ATTRIBUTES ALIAS: 'GetRotaryTorqueGauge' :: GetRotaryTorqueGauge + implicit none + GetRotaryTorqueGauge = RotaryTorqueGauge + end function + + real(8) function GetRotaryRPMGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetRotaryRPMGauge + !DEC$ ATTRIBUTES ALIAS: 'GetRotaryRPMGauge' :: GetRotaryRPMGauge + implicit none + GetRotaryRPMGauge = RotaryRPMGauge + end function + + integer function GetAcidGasDetectionLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetAcidGasDetectionLED + !DEC$ ATTRIBUTES ALIAS: 'GetAcidGasDetectionLED' :: GetAcidGasDetectionLED + implicit none + GetAcidGasDetectionLED = AcidGasDetectionLED + end function + + real(8) function GetTotalStrokeCounter() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTotalStrokeCounter + !DEC$ ATTRIBUTES ALIAS: 'GetTotalStrokeCounter' :: GetTotalStrokeCounter + implicit none + GetTotalStrokeCounter = TotalStrokeCounter + !GetTotalStrokeCounter = 456.9 + end function + + real(8) function GetPitGainLossGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetPitGainLossGauge + !DEC$ ATTRIBUTES ALIAS: 'GetPitGainLossGauge' :: GetPitGainLossGauge + implicit none + GetPitGainLossGauge = PitGainLossGauge + !GetPitGainLossGauge = 44 + end function + + real(8) function GetMudTanksVolumeGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMudTanksVolumeGauge + !DEC$ ATTRIBUTES ALIAS: 'GetMudTanksVolumeGauge' :: GetMudTanksVolumeGauge + implicit none + GetMudTanksVolumeGauge = MudTanksVolumeGauge / 42.0 + end function + + integer function GetMVTAlarmLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMVTAlarmLED + !DEC$ ATTRIBUTES ALIAS: 'GetMVTAlarmLED' :: GetMVTAlarmLED + implicit none + GetMVTAlarmLED = MVTAlarmLED + !GetMVTAlarmLED = 1 + end function + + real(8) function GetReturnMudFlowGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetReturnMudFlowGauge + !DEC$ ATTRIBUTES ALIAS: 'GetReturnMudFlowGauge' :: GetReturnMudFlowGauge + implicit none + GetReturnMudFlowGauge = ReturnMudFlowGauge + !GetReturnMudFlowGauge = 12 + end function + + real(8) function GetFillStrokeCounter() + !DEC$ ATTRIBUTES DLLEXPORT :: GetFillStrokeCounter + !DEC$ ATTRIBUTES ALIAS: 'GetFillStrokeCounter' :: GetFillStrokeCounter + implicit none + GetFillStrokeCounter = FillStrokeCounter + end function + + real(8) function GetMFFITotalStrokeCounter() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMFFITotalStrokeCounter + !DEC$ ATTRIBUTES ALIAS: 'GetMFFITotalStrokeCounter' :: GetMFFITotalStrokeCounter + implicit none + GetMFFITotalStrokeCounter = MFFITotalStrokeCounter + end function + + integer function GetMFFIAlarmLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMFFIAlarmLED + !DEC$ ATTRIBUTES ALIAS: 'GetMFFIAlarmLED' :: GetMFFIAlarmLED + implicit none + GetMFFIAlarmLED = MFFIAlarmLED + !GetMFFIAlarmLED = 1 + end function + + integer function GetMFFIPumpLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMFFIPumpLED + !DEC$ ATTRIBUTES ALIAS: 'GetMFFIPumpLED' :: GetMFFIPumpLED + implicit none + GetMFFIPumpLED = MFFIPumpLED + end function + + real(8) function GetTotalWellDepth() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTotalWellDepth + !DEC$ ATTRIBUTES ALIAS: 'GetTotalWellDepth' :: GetTotalWellDepth + implicit none + GetTotalWellDepth = TotalWellDepth + end function + + real(8) function GetBitDepth() + !DEC$ ATTRIBUTES DLLEXPORT :: GetBitDepth + !DEC$ ATTRIBUTES ALIAS: 'GetBitDepth' :: GetBitDepth + implicit none + GetBitDepth = BitDepth + end function + + real(8) function GetHookLoad() + !DEC$ ATTRIBUTES DLLEXPORT :: GetHookLoad + !DEC$ ATTRIBUTES ALIAS: 'GetHookLoad' :: GetHookLoad + implicit none + GetHookLoad = HookLoad + end function + + real(8) function GetStandPipePressure2() + !DEC$ ATTRIBUTES DLLEXPORT :: GetStandPipePressure2 + !DEC$ ATTRIBUTES ALIAS: 'GetStandPipePressure2' :: GetStandPipePressure2 + implicit none + GetStandPipePressure2 = StandPipePressure + end function + + real(8) function GetCasingPressure2() + !DEC$ ATTRIBUTES DLLEXPORT :: GetCasingPressure2 + !DEC$ ATTRIBUTES ALIAS: 'GetCasingPressure2' :: GetCasingPressure2 + implicit none + GetCasingPressure2 = CasingPressure + end function + + real(8) function GetMP1SPM() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMP1SPM + !DEC$ ATTRIBUTES ALIAS: 'GetMP1SPM' :: GetMP1SPM + implicit none + GetMP1SPM = MP1SPM + end function + + real(8) function GetMP2SPM() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMP2SPM + !DEC$ ATTRIBUTES ALIAS: 'GetMP2SPM' :: GetMP2SPM + implicit none + GetMP2SPM = MP2SPM + end function + + real(8) function GetRTTorque() + !DEC$ ATTRIBUTES DLLEXPORT :: GetRTTorque + !DEC$ ATTRIBUTES ALIAS: 'GetRTTorque' :: GetRTTorque + implicit none + GetRTTorque = RTTorque + end function + + real(8) function GetRTRPM() + !DEC$ ATTRIBUTES DLLEXPORT :: GetRTRPM + !DEC$ ATTRIBUTES ALIAS: 'GetRTRPM' :: GetRTRPM + implicit none + GetRTRPM = RTRPM + end function + + real(8) function GetWOP() + !DEC$ ATTRIBUTES DLLEXPORT :: GetWOP + !DEC$ ATTRIBUTES ALIAS: 'GetWOP' :: GetWOP + implicit none + GetWOP = WOP + end function + + real(8) function GetROP() + !DEC$ ATTRIBUTES DLLEXPORT :: GetROP + !DEC$ ATTRIBUTES ALIAS: 'GetROP' :: GetROP + implicit none + GetROP = ROP + end function + + real(8) function GetMudWeightIn() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMudWeightIn + !DEC$ ATTRIBUTES ALIAS: 'GetMudWeightIn' :: GetMudWeightIn + implicit none + GetMudWeightIn = MudWeightIn + end function + + real(8) function GetMudWeightOut() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMudWeightOut + !DEC$ ATTRIBUTES ALIAS: 'GetMudWeightOut' :: GetMudWeightOut + implicit none + GetMudWeightOut = MudWeightOut + end function + + logical function GetBuzzer1() + !DEC$ ATTRIBUTES DLLEXPORT :: GetBuzzer1 + !DEC$ ATTRIBUTES ALIAS: 'GetBuzzer1' :: GetBuzzer1 + implicit none + GetBuzzer1 = Buzzer1 + !GetBuzzer1 = .true. + end function + + logical function GetBuzzer2() + !DEC$ ATTRIBUTES DLLEXPORT :: GetBuzzer2 + !DEC$ ATTRIBUTES ALIAS: 'GetBuzzer2' :: GetBuzzer2 + implicit none + GetBuzzer2 = Buzzer2 + !GetBuzzer2 = .true. + end function + + logical function GetBuzzer3() + !DEC$ ATTRIBUTES DLLEXPORT :: GetBuzzer3 + !DEC$ ATTRIBUTES ALIAS: 'GetBuzzer3' :: GetBuzzer3 + implicit none + GetBuzzer3 = Buzzer3 + !GetBuzzer3 = .true. + end function + + logical function GetBuzzer4() + !DEC$ ATTRIBUTES DLLEXPORT :: GetBuzzer4 + !DEC$ ATTRIBUTES ALIAS: 'GetBuzzer4' :: GetBuzzer4 + implicit none + GetBuzzer4 = Buzzer4 + !GetBuzzer4 = .true. + end function + + + + + + + + + + + !portable + real(8) function GetPortWeightOnBit() + !DEC$ ATTRIBUTES DLLEXPORT :: GetPortWeightOnBit + !DEC$ ATTRIBUTES ALIAS: 'GetPortWeightOnBit' :: GetPortWeightOnBit + implicit none + GetPortWeightOnBit = PortWeightOnBit + end function + + real(8) function GetPortHookLoad() + !DEC$ ATTRIBUTES DLLEXPORT :: GetPortHookLoad + !DEC$ ATTRIBUTES ALIAS: 'GetPortHookLoad' :: GetPortHookLoad + implicit none + GetPortHookLoad = PortHookLoad + end function + + real(8) function GetPortCasingPressure() + !DEC$ ATTRIBUTES DLLEXPORT :: GetPortCasingPressure + !DEC$ ATTRIBUTES ALIAS: 'GetPortCasingPressure' :: GetPortCasingPressure + implicit none + GetPortCasingPressure = PortCasingPressure + end function + + real(8) function GetPortPumpPressure() + !DEC$ ATTRIBUTES DLLEXPORT :: GetPortPumpPressure + !DEC$ ATTRIBUTES ALIAS: 'GetPortPumpPressure' :: GetPortPumpPressure + implicit none + GetPortPumpPressure = PortPumpPressure + end function + + +end module CDataDisplayConsole \ No newline at end of file diff --git a/CSharp/Equipments/ControlPanels/CDataDisplayConsoleVariables.f90 b/CSharp/Equipments/ControlPanels/CDataDisplayConsoleVariables.f90 new file mode 100644 index 0000000..1bfdd32 --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CDataDisplayConsoleVariables.f90 @@ -0,0 +1,258 @@ +module CDataDisplayConsoleVariables + use CIActionReference + use CDoubleEventHandlerCollection + implicit none + public + + !portable + real(8) :: TripAlarmLow + real(8) :: TripAlarmHigh + real(8) :: RetFlowAlarmLow + real(8) :: RetFlowAlarmHigh + real(8) :: PitAlarmLow + real(8) :: PitAlarmHigh + + real(8) :: PortWeightOnBit + real(8) :: PortHookLoad + real(8) :: PortCasingPressure + real(8) :: PortPumpPressure + + + ! Input vars + real(8) :: TripTankSetAlarmLow + real(8) :: TripTankSetAlarmHigh + integer :: TripTankSetAlarmSwitch + logical :: TripTankPowerSwitch + logical :: TripTankPumpSwitch + logical :: TripTankHornSwitch + logical :: AcidGasDetectionHornSwitch + logical :: TotalStrokeCounterResetSwitch + logical :: DrillingTrippingSelectorSwitch + real(8) :: MVTSetAlarmLowKnob + real(8) :: MVTSetAlarmHighKnob + integer :: MVTSetAlarmSwitch + logical :: MudTank1Switch + logical :: MudTank2Switch + logical :: MudTank3Switch + logical :: MudTank4Switch + real(8) :: MVTFineKnob + real(8) :: MVTCoarseKnob + logical :: MVTHornSwitch + logical :: MVTDeviationTripSelectionSwitch + logical :: MVTPowerSwitch + logical :: MFFIResetTotalStrokes + logical :: MFFIResetFillCounter + integer :: MFFIPumpSelectorSwitch + logical :: MFFIFillSPMSelectorSwitch + real(8) :: MFFISetAlarmLowKnob + real(8) :: MFFISetAlarmHighKnob + integer :: MFFISetAlarmSwitch + logical :: MFFIPowerSwitch + logical :: MFFIHornSwitch + + logical :: ResetWob + logical :: Clutch + + ! Output vars + real(8) :: WOBPointer + real(8) :: HookLoadPointer + real(8) :: TripTankGauge + integer :: TripTankAlarmLED + integer :: TripTankPumpLED + real(8) :: StandPipePressureGauge + real(8) :: CasingPressureGauge + real(8) :: MP1SPMGauge + real(8) :: MP2SPMGauge + real(8) :: ReturnLineTempGauge + real(8) :: RotaryTorqueGauge + real(8) :: RotaryRPMGauge + type(DoubleEventHandlerCollection) :: OnRotaryRpmChange + integer :: AcidGasDetectionLED + real(8) :: TotalStrokeCounter + !real(8) :: TotalStrokeCounter_temp + real(8) :: PitGainLossGauge + real(8) :: MudTanksVolumeGauge + integer :: MVTAlarmLED + real(8) :: ReturnMudFlowGauge + real(8) :: FillStrokeCounter + real(8) :: MFFITotalStrokeCounter + integer :: MFFIAlarmLED + integer :: MFFIPumpLED + real(8) :: TotalWellDepth + real(8) :: BitDepth + real(8) :: HookLoad + real(8) :: StandPipePressure + real(8) :: CasingPressure + real(8) :: MP1SPM + real(8) :: MP2SPM + real(8) :: RTTorque + real(8) :: RTRPM + real(8) :: WOP + real(8) :: ROP + real(8) :: MudWeightIn + real(8) :: MudWeightOut + logical :: Buzzer1 + logical :: Buzzer2 + logical :: Buzzer3 + logical :: Buzzer4 + + ! events + procedure (ActionDualDouble), pointer :: PumpsSpmChanges => null() + + contains + + + subroutine Set_TotalDepth(v) + use CDrillWatchVariables, only: Depth + use CSimulationVariables, only: SetDistanceDrilled + implicit none + real(8), intent(in) :: v + TotalWellDepth = v + Depth = v + call SetDistanceDrilled(v) + end subroutine + + subroutine Set_BitPosition(v) + use CDrillWatchVariables, only: BitPosition + implicit none + real(8), intent(in) :: v + BitDepth = v + BitPosition = v + end subroutine + + subroutine Set_RotaryTorque(v) + use CDrillWatchVariables, only: Torque + implicit none + real(8), intent(in) :: v + RotaryTorqueGauge = v + Torque = v + RTTorque = v + end subroutine + + + subroutine Set_MudWeightIn(v) + use CDrillWatchVariables, only: MudWeightInDw => MudWeightIn + implicit none + real(8), intent(in) :: v + MudWeightIn = v + MudWeightInDw = v + end subroutine + + subroutine Set_MudWeightOut(v) + use CDrillWatchVariables, only: MudWeightOutDw => MudWeightOut + implicit none + real(8), intent(in) :: v + MudWeightOut = v + MudWeightOutDw = v + end subroutine + + subroutine Set_TripTankVolume(v) + use CDrillWatchVariables, only: TripTankVolume + implicit none + real(8), intent(in) :: v + TripTankVolume = v + end subroutine + + subroutine Set_FillVolume(v) + use CDrillWatchVariables, only: FillVolume + implicit none + real(8), intent(in) :: v + FillVolume = v + end subroutine + + + + + + + + + + subroutine Set_HookLoad(v) + use CDrillWatchVariables, only: HookLoadDw => HookLoad + implicit none + real(8), intent(in) :: v + HookLoadPointer = v + HookLoadDw = v * 1000 + HookLoad = v + end subroutine + + subroutine Set_WeightOnBit(v) + use CDrillWatchVariables, only: WeightOnBit + implicit none + real(8), intent(in) :: v + WOBPointer = v + WeightOnBit = v + WOP = v + end subroutine + + subroutine Set_ROP(v) + use CDrillWatchVariables, only: ROPDw => ROP + implicit none + real(8), intent(in) :: v + ROP = v + ROPDw = v + end subroutine + + subroutine Set_CasingPressure(v) + use CDrillWatchVariables, only: CasingPressureDw => CasingPressure + use CChokeControlPanelVariables, only: CasingPressureChoke => CasingPressure + implicit none + real(8), intent(in) :: v + CasingPressureGauge = v + CasingPressureDw = v + CasingPressureChoke = v + CasingPressure = v + end subroutine + + subroutine Set_StandPipePressure(v) + use CDrillWatchVariables, only: PumpPressure + use CChokeControlPanelVariables, only: StandPipePressureChoke => StandPipePressure + implicit none + real(8), intent(in) :: v + StandPipePressureGauge = v + PumpPressure = v + StandPipePressureChoke = v + StandPipePressure = v + + + + end subroutine + + + subroutine Set_RotaryRPMGauge(v) + use CDrillWatchVariables, only: RPM + implicit none + real(8), intent(in) :: v + RotaryRPMGauge = v + RPM = v + RTRPM = v + call OnRotaryRpmChange%RunAll(v) + end subroutine + + + + + subroutine Set_MP1SPMGauge(v) + implicit none + real(8), intent(in) :: v + MP1SPMGauge = v + MP1SPM = v + if(associated(PumpsSpmChanges)) call PumpsSpmChanges(MP1SPMGauge, MP2SPMGauge) +#ifdef deb + print*, 'MP1SPMGauge=', MP1SPMGauge +#endif + end subroutine + + subroutine Set_MP2SPMGauge(v) + implicit none + real(8), intent(in) :: v + MP2SPMGauge = v + MP2SPM = v + if(associated(PumpsSpmChanges)) call PumpsSpmChanges(MP1SPMGauge, MP2SPMGauge) +#ifdef deb + print*, 'MP2SPMGauge=', MP2SPMGauge +#endif + end subroutine + +end module CDataDisplayConsoleVariables \ No newline at end of file diff --git a/CSharp/Equipments/ControlPanels/CDrillingConsole.f90 b/CSharp/Equipments/ControlPanels/CDrillingConsole.f90 new file mode 100644 index 0000000..08869eb --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CDrillingConsole.f90 @@ -0,0 +1,871 @@ +module CDrillingConsole + use CDrillingConsoleVariables + use CSimulationVariables + use CLog4 + use CLog3 + implicit none + public + contains + + ! Input routines + subroutine SetAssignmentSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAssignmentSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetAssignmentSwitch' :: SetAssignmentSwitch + implicit none + integer, intent(in) :: v + AssignmentSwitch = v +#ifdef deb + call Log_4( 'AssignmentSwitch=', AssignmentSwitch) +#endif + end subroutine + + subroutine SetEmergencySwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetEmergencySwitch + !DEC$ ATTRIBUTES ALIAS: 'SetEmergencySwitch' :: SetEmergencySwitch + implicit none + logical, intent(in) :: v + EmergencySwitch = v +#ifdef deb + print*, 'EmergencySwitch=', EmergencySwitch +#endif + end subroutine + + subroutine SetRTTorqueLimitKnob(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRTTorqueLimitKnob + !DEC$ ATTRIBUTES ALIAS: 'SetRTTorqueLimitKnob' :: SetRTTorqueLimitKnob + implicit none + real*8, intent(in) :: v + RTTorqueLimitKnob = v +#ifdef deb + print*, 'RTTorqueLimitKnob=', RTTorqueLimitKnob +#endif + end subroutine + + subroutine SetMP1CPSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMP1CPSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetMP1CPSwitch' :: SetMP1CPSwitch + implicit none + integer, intent(in) :: v + + if(MP1CPSwitch == v) return + + if(SimulationState == SimulationState_Started) then + MP1CPSwitchI = MP1CPSwitchI + 1 + if(MP1CPSwitchI >= 1) MP1CPSwitch = v + if(MP1CPSwitchI >= 100) MP1CPSwitchI = 1 + !call Log_3( "MP1CPSwitchI=", MP1CPSwitchI) + !call Log_3( "MP1CPSwitch=", MP1CPSwitch) + + !MP1CPSwitch = v + endif +! if(SimulationState == SimulationState_Started) then +! !call Log_3( 'MP1CPSwitc(s)h=', MP1CPSwitch) +! if(MP1CPSwitchT /= v) then +! MP1CPSwitchT = v +! MP1CPSwitch = v +!#ifdef deb +! !print*, 'MP1CPSwitch=', MP1CPSwitch +! !call Log_3( 'MP1CPSwitch=', MP1CPSwitch) +!#endif +! endif +! else +! MP1CPSwitchT = v +! endif + end subroutine + + subroutine SetMP1Throttle(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMP1Throttle + !DEC$ ATTRIBUTES ALIAS: 'SetMP1Throttle' :: SetMP1Throttle + implicit none + real*8, intent(in) :: v + if(MP1Throttle == v) return + if(SimulationState == SimulationState_Started) then + if( abs(v - MP1Throttle) > 0.1) MP1ThrottleUpdate = .true. + if(MP1ThrottleUpdate) MP1Throttle = v + + !call Log_3( 'v-mp1=', v) + !call Log_3( 'MP1Throttle=', MP1Throttle) + !call Log_3( 'MP1ThrottleUpdate=', MP1ThrottleUpdate) + + !MP1Throttle = v + endif +#ifdef deb + print*, 'MP1Throttle=', MP1Throttle +#endif + end subroutine + + subroutine SetMP2Switch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMP2Switch + !DEC$ ATTRIBUTES ALIAS: 'SetMP2Switch' :: SetMP2Switch + implicit none + logical, intent(in) :: v + !call Log_3( 'v=', MP2SwitchT) + + if(MP2Switch == v) return + + if(SimulationState == SimulationState_Started) then + MP2SwitchI = MP2SwitchI + 1 + if(MP2SwitchI >= 1) MP2Switch = v + if(MP2SwitchI >= 100) MP2SwitchI = 1 + !call Log_3( "MP1CPSwitchI=", MP1CPSwitchI) + !call Log_3( "MP2Switch=", MP2Switch) + + !MP2Switch = v + endif + +! if(SimulationState == SimulationState_Started) then +! !call Log_3( 'MP2Switch(s)=', MP2Switch) +! if(MP2SwitchT /= v) then +! MP2SwitchT = v +! MP2Switch = v +!#ifdef deb +! !print*, 'MP2Switch=', MP2Switch +! !call Log_3( 'MP2Switch=', MP2Switch) +!#endif +! endif +! else +! MP2SwitchT = v +! !call Log_3( 'MP2SwitchTMP2SwitchTMP2SwitchT=', MP2SwitchT) +! endif + end subroutine + + subroutine SetMP2Throttle(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMP2Throttle + !DEC$ ATTRIBUTES ALIAS: 'SetMP2Throttle' :: SetMP2Throttle + implicit none + real*8, intent(in) :: v + if(MP2Throttle == v) return + if(SimulationState == SimulationState_Started) then + if( abs(v - MP2Throttle) > 0.1) MP2ThrottleUpdate = .true. + if(MP2ThrottleUpdate) MP2Throttle = v + + !call Log_3( 'v-mp2=', v) + !call Log_3( 'MP2Throttle=', MP2Throttle) + !call Log_3( 'MP2ThrottleUpdate=', MP2ThrottleUpdate) + + !MP2Throttle = v + endif +#ifdef deb + print*, 'MP2Throttle=', MP2Throttle +#endif + end subroutine + + subroutine SetDWSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetDWSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetDWSwitch' :: SetDWSwitch + implicit none + integer, intent(in) :: v + DWSwitch = v +#ifdef deb + print*, 'DWSwitch=', DWSwitch +#endif + end subroutine + + subroutine SetDWThrottle(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetDWThrottle + !DEC$ ATTRIBUTES ALIAS: 'SetDWThrottle' :: SetDWThrottle + implicit none + real*8, intent(in) :: v + DWThrottle = v +#ifdef deb + print*, 'DWThrottle=', DWThrottle +#endif + end subroutine + + subroutine SetRTSwitch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRTSwitch + !DEC$ ATTRIBUTES ALIAS: 'SetRTSwitch' :: SetRTSwitch + implicit none + integer, intent(in) :: v + RTSwitch = v +#ifdef deb + print*, 'RTSwitch=', RTSwitch +#endif + end subroutine + + subroutine SetRTThrottle(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRTThrottle + !DEC$ ATTRIBUTES ALIAS: 'SetRTThrottle' :: SetRTThrottle + implicit none + real*8, intent(in) :: v + RTThrottle = v +#ifdef deb + print*, 'RTThrottle=', RTThrottle +#endif + end subroutine + + subroutine SetDWBreak(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetDWBreak + !DEC$ ATTRIBUTES ALIAS: 'SetDWBreak' :: SetDWBreak + implicit none + real*8, intent(in) :: v + !if(ForceBreak) return + PreviousDWBreak = DWBreak + DWBreak = v +#ifdef deb + print*, 'DWBreak=', DWBreak +#endif + end subroutine + + subroutine SetDWAcceleretor(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetDWAcceleretor + !DEC$ ATTRIBUTES ALIAS: 'SetDWAcceleretor' :: SetDWAcceleretor + implicit none + real*8, intent(in) :: v + DWAcceleretor = v +#ifdef deb + print*, 'DWAcceleretor=', DWAcceleretor +#endif + end subroutine + + subroutine SetDWTransmisionLever(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetDWTransmisionLever + !DEC$ ATTRIBUTES ALIAS: 'SetDWTransmisionLever' :: SetDWTransmisionLever + implicit none + real*8, intent(in) :: v + DWTransmisionLever = v +#ifdef deb + print*, 'DWTransmisionLever=', DWTransmisionLever +#endif + end subroutine + + subroutine SetDWPowerLever(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetDWPowerLever + !DEC$ ATTRIBUTES ALIAS: 'SetDWPowerLever' :: SetDWPowerLever + implicit none + real*8, intent(in) :: v + DWPowerLever = v +#ifdef deb + print*, 'DWPowerLever=', DWPowerLever +#endif + end subroutine + + subroutine SetTongLever(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTongLever + !DEC$ ATTRIBUTES ALIAS: 'SetTongLever' :: SetTongLever + implicit none + real*8, intent(in) :: v + if (TongLever == v) return + TongLever = v + + ! if(dint(TongLever) == 1.0) then + ! call OnBreakoutLeverPress%RunAll() +! #ifdef deb + ! print*, 'OnBreakoutLeverPress=', size(OnBreakoutLeverPress%Delegates) +! #endif + ! endif + ! if(dint(TongLever) == -1.0) then + ! call OnMakeupLeverPress%RunAll() + +! #ifdef deb +! print*, 'OnMakeupPress=', size(OnMakeupLeverPress%Delegates) +! #endif +! endif + ! if(dint(TongLever) == 0.0) then + ! call OnTongNeutralPress%RunAll() +! #ifdef deb +! print*, 'OnTongNeutralPress=', size(OnTongNeutralPress%Delegates) +! #endif +! endif + +#ifdef deb + print*, 'TongLever=', TongLever +#endif + end subroutine + + subroutine SetRTTransmissionLever(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRTTransmissionLever + !DEC$ ATTRIBUTES ALIAS: 'SetRTTransmissionLever' :: SetRTTransmissionLever + implicit none + real*8, intent(in) :: v + RTTransmissionLever = v +#ifdef deb + print*, 'RTTransmissionLever=', RTTransmissionLever +#endif + end subroutine + + subroutine SetDWClutchLever(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetDWClutchLever + !DEC$ ATTRIBUTES ALIAS: 'SetDWClutchLever' :: SetDWClutchLever + implicit none + real*8, intent(in) :: v + DWClutchLever = v +#ifdef deb + print*, 'DWClutchLever=', DWClutchLever +#endif + end subroutine + + subroutine SetEddyBreakLever(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetEddyBreakLever + !DEC$ ATTRIBUTES ALIAS: 'SetEddyBreakLever' :: SetEddyBreakLever + implicit none + real*8, intent(in) :: v + EddyBreakLever = v +#ifdef deb + print*, 'EddyBreakLever=', EddyBreakLever +#endif + end subroutine + + subroutine SetAutoDW(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAutoDW + !DEC$ ATTRIBUTES ALIAS: 'SetAutoDW' :: SetAutoDW + implicit none + logical, intent(in) :: v + AutoDW = v +#ifdef deb + print*, 'AutoDW=', AutoDW +#endif + end subroutine + + subroutine SetGEN1(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetGEN1 + !DEC$ ATTRIBUTES ALIAS: 'SetGEN1' :: SetGEN1 + implicit none + logical, intent(in) :: v + GEN1 = v +#ifdef deb + print*, 'GEN1=', GEN1 +#endif + end subroutine + + subroutine SetGEN2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetGEN2 + !DEC$ ATTRIBUTES ALIAS: 'SetGEN2' :: SetGEN2 + implicit none + logical, intent(in) :: v + GEN2 = v +#ifdef deb + print*, 'GEN2=', GEN2 +#endif + end subroutine + + subroutine SetGEN3(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetGEN3 + !DEC$ ATTRIBUTES ALIAS: 'SetGEN3' :: SetGEN3 + implicit none + logical, intent(in) :: v + GEN3 = v +#ifdef deb + print*, 'GEN3=', GEN3 +#endif + end subroutine + + subroutine SetGEN4(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetGEN4 + !DEC$ ATTRIBUTES ALIAS: 'SetGEN4' :: SetGEN4 + implicit none + logical, intent(in) :: v + GEN4 = v +#ifdef deb + print*, 'GEN4=', GEN4 +#endif + end subroutine + +! subroutine SetInstallSafetyValve(v) +! !DEC$ ATTRIBUTES DLLEXPORT :: SetInstallSafetyValve +! !DEC$ ATTRIBUTES ALIAS: 'SetInstallSafetyValve' :: SetInstallSafetyValve +! implicit none +! logical, intent(in) :: v +! InstallSafetyValve = v +!#ifdef deb +! print*, 'InstallSafetyValve=', InstallSafetyValve +!#endif +! end subroutine +! +! subroutine SetOpenSafetyValve(v) +! !DEC$ ATTRIBUTES DLLEXPORT :: SetOpenSafetyValve +! !DEC$ ATTRIBUTES ALIAS: 'SetOpenSafetyValve' :: SetOpenSafetyValve +! implicit none +! logical, intent(in) :: v +! OpenSafetyValve = v +!#ifdef deb +! print*, 'OpenSafetyValve=', OpenSafetyValve +!#endif +! end subroutine +! +! subroutine SetRemoveSafetyValve(v) +! !DEC$ ATTRIBUTES DLLEXPORT :: SetRemoveSafetyValve +! !DEC$ ATTRIBUTES ALIAS: 'SetRemoveSafetyValve' :: SetRemoveSafetyValve +! implicit none +! logical, intent(in) :: v +! RemoveSafetyValve = v +!#ifdef deb +! print*, 'RemoveSafetyValve=', RemoveSafetyValve +!#endif +! end subroutine +! +! subroutine SetCloseSafetyValve(v) +! !DEC$ ATTRIBUTES DLLEXPORT :: SetCloseSafetyValve +! !DEC$ ATTRIBUTES ALIAS: 'SetCloseSafetyValve' :: SetCloseSafetyValve +! implicit none +! logical, intent(in) :: v +! CloseSafetyValve = v +!#ifdef deb +! print*, 'CloseSafetyValve=', CloseSafetyValve +!#endif +! end subroutine +! +! subroutine SetMakeJoint(v) +! !DEC$ ATTRIBUTES DLLEXPORT :: SetMakeJoint +! !DEC$ ATTRIBUTES ALIAS: 'SetMakeJoint' :: SetMakeJoint +! implicit none +! logical, intent(in) :: v +! MakeJoint = v +!#ifdef deb +! print*, 'MakeJoint=', MakeJoint +!#endif +! end subroutine +! +! subroutine SetBreakJoint(v) +! !DEC$ ATTRIBUTES DLLEXPORT :: SetBreakJoint +! !DEC$ ATTRIBUTES ALIAS: 'SetBreakJoint' :: SetBreakJoint +! implicit none +! logical, intent(in) :: v +! BreakJoint = v +!#ifdef deb +! print*, 'BreakJoint=', BreakJoint +!#endif +! end subroutine + + subroutine SetOpenKellyCock(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetOpenKellyCock + !DEC$ ATTRIBUTES ALIAS: 'SetOpenKellyCock' :: SetOpenKellyCock + use CManifolds, OpenKellyCockSub => OpenKellyCock + implicit none + logical, intent(in) :: v + if (OpenKellyCock == v) return + OpenKellyCock = v + ! if (v) call OnOpenKellyCockPress%RunAll() + if(v .and. Permission_OpenKellyCock) call OpenKellyCockSub() +#ifdef deb + print*, 'OpenKellyCock=', OpenKellyCock +#endif + end subroutine + + subroutine SetCloseKellyCock(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCloseKellyCock + !DEC$ ATTRIBUTES ALIAS: 'SetCloseKellyCock' :: SetCloseKellyCock + use CManifolds, CloseKellyCockSub => CloseKellyCock + implicit none + logical, intent(in) :: v + if (CloseKellyCock == v) return + CloseKellyCock = v + ! if (v) call OnCloseKellyCockPress%RunAll() + if(v .and. Permission_CloseKellyCock) call CloseKellyCockSub() +#ifdef deb + print*, 'CloseKellyCock=', CloseKellyCock +#endif + end subroutine + + subroutine SetOpenSafetyValve(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetOpenSafetyValve + !DEC$ ATTRIBUTES ALIAS: 'SetOpenSafetyValve' :: SetOpenSafetyValve + !use CManifolds, OpenSafetyValveSub => OpenSafetyValve + implicit none + logical, intent(in) :: v + if (OpenSafetyValve == v) return + OpenSafetyValve = v + ! if (v) call OnOpenSafetyValvePress%RunAll() + !if(v .and. Permission_OpenSafetyValve) call OpenSafetyValveSub() +#ifdef deb + print*, 'OpenSafetyValve=', OpenSafetyValve +#endif + end subroutine + + subroutine SetCloseSafetyValve(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCloseSafetyValve + !DEC$ ATTRIBUTES ALIAS: 'SetCloseSafetyValve' :: SetCloseSafetyValve + !use CManifolds, CloseSafetyValveSub => CloseSafetyValve + implicit none + logical, intent(in) :: v + if (CloseSafetyValve == v) return + CloseSafetyValve = v + ! if (v) call OnCloseSafetyValvePress%RunAll() + !if(v .and. Permission_CloseSafetyValve) call CloseSafetyValveSub() +#ifdef deb + print*, 'CloseSafetyValve=', CloseSafetyValve +#endif + end subroutine + + subroutine SetIRSafetyValve(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetIRSafetyValve + !DEC$ ATTRIBUTES ALIAS: 'SetIRSafetyValve' :: SetIRSafetyValve + use CManifolds + implicit none + logical, intent(in) :: v + logical :: prev + if (IRSafetyValve == v) return + prev = IRSafetyValve + IRSafetyValve = v + ! if (v) call OnIRSafetyValvePress%RunAll() + !if(prev /= IRSafetyValve .and. v .and. Permission_IRSafetyValve) call ToggleSafetyValve() + !if(prev /= IRSafetyValve .and. v) call ToggleSafetyValve() +#ifdef deb + print*, 'IRSafetyValve=', IRSafetyValve +#endif + end subroutine + + subroutine SetIRIBop(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetIRIBop + !DEC$ ATTRIBUTES ALIAS: 'SetIRIBop' :: SetIRIBop + use CManifolds + implicit none + logical, intent(in) :: v + logical :: prev + if (IRIBop == v) return + prev = IRIBop + IRIBop = v + ! if (v) call OnIRIBopPress%RunAll() + !if(prev /= IRIBop .and. v .and. Permission_IRIBop) call ToggleIBop() + !if(prev /= IRIBop .and. v) call ToggleIBop() +#ifdef deb + print*, 'IRIBop=', IRIBop +#endif + end subroutine + + + + subroutine SetLatchPipe(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLatchPipe + !DEC$ ATTRIBUTES ALIAS: 'SetLatchPipe' :: SetLatchPipe + implicit none + logical, intent(in) :: v + if (LatchPipe .eqv. v) return + LatchPipe = v + ! if (v) call OnLatchPipePress%RunAll() +#ifdef deb + print*, 'LatchPipe=', LatchPipe +#endif + end subroutine + + subroutine SetUnlatchPipe(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetUnlatchPipe + !DEC$ ATTRIBUTES ALIAS: 'SetUnlatchPipe' :: SetUnlatchPipe + implicit none + logical, intent(in) :: v + if (UnlatchPipe .eqv. v) return + UnlatchPipe = v + ! if (v) call OnUnlatchPipePress%RunAll() +#ifdef deb + print*, 'UnlatchPipe=', UnlatchPipe +#endif + end subroutine + + subroutine SetSwing(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetSwing + !DEC$ ATTRIBUTES ALIAS: 'SetSwing' :: SetSwing + implicit none + logical, intent(in) :: v + if (Swing .eqv. v) return + Swing = v + ! if (v) call OnSwingPress%RunAll() +#ifdef deb + print*, 'Swing=', Swing +#endif + end subroutine + + subroutine SetFillMouseHole(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetFillMouseHole + !DEC$ ATTRIBUTES ALIAS: 'SetFillMouseHole' :: SetFillMouseHole + implicit none + logical, intent(in) :: v + if (FillMouseHole .eqv. v) return + FillMouseHole = v + ! if (v) call OnFillMouseHolePress%RunAll() +#ifdef deb + print*, 'FillMouseHole=', FillMouseHole +#endif + end subroutine + + subroutine SetSlips(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetSlips + !DEC$ ATTRIBUTES ALIAS: 'SetSlips' :: SetSlips + implicit none + logical, intent(in) :: v + if (Slips .eqv. v) return + Slips = v +#ifdef deb + print*, 'Slips=', Slips +#endif + ! if (v) call OnSlipsPress%RunAll() + end subroutine + + + subroutine SetBrakeLeverCoefficient(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetBrakeLeverCoefficient + !DEC$ ATTRIBUTES ALIAS: 'SetBrakeLeverCoefficient' :: SetBrakeLeverCoefficient + implicit none + real, intent(in) :: v + BrakeLeverCoefficient = v +#ifdef deb + print*, 'BrakeLeverCoefficient=', BrakeLeverCoefficient +#endif + end subroutine + + subroutine SetHideDrillingBrake(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetHideDrillingBrake + !DEC$ ATTRIBUTES ALIAS: 'SetHideDrillingBrake' :: SetHideDrillingBrake + implicit none + logical, intent(in) :: v + HideDrillingBrake = v +#ifdef deb + print*, 'HideDrillingBrake=', HideDrillingBrake +#endif + end subroutine + + + + + + + + + subroutine SetParkingBrake(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetParkingBrake + !DEC$ ATTRIBUTES ALIAS: 'SetParkingBrake' :: SetParkingBrake + implicit none + logical, intent(in) :: v + ParkingBrakeBtn = v +#ifdef deb + print*, 'ParkingBrakeBtn=', ParkingBrakeBtn +#endif + end subroutine + + + + + + + + + + + + + ! Output routines + + logical function GetParkingBrakeLed() + !DEC$ ATTRIBUTES DLLEXPORT :: GetParkingBrakeLed + !DEC$ ATTRIBUTES ALIAS: 'GetParkingBrakeLed' :: GetParkingBrakeLed + implicit none + GetParkingBrakeLed = ParkingBrakeLed + !GetParkingBrakeLed = .true. + end function + + + integer function GetGEN1LED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetGEN1LED + !DEC$ ATTRIBUTES ALIAS: 'GetGEN1LED' :: GetGEN1LED + implicit none + GetGEN1LED = 1 + !GetGEN1LED = GEN1LED + end function + + integer function GetGEN2LED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetGEN2LED + !DEC$ ATTRIBUTES ALIAS: 'GetGEN2LED' :: GetGEN2LED + implicit none + GetGEN2LED = 1 + !GetGEN2LED = GEN2LED + end function + + integer function GetGEN3LED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetGEN3LED + !DEC$ ATTRIBUTES ALIAS: 'GetGEN3LED' :: GetGEN3LED + implicit none + GetGEN3LED = 1 + !GetGEN3LED = GEN3LED + end function + + integer function GetGEN4LED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetGEN4LED + !DEC$ ATTRIBUTES ALIAS: 'GetGEN4LED' :: GetGEN4LED + implicit none + GetGEN4LED = 1 + !GetGEN4LED = GEN4LED + end function + + integer function GetSCR1LED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSCR1LED + !DEC$ ATTRIBUTES ALIAS: 'GetSCR1LED' :: GetSCR1LED + implicit none + GetSCR1LED = SCR1LED + end function + + integer function GetSCR2LED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSCR2LED + !DEC$ ATTRIBUTES ALIAS: 'GetSCR2LED' :: GetSCR2LED + implicit none + GetSCR2LED = SCR2LED + end function + + integer function GetSCR3LED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSCR3LED + !DEC$ ATTRIBUTES ALIAS: 'GetSCR3LED' :: GetSCR3LED + implicit none + GetSCR3LED = SCR3LED + end function + + integer function GetSCR4LED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSCR4LED + !DEC$ ATTRIBUTES ALIAS: 'GetSCR4LED' :: GetSCR4LED + implicit none + GetSCR4LED = SCR4LED + end function + + integer function GetMP1BLWR() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMP1BLWR + !DEC$ ATTRIBUTES ALIAS: 'GetMP1BLWR' :: GetMP1BLWR + implicit none + GetMP1BLWR = MP1BLWR + end function + + integer function GetMP2BLWR() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMP2BLWR + !DEC$ ATTRIBUTES ALIAS: 'GetMP2BLWR' :: GetMP2BLWR + implicit none + GetMP2BLWR = MP2BLWR + end function + + integer function GetDWBLWR() + !DEC$ ATTRIBUTES DLLEXPORT :: GetDWBLWR + !DEC$ ATTRIBUTES ALIAS: 'GetDWBLWR' :: GetDWBLWR + implicit none + GetDWBLWR = DWBLWR + end function + + integer function GetRTBLWR() + !DEC$ ATTRIBUTES DLLEXPORT :: GetRTBLWR + !DEC$ ATTRIBUTES ALIAS: 'GetRTBLWR' :: GetRTBLWR + implicit none + GetRTBLWR = RTBLWR + end function + + integer function GetPWRLIM() + !DEC$ ATTRIBUTES DLLEXPORT :: GetPWRLIM + !DEC$ ATTRIBUTES ALIAS: 'GetPWRLIM' :: GetPWRLIM + implicit none + GetPWRLIM = PWRLIM + end function + + real(8) function GetPWRLIMMTR() + !DEC$ ATTRIBUTES DLLEXPORT :: GetPWRLIMMTR + !DEC$ ATTRIBUTES ALIAS: 'GetPWRLIMMTR' :: GetPWRLIMMTR + implicit none + GetPWRLIMMTR = PWRLIMMTR + end function + + real(8) function GetRTTorqueLimitGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetRTTorqueLimitGauge + !DEC$ ATTRIBUTES ALIAS: 'GetRTTorqueLimitGauge' :: GetRTTorqueLimitGauge + implicit none + GetRTTorqueLimitGauge = RTTorqueLimitGauge + end function + + integer function GetAutoDWLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetAutoDWLED + !DEC$ ATTRIBUTES ALIAS: 'GetAutoDWLED' :: GetAutoDWLED + implicit none + GetAutoDWLED = AutoDWLED + end function + + integer function GetGEN1BTNLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetGEN1BTNLED + !DEC$ ATTRIBUTES ALIAS: 'GetGEN1BTNLED' :: GetGEN1BTNLED + implicit none + GetGEN1BTNLED = GEN1BTNLED + end function + + integer function GetGEN2BTNLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetGEN2BTNLED + !DEC$ ATTRIBUTES ALIAS: 'GetGEN2BTNLED' :: GetGEN2BTNLED + implicit none + GetGEN2BTNLED = GEN2BTNLED + end function + + integer function GetGEN3BTNLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetGEN3BTNLED + !DEC$ ATTRIBUTES ALIAS: 'GetGEN3BTNLED' :: GetGEN3BTNLED + implicit none + GetGEN3BTNLED = GEN3BTNLED + end function + + integer function GetGEN4BTNLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetGEN4BTNLED + !DEC$ ATTRIBUTES ALIAS: 'GetGEN4BTNLED' :: GetGEN4BTNLED + implicit none + GetGEN4BTNLED = GEN4BTNLED + end function + + integer function GetOpenKellyCockLed() + !DEC$ ATTRIBUTES DLLEXPORT :: GetOpenKellyCockLed + !DEC$ ATTRIBUTES ALIAS: 'GetOpenKellyCockLed' :: GetOpenKellyCockLed + implicit none + GetOpenKellyCockLed = OpenKellyCockLed + end function + + integer function GetCloseKellyCockLed() + !DEC$ ATTRIBUTES DLLEXPORT :: GetCloseKellyCockLed + !DEC$ ATTRIBUTES ALIAS: 'GetCloseKellyCockLed' :: GetCloseKellyCockLed + implicit none + GetCloseKellyCockLed = CloseKellyCockLed + end function + + integer function GetOpenSafetyValveLed() + !DEC$ ATTRIBUTES DLLEXPORT :: GetOpenSafetyValveLed + !DEC$ ATTRIBUTES ALIAS: 'GetOpenSafetyValveLed' :: GetOpenSafetyValveLed + implicit none + GetOpenSafetyValveLed = OpenSafetyValveLed + end function + + integer function GetCloseSafetyValveLed() + !DEC$ ATTRIBUTES DLLEXPORT :: GetCloseSafetyValveLed + !DEC$ ATTRIBUTES ALIAS: 'GetCloseSafetyValveLed' :: GetCloseSafetyValveLed + implicit none + GetCloseSafetyValveLed = CloseSafetyValveLed + end function + + integer function GetIRSafetyValveLed() + !DEC$ ATTRIBUTES DLLEXPORT :: GetIRSafetyValveLed + !DEC$ ATTRIBUTES ALIAS: 'GetIRSafetyValveLed' :: GetIRSafetyValveLed + implicit none + GetIRSafetyValveLed = IRSafetyValveLed + end function + + integer function GetIRIBopLed() + !DEC$ ATTRIBUTES DLLEXPORT :: GetIRIBopLed + !DEC$ ATTRIBUTES ALIAS: 'GetIRIBopLed' :: GetIRIBopLed + implicit none + GetIRIBopLed = IRIBopLed + end function + + + integer function GetLatchPipeLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetLatchPipeLED + !DEC$ ATTRIBUTES ALIAS: 'GetLatchPipeLED' :: GetLatchPipeLED + implicit none + GetLatchPipeLED = LatchPipeLED + end function + + integer function GetUnlatchPipeLED() + !DEC$ ATTRIBUTES DLLEXPORT :: GetUnlatchPipeLED + !DEC$ ATTRIBUTES ALIAS: 'GetUnlatchPipeLED' :: GetUnlatchPipeLED + implicit none + GetUnlatchPipeLED = UnlatchPipeLED + end function + + integer function GetSwingLed() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSwingLed + !DEC$ ATTRIBUTES ALIAS: 'GetSwingLed' :: GetSwingLed + implicit none + GetSwingLed = SwingLed + end function + + integer function GetFillMouseHoleLed() + !DEC$ ATTRIBUTES DLLEXPORT :: GetFillMouseHoleLed + !DEC$ ATTRIBUTES ALIAS: 'GetFillMouseHoleLed' :: GetFillMouseHoleLed + implicit none + GetFillMouseHoleLed = FillMouseHoleLed + end function + +end module CDrillingConsole \ No newline at end of file diff --git a/CSharp/Equipments/ControlPanels/CDrillingConsoleVariables.f90 b/CSharp/Equipments/ControlPanels/CDrillingConsoleVariables.f90 new file mode 100644 index 0000000..1f8a56d --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CDrillingConsoleVariables.f90 @@ -0,0 +1,132 @@ +module CDrillingConsoleVariables + use CVoidEventHandlerCollection + implicit none + public + + ! Input vars + integer :: AssignmentSwitch + logical :: EmergencySwitch + real(8) :: RTTorqueLimitKnob + integer :: MP1CPSwitchI = 0 !for not turning on pump1 on simulation start + integer :: MP1CPSwitchT !for not turning on pump1 on simulation start + integer :: MP1CPSwitch + logical :: MP1ThrottleUpdate = .false. + real(8) :: MP1Throttle = -1.0 + integer :: MP2SwitchI = 0 !for not turning on pump2 on simulation start + logical :: MP2SwitchT !for not turning on pump2 on simulation start + logical :: MP2Switch + logical :: MP2ThrottleUpdate = .false. + real(8) :: MP2Throttle = -1.0 + integer :: DWSwitch + real(8) :: DWThrottle + integer :: RTSwitch + real(8) :: RTThrottle + + real(8) :: DWBreak + real(8) :: PreviousDWBreak + logical :: ForceBreak = .false. + + real(8) :: DWAcceleretor + real(8) :: DWTransmisionLever + real(8) :: DWPowerLever + + real(8) :: TongLever + ! type(VoidEventHandlerCollection) :: OnBreakoutLeverPress + ! type(VoidEventHandlerCollection) :: OnMakeupLeverPress + ! type(VoidEventHandlerCollection) :: OnTongNeutralPress + + real(8) :: RTTransmissionLever + real(8) :: DWClutchLever + real(8) :: EddyBreakLever + logical :: AutoDW + logical :: GEN1 + logical :: GEN2 + logical :: GEN3 + logical :: GEN4 + logical :: Permission_OpenKellyCock = .false. + logical :: OpenKellyCock + ! type(VoidEventHandlerCollection) :: OnOpenKellyCockPress + + logical :: Permission_CloseKellyCock = .false. + logical :: CloseKellyCock + ! type(VoidEventHandlerCollection) :: OnCloseKellyCockPress + + logical :: Permission_OpenSafetyValve = .false. + logical :: OpenSafetyValve + ! typeVoidEventHandlerCollection) :: OnOpenSafetyValvePress + + logical :: Permission_CloseSafetyValve = .false. + logical :: CloseSafetyValve + ! typeVoidEventHandlerCollection) :: OnCloseSafetyValvePress + + logical :: Permission_IRSafetyValve = .false. + logical :: IRSafetyValve + ! typeVoidEventHandlerCollection) :: OnIRSafetyValvePress + + logical :: Permission_IRIBop = .false. + logical :: IRIBop + ! typeVoidEventHandlerCollection) :: OnIRIBopPress + + logical :: LatchPipe + ! typeVoidEventHandlerCollection) :: OnLatchPipePress + + logical :: UnlatchPipe + ! typeVoidEventHandlerCollection) :: OnUnlatchPipePress + + logical :: Swing + ! typeVoidEventHandlerCollection) :: OnSwingPress + + logical :: FillMouseHole + ! typeVoidEventHandlerCollection) :: OnFillMouseHolePress + + logical :: Slips + ! typeVoidEventHandlerCollection) :: OnSlipsPress + + !logical :: TopDriveIBop + ! + !logical :: TopDriveDrillTorque + !integer :: TopDriveRevOffFwd + !integer :: TopDriveDrillOffTilt + + real :: BrakeLeverCoefficient + logical :: HideDrillingBrake + + logical :: ParkingBrakeBtn + + ! Output vars + logical :: ParkingBrakeLed + integer :: GEN1LED + integer :: GEN2LED + integer :: GEN3LED + integer :: GEN4LED + integer :: SCR1LED + integer :: SCR2LED + integer :: SCR3LED + integer :: SCR4LED + integer :: MP1BLWR + integer :: MP2BLWR + integer :: DWBLWR + integer :: RTBLWR + integer :: PWRLIM + real(8) :: PWRLIMMTR + real(8) :: RTTorqueLimitGauge + integer :: AutoDWLED + integer :: GEN1BTNLED + integer :: GEN2BTNLED + integer :: GEN3BTNLED + integer :: GEN4BTNLED + integer :: OpenKellyCockLed + integer :: CloseKellyCockLed + integer :: OpenSafetyValveLed + integer :: CloseSafetyValveLed + integer :: IRSafetyValveLed + integer :: IRIBopLed + + integer :: LatchPipeLED + integer :: UnlatchPipeLED + integer :: SwingLed + integer :: FillMouseHoleLed + + + contains +end module CDrillingConsoleVariables \ No newline at end of file diff --git a/CSharp/Equipments/ControlPanels/CEquipmentsConstants.f90 b/CSharp/Equipments/ControlPanels/CEquipmentsConstants.f90 new file mode 100644 index 0000000..7e5ab31 --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CEquipmentsConstants.f90 @@ -0,0 +1,11 @@ +module CEquipmentsConstants + implicit none + public + + ! LED State Types + integer :: LedOff = 0 + integer :: LedOn = 1 + integer :: LedBlinking = 2 + + contains +end module CEquipmentsConstants \ No newline at end of file diff --git a/CSharp/Equipments/ControlPanels/CHook.f90 b/CSharp/Equipments/ControlPanels/CHook.f90 new file mode 100644 index 0000000..1804d5a --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CHook.f90 @@ -0,0 +1,6 @@ +module CHook + use CHookVariables + implicit none + public + contains + end module CHook diff --git a/CSharp/Equipments/ControlPanels/CHookActions.f90 b/CSharp/Equipments/ControlPanels/CHookActions.f90 new file mode 100644 index 0000000..5632712 --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CHookActions.f90 @@ -0,0 +1,16 @@ +module CHookActions + use CIActionReference + implicit none + public + procedure (ActionReal), pointer :: HookHeightPtr + contains + + subroutine SubscribeHookHeight(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeHookHeight + !DEC$ ATTRIBUTES ALIAS: 'SubscribeHookHeight' :: SubscribeHookHeight + implicit none + procedure (ActionReal) :: a + HookHeightPtr => a + end subroutine + +end module CHookActions \ No newline at end of file diff --git a/CSharp/Equipments/ControlPanels/CHookVariables.f90 b/CSharp/Equipments/ControlPanels/CHookVariables.f90 new file mode 100644 index 0000000..06222ad --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CHookVariables.f90 @@ -0,0 +1,79 @@ +module CHookVariables + use CRealEventHandlerCollection + use CHookActions + implicit none + public + + real :: HookHeight_S = 0.0 + real :: HookHeight + type(RealEventHandlerCollection) :: OnHookHeightChange + + contains + + subroutine Set_HookHeight(v) + use CDrillingConsoleVariables + implicit none + real , intent(in) :: v + +#ifdef ExcludeExtraChanges + if(HookHeight == v) return +#endif + HookHeight = v + + if(associated(HookHeightPtr)) then + call HookHeightPtr(HookHeight) + end if + +#ifdef deb + print*, 'HookHeight=', HookHeight +#endif + + call OnHookHeightChange%RunAll(HookHeight) + end subroutine + + + subroutine Set_HookHeight_S(v) + implicit none + real , intent(in) :: v + + if(v == HookHeight) then + return + elseif (v > HookHeight) then + loop1: do + call Set_HookHeight(HookHeight + 0.2) + if(abs(v - HookHeight) <= 0.1) then + call Set_HookHeight(v) + exit loop1 + endif + call sleepqq(100) + enddo loop1 + else ! v < HookHeight + loop2: do + call Set_HookHeight(HookHeight - 0.2) + if(abs(HookHeight - v) <= 0.1) then + call Set_HookHeight(v) + exit loop2 + endif + call sleepqq(100) + enddo loop2 + endif + + end subroutine + + + subroutine Set_HookHeight_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_HookHeight_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_HookHeight_WN' :: Set_HookHeight_WN + implicit none + real , intent(in) :: v + !call Set_HookHeight(v) + HookHeight_S = v + end subroutine + + + subroutine Update_HookHeight_From_Snapshot() + implicit none + call Set_HookHeight_S(HookHeight_S) + end subroutine + +end module CHookVariables \ No newline at end of file diff --git a/CSharp/Equipments/ControlPanels/CStandPipeManifold.f90 b/CSharp/Equipments/ControlPanels/CStandPipeManifold.f90 new file mode 100644 index 0000000..97d1b4a --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CStandPipeManifold.f90 @@ -0,0 +1,206 @@ +module CStandPipeManifold + use CStandPipeManifoldVariables + use CManifolds + implicit none + public + contains + + ! Input routines + subroutine SetStandPipeManifoldValve1(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipeManifoldValve1 + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipeManifoldValve1' :: SetStandPipeManifoldValve1 + implicit none + logical, intent(in) :: v + StandPipeManifoldValve1 = v + call ChangeValve(13, v) +#ifdef deb + print*, 'StandPipeManifoldValve1=', StandPipeManifoldValve1 +#endif + end subroutine + + subroutine SetStandPipeManifoldValve2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipeManifoldValve2 + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipeManifoldValve2' :: SetStandPipeManifoldValve2 + implicit none + logical, intent(in) :: v + StandPipeManifoldValve2 = v + call ChangeValve(14, v) +#ifdef deb + print*, 'StandPipeManifoldValve2=', StandPipeManifoldValve2 +#endif + end subroutine + + subroutine SetStandPipeManifoldValve3(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipeManifoldValve3 + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipeManifoldValve3' :: SetStandPipeManifoldValve3 + implicit none + logical, intent(in) :: v + StandPipeManifoldValve3 = v + call ChangeValve(15, v) +#ifdef deb + print*, 'StandPipeManifoldValve3=', StandPipeManifoldValve3 +#endif + end subroutine + + subroutine SetStandPipeManifoldValve4(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipeManifoldValve4 + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipeManifoldValve4' :: SetStandPipeManifoldValve4 + implicit none + logical, intent(in) :: v + StandPipeManifoldValve4 = v + call ChangeValve(11, v) +#ifdef deb + print*, 'StandPipeManifoldValve4=', StandPipeManifoldValve4 +#endif + end subroutine + + subroutine SetStandPipeManifoldValve5(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipeManifoldValve5 + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipeManifoldValve5' :: SetStandPipeManifoldValve5 + implicit none + logical, intent(in) :: v + StandPipeManifoldValve5 = v + call ChangeValve(12, v) +#ifdef deb + print*, 'StandPipeManifoldValve5=', StandPipeManifoldValve5 +#endif + end subroutine + + subroutine SetStandPipeManifoldValve6(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipeManifoldValve6 + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipeManifoldValve6' :: SetStandPipeManifoldValve6 + implicit none + logical, intent(in) :: v + StandPipeManifoldValve6 = v + call ChangeValve(9, v) +#ifdef deb + print*, 'StandPipeManifoldValve6=', StandPipeManifoldValve6 +#endif + end subroutine + + subroutine SetStandPipeManifoldValve7(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipeManifoldValve7 + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipeManifoldValve7' :: SetStandPipeManifoldValve7 + implicit none + logical, intent(in) :: v + StandPipeManifoldValve7 = v + call ChangeValve(10, v) +#ifdef deb + print*, 'StandPipeManifoldValve7=', StandPipeManifoldValve7 +#endif + end subroutine + + subroutine SetStandPipeManifoldValve8(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipeManifoldValve8 + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipeManifoldValve8' :: SetStandPipeManifoldValve8 + implicit none + logical, intent(in) :: v + StandPipeManifoldValve8 = v + call ChangeValve(6, v) +#ifdef deb + print*, 'StandPipeManifoldValve8=', StandPipeManifoldValve8 +#endif + end subroutine + + subroutine SetStandPipeManifoldValve9(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipeManifoldValve9 + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipeManifoldValve9' :: SetStandPipeManifoldValve9 + implicit none + logical, intent(in) :: v + StandPipeManifoldValve9 = v + call ChangeValve(7, v) +#ifdef deb + print*, 'StandPipeManifoldValve9=', StandPipeManifoldValve9 +#endif + end subroutine + + subroutine SetStandPipeManifoldValve10(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipeManifoldValve10 + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipeManifoldValve10' :: SetStandPipeManifoldValve10 + implicit none + logical, intent(in) :: v + StandPipeManifoldValve10 = v + call ChangeValve(8, v) +#ifdef deb + print*, 'StandPipeManifoldValve10=', StandPipeManifoldValve10 +#endif + end subroutine + + subroutine SetStandPipeManifoldValve11(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipeManifoldValve11 + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipeManifoldValve11' :: SetStandPipeManifoldValve11 + implicit none + logical, intent(in) :: v + StandPipeManifoldValve11 = v + call ChangeValve(1, v) +#ifdef deb + print*, 'StandPipeManifoldValve11=', StandPipeManifoldValve11 +#endif + end subroutine + + subroutine SetStandPipeManifoldValve12(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipeManifoldValve12 + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipeManifoldValve12' :: SetStandPipeManifoldValve12 + implicit none + logical, intent(in) :: v + StandPipeManifoldValve12 = v + call ChangeValve(2, v) +#ifdef deb + print*, 'StandPipeManifoldValve12=', StandPipeManifoldValve12 +#endif + end subroutine + + subroutine SetStandPipeManifoldValve13(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipeManifoldValve13 + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipeManifoldValve13' :: SetStandPipeManifoldValve13 + implicit none + logical, intent(in) :: v + StandPipeManifoldValve13 = v + call ChangeValve(3, v) +#ifdef deb + print*, 'StandPipeManifoldValve13=', StandPipeManifoldValve13 +#endif + end subroutine + + subroutine SetStandPipeManifoldValve14(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipeManifoldValve14 + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipeManifoldValve14' :: SetStandPipeManifoldValve14 + implicit none + logical, intent(in) :: v + StandPipeManifoldValve14 = v + call ChangeValve(4, v) +#ifdef deb + print*, 'StandPipeManifoldValve14=', StandPipeManifoldValve14 +#endif + end subroutine + + subroutine SetStandPipeManifoldValve15(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipeManifoldValve15 + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipeManifoldValve15' :: SetStandPipeManifoldValve15 + implicit none + logical, intent(in) :: v + StandPipeManifoldValve15 = v + call ChangeValve(5, v) +#ifdef deb + print*, 'StandPipeManifoldValve15=', StandPipeManifoldValve15 +#endif + end subroutine + + ! Output routines + real(8) function GetStandPipeGauge1() + !DEC$ ATTRIBUTES DLLEXPORT :: GetStandPipeGauge1 + !DEC$ ATTRIBUTES ALIAS: 'GetStandPipeGauge1' :: GetStandPipeGauge1 + implicit none + GetStandPipeGauge1 = StandPipeGauge1 + !GetStandPipeGauge1 = 567.4 + end function + + real(8) function GetStandPipeGauge2() + !DEC$ ATTRIBUTES DLLEXPORT :: GetStandPipeGauge2 + !DEC$ ATTRIBUTES ALIAS: 'GetStandPipeGauge2' :: GetStandPipeGauge2 + implicit none + GetStandPipeGauge2 = StandPipeGauge2 + !GetStandPipeGauge2 = 1564.0 + end function + +end module CStandPipeManifold \ No newline at end of file diff --git a/CSharp/Equipments/ControlPanels/CStandPipeManifoldVariables.f90 b/CSharp/Equipments/ControlPanels/CStandPipeManifoldVariables.f90 new file mode 100644 index 0000000..cbab48f --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CStandPipeManifoldVariables.f90 @@ -0,0 +1,27 @@ +module CStandPipeManifoldVariables + implicit none + public + + ! Input vars + logical :: StandPipeManifoldValve1 + logical :: StandPipeManifoldValve2 + logical :: StandPipeManifoldValve3 + logical :: StandPipeManifoldValve4 + logical :: StandPipeManifoldValve5 + logical :: StandPipeManifoldValve6 + logical :: StandPipeManifoldValve7 + logical :: StandPipeManifoldValve8 + logical :: StandPipeManifoldValve9 + logical :: StandPipeManifoldValve10 + logical :: StandPipeManifoldValve11 + logical :: StandPipeManifoldValve12 + logical :: StandPipeManifoldValve13 + logical :: StandPipeManifoldValve14 + logical :: StandPipeManifoldValve15 + + ! Output vars + real(8) :: StandPipeGauge1 + real(8) :: StandPipeGauge2 + + contains +end module CStandPipeManifoldVariables \ No newline at end of file diff --git a/CSharp/Equipments/ControlPanels/CTopDrivePanel.f90 b/CSharp/Equipments/ControlPanels/CTopDrivePanel.f90 new file mode 100644 index 0000000..413a3e7 --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CTopDrivePanel.f90 @@ -0,0 +1,211 @@ +module CTopDrivePanel + use CTopDrivePanelVariables + use CLog3 + implicit none + public + contains + + ! Input routines + subroutine SetTopDriveTdsPowerState(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTopDriveTdsPowerState + !DEC$ ATTRIBUTES ALIAS: 'SetTopDriveTdsPowerState' :: SetTopDriveTdsPowerState + implicit none + integer, intent(in) :: v + TopDriveTdsPowerState = v +#ifdef deb + call Log_3( 'TopDriveTdsPowerState=', TopDriveTdsPowerState) +#endif + end subroutine + + subroutine SetTopDriveTorqueWrench(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTopDriveTorqueWrench + !DEC$ ATTRIBUTES ALIAS: 'SetTopDriveTorqueWrench' :: SetTopDriveTorqueWrench + implicit none + logical, intent(in) :: v + TopDriveTorqueWrench = v +#ifdef deb + call Log_3( 'TopDriveTorqueWrench=', TopDriveTorqueWrench) +#endif + end subroutine + + subroutine SetTopDriveDrillTorqueState(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTopDriveDrillTorqueState + !DEC$ ATTRIBUTES ALIAS: 'SetTopDriveDrillTorqueState' :: SetTopDriveDrillTorqueState + implicit none + integer, intent(in) :: v + TopDriveDrillTorqueState = v +#ifdef deb + call Log_3( 'TopDriveDrillTorqueState=', TopDriveDrillTorqueState) +#endif + end subroutine + + subroutine SetTopDriveLinkTiltState(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTopDriveLinkTiltState + !DEC$ ATTRIBUTES ALIAS: 'SetTopDriveLinkTiltState' :: SetTopDriveLinkTiltState + implicit none + integer, intent(in) :: v + TopDriveLinkTiltState = v +#ifdef deb + call Log_3( 'TopDriveLinkTiltState=', TopDriveLinkTiltState) +#endif + end subroutine + + subroutine SetTopDriveIbop(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTopDriveIbop + !DEC$ ATTRIBUTES ALIAS: 'SetTopDriveIbop' :: SetTopDriveIbop + implicit none + logical, intent(in) :: v + TopDriveIbop = v +#ifdef deb + call Log_3( 'TopDriveIbop=', TopDriveIbop) +#endif + end subroutine + + subroutine SetTopDriveTorqueLimitKnob(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTopDriveTorqueLimitKnob + !DEC$ ATTRIBUTES ALIAS: 'SetTopDriveTorqueLimitKnob' :: SetTopDriveTorqueLimitKnob + use CSimulationVariables, only: IsPortable + use CDrillingConsoleVariables, only: RTSwitch, RTTorqueLimitKnob + use CWarningsVariables, only: Activate_TopdriveRotaryTableConfilict + use CScaleRange + implicit none + real, intent(in) :: v + if (IsPortable) then + if(TopDriveTdsPowerState /= 0 .and. RTSwitch /= 0) call Activate_TopdriveRotaryTableConfilict() + if(TopDriveTdsPowerState /= 0 .and. RTSwitch == 0) then + RTTorqueLimitKnob = 0 + TopDriveTorqueLimitKnob = v +#ifdef deb + call Log_3( 'RTTorqueLimitKnob=', RTTorqueLimitKnob ) + call Log_3( 'TopDriveTorqueLimitKnob=', TopDriveTorqueLimitKnob ) +#endif + endif + if(TopDriveTdsPowerState == 0 .and. RTSwitch /= 0) then + TopDriveTorqueLimitKnob = 0 + RTTorqueLimitKnob = real(ScaleRange(v, 0.0, 10.0, 0.0, 6000.0), 8) +#ifdef deb + call Log_3( 'RTTorqueLimitKnob=', RTTorqueLimitKnob ) + call Log_3( 'TopDriveTorqueLimitKnob=', TopDriveTorqueLimitKnob ) +#endif + endif + else + TopDriveTorqueLimitKnob = v +#ifdef deb + call Log_3( 'TopDriveTorqueLimitKnob=', TopDriveTorqueLimitKnob) +#endif + endif + + end subroutine + + subroutine SetRpmKnob(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRpmKnob + !DEC$ ATTRIBUTES ALIAS: 'SetRpmKnob' :: SetRpmKnob + use CSimulationVariables, only: IsPortable + use CDrillingConsoleVariables, only: RTSwitch, RTThrottle + use CWarningsVariables, only: Activate_TopdriveRotaryTableConfilict + use CScaleRange + implicit none + real, intent(in) :: v + if (IsPortable) then + if(TopDriveTdsPowerState /= 0 .and. RTSwitch /= 0) call Activate_TopdriveRotaryTableConfilict() + if(TopDriveTdsPowerState /= 0 .and. RTSwitch == 0) then + RTThrottle = 0 + RpmKnob = v +#ifdef deb + call Log_3( 'RTThrottle=', RTThrottle ) + call Log_3( 'RpmKnob=', RpmKnob ) +#endif + endif + if(TopDriveTdsPowerState == 0 .and. RTSwitch /= 0) then + RpmKnob = 0 + RTThrottle = real(ScaleRange(v, 0.0, 965.0, 0.0, 250.0), 8) +#ifdef deb + call Log_3( 'RpmKnob=', RpmKnob ) + call Log_3( 'RTThrottle=', RTThrottle ) +#endif + endif + else + RpmKnob = v + endif + + + + if (IsPortable) then + ! + else + RpmKnob = v +#ifdef deb + call Log_3( 'RpmKnob=', RpmKnob ) +#endif + endif + + end subroutine + + + ! Output routines + integer function GetTopDriveOperationFaultLed() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTopDriveOperationFaultLed + !DEC$ ATTRIBUTES ALIAS: 'GetTopDriveOperationFaultLed' :: GetTopDriveOperationFaultLed + implicit none + GetTopDriveOperationFaultLed = TopDriveOperationFaultLed + !GetTopDriveOperationFaultLed = 1 + end function + + integer function GetTopDriveTdsPowerLed() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTopDriveTdsPowerLed + !DEC$ ATTRIBUTES ALIAS: 'GetTopDriveTdsPowerLed' :: GetTopDriveTdsPowerLed + implicit none + GetTopDriveTdsPowerLed = TopDriveTdsPowerLed + !GetTopDriveTdsPowerLed = 1 + end function + + integer function GetTopDriveTorqueWrenchLed() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTopDriveTorqueWrenchLed + !DEC$ ATTRIBUTES ALIAS: 'GetTopDriveTorqueWrenchLed' :: GetTopDriveTorqueWrenchLed + implicit none + GetTopDriveTorqueWrenchLed = TopDriveTorqueWrenchLed + !GetTopDriveTorqueWrenchLed = 1 + end function + + integer function GetTopDriveLinkTiltLed() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTopDriveLinkTiltLed + !DEC$ ATTRIBUTES ALIAS: 'GetTopDriveLinkTiltLed' :: GetTopDriveLinkTiltLed + implicit none + GetTopDriveLinkTiltLed = TopDriveLinkTiltLed + !GetTopDriveLinkTiltLed = 1 + end function + + integer function GetTopDriveIbopLed() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTopDriveIbopLed + !DEC$ ATTRIBUTES ALIAS: 'GetTopDriveIbopLed' :: GetTopDriveIbopLed + implicit none + GetTopDriveIbopLed = TopDriveIbopLed + !GetTopDriveIbopLed = 1 + end function + + real function GetTopDriveTorqueGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTopDriveTorqueGauge + !DEC$ ATTRIBUTES ALIAS: 'GetTopDriveTorqueGauge' :: GetTopDriveTorqueGauge + implicit none + GetTopDriveTorqueGauge = TopDriveTorqueGauge + !GetTopDriveTorqueGauge = 340 + end function + + real function GetTopDriveTorqueLimitGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTopDriveTorqueLimitGauge + !DEC$ ATTRIBUTES ALIAS: 'GetTopDriveTorqueLimitGauge' :: GetTopDriveTorqueLimitGauge + implicit none + GetTopDriveTorqueLimitGauge = TopDriveTorqueLimitGauge + !GetTopDriveTorqueLimitGauge = 442 + end function + + real function GetTopDriveRpmGauge() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTopDriveRpmGauge + !DEC$ ATTRIBUTES ALIAS: 'GetTopDriveRpmGauge' :: GetTopDriveRpmGauge + implicit none + GetTopDriveRpmGauge = TopDriveRpmGauge + !GetTopDriveRpmGauge = 67 + end function + + + end module CTopDrivePanel diff --git a/CSharp/Equipments/ControlPanels/CTopDrivePanelVariables.f90 b/CSharp/Equipments/ControlPanels/CTopDrivePanelVariables.f90 new file mode 100644 index 0000000..a6fc0a0 --- /dev/null +++ b/CSharp/Equipments/ControlPanels/CTopDrivePanelVariables.f90 @@ -0,0 +1,43 @@ +module CTopDrivePanelVariables + implicit none + public + + ! const + integer :: TdsPower_REV = 1 + integer :: TdsPower_OFF = 0 + integer :: TdsPower_FWD = -1 + + integer :: TdsMu_TORQ = 1 + integer :: TdsMu_SPINE = 0 + integer :: TdsMu_DRILL = -1 + + integer :: TdsLinkTilt_TILT = 1 + integer :: TdsLinkTilt_OFF = 0 + integer :: TdsLinkTilt_DRILL = -1 + + integer :: LED_OFF = 0 + integer :: LED_ON = 1 + integer :: LED_BLINK = 2 + + ! Input vars + integer :: TopDriveTdsPowerState + logical :: TopDriveTorqueWrench + integer :: TopDriveDrillTorqueState + integer :: TopDriveLinkTiltState + logical :: TopDriveIbop + real :: TopDriveTorqueLimitKnob + real :: RpmKnob + + + ! Output vars + integer :: TopDriveOperationFaultLed + integer :: TopDriveTdsPowerLed + integer :: TopDriveTorqueWrenchLed + integer :: TopDriveLinkTiltLed + integer :: TopDriveIbopLed + real :: TopDriveTorqueLimitGauge + real :: TopDriveTorqueGauge + real :: TopDriveRpmGauge + + contains + end module CTopDrivePanelVariables \ No newline at end of file diff --git a/CSharp/Equipments/ControlPanels/cequipmentsconstants.mod b/CSharp/Equipments/ControlPanels/cequipmentsconstants.mod new file mode 100644 index 0000000..4214a04 Binary files /dev/null and b/CSharp/Equipments/ControlPanels/cequipmentsconstants.mod differ diff --git a/CSharp/Equipments/ControlPanels/ctopdrivepanelvariables.mod b/CSharp/Equipments/ControlPanels/ctopdrivepanelvariables.mod new file mode 100644 index 0000000..b228629 Binary files /dev/null and b/CSharp/Equipments/ControlPanels/ctopdrivepanelvariables.mod differ diff --git a/CSharp/Equipments/DrillWatch/CDrillWatch.f90 b/CSharp/Equipments/DrillWatch/CDrillWatch.f90 new file mode 100644 index 0000000..297f52d --- /dev/null +++ b/CSharp/Equipments/DrillWatch/CDrillWatch.f90 @@ -0,0 +1,171 @@ +module CDrillWatch + use CDrillWatchVariables + !use CSimulationVariables + implicit none + public + contains + + ! Input routines + + ! Output routines + + real(8) function GetDepth() + !DEC$ ATTRIBUTES DLLEXPORT :: GetDepth + !DEC$ ATTRIBUTES ALIAS: 'GetDepth' :: GetDepth + implicit none + GetDepth = Depth + !GetDepth = Depth + 10 + SimulationTime + end function + + real(8) function GetBitPosition() + !DEC$ ATTRIBUTES DLLEXPORT :: GetBitPosition + !DEC$ ATTRIBUTES ALIAS: 'GetBitPosition' :: GetBitPosition + implicit none + GetBitPosition = BitPosition + !GetBitPosition = BitPosition + 20 + SimulationTime + end function + + real(8) function GetHookLoadD() + !DEC$ ATTRIBUTES DLLEXPORT :: GetHookLoadD + !DEC$ ATTRIBUTES ALIAS: 'GetHookLoadD' :: GetHookLoadD + implicit none + GetHookLoadD = HookLoad + !GetHookLoadD = HookLoad + 30 + SimulationTime + end function + + real(8) function GetWeightOnBit() + !DEC$ ATTRIBUTES DLLEXPORT :: GetWeightOnBit + !DEC$ ATTRIBUTES ALIAS: 'GetWeightOnBit' :: GetWeightOnBit + implicit none + GetWeightOnBit = WeightOnBit + !GetWeightOnBit = WeightOnBit + 40 + SimulationTime + end function + + real(8) function GetRPM() + !DEC$ ATTRIBUTES DLLEXPORT :: GetRPM + !DEC$ ATTRIBUTES ALIAS: 'GetRPM' :: GetRPM + implicit none + GetRPM = RPM + !GetRPM = RPM + 50 + SimulationTime + end function + + real(8) function GetROP2() + !DEC$ ATTRIBUTES DLLEXPORT :: GetROP2 + !DEC$ ATTRIBUTES ALIAS: 'GetROP2' :: GetROP2 + implicit none + GetROP2 = ROP + !GetROP2 = ROP + 60 + SimulationTime + end function + + real(8) function GetTorque() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTorque + !DEC$ ATTRIBUTES ALIAS: 'GetTorque' :: GetTorque + implicit none + GetTorque = Torque + !GetTorque = Torque + 70 + SimulationTime + end function + + real(8) function GetPumpPressureD() + !DEC$ ATTRIBUTES DLLEXPORT :: GetPumpPressureD + !DEC$ ATTRIBUTES ALIAS: 'GetPumpPressureD' :: GetPumpPressureD + implicit none + GetPumpPressureD = PumpPressure + !GetPumpPressureD = PumpPressure + 80 + SimulationTime + end function + + real(8) function GetSPM1() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSPM1 + !DEC$ ATTRIBUTES ALIAS: 'GetSPM1' :: GetSPM1 + implicit none + GetSPM1 = SPM1 + !GetSPM1 = SPM1 + 90 + SimulationTime + end function + + real(8) function GetSPM2() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSPM2 + !DEC$ ATTRIBUTES ALIAS: 'GetSPM2' :: GetSPM2 + implicit none + GetSPM2 = SPM2 + !GetSPM2 = SPM2 + 100 + SimulationTime + end function + + ! real(8) function GetSPM3() + !!DEC$ ATTRIBUTES DLLEXPORT :: GetSPM3 + !!DEC$ ATTRIBUTES ALIAS: 'GetSPM3' :: GetSPM3 + ! implicit none + ! GetSPM3 = SPM3 + !end function + + real(8) function GetCasingPressureD() + !DEC$ ATTRIBUTES DLLEXPORT :: GetCasingPressureD + !DEC$ ATTRIBUTES ALIAS: 'GetCasingPressureD' :: GetCasingPressureD + implicit none + GetCasingPressureD = CasingPressure + !GetCasingPressureD = CasingPressure + 110 + SimulationTime + end function + + real(8) function GetPercentFlow() + !DEC$ ATTRIBUTES DLLEXPORT :: GetPercentFlow + !DEC$ ATTRIBUTES ALIAS: 'GetPercentFlow' :: GetPercentFlow + implicit none + GetPercentFlow = PercentFlow + !GetPercentFlow = PercentFlow + 120 + SimulationTime + end function + + real(8) function GetPitGainLose() + !DEC$ ATTRIBUTES DLLEXPORT :: GetPitGainLose + !DEC$ ATTRIBUTES ALIAS: 'GetPitGainLose' :: GetPitGainLose + implicit none + GetPitGainLose = PitGainLose + !GetPitGainLose = PitGainLose + 130 + SimulationTime + end function + + real(8) function GetPitVolume() + !DEC$ ATTRIBUTES DLLEXPORT :: GetPitVolume + !DEC$ ATTRIBUTES ALIAS: 'GetPitVolume' :: GetPitVolume + implicit none + GetPitVolume = PitVolume + !GetPitVolume = PitVolume + 140 + SimulationTime + end function + + real(8) function GetKillMudVolume() + !DEC$ ATTRIBUTES DLLEXPORT :: GetKillMudVolume + !DEC$ ATTRIBUTES ALIAS: 'GetKillMudVolume' :: GetKillMudVolume + implicit none + GetKillMudVolume = KillMudVolume + !GetKillMudVolume = KillMudVolume + 150 + SimulationTime + end function + + real(8) function GetTripTankVolume() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTripTankVolume + !DEC$ ATTRIBUTES ALIAS: 'GetTripTankVolume' :: GetTripTankVolume + implicit none + GetTripTankVolume = TripTankVolume + !GetTripTankVolume = TripTankVolume + 160 + SimulationTime + end function + + real(8) function GetMudWeightInD() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMudWeightInD + !DEC$ ATTRIBUTES ALIAS: 'GetMudWeightInD' :: GetMudWeightInD + implicit none + GetMudWeightInD = MudWeightIn + !GetMudWeightInD = MudWeightIn + 170 + SimulationTime + end function + + real(8) function GetFillVolume() + !DEC$ ATTRIBUTES DLLEXPORT :: GetFillVolume + !DEC$ ATTRIBUTES ALIAS: 'GetFillVolume' :: GetFillVolume + implicit none + GetFillVolume = FillVolume + !GetFillVolume = FillVolume + 180 + SimulationTime + end function + + real(8) function GetMudWeightOutD() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMudWeightOutD + !DEC$ ATTRIBUTES ALIAS: 'GetMudWeightOutD' :: GetMudWeightOutD + implicit none + GetMudWeightOutD = MudWeightOut + !GetMudWeightOutD = MudWeightOut + 190 + SimulationTime + end function + +end module CDrillWatch \ No newline at end of file diff --git a/CSharp/Equipments/DrillWatch/CDrillWatchVariables.f90 b/CSharp/Equipments/DrillWatch/CDrillWatchVariables.f90 new file mode 100644 index 0000000..6931d06 --- /dev/null +++ b/CSharp/Equipments/DrillWatch/CDrillWatchVariables.f90 @@ -0,0 +1,33 @@ +module CDrillWatchVariables + implicit none + + public + + + ! Input vars + + ! Output vars + real(8) :: Depth + real(8) :: BitPosition + real(8) :: HookLoad + real(8) :: WeightOnBit + real(8) :: RPM + real(8) :: ROP + real(8) :: Torque + real(8) :: PumpPressure + real(8) :: SPM1 + real(8) :: SPM2 + !real(8) :: SPM3 + real(8) :: CasingPressure + real(8) :: PercentFlow + real(8) :: PitGainLose + real(8) :: PitVolume + real(8) :: KillMudVolume + real(8) :: TripTankVolume + real(8) :: MudWeightIn + real(8) :: FillVolume + real(8) :: MudWeightOut + + + contains +end module CDrillWatchVariables \ No newline at end of file diff --git a/CSharp/Equipments/MudPathFinding/CArrangement.f90 b/CSharp/Equipments/MudPathFinding/CArrangement.f90 new file mode 100644 index 0000000..cac2891 --- /dev/null +++ b/CSharp/Equipments/MudPathFinding/CArrangement.f90 @@ -0,0 +1,137 @@ +module CArrangement + implicit none + public + + integer, parameter :: Normal = 0 + integer, parameter :: Relation = 1 + integer, parameter :: Input = 2 + integer, parameter :: Output = 3 + integer, parameter :: InputOutput = 4 + + + type, public :: Arrangement + integer, allocatable :: Adjacent(:) !adjacent valves that is connected to this valve + logical :: Status !valve status ... open/close ... true/false + integer :: ValveType ! Normal/Input/Output/InputOutput + integer :: Number + logical :: IsTraversed + contains + procedure :: Init => Init + procedure :: IsConnectedTo => IsConnectedTo + procedure :: IsSource => IsSource + procedure :: Length => Length + procedure :: AdjacentTo => AdjacentTo + procedure :: RemoveAdjacent => RemoveAdjacent + end type Arrangement + contains + + subroutine Init(this, value) + implicit none + class(Arrangement), intent(inout) :: this + integer, intent(in) :: value + if(allocated(this%Adjacent)) deallocate(this%Adjacent) + this%Status = .false. + this%IsTraversed = .false. + this%ValveType = Normal + this%Number = value + end subroutine + + integer function Length(this) + implicit none + class(Arrangement), intent(in) :: this + if(allocated(this%Adjacent)) then + Length = size(this%Adjacent) + return + end if + Length = 0 + end function + + subroutine AdjacentTo(this, value) + implicit none + class(Arrangement), intent(inout) :: this + integer, intent(in) :: value + integer, allocatable :: tempArr(:) + integer :: i, isize + + if(allocated(this%Adjacent)) then + isize = size(this%Adjacent) + + ! check to see if already AdjacentTo that valve# + do i=1,isize + if(this%Adjacent(i)==value) return + end do + + ! if value is a new entry then add it to the collection + allocate(tempArr(isize+1)) + do i=1,isize + tempArr(i) = this%Adjacent(i) + end do + tempArr(isize+1) = value + deallocate(this%Adjacent) + call move_alloc(tempArr, this%Adjacent) + else + allocate(this%Adjacent(1)) + this%Adjacent(1) = value + end if + end subroutine + + logical function IsConnectedTo(this, value) + implicit none + class(Arrangement), intent(in) :: this + integer, intent(in) :: value + if(.not.allocated(this%Adjacent)) then + IsConnectedTo = .false. + return + endif + IsConnectedTo = any(this%Adjacent == value) + return + end function + + logical function IsSource(this) + implicit none + class(Arrangement), intent(in) :: this + IsSource = this%ValveType > Relation + end function + + + + subroutine RemoveAdjacent(this, value) + implicit none + class(Arrangement), intent(inout) :: this + integer, intent(in) :: value + integer, allocatable :: tempArr(:) + integer :: i, index, isize + logical :: found + + if(.not.allocated(this%Adjacent))return + index = -1 + do i=1, size(this%Adjacent) + if(this%Adjacent(i)==value) then + index = i + exit + end if + end do + + if(index <= 0 .or. index > size(this%Adjacent)) return + + allocate(tempArr(size(this%Adjacent)-1)) + found = .false. + do i=1, size(this%Adjacent) + if(i==index) then + found = .true. + cycle + end if + if(found) then + tempArr(i-1) = this%Adjacent(i) + else + tempArr(i) = this%Adjacent(i) + endif + end do + deallocate(this%Adjacent) + call move_alloc(tempArr, this%Adjacent) + + + end subroutine + + +end module CArrangement \ No newline at end of file diff --git a/CSharp/Equipments/MudPathFinding/CManifolds.f90 b/CSharp/Equipments/MudPathFinding/CManifolds.f90 new file mode 100644 index 0000000..57e0959 --- /dev/null +++ b/CSharp/Equipments/MudPathFinding/CManifolds.f90 @@ -0,0 +1,1389 @@ +module CManifolds + use CStack + use CArrangement + use CPathChangeEvents + use CDrillingConsoleVariables, only: IRSafetyValveLed, IRIBopLed, OpenKellyCockLed, CloseKellyCockLed, OpenSafetyValveLed, CloseSafetyValveLed + implicit none + + public + integer, parameter :: ValveCount = 128 + integer, parameter :: MinSource = 71 + integer, parameter :: MaxSource = 90 + integer, parameter :: MinRelation = 91 + integer, parameter :: MaxRelation = 128 + type(Arrangement) :: Valve(ValveCount) + type(Path), allocatable :: OpenPaths(:) + type(Stack) :: Fringe + logical :: IsRepititveOutput + + logical :: IsSafetyValveInstalled + logical :: IsSafetyValveInstalled_KellyMode + logical :: IsSafetyValveInstalled_TripMode + logical :: IsSafetyValveInstalled_TopDrive + logical :: SafetyValve + logical :: IsIBopInstalled + logical :: IBop + logical :: IsKellyCockInstalled + logical :: KellyCock + logical :: IsTopDriveIBopInstalled + logical :: TopDriveIBop + logical :: IsFloatValveInstalled + logical :: FloatValve + + logical :: IsPathsDirty = .false. + + logical :: IsTraverse = .false. + + contains + + subroutine PathFinding_Setup() + use CSimulationVariables + implicit none + IsTraverse = .false. + call Setup() + !call OnSimulationInitialization%Add(PathFinding_Init) + !call OnSimulationStop%Add(PathFinding_Init) + !call OnPathFindingStep%Add(PathFinding_Step) + !call OnPathFindingOutput%Add(PathFinding_Output) + call OnPathFindingMain%Add(PathFindingMainBody) + end subroutine + + subroutine PathFinding_Init + implicit none + IsTraverse = .false. + call Setup() + end subroutine PathFinding_Init + + subroutine PathFinding_Step + implicit none + end subroutine PathFinding_Step + + subroutine PathFinding_Output + implicit none + end subroutine PathFinding_Output + + subroutine PathFindingMainBody + use CSimulationVariables + implicit none + loop : do + if(IsStopped) call Quit() + call sleepqq(50) + if (IsPathsDirty) then + IsPathsDirty = .false. + call Traverse() + endif + end do loop + end subroutine PathFindingMainBody + + subroutine Traverse() + use CLog5 + implicit none + integer :: i, Duration + integer, dimension(8) :: StartTime,EndTime !TODO: clean up + call DATE_AND_TIME(values=StartTime) !TODO: clean up + + call BeforeTraverse%RunAll() + + + if(allocated(OpenPaths)) deallocate(OpenPaths) + do i=MinSource, MaxSource + if(IsValveOpen(i)) then + call AddRootNode(i) + call AddChildren(Valve(i)) + endif + enddo + + call PostProcess(OpenPaths) + + call AfterTraverse%RunAll() + + IsTraverse = .true. + + !TODO: clean up +#ifdef Log5 + CALL DATE_AND_TIME(values=EndTime) + Duration= EndTime(8) - StartTime(8) + !print*, 'Duration= ', Duration, 'ms' + call Log_5('Duration= ', Duration) + call DisplayOpenPaths() + + call Log_5('==========================================') +#endif + + endsubroutine + + subroutine PostProcess(pathArr) + implicit none + type(Path), allocatable, intent(inout) :: pathArr(:) + integer :: i + + if(.not.allocated(pathArr)) return + + i = 1 + do + call pathArr(i)%Purge(MinRelation, MaxRelation) + + if(pathArr(i)%Length() <= 2) then + call RemovePath(pathArr, i) + else + i = i + 1 + endif + + if(i > size(pathArr)) exit + enddo + + end subroutine + + subroutine AddRootNode(valve) + implicit none + integer, intent(in) :: valve + call Fringe%Push(valve) + end subroutine + + recursive subroutine AddChildren(node) + implicit none + type(Arrangement), intent(inout) :: node + integer :: i,t + + do i=1, Valve(node%Number)%Length() + t = Valve(node%Number)%Adjacent(i) + + if(IsValveOpen(t)) then + + if(Fringe%DoesHave(t)) cycle + + call Fringe%Push(t) + + if(Valve(t)%IsSource()) then + call AddPath(OpenPaths, Fringe%List) + call Fringe%Pop() + cycle + endif + + call AddChildren(Valve(node%Adjacent(i))) + + end if + enddo + call Fringe%Pop() + end subroutine + + logical function IsValveOpen(no) + implicit none + integer, intent(in) :: no + + IsValveOpen = Valve(no)%Status + + end function + + subroutine AddPath(pathArr, p) + implicit none + type(Path), intent(in) :: p + type(Path), allocatable, intent(inout) :: pathArr(:) + type(Path), allocatable :: tempArr(:) + integer :: i, isize + + if(p%IsNull()) return + if(p%Length()<=1) return + + call OnPathOpen%RunAll(p%Valves) + + if(allocated(pathArr)) then + isize = size(pathArr) + + + ! check to see if already have a path same as p + do i=1,isize + if(pathArr(i)%First()==p%First() .and. pathArr(i)%Last()==p%Last()) then + ! if there is then + ! check to see if both have exacly a same length + if(pathArr(i)%Length()==p%Length())then + ! now they are the same so ignore adding this one + return + else + !if they have different lengths then choose the shorter one + if(pathArr(i)%Length()>p%Length())pathArr(i) = p + return + endif + + endif + end do + + + + !TODO: if p last valve is input source then ignore adding it + !TODO: if p start valve is output source then ignore adding it + + + + ! if p is a new entry then add it to the collections of found paths + allocate(tempArr(isize+1)) + do i=1,isize + tempArr(i) = pathArr(i) + end do + tempArr(isize+1) = p + deallocate(pathArr) + call move_alloc(tempArr, pathArr) + else + allocate(pathArr(1)) + pathArr(1) = p + end if + + endsubroutine + + subroutine RemovePath(pathArr, index) + implicit none + integer, intent(in) :: index + type(Path), allocatable, intent(inout) :: pathArr(:) + type(Path), allocatable :: tempArr(:) + integer :: i + logical :: found + + if(index <= 0 .or. index > size(pathArr)) return + if(.not.allocated(pathArr))return + allocate(tempArr(size(pathArr)-1)) + found = .false. + do i=1, size(pathArr) + if(i==index) then + found = .true. + cycle + end if + if(found) then + tempArr(i-1) = pathArr(i) + !call OnPathClose%RunAll(pathArr(i)%Valves) + else + tempArr(i) = pathArr(i) + endif + end do + deallocate(pathArr) + call move_alloc(tempArr, pathArr) + + endsubroutine + + subroutine Setup() + implicit none + integer :: i + + ! initialize all valves + do i = 1, ValveCount + call Valve(i)%init(i) + end do + + ! open source valves + do i = MinSource , MaxSource + Valve(i)%Status = .true. + Valve(i)%ValveType = InputOutput + end do + + do i = MinRelation , MaxRelation + Valve(i)%Status = .true. + Valve(i)%ValveType = Relation + end do + + + + ! make adjustments + call Valve(1)%AdjacentTo(91) + + call Valve(2)%AdjacentTo(92) + call Valve(2)%AdjacentTo(117) + + call Valve(3)%AdjacentTo(93) + call Valve(3)%AdjacentTo(118) + + call Valve(4)%AdjacentTo(94) + + call Valve(5)%AdjacentTo(95) + + call Valve(6)%AdjacentTo(91) + call Valve(6)%AdjacentTo(92) + + call Valve(7)%AdjacentTo(92) + call Valve(7)%AdjacentTo(93) + + call Valve(8)%AdjacentTo(93) + call Valve(8)%AdjacentTo(94) + + call Valve(9)%AdjacentTo(91) + call Valve(9)%AdjacentTo(96) + + call Valve(10)%AdjacentTo(94) + call Valve(10)%AdjacentTo(98) + + call Valve(11)%AdjacentTo(96) + call Valve(11)%AdjacentTo(97) + + call Valve(12)%AdjacentTo(97) + call Valve(12)%AdjacentTo(98) + + call Valve(13)%AdjacentTo(96) + call Valve(13)%AdjacentTo(99) + + call Valve(14)%AdjacentTo(78) + call Valve(14)%AdjacentTo(97) + !call Valve(14)%AdjacentTo(126) + + call Valve(15)%AdjacentTo(98) + call Valve(15)%AdjacentTo(99) + + call Valve(16)%AdjacentTo(121) + !call Valve(16)%AdjacentTo() + + call Valve(17)%AdjacentTo(122) + !call Valve(17)%AdjacentTo() + + call Valve(18)%AdjacentTo(123) + !call Valve(18)%AdjacentTo() + + call Valve(19)%AdjacentTo(101) + call Valve(19)%AdjacentTo(102) + + call Valve(20)%AdjacentTo(100) + + call Valve(21)%AdjacentTo(101) + + call Valve(22)%AdjacentTo(102) + + call Valve(23)%AdjacentTo(71) + + call Valve(24)%AdjacentTo(71) + + call Valve(25)%AdjacentTo(108) + call Valve(25)%AdjacentTo(118) + + call Valve(26)%AdjacentTo(109) + call Valve(26)%AdjacentTo(117) + + call Valve(27)%AdjacentTo(32) + call Valve(27)%AdjacentTo(108) + + call Valve(28)%AdjacentTo(33) + call Valve(28)%AdjacentTo(108) + + call Valve(29)%AdjacentTo(110) + call Valve(29)%AdjacentTo(113) + + call Valve(30)%AdjacentTo(34) + call Valve(30)%AdjacentTo(109) + + call Valve(31)%AdjacentTo(35) + call Valve(31)%AdjacentTo(109) + + call Valve(32)%AdjacentTo(27) + call Valve(32)%AdjacentTo(61) + + call Valve(33)%AdjacentTo(28) + call Valve(33)%AdjacentTo(62) + + call Valve(34)%AdjacentTo(30) + call Valve(34)%AdjacentTo(63) + + call Valve(35)%AdjacentTo(31) + call Valve(35)%AdjacentTo(64) + + call Valve(36)%AdjacentTo(116) + + call Valve(37)%AdjacentTo(78) + + call Valve(38)%AdjacentTo(71) + + call Valve(39)%AdjacentTo(77) + + !call Valve(40)%AdjacentTo(105) + call Valve(40)%AdjacentTo(80) + + call Valve(41)%AdjacentTo(77) + + call Valve(42)%AdjacentTo(71) + + call Valve(43)%AdjacentTo(106) + + call Valve(44)%AdjacentTo(77) + + call Valve(45)%AdjacentTo(71) + + call Valve(46)%AdjacentTo(104) + + call Valve(47)%AdjacentTo(104) + call Valve(47)%AdjacentTo(117) + + call Valve(48)%AdjacentTo(69) + call Valve(48)%AdjacentTo(79) + + call Valve(49)%AdjacentTo(104) + call Valve(49)%AdjacentTo(79) + + !call Valve(50)%AdjacentTo(48) + call Valve(50)%AdjacentTo(51) + !call Valve(50)%AdjacentTo(54) + call Valve(50)%AdjacentTo(104) + + call Valve(51)%AdjacentTo(50) + call Valve(51)%AdjacentTo(52) + + call Valve(52)%AdjacentTo(51) + !call Valve(52)%AdjacentTo(127) + call Valve(52)%AdjacentTo(80) + + !call Valve(53)%AdjacentTo(103) + !call Valve(53)%AdjacentTo(105) + call Valve(53)%AdjacentTo(80) + + !call Valve(54)%AdjacentTo(69) + !call Valve(54)%AdjacentTo(124) + + !call Valve(55)%AdjacentTo(103) + !call Valve(55)%AdjacentTo(124) + + call Valve(56)%AdjacentTo(128) + call Valve(56)%AdjacentTo(127) + + !call Valve(57)%AdjacentTo(14) + !call Valve(57)%AdjacentTo(103) + !call Valve(57)%AdjacentTo(126) + + call Valve(58)%AdjacentTo(78) + + call Valve(59)%AdjacentTo(78) + + call Valve(60)%AdjacentTo(78) + + call Valve(61)%AdjacentTo(32) + call Valve(61)%AdjacentTo(115) + + call Valve(62)%AdjacentTo(33) + call Valve(62)%AdjacentTo(114) + + call Valve(63)%AdjacentTo(112) + call Valve(63)%AdjacentTo(34) + + call Valve(64)%AdjacentTo(35) + call Valve(64)%AdjacentTo(111) + + call Valve(65)%AdjacentTo(120) + + call Valve(66)%AdjacentTo(120) + + call Valve(67)%AdjacentTo(73) + + call Valve(68)%AdjacentTo(125) + call Valve(68)%AdjacentTo(126) + + call Valve(69)%AdjacentTo(48) + call Valve(69)%AdjacentTo(124) + + !call Valve(70)%AdjacentTo() + !call Valve(70)%AdjacentTo() + + call Valve(71)%AdjacentTo(20) + call Valve(71)%AdjacentTo(44) + call Valve(71)%AdjacentTo(59) + + call Valve(72)%AdjacentTo(21) + call Valve(72)%AdjacentTo(23) + + call Valve(73)%AdjacentTo(22) + + call Valve(74)%AdjacentTo(24) + + !call Valve(75)%AdjacentTo() + + !call Valve(76)%AdjacentTo() + + call Valve(77)%AdjacentTo(43) + call Valve(77)%AdjacentTo(58) + + !call Valve(78)%AdjacentTo() + + call Valve(79)%AdjacentTo(48) + call Valve(79)%AdjacentTo(49) + + call Valve(80)%AdjacentTo(52) + call Valve(80)%AdjacentTo(107) + + call Valve(81)%AdjacentTo(53) + + call Valve(82)%AdjacentTo(16) + + call Valve(83)%AdjacentTo(17) + + call Valve(84)%AdjacentTo(18) + + !call Valve(85)%AdjacentTo() + + !call Valve(86)%AdjacentTo() + + !call Valve(87)%AdjacentTo() + + !call Valve(88)%AdjacentTo() + + !!call Valve(89)%AdjacentTo() + + !call Valve(90)%AdjacentTo() + + call Valve(91)%AdjacentTo(6) + call Valve(91)%AdjacentTo(9) + call Valve(91)%AdjacentTo(75) + + call Valve(92)%AdjacentTo(6) + call Valve(92)%AdjacentTo(7) + call Valve(92)%AdjacentTo(2) + + call Valve(93)%AdjacentTo(3) + call Valve(93)%AdjacentTo(7) + call Valve(93)%AdjacentTo(8) + + call Valve(94)%AdjacentTo(8) + call Valve(94)%AdjacentTo(10) + call Valve(94)%AdjacentTo(95) + + call Valve(95)%AdjacentTo(76) + call Valve(95)%AdjacentTo(94) + + call Valve(96)%AdjacentTo(9) + call Valve(96)%AdjacentTo(11) + call Valve(96)%AdjacentTo(13) + + call Valve(97)%AdjacentTo(11) + call Valve(97)%AdjacentTo(12) + call Valve(97)%AdjacentTo(14) + + call Valve(98)%AdjacentTo(10) + call Valve(98)%AdjacentTo(12) + call Valve(98)%AdjacentTo(15) + + call Valve(99)%AdjacentTo(13) + call Valve(99)%AdjacentTo(15) + call Valve(99)%AdjacentTo(125) + + !call Valve(100)%AdjacentTo(16) + call Valve(100)%AdjacentTo(82) + call Valve(100)%AdjacentTo(101) + + !call Valve(101)%AdjacentTo(17) + call Valve(101)%AdjacentTo(19) + call Valve(101)%AdjacentTo(83) + call Valve(101)%AdjacentTo(100) + + !call Valve(102)%AdjacentTo(18) + call Valve(102)%AdjacentTo(19) + call Valve(102)%AdjacentTo(84) + + !call Valve(103)%AdjacentTo(53) + !call Valve(103)%AdjacentTo(56) + call Valve(103)%AdjacentTo(124) + !call Valve(103)%AdjacentTo(56) + !call Valve(103)%AdjacentTo(78) + + call Valve(104)%AdjacentTo(46) + call Valve(104)%AdjacentTo(47) + call Valve(104)%AdjacentTo(49) + call Valve(104)%AdjacentTo(50) + + !call Valve(105)%AdjacentTo(53) + !call Valve(105)%AdjacentTo(107) + !call Valve(105)%AdjacentTo(127) + + call Valve(106)%AdjacentTo(40) + call Valve(106)%AdjacentTo(45) + + + call Valve(107)%AdjacentTo(41) + !call Valve(107)%AdjacentTo(105) + call Valve(107)%AdjacentTo(119) + !call Valve(107)%AdjacentTo(42) + + call Valve(108)%AdjacentTo(25) + call Valve(108)%AdjacentTo(27) + call Valve(108)%AdjacentTo(28) + call Valve(108)%AdjacentTo(110) + + call Valve(109)%AdjacentTo(26) + call Valve(109)%AdjacentTo(30) + call Valve(109)%AdjacentTo(31) + call Valve(109)%AdjacentTo(110) + + call Valve(110)%AdjacentTo(29) + call Valve(110)%AdjacentTo(85) + call Valve(110)%AdjacentTo(108) + call Valve(110)%AdjacentTo(109) + + call Valve(111)%AdjacentTo(37) + call Valve(111)%AdjacentTo(64) + call Valve(111)%AdjacentTo(112) + + call Valve(112)%AdjacentTo(63) + call Valve(112)%AdjacentTo(111) + call Valve(112)%AdjacentTo(113) + + call Valve(113)%AdjacentTo(29) + call Valve(113)%AdjacentTo(112) + call Valve(113)%AdjacentTo(114) + + call Valve(114)%AdjacentTo(62) + call Valve(114)%AdjacentTo(113) + call Valve(114)%AdjacentTo(115) + + call Valve(115)%AdjacentTo(36) + call Valve(115)%AdjacentTo(61) + call Valve(115)%AdjacentTo(114) + + call Valve(116)%AdjacentTo(38) + call Valve(116)%AdjacentTo(39) + + call Valve(117)%AdjacentTo(2) + call Valve(117)%AdjacentTo(26) + call Valve(117)%AdjacentTo(47) + + call Valve(118)%AdjacentTo(3) + call Valve(118)%AdjacentTo(25) + call Valve(118)%AdjacentTo(46) + + call Valve(119)%AdjacentTo(42) + call Valve(119)%AdjacentTo(60) + call Valve(119)%AdjacentTo(107) + + call Valve(120)%AdjacentTo(71) + + !call Valve(121)%AdjacentTo(16) + call Valve(121)%AdjacentTo(1) + call Valve(121)%AdjacentTo(65) + + !call Valve(122)%AdjacentTo(17) + call Valve(122)%AdjacentTo(4) + call Valve(122)%AdjacentTo(66) + + !call Valve(123)%AdjacentTo(18) + call Valve(123)%AdjacentTo(5) + call Valve(123)%AdjacentTo(67) + + !call Valve(124)%AdjacentTo(54) + !call Valve(124)%AdjacentTo(55) + call Valve(124)%AdjacentTo(69) + call Valve(124)%AdjacentTo(103) + + call Valve(125)%AdjacentTo(68) + call Valve(125)%AdjacentTo(99) + ! call Valve(125)%AdjacentTo(126) + + call Valve(126)%AdjacentTo(128) + call Valve(126)%AdjacentTo(68) + !call Valve(126)%AdjacentTo(125) + + call Valve(127)%AdjacentTo(56) + call Valve(127)%AdjacentTo(78) + !call Valve(127)%AdjacentTo(105) + + call Valve(128)%AdjacentTo(56) + call Valve(128)%AdjacentTo(126) + + + ! initialization + call ChangeValve(60, .true.) + call RemoveIBop() + call ToggleFillupHead(.false.) + call ToggleMudBox(.false.) + call RemoveTopDriveIBop() + call InstallSafetyValve_KellyMode() + call KellyDisconnected() + end subroutine + + + + subroutine KellyConnected() + !use CLog3 + implicit none + + call Valve(127)%RemoveAdjacent(78) + + call Valve(127)%AdjacentTo(103) + call Valve(103)%AdjacentTo(127) + +#ifdef deb + print*, 'KellyConnected()' + !call Log_3( 'KellyConnected()') +#endif + IsPathsDirty = .true. + end subroutine + + subroutine KellyDisconnected() + !use CLog3 + implicit none + + call Valve(127)%RemoveAdjacent(103) + call Valve(103)%RemoveAdjacent(127) + + call Valve(127)%AdjacentTo(78) + +#ifdef deb + print*, 'KellyDisconnected()' + !call Log_3( 'KellyDisconnected()') +#endif + + IsPathsDirty = .true. + + end subroutine + + + + + + + + + + subroutine InstallSafetyValve_KellyMode() + implicit none + IsSafetyValveInstalled_KellyMode = .true. + + call RemoveTopDriveIBop() + + ! Remove Safey Valve (54) + call Valve(124)%RemoveAdjacent(54) + call Valve(54)%RemoveAdjacent(124) + + call Valve(69)%RemoveAdjacent(54) + call Valve(54)%RemoveAdjacent(69) + + ! Remove 126-103 cnn + call Valve(128)%RemoveAdjacent(127) + call Valve(127)%RemoveAdjacent(128) + + ! now make cnn + call Valve(124)%AdjacentTo(69) + call Valve(69)%AdjacentTo(124) + + call Valve(128)%AdjacentTo(56) + + call Valve(56)%AdjacentTo(128) + call Valve(56)%AdjacentTo(127) + + call Valve(127)%AdjacentTo(56) + +#ifdef deb + print*, 'InstallSafetyValve_KellyMode()' +#endif + + IRSafetyValveLed = 1 + call OpenSafetyValve_KellyMode() + end subroutine + + subroutine RemoveSafetyValve_KellyMode() + implicit none + IsSafetyValveInstalled_KellyMode = .false. + + call Valve(128)%RemoveAdjacent(56) + call Valve(56)%RemoveAdjacent(128) + + call Valve(127)%RemoveAdjacent(56) + call Valve(56)%RemoveAdjacent(127) + + call Valve(127)%AdjacentTo(128) + call Valve(128)%AdjacentTo(127) + + IRSafetyValveLed = 0 + call CloseSafetyValve_KellyMode() + OpenSafetyValveLed = 0 + CloseSafetyValveLed = 0 + +#ifdef deb + print*, 'RemoveSafetyValve_KellyMode()' +#endif + + end subroutine + + subroutine OpenSafetyValve_KellyMode() + implicit none + if(.not.IsSafetyValveInstalled_KellyMode) return + OpenSafetyValveLed = 1 + CloseSafetyValveLed = 0 + SafetyValve = .true. + call ChangeValve(56, SafetyValve) + +#ifdef deb + print*, 'OpenSafetyValve_KellyMode()' +#endif + + end subroutine + + subroutine CloseSafetyValve_KellyMode() + implicit none + if(.not.IsSafetyValveInstalled_KellyMode) return + CloseSafetyValveLed = 1 + OpenSafetyValveLed = 0 + SafetyValve = .false. + call ChangeValve(56, SafetyValve) + +#ifdef deb + print*, 'CloseSafetyValve_KellyMode()' +#endif + + end subroutine + + + + + + + + + + + subroutine InstallSafetyValve_TripMode() + implicit none + IsSafetyValveInstalled_TripMode = .true. + + call Valve(128)%RemoveAdjacent(56) + call Valve(56)%RemoveAdjacent(128) + + call Valve(127)%RemoveAdjacent(56) + call Valve(56)%RemoveAdjacent(127) + + call Valve(69)%RemoveAdjacent(124) + call Valve(124)%RemoveAdjacent(69) + + + call Valve(127)%AdjacentTo(128) + call Valve(128)%AdjacentTo(127) + + call Valve(124)%AdjacentTo(54) + call Valve(54)%AdjacentTo(124) + + call Valve(54)%AdjacentTo(69) + call Valve(69)%AdjacentTo(54) + + IRSafetyValveLed = 1 + call OpenSafetyValve_TripMode() + +#ifdef deb + print*, 'InstallSafetyValve_TripMode()' +#endif + + end subroutine + + subroutine RemoveSafetyValve_TripMode() + implicit none + IsSafetyValveInstalled_TripMode = .false. + + call Valve(124)%RemoveAdjacent(54) + call Valve(54)%RemoveAdjacent(124) + + call Valve(54)%RemoveAdjacent(69) + call Valve(69)%RemoveAdjacent(54) + + call Valve(124)%AdjacentTo(69) + call Valve(69)%AdjacentTo(124) + + IRSafetyValveLed = 0 + call CloseSafetyValve_TripMode() + OpenSafetyValveLed = 0 + CloseSafetyValveLed = 0 + +#ifdef deb + print*, 'RemoveSafetyValve_TripMode()' +#endif + + end subroutine + + subroutine OpenSafetyValve_TripMode() + implicit none + if(.not.IsSafetyValveInstalled_TripMode) return + OpenSafetyValveLed = 1 + CloseSafetyValveLed = 0 + SafetyValve = .true. + call ChangeValve(54, SafetyValve) + +#ifdef deb + print*, 'OpenSafetyValve_TripMode()' +#endif + + end subroutine + + subroutine CloseSafetyValve_TripMode() + implicit none + if(.not.IsSafetyValveInstalled_TripMode) return + CloseSafetyValveLed = 1 + OpenSafetyValveLed = 0 + SafetyValve = .false. + call ChangeValve(54, SafetyValve) + +#ifdef deb + print*, 'CloseSafetyValve_TripMode()' +#endif + + end subroutine + + + + + + + + + subroutine InstallSafetyValve_TopDrive() + implicit none + IsSafetyValveInstalled_TopDrive = .true. + + call Valve(128)%RemoveAdjacent(56) + call Valve(56)%RemoveAdjacent(128) + + call Valve(127)%RemoveAdjacent(56) + call Valve(56)%RemoveAdjacent(127) + + call Valve(69)%RemoveAdjacent(124) + call Valve(124)%RemoveAdjacent(69) + + call Valve(124)%AdjacentTo(54) + call Valve(54)%AdjacentTo(124) + + call Valve(54)%AdjacentTo(69) + call Valve(69)%AdjacentTo(54) + + IRSafetyValveLed = 1 + call OpenSafetyValve_TopDrive() + +#ifdef deb + print*, 'InstallSafetyValve_TopDrive()' +#endif + + end subroutine + + subroutine RemoveSafetyValve_TopDrive() + implicit none + IsSafetyValveInstalled_TopDrive = .false. + + call Valve(124)%RemoveAdjacent(54) + call Valve(54)%RemoveAdjacent(124) + + call Valve(54)%RemoveAdjacent(69) + call Valve(69)%RemoveAdjacent(54) + + call Valve(124)%AdjacentTo(69) + call Valve(69)%AdjacentTo(124) + + IRSafetyValveLed = 0 + call CloseSafetyValve_TopDrive() + OpenSafetyValveLed = 0 + CloseSafetyValveLed = 0 + +#ifdef deb + print*, 'RemoveSafetyValve_TopDrive()' +#endif + + end subroutine + + subroutine OpenSafetyValve_TopDrive() + implicit none + if(.not.IsSafetyValveInstalled_TopDrive) return + OpenSafetyValveLed = 1 + CloseSafetyValveLed = 0 + SafetyValve = .true. + +#ifdef deb + print*, 'OpenSafetyValve_TopDrive()' +#endif + + call ChangeValve(54, SafetyValve) + end subroutine + + subroutine CloseSafetyValve_TopDrive() + implicit none + if(.not.IsSafetyValveInstalled_TopDrive) return + CloseSafetyValveLed = 1 + OpenSafetyValveLed = 0 + SafetyValve = .false. + +#ifdef deb + print*, 'CloseSafetyValve_TopDrive()' +#endif + + call ChangeValve(54, SafetyValve) + end subroutine + + + + + + + + + + subroutine InstallIBop() + implicit none + IsIBopInstalled = .true. + + call Valve(103)%RemoveAdjacent(124) + call Valve(124)%RemoveAdjacent(103) + + call Valve(55)%AdjacentTo(103) + call Valve(55)%AdjacentTo(124) + + call Valve(103)%AdjacentTo(55) + call Valve(124)%AdjacentTo(55) + +#ifdef deb + print*, 'InstallIBop()' +#endif + + IRIBopLed = 1 + call OpenIBop() + end subroutine + + subroutine RemoveIBop() + implicit none + IsIBopInstalled = .false. + + call Valve(55)%RemoveAdjacent(103) + call Valve(55)%RemoveAdjacent(124) + + call Valve(103)%RemoveAdjacent(55) + call Valve(124)%RemoveAdjacent(55) + + call Valve(103)%AdjacentTo(124) + call Valve(124)%AdjacentTo(103) + +#ifdef deb + print*, 'RemoveIBop()' +#endif + + IRIBopLed = 0 + IBop = .false. + call ChangeValve(55, IBop) + end subroutine + + subroutine OpenIBop() + implicit none + if(.not.IsIBopInstalled) return + IBop = .true. + +#ifdef deb + print*, 'OpenIBop()' +#endif + + call ChangeValve(55, IBop) + end subroutine + + subroutine CloseIBop() + implicit none + if(.not.IsIBopInstalled) return + IBop = .false. + +#ifdef deb + print*, 'CloseIBop()' +#endif + + call ChangeValve(55, IBop) + end subroutine + + + + + + + subroutine InstallKellyCock() + implicit none + IsKellyCockInstalled = .true. + + call Valve(125)%RemoveAdjacent(126) + call Valve(126)%RemoveAdjacent(125) + + call Valve(125)%AdjacentTo(68) + + call Valve(68)%AdjacentTo(125) + call Valve(68)%AdjacentTo(126) + + call Valve(126)%AdjacentTo(68) + +#ifdef deb + print*, 'InstallKellyCock()' +#endif + + call OpenKellyCock() + end subroutine + + subroutine RemoveKellyCock() + implicit none + IsKellyCockInstalled = .false. + + call Valve(125)%RemoveAdjacent(68) + call Valve(126)%RemoveAdjacent(68) + + call Valve(68)%RemoveAdjacent(125) + call Valve(68)%RemoveAdjacent(126) + + call Valve(125)%AdjacentTo(126) + call Valve(126)%AdjacentTo(125) + + KellyCock = .false. + call ChangeValve(68, KellyCock) + CloseKellyCockLed = 0 + OpenKellyCockLed = 0 + +#ifdef deb + print*, 'RemoveKellyCock()' +#endif + + end subroutine + + subroutine OpenKellyCock() + implicit none + if(.not.IsKellyCockInstalled) return + OpenKellyCockLed = 1 + CloseKellyCockLed = 0 + KellyCock = .true. + +#ifdef deb + print*, 'OpenKellyCock()' +#endif + + call ChangeValve(68, KellyCock) + end subroutine + + subroutine CloseKellyCock() + implicit none + if(.not.IsKellyCockInstalled) return + CloseKellyCockLed = 1 + OpenKellyCockLed = 0 + KellyCock = .false. + +#ifdef deb + print*, 'CloseKellyCock()' +#endif + + call ChangeValve(68, KellyCock) + end subroutine + + + + + + + + + subroutine InstallTopDriveIBop() + implicit none + IsTopDriveIBopInstalled = .true. + + call Valve(126)%RemoveAdjacent(128) + call Valve(128)%RemoveAdjacent(126) + + + call Valve(126)%AdjacentTo(70) + call Valve(70)%AdjacentTo(126) + + call Valve(128)%AdjacentTo(70) + call Valve(70)%AdjacentTo(128) + +#ifdef deb + print*, 'InstallTopDriveIBop()' +#endif + call OpenTopDriveIBop() + end subroutine + + subroutine RemoveTopDriveIBop() + implicit none + IsTopDriveIBopInstalled = .false. + + call Valve(126)%RemoveAdjacent(70) + call Valve(70)%RemoveAdjacent(126) + + call Valve(128)%RemoveAdjacent(70) + call Valve(70)%RemoveAdjacent(128) + + call Valve(126)%AdjacentTo(128) + call Valve(128)%AdjacentTo(126) + +#ifdef deb + print*, 'RemoveTopDriveIBop()' +#endif + TopDriveIBop = .false. + call ChangeValve(70, TopDriveIBop) + end subroutine + + subroutine OpenTopDriveIBop() + implicit none + if(.not.IsTopDriveIBopInstalled) return + TopDriveIBop = .true. + call ChangeValve(70, TopDriveIBop) +#ifdef deb + print*, 'OpenTopDriveIBop()' +#endif + end subroutine + + subroutine CloseTopDriveIBop() + implicit none + if(.not.IsTopDriveIBopInstalled) return + TopDriveIBop = .false. + call ChangeValve(70, TopDriveIBop) +#ifdef deb + print*, 'CloseTopDriveIBop()' +#endif + end subroutine + + + + + + + + + + subroutine InstallFloatValve() + implicit none + IsFloatValveInstalled = .true. + + call Valve(69)%RemoveAdjacent(79) + call Valve(79)%RemoveAdjacent(69) + + call Valve(48)%AdjacentTo(69) + call Valve(48)%AdjacentTo(79) + + call Valve(69)%AdjacentTo(48) + call Valve(79)%AdjacentTo(48) +#ifdef deb + print*, 'InstallFloatValve()' +#endif + call OpenFloatValve() + end subroutine + + subroutine RemoveFloatValve() + implicit none + IsFloatValveInstalled = .false. + + call Valve(48)%RemoveAdjacent(69) + call Valve(48)%RemoveAdjacent(79) + + call Valve(69)%RemoveAdjacent(48) + call Valve(79)%RemoveAdjacent(48) + + call Valve(69)%AdjacentTo(79) + call Valve(79)%AdjacentTo(69) +#ifdef deb + print*, 'RemoveFloatValve()' +#endif + FloatValve = .false. + call ChangeValve(48, FloatValve) + end subroutine + + subroutine OpenFloatValve() + implicit none + if(.not.IsFloatValveInstalled) return + FloatValve = .true. +#ifdef deb + print*, 'OpenFloatValve()' +#endif + call ChangeValve(48, FloatValve) + end subroutine + + subroutine CloseFloatValve() + implicit none + if(.not.IsFloatValveInstalled) return + FloatValve = .false. +#ifdef deb + print*, 'CloseFloatValve()' +#endif + call ChangeValve(48, FloatValve) + end subroutine + + + + + + + + subroutine ToggleFillupHead(v) + implicit none + logical, intent(in) :: v + if(v) then + call Valve(14)%RemoveAdjacent(78) + + call Valve(14)%AdjacentTo(57) + call Valve(57)%AdjacentTo(14) + call Valve(57)%AdjacentTo(103) + call Valve(103)%AdjacentTo(57) + + else + call Valve(14)%RemoveAdjacent(57) + call Valve(57)%RemoveAdjacent(14) + call Valve(57)%RemoveAdjacent(103) + call Valve(103)%RemoveAdjacent(57) + + call Valve(14)%AdjacentTo(78) + endif + IsPathsDirty = .true. + call ChangeValve(57, .true.) + end subroutine + + subroutine ToggleMudBox(v) + implicit none + logical, intent(in) :: v + call ChangeValve(53, v) + end subroutine + + + + + + + + + + subroutine ToggleMiddleRams(v) + implicit none + logical, intent(in) :: v + Valve(50)%Status = v + call ChangeValve(69, v) + end subroutine + + + + + + + + + subroutine ChangeValve(i, state) + implicit none + integer, intent(in) :: i + logical, intent(in) :: state + + if(Valve(i)%Status==state) return + Valve(i)%Status = state + if(i == 41 .or. i == 42) then + if(Valve(41)%Status == .false. .and. Valve(42)%Status == .false.) then + Valve(60)%Status = .true. + else + Valve(60)%Status = .false. + endif + endif +#ifdef deb + print*, 'Valve(', i, ') = ', state +#endif + !call Traverse() + IsPathsDirty = .true. + end subroutine + + + + + + subroutine DisplayOpenPaths() + implicit none + integer :: i + if(allocated(OpenPaths)) then + do i = 1, size(OpenPaths) + call OpenPaths(i)%Display() + end do + end if + end subroutine + + subroutine DisplayOpenPathsWrite() + implicit none + integer :: i + if(allocated(OpenPaths)) then + do i = 1, size(OpenPaths) + call OpenPaths(i)%DisplayWrite() + end do + end if + end subroutine + +end module CManifolds \ No newline at end of file diff --git a/CSharp/Equipments/MudPathFinding/CPath.f90 b/CSharp/Equipments/MudPathFinding/CPath.f90 new file mode 100644 index 0000000..a0f99b3 --- /dev/null +++ b/CSharp/Equipments/MudPathFinding/CPath.f90 @@ -0,0 +1,231 @@ +module CPath + use CLog5 + implicit none + public + + type, public :: Path + integer, allocatable :: Valves(:) + logical :: IsClosed + contains + procedure :: Display => Display + procedure :: DisplayWrite => DisplayWrite + procedure :: First => First + procedure :: Last => Last + procedure :: Length => Length + procedure :: Get => Get + procedure :: Add => Add + procedure :: Remove => Remove + procedure :: Purge => Purge + procedure :: Copy => Copy + procedure :: MakeNull => MakeNull + procedure :: IsNull => IsNull + procedure :: Equal => Equal + procedure :: Find => Find + end type Path + + contains + + + subroutine DisplayWrite(this) + implicit none + class(Path), intent(in) :: this + character(len=512) :: temp + integer :: i + if(allocated(this%valves)) then + write(temp, '(a1,i0,a3,i0,a4,9999(g0))') '(', this%First(), '<=>', this%Last(), ') : ', (this%Valves(i), ", ",i=1,size(this%Valves)) + write(*,*) temp + end if + end subroutine + + subroutine Display(this) + implicit none + class(Path), intent(in) :: this + character(len=512) :: temp + integer :: i + if(allocated(this%valves)) then + write(temp, '(a1,i0,a3,i0,a4,9999(g0))') '(', this%First(), '<=>', this%Last(), ') : ', (this%Valves(i), ", ",i=1,size(this%Valves)) + call Log_5(temp) + end if + end subroutine + + integer function First(this) + implicit none + class(Path), intent(in) :: this + if(allocated(this%Valves) .and. size(this%Valves) > 0) then + First = this%Valves(1) + return + end if + First = 0 + end function + + integer function Last(this) + implicit none + class(Path), intent(in) :: this + if(allocated(this%Valves) .and. size(this%Valves) > 0) then + Last = this%Valves(size(this%Valves)) + return + end if + Last = 0 + end function + + integer function Length(this) + implicit none + class(Path), intent(in) :: this + if(allocated(this%Valves)) then + Length = size(this%Valves) + return + end if + Length = 0 + end function + + integer function Get(this, index) + implicit none + class(Path), intent(in) :: this + integer, intent(in) :: index + if(allocated(this%Valves)) then + + if(index < 1 .or. index > size(this%Valves)) then + Get = -1 + return + endif + + Get = this%Valves(index) + return + end if + get = -1 + end function + + subroutine Add(this, value) + implicit none + class(Path), intent(inout) :: this + integer, allocatable :: tempArr(:) + integer, intent(in) :: value + integer :: i, isize + + if(allocated(this%Valves)) then + isize = size(this%Valves) + allocate(tempArr(isize+1)) + do i=1,isize + tempArr(i) = this%Valves(i) + end do + tempArr(isize+1) = value + deallocate(this%Valves) + call move_alloc(tempArr, this%Valves) + else + allocate(this%Valves(1)) + this%Valves(1) = value + end if + + end subroutine + + subroutine Remove(this, index) + implicit none + class(Path), intent(inout) :: this + integer, intent(in) :: index + integer, allocatable :: tempArr(:) + integer :: i + logical :: found + + if(index <= 0 .or. index > size(this%Valves)) return + if(.not.allocated(this%Valves))return + allocate(tempArr(size(this%Valves)-1)) + found = .false. + do i=1, size(this%Valves) + if(i==index) then + found = .true. + cycle + end if + if(found) then + tempArr(i-1) = this%Valves(i) + else + tempArr(i) = this%Valves(i) + endif + end do + deallocate(this%valves) + call move_alloc(tempArr, this%valves) + end subroutine + + + subroutine Purge(this, min, max) + implicit none + class(Path), intent(inout) :: this + integer, intent(in) :: min + integer, intent(in) :: max + integer :: i + + i = 1 + do + ! + if(this%Valves(i) >= min .and. this%Valves(i) <= max) then + call this%Remove(i) + else + i = i + 1 + endif + + if(i > this%Length()) exit + enddo + + end subroutine + + + subroutine Copy(this, from) + implicit none + class(Path), intent(inout) :: this + class(Path), intent(in) :: from + if(allocated(from%Valves)) then + if(allocated(this%Valves)) deallocate(this%Valves) + allocate(this%Valves(size(from%Valves))) + this%Valves(:) = from%Valves(:) + end if + end subroutine + + subroutine MakeNull(this) + implicit none + class(Path), intent(inout) :: this + if(allocated(this%Valves)) deallocate(this%Valves) + end subroutine + + logical function IsNull(this) + implicit none + class(Path), intent(in) :: this + IsNull = .not.allocated(this%Valves) + return + end function + + logical function Equal(this, otherPath) + implicit none + class(Path), intent(inout) :: this + class(Path), intent(in) :: otherPath + integer :: i, sizeThis, sizeOtherPath + + sizeThis = size(this%Valves) + sizeOtherPath = size(otherPath%Valves) + + if(sizeThis /= sizeOtherPath) then + Equal = .false. + return + end if + + do i = 1, sizeThis + if(this%Valves(i) /= otherPath%Valves(i)) then + Equal = .false. + return + end if + end do + + Equal = .true. + return + end function + + logical function Find(this, value) + implicit none + class(Path), intent(in) :: this + integer, intent(in) :: value + if(allocated(this%Valves)) then + Find = any(this%Valves == value) + return + end if + Find = .false. + end function + +end module CPath \ No newline at end of file diff --git a/CSharp/Equipments/MudPathFinding/CPathChangeEvents.f90 b/CSharp/Equipments/MudPathFinding/CPathChangeEvents.f90 new file mode 100644 index 0000000..819209f --- /dev/null +++ b/CSharp/Equipments/MudPathFinding/CPathChangeEvents.f90 @@ -0,0 +1,12 @@ +module CPathChangeEvents + use CIntegerArrayEventHandlerCollection + use CVoidEventHandlerCollection + implicit none + public + + type(VoidEventHandlerCollection) :: BeforeTraverse + type(VoidEventHandlerCollection) :: AfterTraverse + type(IntegerArrayEventHandlerCollection) :: OnPathOpen + + contains +end module CPathChangeEvents \ No newline at end of file diff --git a/CSharp/Equipments/MudPathFinding/CStack.f90 b/CSharp/Equipments/MudPathFinding/CStack.f90 new file mode 100644 index 0000000..7974679 --- /dev/null +++ b/CSharp/Equipments/MudPathFinding/CStack.f90 @@ -0,0 +1,42 @@ +module CStack + use CPath + implicit none + public + + type, public :: Stack + type(Path) :: List + contains + procedure :: Clear => Clear + procedure :: Push => Push + procedure :: Pop => Pop + procedure :: DoesHave => DoesHave + end type Stack + contains + + subroutine Clear(this) + implicit none + class(Stack), intent(inout) :: this + call this%List%MakeNull() + end subroutine + + subroutine Push(this, value) + implicit none + class(Stack), intent(inout) :: this + integer, intent(in) :: value + call this%List%Add(value) + end subroutine + + subroutine Pop(this) + implicit none + class(Stack), intent(inout) :: this + call this%List%Remove(this%List%Length()) + end subroutine + + logical function DoesHave(this, value) + implicit none + class(Stack), intent(in) :: this + integer, intent(in) :: value + DoesHave = this%List%Find(value) + end function + +end module CStack \ No newline at end of file diff --git a/CSharp/Equipments/Tanks/CTanks.f90 b/CSharp/Equipments/Tanks/CTanks.f90 new file mode 100644 index 0000000..551b9ad --- /dev/null +++ b/CSharp/Equipments/Tanks/CTanks.f90 @@ -0,0 +1,252 @@ + + module CTanks + use CTanksVariables + use CSimulationVariables + use CManifolds + implicit none + public + contains + + ! Input routines + subroutine SetWaterRate(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetWaterRate + !DEC$ ATTRIBUTES ALIAS: 'SetWaterRate' :: SetWaterRate + implicit none + real*8, intent(in) :: v + WaterRate = v +#ifdef deb + print*, 'WaterRate=', WaterRate +#endif + end subroutine + + subroutine SetCementTankVolume(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCementTankVolume + !DEC$ ATTRIBUTES ALIAS: 'SetCementTankVolume' :: SetCementTankVolume + implicit none + real*8, intent(in) :: v + CementTankVolume = v +#ifdef deb + print*, 'CementTankVolume=', CementTankVolume +#endif + end subroutine + + subroutine SetCementTankDensity(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCementTankDensity + !DEC$ ATTRIBUTES ALIAS: 'SetCementTankDensity' :: SetCementTankDensity + implicit none + real*8, intent(in) :: v + CementTankDensity = v +#ifdef deb + print*, 'CementTankDensity=', CementTankDensity +#endif + end subroutine + + subroutine SetTripTankVolume(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTripTankVolume + !DEC$ ATTRIBUTES ALIAS: 'SetTripTankVolume' :: SetTripTankVolume + implicit none + real*8, intent(in) :: v + TripTankVolume = v +#ifdef deb + print*, 'TripTankVolume=', TripTankVolume +#endif + end subroutine + + subroutine SetTripTankDensity(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTripTankDensity + !DEC$ ATTRIBUTES ALIAS: 'SetTripTankDensity' :: SetTripTankDensity + implicit none + real*8, intent(in) :: v + TripTankDensity = v +#ifdef deb + print*, 'TripTankDensity=', TripTankDensity +#endif + end subroutine + +! subroutine SetManualPumpPowerT(v) +! !DEC$ ATTRIBUTES DLLEXPORT :: SetManualPumpPowerT +! !DEC$ ATTRIBUTES ALIAS: 'SetManualPumpPowerT' :: SetManualPumpPowerT +! implicit none +! logical, intent(in) :: v +! ManualPumpPower = v +! call ChangeValve(43, v) +!#ifdef deb +! print*, 'ManualPumpPowerT=', ManualPumpPower +!#endif +! end subroutine + + subroutine SetValve1T(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetValve1T + !DEC$ ATTRIBUTES ALIAS: 'SetValve1T' :: SetValve1T + implicit none + logical, intent(in) :: v + Valve1 = v + call ChangeValve(40, v) +#ifdef deb + print*, 'Valve1T=', Valve1 +#endif + end subroutine + + subroutine SetValve2T(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetValve2T + !DEC$ ATTRIBUTES ALIAS: 'SetValve2T' :: SetValve2T + implicit none + logical, intent(in) :: v + Valve2 = v + call ChangeValve(41, v) +#ifdef deb + print*, 'Valve2T=', Valve2 +#endif + end subroutine + + subroutine SetValve3T(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetValve3T + !DEC$ ATTRIBUTES ALIAS: 'SetValve3T' :: SetValve3T + implicit none + logical, intent(in) :: v + Valve3 = v + call ChangeValve(45, v) +#ifdef deb + print*, 'Valve3T=', Valve3 +#endif + end subroutine + + subroutine SetValve4T(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetValve4T + !DEC$ ATTRIBUTES ALIAS: 'SetValve4T' :: SetValve4T + implicit none + logical, intent(in) :: v + Valve4 = v + call ChangeValve(58, v) +#ifdef deb + print*, 'Valve4T=', Valve4 +#endif + end subroutine + + subroutine SetValve5T(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetValve5T + !DEC$ ATTRIBUTES ALIAS: 'SetValve5T' :: SetValve5T + implicit none + logical, intent(in) :: v + Valve5 = v + call ChangeValve(42, v) +#ifdef deb + print*, 'Valve5T=', Valve5 +#endif + end subroutine + + + + + + + + + + + + + + + subroutine SetValve6(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetValve6 + !DEC$ ATTRIBUTES ALIAS: 'SetValve6' :: SetValve6 + implicit none + logical, intent(in) :: v + Valve6 = v + call ChangeValve(38, v) + !WRITE (*,*) ' valve 38 ', v +#ifdef deb + print*, 'Valve6=', Valve6 +#endif + end subroutine + + subroutine SetValve7(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetValve7 + !DEC$ ATTRIBUTES ALIAS: 'SetValve7' :: SetValve7 + implicit none + logical, intent(in) :: v + Valve7 = v + call ChangeValve(59, v) +#ifdef deb + print*, 'Valve7=', Valve7 +#endif + end subroutine + + subroutine SetValve8(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetValve8 + !DEC$ ATTRIBUTES ALIAS: 'SetValve8' :: SetValve8 + implicit none + logical, intent(in) :: v + Valve8 = v + call ChangeValve(39, v) +#ifdef deb + print*, 'Valve8=', Valve8 +#endif + end subroutine + + subroutine SetValve9(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetValve9 + !DEC$ ATTRIBUTES ALIAS: 'SetValve9' :: SetValve9 + implicit none + logical, intent(in) :: v + Valve9 = v + call ChangeValve(36, v) + !WRITE (*,*) ' valve 36 ', v +#ifdef deb + print*, 'Valve9=', Valve9 +#endif + end subroutine + + subroutine SetValve10(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetValve10 + !DEC$ ATTRIBUTES ALIAS: 'SetValve10' :: SetValve10 + implicit none + logical, intent(in) :: v + Valve10 = v + call ChangeValve(37, v) +#ifdef deb + print*, 'Valve10=', Valve10 +#endif + end subroutine + + subroutine SetValve11(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetValve11 + !DEC$ ATTRIBUTES ALIAS: 'SetValve11' :: SetValve11 + implicit none + logical, intent(in) :: v + Valve11 = v + call ChangeValve(44, v) +#ifdef deb + print*, 'Valve11=', Valve11 +#endif + end subroutine + + + ! Output routines + + real(8) function GetTripTankVolumeT() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTripTankVolumeT + !DEC$ ATTRIBUTES ALIAS: 'GetTripTankVolumeT' :: GetTripTankVolumeT + implicit none + GetTripTankVolumeT = TripTankVolume + !GetTripTankVolumeT = 50.0 + SimulationTime + end function + + real(8) function GetTripTankDensity() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTripTankDensity + !DEC$ ATTRIBUTES ALIAS: 'GetTripTankDensity' :: GetTripTankDensity + implicit none + GetTripTankDensity = TripTankDensity + !GetTripTankDensity = 13.0 + SimulationTime + end function + + logical function GetManualPumpPowerT() + !DEC$ ATTRIBUTES DLLEXPORT :: GetManualPumpPowerT + !DEC$ ATTRIBUTES ALIAS: 'GetManualPumpPowerT' :: GetManualPumpPowerT + implicit none + GetManualPumpPowerT = ManualPumpPower + !GetManualPumpPowerT = .true. + end function + +end module CTanks \ No newline at end of file diff --git a/CSharp/Equipments/Tanks/CTanksVariables.f90 b/CSharp/Equipments/Tanks/CTanksVariables.f90 new file mode 100644 index 0000000..5e6cb7d --- /dev/null +++ b/CSharp/Equipments/Tanks/CTanksVariables.f90 @@ -0,0 +1,41 @@ +module CTanksVariables + implicit none + public + + ! Input vars + real(8) :: WaterRate + real(8) :: CementTankVolume + real(8) :: CementTankDensity + real(8) :: TripTankVolume + real(8) :: TripTankDensity + logical :: ManualPumpPower + logical :: Valve1 + logical :: Valve2 + logical :: Valve3 + logical :: Valve4 + logical :: Valve5 + + logical :: Valve6 + logical :: Valve7 + logical :: Valve8 + logical :: Valve9 + logical :: Valve10 + logical :: Valve11 + + ! Output vars + + + contains + + subroutine Set_ManualPumpPower(v) + use CManifolds, only:ChangeValve + implicit none + logical, intent(in) :: v + ManualPumpPower = v + call ChangeValve(43, v) +#ifdef deb + print*, 'ManualPumpPower=', ManualPumpPower +#endif + end subroutine + +end module CTanksVariables \ No newline at end of file diff --git a/CSharp/ErrorLog/CError.f90 b/CSharp/ErrorLog/CError.f90 new file mode 100644 index 0000000..f6d379f --- /dev/null +++ b/CSharp/ErrorLog/CError.f90 @@ -0,0 +1,303 @@ +module CError + use CIActionReference + implicit none + public + interface Error + module procedure :: Error1, Error2, Error3, Error4, Error5 + end interface + + interface ErrorStop + module procedure :: ErrorStop1, ErrorStop2, ErrorStop3, ErrorStop4, ErrorStop5 + end interface + + procedure (ActionString), pointer :: ErrorMessagePtr + procedure (ActionStringInt), pointer :: ErrorMessageIntPtr + procedure (ActionStringFloat), pointer :: ErrorMessageFloatPtr + procedure (ActionStringDouble), pointer :: ErrorMessageDoublePtr + procedure (ActionStringBool), pointer :: ErrorMessageBoolPtr + + procedure (ActionString), pointer :: ErrorStopPtr + procedure (ActionStringInt), pointer :: ErrorStopIntPtr + procedure (ActionStringFloat), pointer :: ErrorStopFloatPtr + procedure (ActionStringDouble), pointer :: ErrorStopDoublePtr + procedure (ActionStringBool), pointer :: ErrorStopBoolPtr + contains + + subroutine Error1(message) + implicit none + character(len=*), intent(in) :: message + if(associated(ErrorMessagePtr)) call ErrorMessagePtr(message) + end subroutine + + subroutine Error2(message, value) + implicit none + character(len=*), intent(in) :: message + integer, intent(in) :: value + !character(len=256) :: temp + !temp(:)=' ' + !write(temp,*) value + !if(associated(ErrorMessagePtr)) call ErrorMessagePtr(trim(message//' '//adjustl(temp))) + if(associated(ErrorMessageIntPtr)) call ErrorMessageIntPtr(message, value) + end subroutine + + subroutine Error3(message, value) + implicit none + character(len=*), intent(in) :: message + real, intent(in) :: value + !character(len=256) :: temp + !temp(:)=' ' + !write(temp,*) value + !if(associated(ErrorMessagePtr)) call ErrorMessagePtr(trim(message//' '//adjustl(temp))) + if(associated(ErrorMessageFloatPtr)) call ErrorMessageFloatPtr(message, value) + end subroutine + + subroutine Error4(message, value) + implicit none + character(len=*), intent(in) :: message + real(8), intent(in) :: value + !character(len=256) :: temp + !temp(:)=' ' + !write(temp,*) value + !if(associated(ErrorMessagePtr)) call ErrorMessagePtr(trim(message//' '//adjustl(temp))) + if(associated(ErrorMessageDoublePtr)) call ErrorMessageDoublePtr(message, value) + end subroutine + + subroutine Error5(message, value) + implicit none + character(len=*), intent(in) :: message + logical, intent(in) :: value + !if(value) then + ! if(associated(ErrorMessagePtr)) call ErrorMessagePtr(message//' '//'TRUE') + !else + ! if(associated(ErrorMessagePtr)) call ErrorMessagePtr(message//' '//'FALSE') + !endif + if(associated(ErrorMessageBoolPtr)) call ErrorMessageBoolPtr(message, value) + end subroutine + + + + + + + + + + + + + + subroutine ErrorStop1(message) + !use ifmt + implicit none + character(len=*), intent(in) :: message + if(associated(ErrorStopPtr)) then + call ErrorStopPtr(message) + ! call ExitThread(0) + end if + end subroutine + + subroutine ErrorStop2(message, value) + !use ifmt + implicit none + character(len=*), intent(in) :: message + integer, intent(in) :: value + !character(len=256) :: temp + !temp(:)=' ' + !write(temp,*) value + !if(associated(ErrorStopPtr)) then + ! call ErrorStopPtr(trim(message//' '//adjustl(temp))) + ! ! call ExitThread(0) + !end if + if(associated(ErrorStopIntPtr)) then + call ErrorStopIntPtr(message, value) + ! call ExitThread(0) + end if + end subroutine + + subroutine ErrorStop3(message, value) + !use ifmt + implicit none + character(len=*), intent(in) :: message + real, intent(in) :: value + !character(len=256) :: temp + !temp(:)=' ' + !write(temp,*) value + !if(associated(ErrorStopPtr)) then + ! call ErrorStopPtr(trim(message//' '//adjustl(temp))) + ! ! call ExitThread(0) + !end if + if(associated(ErrorStopFloatPtr)) then + call ErrorStopFloatPtr(message, value) + ! ! call ExitThread(0) + end if + end subroutine + + subroutine ErrorStop4(message, value) + ! use ifmt + implicit none + character(len=*), intent(in) :: message + real(8), intent(in) :: value + !character(len=256) :: temp + !temp(:)=' ' + !write(temp,*) value + !if(associated(ErrorStopPtr)) then + ! call ErrorStopPtr(trim(message//' '//adjustl(temp))) + ! ! call ExitThread(0) + !end if + if(associated(ErrorStopDoublePtr)) then + call ErrorStopDoublePtr(message, value) + ! ! call ExitThread(0) + end if + end subroutine + + subroutine ErrorStop5(message, value) + !use ifmt + implicit none + character(len=*), intent(in) :: message + logical, intent(in) :: value + !if(value) then + ! if(associated(ErrorStopPtr)) then + ! call ErrorStopPtr(message//' '//'TRUE') + ! ! ! call ExitThread(0) + ! end if + !else + ! if(associated(ErrorStopPtr)) then + ! call ErrorStopPtr(message//' '//'FALSE') + ! ! ! call ExitThread(0) + ! end if + !endif + if(associated(ErrorStopBoolPtr)) then + call ErrorStopBoolPtr(message, value) + ! call ExitThread(0) + end if + end subroutine + + + + + + + + + + + + + + + subroutine SubscribeErrorMessage(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorMessage + !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorMessage' :: SubscribeErrorMessage + implicit none + procedure (ActionString) :: a + ErrorMessagePtr => a + end subroutine + + + subroutine SubscribeErrorMessageInt(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorMessageInt + !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorMessageInt' :: SubscribeErrorMessageInt + implicit none + procedure (ActionStringInt) :: a + ErrorMessageIntPtr => a + end subroutine + + subroutine SubscribeErrorMessageFloat(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorMessageFloat + !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorMessageFloat' :: SubscribeErrorMessageFloat + implicit none + procedure (ActionStringFloat) :: a + ErrorMessageFloatPtr => a + end subroutine + + subroutine SubscribeErrorMessageDouble(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorMessageDouble + !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorMessageDouble' :: SubscribeErrorMessageDouble + implicit none + procedure (ActionStringDouble) :: a + ErrorMessageDoublePtr => a + end subroutine + + subroutine SubscribeErrorMessageBool(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorMessageBool + !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorMessageBool' :: SubscribeErrorMessageBool + implicit none + procedure (ActionStringBool) :: a + ErrorMessageBoolPtr => a + end subroutine + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + subroutine SubscribeErrorStop(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorStop + !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorStop' :: SubscribeErrorStop + implicit none + procedure (ActionString) :: a + ErrorStopPtr => a + end subroutine + + subroutine SubscribeErrorStopInt(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorStopInt + !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorStopInt' :: SubscribeErrorStopInt + implicit none + procedure (ActionStringInt) :: a + ErrorStopIntPtr => a + end subroutine + + + subroutine SubscribeErrorStopFloat(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorStopFloat + !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorStopFloat' :: SubscribeErrorStopFloat + implicit none + procedure (ActionStringFloat) :: a + ErrorStopFloatPtr => a + end subroutine + + subroutine SubscribeErrorStopDouble(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorStopDouble + !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorStopDouble' :: SubscribeErrorStopDouble + implicit none + procedure (ActionStringDouble) :: a + ErrorStopDoublePtr => a + end subroutine + + subroutine SubscribeErrorStopBool(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorStopBool + !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorStopBool' :: SubscribeErrorStopBool + implicit none + procedure (ActionStringBool) :: a + ErrorStopBoolPtr => a + end subroutine + +end module CError \ No newline at end of file diff --git a/CSharp/ErrorLog/CLog1.f90 b/CSharp/ErrorLog/CLog1.f90 new file mode 100644 index 0000000..a95afd6 --- /dev/null +++ b/CSharp/ErrorLog/CLog1.f90 @@ -0,0 +1,113 @@ +module CLog1 + use CIActionReference + implicit none + public + interface Log_1 + module procedure :: Log1Log1, Log1Log2, Log1Log3, Log1Log4, Log1Log5 + end interface + + procedure (ActionString), pointer :: Log1MsgPtr + procedure (ActionStringInt), pointer :: Log1MsgIntPtr + procedure (ActionStringFloat), pointer :: Log1MsgFloatPtr + procedure (ActionStringDouble), pointer :: Log1MsgDoublePtr + procedure (ActionStringBool), pointer :: Log1MsgBoolPtr + contains + + subroutine Log1Log1(message) + implicit none + character(len=*), intent(in) :: message +#ifdef Log1 + if(associated(Log1MsgPtr)) call Log1MsgPtr(message) +#endif + end subroutine + + subroutine Log1Log2(message, value) + implicit none + character(len=*), intent(in) :: message + integer, intent(in) :: value +#ifdef Log1 + if(associated(Log1MsgIntPtr)) call Log1MsgIntPtr(message, value) +#endif + end subroutine + + subroutine Log1Log3(message, value) + implicit none + character(len=*), intent(in) :: message + real, intent(in) :: value +#ifdef Log1 + if(associated(Log1MsgFloatPtr)) call Log1MsgFloatPtr(message, value) +#endif + end subroutine + + subroutine Log1Log4(message, value) + implicit none + character(len=*), intent(in) :: message + real(8), intent(in) :: value +#ifdef Log1 + if(associated(Log1MsgDoublePtr)) call Log1MsgDoublePtr(message, value) +#endif + end subroutine + + subroutine Log1Log5(message, value) + implicit none + character(len=*), intent(in) :: message + logical, intent(in) :: value +#ifdef Log1 + if(associated(Log1MsgBoolPtr)) call Log1MsgBoolPtr(message, value) +#endif + end subroutine + + + + + + + + + + + + + + + subroutine SubscribeLog1Message(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog1Message + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog1Message' :: SubscribeLog1Message + implicit none + procedure (ActionString) :: a + Log1MsgPtr => a + end subroutine + + subroutine SubscribeLog1MsgInt(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog1MsgInt + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog1MsgInt' :: SubscribeLog1MsgInt + implicit none + procedure (ActionStringInt) :: a + Log1MsgIntPtr => a + end subroutine + + subroutine SubscribeLog1MsgFloat(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog1MsgFloat + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog1MsgFloat' :: SubscribeLog1MsgFloat + implicit none + procedure (ActionStringFloat) :: a + Log1MsgFloatPtr => a + end subroutine + + subroutine SubscribeLog1MsgDouble(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog1MsgDouble + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog1MsgDouble' :: SubscribeLog1MsgDouble + implicit none + procedure (ActionStringDouble) :: a + Log1MsgDoublePtr => a + end subroutine + + subroutine SubscribeLog1MsgBool(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog1MsgBool + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog1MsgBool' :: SubscribeLog1MsgBool + implicit none + procedure (ActionStringBool) :: a + Log1MsgBoolPtr => a + end subroutine + +end module CLog1 \ No newline at end of file diff --git a/CSharp/ErrorLog/CLog2.f90 b/CSharp/ErrorLog/CLog2.f90 new file mode 100644 index 0000000..7db07dd --- /dev/null +++ b/CSharp/ErrorLog/CLog2.f90 @@ -0,0 +1,113 @@ +module CLog2 + use CIActionReference + implicit none + public + interface Log_2 + module procedure :: Log2Log1, Log2Log2, Log2Log3, Log2Log4, Log2Log5 + end interface + + procedure (ActionString), pointer :: Log2MsgPtr + procedure (ActionStringInt), pointer :: Log2MsgIntPtr + procedure (ActionStringFloat), pointer :: Log2MsgFloatPtr + procedure (ActionStringDouble), pointer :: Log2MsgDoublePtr + procedure (ActionStringBool), pointer :: Log2MsgBoolPtr + contains + + subroutine Log2Log1(message) + implicit none + character(len=*), intent(in) :: message +#ifdef Log2 + if(associated(Log2MsgPtr)) call Log2MsgPtr(message) +#endif + end subroutine + + subroutine Log2Log2(message, value) + implicit none + character(len=*), intent(in) :: message + integer, intent(in) :: value +#ifdef Log2 + if(associated(Log2MsgIntPtr)) call Log2MsgIntPtr(message, value) +#endif + end subroutine + + subroutine Log2Log3(message, value) + implicit none + character(len=*), intent(in) :: message + real, intent(in) :: value +#ifdef Log2 + if(associated(Log2MsgFloatPtr)) call Log2MsgFloatPtr(message, value) +#endif + end subroutine + + subroutine Log2Log4(message, value) + implicit none + character(len=*), intent(in) :: message + real(8), intent(in) :: value +#ifdef Log2 + if(associated(Log2MsgDoublePtr)) call Log2MsgDoublePtr(message, value) +#endif + end subroutine + + subroutine Log2Log5(message, value) + implicit none + character(len=*), intent(in) :: message + logical, intent(in) :: value +#ifdef Log2 + if(associated(Log2MsgBoolPtr)) call Log2MsgBoolPtr(message, value) +#endif + end subroutine + + + + + + + + + + + + + + + subroutine SubscribeLog2Message(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog2Message + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog2Message' :: SubscribeLog2Message + implicit none + procedure (ActionString) :: a + Log2MsgPtr => a + end subroutine + + subroutine SubscribeLog2MsgInt(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog2MsgInt + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog2MsgInt' :: SubscribeLog2MsgInt + implicit none + procedure (ActionStringInt) :: a + Log2MsgIntPtr => a + end subroutine + + subroutine SubscribeLog2MsgFloat(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog2MsgFloat + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog2MsgFloat' :: SubscribeLog2MsgFloat + implicit none + procedure (ActionStringFloat) :: a + Log2MsgFloatPtr => a + end subroutine + + subroutine SubscribeLog2MsgDouble(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog2MsgDouble + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog2MsgDouble' :: SubscribeLog2MsgDouble + implicit none + procedure (ActionStringDouble) :: a + Log2MsgDoublePtr => a + end subroutine + + subroutine SubscribeLog2MsgBool(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog2MsgBool + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog2MsgBool' :: SubscribeLog2MsgBool + implicit none + procedure (ActionStringBool) :: a + Log2MsgBoolPtr => a + end subroutine + +end module CLog2 \ No newline at end of file diff --git a/CSharp/ErrorLog/CLog3.f90 b/CSharp/ErrorLog/CLog3.f90 new file mode 100644 index 0000000..866aaa0 --- /dev/null +++ b/CSharp/ErrorLog/CLog3.f90 @@ -0,0 +1,113 @@ +module CLog3 + use CIActionReference + implicit none + public + interface Log_3 + module procedure :: Log3Log1, Log3Log2, Log3Log3, Log3Log4, Log3Log5 + end interface + + procedure (ActionString), pointer :: Log3MsgPtr + procedure (ActionStringInt), pointer :: Log3MsgIntPtr + procedure (ActionStringFloat), pointer :: Log3MsgFloatPtr + procedure (ActionStringDouble), pointer :: Log3MsgDoublePtr + procedure (ActionStringBool), pointer :: Log3MsgBoolPtr + contains + + subroutine Log3Log1(message) + implicit none + character(len=*), intent(in) :: message +#ifdef Log3 + if(associated(Log3MsgPtr)) call Log3MsgPtr(message) +#endif + end subroutine + + subroutine Log3Log2(message, value) + implicit none + character(len=*), intent(in) :: message + integer, intent(in) :: value +#ifdef Log3 + if(associated(Log3MsgIntPtr)) call Log3MsgIntPtr(message, value) +#endif + end subroutine + + subroutine Log3Log3(message, value) + implicit none + character(len=*), intent(in) :: message + real, intent(in) :: value +#ifdef Log3 + if(associated(Log3MsgFloatPtr)) call Log3MsgFloatPtr(message, value) +#endif + end subroutine + + subroutine Log3Log4(message, value) + implicit none + character(len=*), intent(in) :: message + real(8), intent(in) :: value +#ifdef Log3 + if(associated(Log3MsgDoublePtr)) call Log3MsgDoublePtr(message, value) +#endif + end subroutine + + subroutine Log3Log5(message, value) + implicit none + character(len=*), intent(in) :: message + logical, intent(in) :: value +#ifdef Log3 + if(associated(Log3MsgBoolPtr)) call Log3MsgBoolPtr(message, value) +#endif + end subroutine + + + + + + + + + + + + + + + subroutine SubscribeLog3Message(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog3Message + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog3Message' :: SubscribeLog3Message + implicit none + procedure (ActionString) :: a + Log3MsgPtr => a + end subroutine + + subroutine SubscribeLog3MsgInt(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog3MsgInt + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog3MsgInt' :: SubscribeLog3MsgInt + implicit none + procedure (ActionStringInt) :: a + Log3MsgIntPtr => a + end subroutine + + subroutine SubscribeLog3MsgFloat(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog3MsgFloat + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog3MsgFloat' :: SubscribeLog3MsgFloat + implicit none + procedure (ActionStringFloat) :: a + Log3MsgFloatPtr => a + end subroutine + + subroutine SubscribeLog3MsgDouble(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog3MsgDouble + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog3MsgDouble' :: SubscribeLog3MsgDouble + implicit none + procedure (ActionStringDouble) :: a + Log3MsgDoublePtr => a + end subroutine + + subroutine SubscribeLog3MsgBool(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog3MsgBool + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog3MsgBool' :: SubscribeLog3MsgBool + implicit none + procedure (ActionStringBool) :: a + Log3MsgBoolPtr => a + end subroutine + +end module CLog3 \ No newline at end of file diff --git a/CSharp/ErrorLog/CLog4.f90 b/CSharp/ErrorLog/CLog4.f90 new file mode 100644 index 0000000..16241bd --- /dev/null +++ b/CSharp/ErrorLog/CLog4.f90 @@ -0,0 +1,113 @@ +module CLog4 + use CIActionReference + implicit none + public + interface Log_4 + module procedure :: Log4Log1, Log4Log2, Log4Log3, Log4Log4, Log4Log5 + end interface + + procedure (ActionString), pointer :: Log4MsgPtr + procedure (ActionStringInt), pointer :: Log4MsgIntPtr + procedure (ActionStringFloat), pointer :: Log4MsgFloatPtr + procedure (ActionStringDouble), pointer :: Log4MsgDoublePtr + procedure (ActionStringBool), pointer :: Log4MsgBoolPtr + contains + + subroutine Log4Log1(message) + implicit none + character(len=*), intent(in) :: message +#ifdef Log4 + if(associated(Log4MsgPtr)) call Log4MsgPtr(message) +#endif + end subroutine + + subroutine Log4Log2(message, value) + implicit none + character(len=*), intent(in) :: message + integer, intent(in) :: value +#ifdef Log4 + if(associated(Log4MsgIntPtr)) call Log4MsgIntPtr(message, value) +#endif + end subroutine + + subroutine Log4Log3(message, value) + implicit none + character(len=*), intent(in) :: message + real, intent(in) :: value +#ifdef Log4 + if(associated(Log4MsgFloatPtr)) call Log4MsgFloatPtr(message, value) +#endif + end subroutine + + subroutine Log4Log4(message, value) + implicit none + character(len=*), intent(in) :: message + real(8), intent(in) :: value +#ifdef Log4 + if(associated(Log4MsgDoublePtr)) call Log4MsgDoublePtr(message, value) +#endif + end subroutine + + subroutine Log4Log5(message, value) + implicit none + character(len=*), intent(in) :: message + logical, intent(in) :: value +#ifdef Log4 + if(associated(Log4MsgBoolPtr)) call Log4MsgBoolPtr(message, value) +#endif + end subroutine + + + + + + + + + + + + + + + subroutine SubscribeLog4Message(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog4Message + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog4Message' :: SubscribeLog4Message + implicit none + procedure (ActionString) :: a + Log4MsgPtr => a + end subroutine + + subroutine SubscribeLog4MsgInt(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog4MsgInt + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog4MsgInt' :: SubscribeLog4MsgInt + implicit none + procedure (ActionStringInt) :: a + Log4MsgIntPtr => a + end subroutine + + subroutine SubscribeLog4MsgFloat(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog4MsgFloat + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog4MsgFloat' :: SubscribeLog4MsgFloat + implicit none + procedure (ActionStringFloat) :: a + Log4MsgFloatPtr => a + end subroutine + + subroutine SubscribeLog4MsgDouble(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog4MsgDouble + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog4MsgDouble' :: SubscribeLog4MsgDouble + implicit none + procedure (ActionStringDouble) :: a + Log4MsgDoublePtr => a + end subroutine + + subroutine SubscribeLog4MsgBool(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog4MsgBool + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog4MsgBool' :: SubscribeLog4MsgBool + implicit none + procedure (ActionStringBool) :: a + Log4MsgBoolPtr => a + end subroutine + +end module CLog4 \ No newline at end of file diff --git a/CSharp/ErrorLog/CLog5.f90 b/CSharp/ErrorLog/CLog5.f90 new file mode 100644 index 0000000..50c9ef1 --- /dev/null +++ b/CSharp/ErrorLog/CLog5.f90 @@ -0,0 +1,113 @@ +module CLog5 + use CIActionReference + implicit none + public + interface Log_5 + module procedure :: Log5Log1, Log5Log2, Log5Log3, Log5Log4, Log5Log5 + end interface + + procedure (ActionString), pointer :: Log5MsgPtr + procedure (ActionStringInt), pointer :: Log5MsgIntPtr + procedure (ActionStringFloat), pointer :: Log5MsgFloatPtr + procedure (ActionStringDouble), pointer :: Log5MsgDoublePtr + procedure (ActionStringBool), pointer :: Log5MsgBoolPtr + contains + + subroutine Log5Log1(message) + implicit none + character(len=*), intent(in) :: message +#ifdef Log5 + if(associated(Log5MsgPtr)) call Log5MsgPtr(message) +#endif + end subroutine + + subroutine Log5Log2(message, value) + implicit none + character(len=*), intent(in) :: message + integer, intent(in) :: value +#ifdef Log5 + if(associated(Log5MsgIntPtr)) call Log5MsgIntPtr(message, value) +#endif + end subroutine + + subroutine Log5Log3(message, value) + implicit none + character(len=*), intent(in) :: message + real, intent(in) :: value +#ifdef Log5 + if(associated(Log5MsgFloatPtr)) call Log5MsgFloatPtr(message, value) +#endif + end subroutine + + subroutine Log5Log4(message, value) + implicit none + character(len=*), intent(in) :: message + real(8), intent(in) :: value +#ifdef Log5 + if(associated(Log5MsgDoublePtr)) call Log5MsgDoublePtr(message, value) +#endif + end subroutine + + subroutine Log5Log5(message, value) + implicit none + character(len=*), intent(in) :: message + logical, intent(in) :: value +#ifdef Log5 + if(associated(Log5MsgBoolPtr)) call Log5MsgBoolPtr(message, value) +#endif + end subroutine + + + + + + + + + + + + + + + subroutine SubscribeLog5Message(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog5Message + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog5Message' :: SubscribeLog5Message + implicit none + procedure (ActionString) :: a + Log5MsgPtr => a + end subroutine + + subroutine SubscribeLog5MsgInt(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog5MsgInt + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog5MsgInt' :: SubscribeLog5MsgInt + implicit none + procedure (ActionStringInt) :: a + Log5MsgIntPtr => a + end subroutine + + subroutine SubscribeLog5MsgFloat(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog5MsgFloat + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog5MsgFloat' :: SubscribeLog5MsgFloat + implicit none + procedure (ActionStringFloat) :: a + Log5MsgFloatPtr => a + end subroutine + + subroutine SubscribeLog5MsgDouble(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog5MsgDouble + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog5MsgDouble' :: SubscribeLog5MsgDouble + implicit none + procedure (ActionStringDouble) :: a + Log5MsgDoublePtr => a + end subroutine + + subroutine SubscribeLog5MsgBool(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLog5MsgBool + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLog5MsgBool' :: SubscribeLog5MsgBool + implicit none + procedure (ActionStringBool) :: a + Log5MsgBoolPtr => a + end subroutine + +end module CLog5 \ No newline at end of file diff --git a/CSharp/OperationScenarios/Common/COperationScenariosMain.f90 b/CSharp/OperationScenarios/Common/COperationScenariosMain.f90 new file mode 100644 index 0000000..08bf13e --- /dev/null +++ b/CSharp/OperationScenarios/Common/COperationScenariosMain.f90 @@ -0,0 +1,716 @@ +module COperationScenariosMain + use CIActionReference + implicit none + public + procedure (ActionVoid), pointer :: UpdateUnityPtr + contains + + ! subroutine OperationScenarios_Setup() + ! use CSimulationVariables + ! implicit none + ! call OnSimulationInitialization%Add(OperationScenarios_Init) + ! call OnSimulationStop%Add(OperationScenarios_Init) + ! !call OnOperationScenariosStep%Add(OperationScenarios_Step) + ! !call OnOperationScenariosOutput%Add(OperationScenarios_Output) + ! call OnOperationScenariosMain%Add(OperationScenariosMainBody) + ! end subroutine + + ! subroutine OperationScenarios_Init + ! use COperationScenariosSettings, OperationScenariosInitialization => Initialization + ! implicit none + ! call OperationScenariosInitialization() + ! end subroutine OperationScenarios_Init + + subroutine OperationScenarios_Step + use CSimulationVariables + use CKellyConnectionEnum + use CElevatorConnectionEnum + use CCloseKellyCockLedNotification + use CCloseSafetyValveLedNotification + use CFillMouseHoleLedNotification + use CIrIBopLedNotification + use CIrSafetyValveLedNotification + use CLatchLedNotification + use COpenKellyCockLedNotification + use COpenSafetyValveLedNotification + use CSlipsNotification + use CSwingLedNotification + use CTongNotification + use CUnlatchLedNotification + use CInstallFillupHeadPermission + use CInstallMudBucketPermission + use CIrIbopPermission + use CIrSafetyValvePermission + use CRemoveFillupHeadPermission + use CRemoveMudBucketPermission + use CHookHeight + use CIbopHeight + use CNearFloorConnection + use CSafetyValveHeight + use CSlackOff + use CStandRack + use CStringPressure + use CZeroStringSpeed + use CUnityInputs, only: & + Get_ElevatorConnectionPossible, & + Get_JointConnectionPossible, & + Get_ElevatorPickup, & + Get_NearFloorPosition, & + Get_SingleSetInMouseHole + use CBucketEnum + use CElevatorEnum + use CHeadEnum + use CIbopEnum + use CKellyEnum + use CMouseHoleEnum + use COperationConditionEnum + use CSafetyValveEnum + use CSlipsEnum + use CSwingEnum + use CTongEnum + use CStringUpdate + use CFlowPipeDisconnectEnum + use CFlowKellyDisconnectEnum + use CFillupHeadPermission + use CSwingDrillPermission + use CSwingOffPermission + use CSwingTiltPermission + use CTdsStemJointHeight + use CTdsConnectionModesEnum + use CTdsElevatorModesEnum + use CTdsSpineEnum + use CTdsSwingEnum + use CTdsTongEnum + use CTdsBackupClamp + use CTdsIbopLedNotification + use CTdsPowerLedNotification + use CTdsTorqueWrenchLedNotification + + implicit none + + call Evaluate_KellyConnection() + call Evaluate_ElevatorConnection() + + call Evaluate_CloseKellyCockLed() + call Evaluate_CloseSafetyValveLed() + call Evaluate_FillMouseHoleLed() + call Evaluate_IrIBopLed() + call Evaluate_IrSafetyValveLed() + call Evaluate_LatchLed() + call Evaluate_OpenKellyCockLed() + call Evaluate_OpenSafetyValveLed() + call Evaluate_SlipsNotification() + call Evaluate_SwingLed() + call Evaluate_TongNotification() + call Evaluate_UnlatchLed() + + call Evaluate_InstallFillupHeadPermission() + call Evaluate_InstallMudBucketPermission() + call Evaluate_IrIbopPermission() + call Evaluate_IrSafetyValvePermission() + call Evaluate_RemoveFillupHeadPermission() + call Evaluate_RemoveMudBucketPermission() + + call Evaluate_MudBucket() + call Evaluate_Elevator() + call Evaluate_FillupHead() + call Evaluate_Ibop() + call Evaluate_Kelly() + call Evaluate_MouseHole() + call Evaluate_MouseHole() + call Evaluate_OperationCondition() + call Evaluate_SafetyValve() + call Evaluate_Slips() + call Evaluate_Swing() + call Evaluate_Tong() + + call Evaluate_StringUpdate() + + call Evaluate_FlowKellyDisconnect() + call Evaluate_FlowPipeDisconnect() + + !if(Get_FillMouseHoleLed()) then + ! call Set_MouseHole(MOUSE_HOLE_FILL) + !else + ! if((Get_KellyConnection() == KELLY_CONNECTION_SINGLE .or.& + ! Get_ElevatorConnection() == ELEVATOR_CONNECTION_SINGLE) .and.& + ! Get_HookHeight() >= 95.0 ) then + ! call Set_MouseHole(MOUSE_HOLE_NEUTRAL) + ! else + ! call Set_MouseHole(MOUSE_HOLE_EMPTY) + ! endif + !endif + + + + + + + + + !topdrive + call Evaluate_TdsElevatorModes() + call Evaluate_TdsConnectionModes() + call Evaluate_SwingTiltPermission() + call Evaluate_SwingOffPermission() + call Evaluate_SwingDrillPermission() + call Evaluate_FillupHeadPermission() + call Evaluate_TdsTong() + call Evaluate_TdsBackupClamp() + call Evaluate_TdsSwing() + call Evaluate_TdsSpine() + + call Evaluate_PowerLed() + call Evaluate_IbopLed() + + call Evaluate_TorqueWrenchLed() + + end subroutine OperationScenarios_Step + + subroutine OperationScenarios_Output + implicit none + end subroutine OperationScenarios_Output + + subroutine OperationScenariosMainBody + use CSimulationVariables + + use CKellyConnectionEnum + use CElevatorConnectionEnum + + use CCloseKellyCockLedNotification + use CCloseSafetyValveLedNotification + use CFillMouseHoleLedNotification + use CIrIBopLedNotification + use CIrSafetyValveLedNotification + use CLatchLedNotification + use COpenKellyCockLedNotification + use COpenSafetyValveLedNotification + use CSlipsNotification + use CSwingLedNotification + use CTongNotification + use CUnlatchLedNotification + + use CInstallFillupHeadPermission + use CInstallMudBucketPermission + use CIrIbopPermission + use CIrSafetyValvePermission + use CRemoveFillupHeadPermission + use CRemoveMudBucketPermission + + use CHookHeight + use CIbopHeight + use CNearFloorConnection + use CSafetyValveHeight + use CSlackOff + use CStandRack + use CStringPressure + use CZeroStringSpeed + + use CUnityInputs, only: & + Get_ElevatorConnectionPossible, & + Get_JointConnectionPossible, & + Get_ElevatorPickup, & + Get_NearFloorPosition, & + Get_SingleSetInMouseHole + + use CBucketEnum + use CElevatorEnum + use CHeadEnum + use CIbopEnum + use CKellyEnum + use CMouseHoleEnum + use COperationConditionEnum + use CSafetyValveEnum + use CSlipsEnum + use CSwingEnum + use CTongEnum + + use CStringUpdate + + use CFlowPipeDisconnectEnum + use CFlowKellyDisconnectEnum + + + use CFillupHeadPermission + use CSwingDrillPermission + use CSwingOffPermission + use CSwingTiltPermission + use CTdsStemJointHeight + use CTdsConnectionModesEnum + use CTdsElevatorModesEnum + use CTdsSpineEnum + use CTdsSwingEnum + use CTdsTongEnum + use CTdsBackupClamp + + use CTdsIbopLedNotification + use CTdsPowerLedNotification + + use CTdsTorqueWrenchLedNotification + + implicit none + loop1: do + call Evaluate_KellyConnection() + call Evaluate_ElevatorConnection() + + call Evaluate_CloseKellyCockLed() + call Evaluate_CloseSafetyValveLed() + call Evaluate_FillMouseHoleLed() + call Evaluate_IrIBopLed() + call Evaluate_IrSafetyValveLed() + call Evaluate_LatchLed() + call Evaluate_OpenKellyCockLed() + call Evaluate_OpenSafetyValveLed() + call Evaluate_SlipsNotification() + call Evaluate_SwingLed() + call Evaluate_TongNotification() + call Evaluate_UnlatchLed() + + call Evaluate_InstallFillupHeadPermission() + call Evaluate_InstallMudBucketPermission() + call Evaluate_IrIbopPermission() + call Evaluate_IrSafetyValvePermission() + call Evaluate_RemoveFillupHeadPermission() + call Evaluate_RemoveMudBucketPermission() + + call Evaluate_MudBucket() + call Evaluate_Elevator() + call Evaluate_FillupHead() + call Evaluate_Ibop() + call Evaluate_Kelly() + call Evaluate_MouseHole() + call Evaluate_MouseHole() + call Evaluate_OperationCondition() + call Evaluate_SafetyValve() + call Evaluate_Slips() + call Evaluate_Swing() + call Evaluate_Tong() + + call Evaluate_StringUpdate() + + call Evaluate_FlowKellyDisconnect() + call Evaluate_FlowPipeDisconnect() + + !if(Get_FillMouseHoleLed()) then + ! call Set_MouseHole(MOUSE_HOLE_FILL) + !else + ! if((Get_KellyConnection() == KELLY_CONNECTION_SINGLE .or.& + ! Get_ElevatorConnection() == ELEVATOR_CONNECTION_SINGLE) .and.& + ! Get_HookHeight() >= 95.0 ) then + ! call Set_MouseHole(MOUSE_HOLE_NEUTRAL) + ! else + ! call Set_MouseHole(MOUSE_HOLE_EMPTY) + ! endif + !endif + + + + + + + + + !topdrive + call Evaluate_TdsElevatorModes() + call Evaluate_TdsConnectionModes() + call Evaluate_SwingTiltPermission() + call Evaluate_SwingOffPermission() + call Evaluate_SwingDrillPermission() + call Evaluate_FillupHeadPermission() + call Evaluate_TdsTong() + call Evaluate_TdsBackupClamp() + call Evaluate_TdsSwing() + call Evaluate_TdsSpine() + + call Evaluate_PowerLed() + call Evaluate_IbopLed() + + call Evaluate_TorqueWrenchLed() + + !if (IsStopped==.true.) exit loop1 + if(IsStopped) call Quit() + call sleepqq(100) + enddo loop1 + end subroutine OperationScenariosMainBody + + + + + subroutine SubscribeUpdateUnity(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeUpdateUnity + !DEC$ ATTRIBUTES ALIAS: 'SubscribeUpdateUnity' :: SubscribeUpdateUnity + implicit none + procedure (ActionVoid) :: a + UpdateUnityPtr => a + end subroutine + + subroutine UpdateUnity() + implicit none + if(associated(UpdateUnityPtr)) call UpdateUnityPtr() + end subroutine + + subroutine PreProcessingSnapshot + !DEC$ ATTRIBUTES DLLEXPORT :: PreProcessingSnapshot + !DEC$ ATTRIBUTES ALIAS: 'PreProcessingSnapshot' :: PreProcessingSnapshot + use CSwingEnumVariables + use CSlipsEnumVariables + use CHookVariables + use CTongEnumVariables + use CHoistingVariables + use CKellyConnectionEnumVariables + use CElevatorConnectionEnumVariables + use COperationConditionEnumVariables + use CMouseHoleEnumVariables + implicit none + + if(DriveType == Kelly_DriveType) then ! kelly mode + + + if(Get_OperationCondition() == OPERATION_DRILL) then + + if(Get_KellyConnection() == KELLY_CONNECTION_NOTHING) then + call Kelly_ConnectionNothing() + + elseif (Get_KellyConnection() == KELLY_CONNECTION_STRING) then + call Kelly_ConnectionString() + + elseif (Get_KellyConnection() == KELLY_CONNECTION_SINGLE) then + call Kelly_ConnectionSingle() + + endif + + elseif (Get_OperationCondition() == OPERATION_TRIP) then + + if(Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING) then + call Elevator_ConnectionNothing() + + elseif (Get_ElevatorConnection() == ELEVATOR_CONNECTION_STRING) then + call Elevator_ConnectionString() + + elseif (Get_ElevatorConnection() == ELEVATOR_CONNECTION_STAND) then + call Elevator_ConnectionStand() + + elseif (Get_ElevatorConnection() == ELEVATOR_CONNECTION_SINGLE) then + call Elevator_ConnectionSingle() + + endif + + + endif + + + + + else ! Topdrive mode + ! + endif + + ! final adjustments + call Update_MouseHole_From_Snapshot() + + end subroutine PreProcessingSnapshot + + + + + subroutine Kelly_ConnectionNothing + use CSwingEnumVariables + use CSlipsEnumVariables + use CHookVariables + implicit none + + call Set_HookHeight(75.0) + call sleep(1) + + ! first wait for unity to get to starting point + loop1: do + if(Get_Swing() == SWING_WELL_END .and. Get_Slips() == SLIPS_SET_END) exit loop1 + call sleepqq(100) + enddo loop1 + call sleep(1) + + !TODO: possibly goto a position to activate swing + + ! goto preferred swing position + if(Swing_S == SWING_MOUSE_HOLE_END) then + call Set_Swing(SWING_MOUSE_HOLE_BEGIN) + call UpdateUnity() + loop2: do + if(Get_Swing() == SWING_MOUSE_HOLE_END) exit loop2 + call sleepqq(100) + enddo loop2 + elseif (Swing_S == SWING_RAT_HOLE_END) then + call Set_Swing(SWING_RAT_HOLE_BEGIN) + call UpdateUnity() + loop3: do + if(Get_Swing() == SWING_RAT_HOLE_END) exit loop3 + call sleepqq(100) + enddo loop3 + !elseif (Swing_S == SWING_WELL_END) then + ! call Set_Swing(SWING_WELL_BEGIN) + ! call UpdateUnity() + ! loop4: do + ! if(Get_Swing() == SWING_WELL_END) exit loop4 + ! call sleepqq(100) + ! enddo loop4 + endif + call sleep(3) + + ! move to final hook height + call Update_HookHeight_From_Snapshot() + call sleep(3) + + end subroutine Kelly_ConnectionNothing + + + + + + subroutine Kelly_ConnectionString + use CSwingEnumVariables + use CSlipsEnumVariables + use CHookVariables + use CTongEnumVariables + implicit none + + call Set_HookHeight(75.0) + call sleep(1) + + ! first wait for unity to get to starting point + loop1: do + if(Get_Swing() == SWING_WELL_END .and. Get_Slips() == SLIPS_SET_END) exit loop1 + call sleepqq(100) + enddo loop1 + call sleep(1) + + ! goto connection to string position + call Set_HookHeight_S(66.7) + call sleep(1) + + ! start tong makeup + call Set_Tong(TONG_MAKEUP_BEGIN) + call UpdateUnity() + loop2: do + if(Get_Tong() == TONG_MAKEUP_END) exit loop2 + call sleepqq(100) + enddo loop2 + call sleepqq(100) + + ! release slips + call Set_Slips(SLIPS_UNSET_BEGIN) + call UpdateUnity() + loop3: do + if(Get_Slips() == SLIPS_UNSET_END) exit loop3 + call sleepqq(100) + enddo loop3 + call sleepqq(100) + + ! move to final hook height + call Update_HookHeight_From_Snapshot() + call sleep(3) + + + ! put slips to saved position + if(Slips_S == SLIPS_SET_END) then + + call Set_Slips(SLIPS_SET_BEGIN) + call UpdateUnity() + loop4: do + if(Get_Slips() == SLIPS_SET_END) exit loop4 + call sleepqq(100) + enddo loop4 + call sleep(1) + endif + + + end subroutine Kelly_ConnectionString + + + + + subroutine Kelly_ConnectionSingle + use CSwingEnumVariables + use CSlipsEnumVariables + use CTongEnumVariables + use CHookVariables + implicit none + + call Set_HookHeight(75.0) + call sleep(1) + + ! first wait for unity to get to starting point + loop1: do + if(Get_Swing() == SWING_WELL_END .and. Get_Slips() == SLIPS_SET_END) exit loop1 + call sleepqq(100) + enddo loop1 + call sleep(1) + + + ! goto swing mouse hole position + call Set_HookHeight_S(70.0) + call sleep(1) + + ! swing mouse hole + call Set_Swing(SWING_MOUSE_HOLE_BEGIN) + call UpdateUnity() + loop2: do + if(Get_Swing() == SWING_MOUSE_HOLE_END) exit loop2 + call sleepqq(100) + enddo loop2 + call sleepqq(100) + + + ! goto makeup pipe location + call Set_HookHeight_S(65.0) + call sleep(1) + + + ! start tong makeup + call Set_Tong(TONG_MAKEUP_BEGIN) + call UpdateUnity() + loop3: do + if(Get_Tong() == TONG_MAKEUP_END) exit loop3 + call sleepqq(100) + enddo loop3 + call sleepqq(100) + + + + if (Swing_S == SWING_WELL_END) then ! already in mouse hole + + ! goto swing location + call Set_HookHeight_S(98.0) + call sleep(1) + + ! goto preferred swing position + call Set_Swing(SWING_WELL_BEGIN) + call UpdateUnity() + loop4: do + if(Get_Swing() == SWING_WELL_END) exit loop4 + call sleepqq(100) + enddo loop4 + call sleep(2) + + endif + + + ! move to final hook height + call Update_HookHeight_From_Snapshot() + call sleep(3) + + end subroutine Kelly_ConnectionSingle + + + + + + + subroutine Elevator_ConnectionNothing + use CSwingEnumVariables + use CSlipsEnumVariables + use CHookVariables + use CKellyEnumVariables + implicit none + + call Set_HookHeight(75.0) + call sleep(1) + + ! first wait for unity to get to starting point + loop1: do + if(Get_Swing() == SWING_WELL_END .and. Get_Slips() == SLIPS_SET_END) exit loop1 + call sleepqq(100) + enddo loop1 + call sleep(1) + + + !TODO: possibly goto a position to activate swing + + !! first goto mouse hole + !call Set_Swing(SWING_MOUSE_HOLE_BEGIN) + !call UpdateUnity() + !loop2: do + ! if(Get_Swing() == SWING_MOUSE_HOLE_END) exit loop2 + ! call sleepqq(100) + !enddo loop2 + !call sleep(1) + ! + !! then goto rat hole + !call Set_Swing(SWING_RAT_HOLE_BEGIN) + !call UpdateUnity() + !loop3: do + ! if(Get_Swing() == SWING_RAT_HOLE_END) exit loop3 + ! call sleepqq(100) + !enddo loop3 + !call sleep(1) + + ! kelly back + call Set_Kelly(KELLY_REMOVE) + call sleepqq(100) + + + + ! goto preferred swing position + if(Swing_S == SWING_MOUSE_HOLE_END) then + call Set_Swing(SWING_MOUSE_HOLE_BEGIN) + call UpdateUnity() + loop4: do + if(Get_Swing() == SWING_MOUSE_HOLE_END) exit loop4 + call sleepqq(100) + enddo loop4 + elseif (Swing_S == SWING_RAT_HOLE_END) then + call Set_Swing(SWING_RAT_HOLE_BEGIN) + call UpdateUnity() + loop5: do + if(Get_Swing() == SWING_RAT_HOLE_END) exit loop5 + call sleepqq(100) + enddo loop5 + elseif (Swing_S == SWING_WELL_END) then + call Set_Swing(SWING_WELL_BEGIN) + call UpdateUnity() + loop6: do + if(Get_Swing() == SWING_WELL_END) exit loop6 + call sleepqq(100) + enddo loop6 + endif + call sleepqq(100) + + + + ! move to final hook height + call Update_HookHeight_From_Snapshot() + call sleep(3) + + end subroutine Elevator_ConnectionNothing + + + + + + subroutine Elevator_ConnectionString + implicit none + end subroutine Elevator_ConnectionString + + + + + + + + subroutine Elevator_ConnectionStand + implicit none + end subroutine Elevator_ConnectionStand + + + + + + + subroutine Elevator_ConnectionSingle + implicit none + end subroutine Elevator_ConnectionSingle + + + + + +end module COperationScenariosMain \ No newline at end of file diff --git a/CSharp/OperationScenarios/Common/COperationScenariosSettings.f90 b/CSharp/OperationScenarios/Common/COperationScenariosSettings.f90 new file mode 100644 index 0000000..13a4f7c --- /dev/null +++ b/CSharp/OperationScenarios/Common/COperationScenariosSettings.f90 @@ -0,0 +1,488 @@ +module COperationScenariosSettings + implicit none + public + contains + + !subroutine Initialization() + ! use CSimulationVariables + ! use CUnityOutputs, only: SetupUnityOutputs => Setup + ! + ! use CBucketEnum + ! use CTongEnum + ! use CSwingEnum + ! use CSlipsEnum + ! use CSafetyValveEnum + ! use COperationConditionEnum + ! use CMouseHoleEnum + ! use CKellyEnum + ! use CKellyConnectionEnum + ! use CIbopEnum + ! use CHeadEnum + ! use CElevatorEnum + ! use CElevatorConnectionEnum + ! + ! use CInstallFillupHeadPermission + ! use CInstallMudBucketPermission + ! use CIrIbopPermission + ! use CIrSafetyValvePermission + ! use CRemoveFillupHeadPermission + ! use CRemoveMudBucketPermission + ! + ! use CCloseKellyCockLedNotification + ! use CCloseSafetyValveLedNotification + ! use CFillMouseHoleLedNotification + ! use CIrIBopLedNotification + ! use CIrSafetyValveLedNotification + ! use CLatchLedNotification + ! use COpenKellyCockLedNotification + ! use COpenSafetyValveLedNotification + ! use CSlipsNotification + ! use CSwingLedNotification + ! use CTongNotification + ! use CUnlatchLedNotification + ! + ! use CHookHeight + ! use CIbopHeight + ! use CNearFloorConnection + ! use CSafetyValveHeight + ! use CSlackOff + ! use CStandRack + ! use CStringPressure + ! use CZeroStringSpeed + ! + ! use CStringUpdate + ! + ! use CFlowPipeDisconnectEnum + ! use CFlowKellyDisconnectEnum + ! + ! use CFillupHeadPermission + ! use CSwingDrillPermission + ! use CSwingOffPermission + ! use CSwingTiltPermission + ! use CTdsStemJointHeight + ! use CTdsConnectionModesEnum + ! use CTdsElevatorModesEnum + ! use CTdsSpineEnum + ! use CTdsSwingEnum + ! use CTdsTongEnum + ! use CTdsBackupClamp + ! + ! use CTdsIbopLedNotification + ! use CTdsPowerLedNotification + ! + ! use CTdsTorqueWrenchLedNotification + ! + ! implicit none + ! + ! call SetupUnityOutputs() + ! + ! call Subscribe_Tong() + ! call Subscribe_MudBucket() + ! call Subscribe_ElevatorConnection() + ! call Subscribe_Elevator() + ! call Subscribe_FillupHead() + ! call Subscribe_Ibop() + ! call Subscribe_KellyConnection() + ! call Subscribe_Kelly() + ! call Subscribe_MouseHole() + ! call Subscribe_OperationCondition() + ! call Subscribe_SafetyValve() + ! call Subscribe_Slips() + ! call Subscribe_Swing() + ! + ! + ! call Subscribe_InstallFillupHeadPermission() + ! call Subscribe_InstallMudBucketPermission() + ! call Subscribe_IrIbopPermission() + ! call Subscribe_IrSafetyValvePermission() + ! call Subscribe_RemoveFillupHeadPermission() + ! call Subscribe_RemoveMudBucketPermission() + ! + ! call Subscribe_CloseKellyCockLed() + ! call Subscribe_CloseSafetyValveLed() + ! call Subscribe_FillMouseHoleLed() + ! call Subscribe_IrIBopLed() + ! call Subscribe_IrSafetyValveLed() + ! call Subscribe_LatchLed() + ! call Subscribe_OpenKellyCockLed() + ! call Subscribe_OpenSafetyValveLed() + ! call Subscribe_SlipsNotification() + ! call Subscribe_SwingLed() + ! call Subscribe_UnlatchLed() + ! + ! call Subscribe_HookHeight() + ! call Subscribe_IbopHeight() + ! call Subscribe_NearFloorConnection() + ! call Subscribe_SafetyValveHeight() + ! call Subscribe_SlackOff() + ! call Subscribe_StringPressure() + ! call Subscribe_ZeroStringSpeed() + ! call Subscribe_StandRack() + ! + ! call Subscribe_StringUpdate() + ! + ! call Subscribe_TongNotification() + ! + ! call Subscribe_FlowKellyDisconnect() + ! call Subscribe_FlowPipeDisconnect() + ! + ! + ! + ! + ! + ! !top drive + ! call Subscribe_TdsConnectionModes() + ! call Subscribe_TdsElevatorModes() + ! call Subscribe_FillupHeadPermission() + ! call Subscribe_SwingDrillPermission() + ! call Subscribe_SwingOffPermission() + ! call Subscribe_SwingTiltPermission() + ! call Subscribe_TdsStemJointHeight() + ! call Subscribe_TdsTong() + ! call Subscribe_TdsBackupClamp() + ! call Subscribe_TdsSwing() + ! call Subscribe_TdsSpine() + ! call Subscribe_PowerLed() + ! call Subscribe_IbopLed() + ! + ! call Subscribe_TorqueWrenchLed() + ! + ! + ! call OnSimulationStart%Add(SetDefaultValues) + ! + !end subroutine + + subroutine SetDefaultValues() + use COperationScenariosVariables + use CHoistingVariables, only: DriveType, TopDrive_DriveType + use CManifolds, only: RemoveSafetyValve_TripMode, RemoveSafetyValve_KellyMode + implicit none + + call Set_KellyConnection(KELLY_CONNECTION_NOTHING) + !Get_KellyConnection() + !KELLY_CONNECTION_NOTHING + !KELLY_CONNECTION_STRING + !KELLY_CONNECTION_SINGLE + call Set_ElevatorConnection(ELEVATOR_CONNECTION_NOTHING) + !Get_ElevatorConnection() + !ELEVATOR_CONNECTION_NOTHING + !ELEVATOR_CONNECTION_STRING + !ELEVATOR_CONNECTION_STAND + !ELEVATOR_CONNECTION_SINGLE + !ELEVATOR_LATCH_STRING + !ELEVATOR_LATCH_SINGLE + !ELEVATOR_LATCH_STAND + + + + + + + + + call Set_CloseKellyCockLed(.false.) !Get_CloseKellyCockLed() + call Set_CloseSafetyValveLed(.false.) !Get_CloseSafetyValveLed() + call Set_FillMouseHoleLed(.true.) !Get_FillMouseHoleLed() + call Set_IrIBopLed(.false.) !Get_IrIBopLed() + !call Set_IrSafetyValveLed(.true.) !Get_IrSafetyValveLed() + if(DriveType == TopDrive_DriveType) then + call RemoveSafetyValve_TripMode() + call RemoveSafetyValve_KellyMode() + call Set_IrSafetyValveLed(.false.) + else + call Set_IrSafetyValveLed(.true.) + endif + call Set_LatchLed(.false.) !Get_LatchLed() + call Set_OpenKellyCockLed(.true.) !Get_OpenKellyCockLed() + call Set_OpenSafetyValveLed(.true.) !Get_OpenSafetyValveLed() + call Set_SlipsNotification(.false.) !Get_SlipsNotification() + call Set_SwingLed(.false.) !Get_SwingLed() + call Set_TongNotification(.false.) !Get_TongNotification() + call Set_UnlatchLed(.false.) !Get_UnlatchLed() + + + + + + + + call Set_InstallFillupHeadPermission(.false.) !Get_InstallFillupHeadPermission() + call Set_InstallMudBucketPermission(.false.) !Get_InstallMudBucketPermission() + call Set_IrIbopPermission(.false.) !Get_IrIbopPermission() + call Set_IrSafetyValvePermission(.false.) !Get_IrSafetyValvePermission() + call Set_RemoveFillupHeadPermission(.false.) !Get_RemoveFillupHeadPermission() + call Set_RemoveMudBucketPermission(.false.) !Get_RemoveMudBucketPermission() + + + + + + + + + + !call Set_HookHeight(REAL(70.0, 8)) !Get_HookHeight() + call Set_IbopHeight(3.0) !Get_IbopHeight() + !call Set_NearFloorConnection(3.0) !Get_NearFloorConnection() + call Set_SafetyValveHeight(3.0) !Get_SafetyValveHeight() + call Set_SlackOff(.true.) !Get_SlackOff() + !call Set_StandRack(0.0) !Get_StandRack() + !call Set_StringPressure(0.0) !Get_StringPressure() + !call Set_ZeroStringSpeed(.true.) !Get_ZeroStringSpeed() + + + + + + + + + !Get_ElevatorConnected() + !Get_JointConnection() + !Get_NearMonkeyBoardPosition() + !Get_NearFloorPosition() + !Get_SingleSetInMouseHole() + !Get_SwingCenter() + + + + + + + call Set_MudBucket(MUD_BUCKET_REMOVE) + !Get_MudBucket() + !MUD_BUCKET_INSTALL + !MUD_BUCKET_REMOVE + + call Set_Elevator(ELEVATOR_NEUTRAL) + ! Get_Elevator() + !ELEVATOR_NEUTRAL + !ELEVATOR_LATCH_STRING_BEGIN + !ELEVATOR_LATCH_STRING_END + !ELEVATOR_UNLATCH_STRING_BEGIN + !ELEVATOR_UNLATCH_STRING_END + !ELEVATOR_LATCH_STAND_BEGIN + !ELEVATOR_LATCH_STAND_END + !ELEVATOR_UNLATCH_STAND_BEGIN + !ELEVATOR_UNLATCH_STAND_END + !ELEVATOR_LATCH_SINGLE_BEGIN + !ELEVATOR_LATCH_SINGLE_END + !ELEVATOR_UNLATCH_SINGLE_BEGIN + !ELEVATOR_UNLATCH_SINGLE_END + + call Set_FillupHead(FILLUP_HEAD_REMOVE) + !Get_FillupHead() + !FILLUP_HEAD_INSTALL + !FILLUP_HEAD_REMOVE + + call Set_Ibop(IBOP_REMOVE) + !Get_Ibop() + !IBOP_INSTALL + !IBOP_REMOVE + + call Set_Kelly(KELLY_INSTALL) + !Get_Kelly() + !KELLY_NEUTRAL + !KELLY_INSTALL + !KELLY_REMOVE + + call Set_MouseHole(MOUSE_HOLE_FILL) + !Get_MouseHole() + !MOUSE_HOLE_NEUTRAL + !MOUSE_HOLE_FILL + !MOUSE_HOLE_EMPTY + + call Set_OperationCondition(OPERATION_DRILL) + !Get_OperationCondition() + !OPERATION_DRILL + !OPERATION_TRIP + + + call Set_SafetyValve(SAFETY_VALVE_INSTALL) + !Get_SafetyValve() + !SAFETY_VALVE_INSTALL + !SAFETY_VALVE_REMOVE + if(DriveType == TopDrive_DriveType) call Set_SafetyValve(SAFETY_VALVE_REMOVE) + + call Set_Slips(SLIPS_SET_BEGIN) + !Get_Slips() + !SLIPS_NEUTRAL + !SLIPS_SET_BEGIN + !SLIPS_SET_END + !SLIPS_UNSET_BEGIN + !SLIPS_UNSET_END + + call Set_Swing(SWING_WELL_BEGIN) + !Get_Swing() + !SWING_NEUTRAL + !SWING_MOUSE_HOLE_BEGIN + !SWING_MOUSE_HOLE_END + !SWING_RAT_HOLE_BEGIN + !SWING_RAT_HOLE_END + !SWING_WELL_BEGIN + !SWING_WELL_END + + call Set_Tong(TONG_NEUTRAL) + !Get_Tong() + !TONG_NEUTRAL + !TONG_BREAKOUT_BEGIN + !TONG_BREAKOUT_END + !TONG_MAKEUP_BEGIN + !TONG_MAKEUP_END + + + call Set_StringUpdate(STRING_UPDATE_NEUTRAL) + !Get_StringUpdate() + !STRING_UPDATE_NEUTRAL + !STRING_UPDATE_ADD_SINGLE + !STRING_UPDATE_ADD_STAND + !STRING_UPDATE_REMOVE_SINGLE + !STRING_UPDATE_REMOVE_STAND + + + + + + + + + + + + + + + + + + + + + + + + + + + call Set_TdsElevatorModes(TDS_ELEVATOR_CONNECTION_NOTHING) + !Get_TdsElevatorModes() + !TDS_ELEVATOR_CONNECTION_NOTHING + !TDS_ELEVATOR_CONNECTION_STRING + !TDS_ELEVATOR_CONNECTION_SINGLE + !TDS_ELEVATOR_CONNECTION_STAND + !TDS_ELEVATOR_LATCH_STRING + !TDS_ELEVATOR_LATCH_SINGLE + !TDS_ELEVATOR_LATCH_STAND + + + + + + call Set_TdsConnectionModes(TDS_CONNECTION_NOTHING) + !Get_TdsConnectionModes() + !TDS_CONNECTION_NOTHING + !TDS_CONNECTION_STRING + !TDS_CONNECTION_SPINE + + + + + call Set_SwingTiltPermission(.false.) !Get_SwingTiltPermission() + call Set_SwingOffPermission(.false.) !Get_SwingOffPermission() + call Set_SwingDrillPermission(.false.) !Get_SwingDrillPermission() + call Set_FillupHeadPermission(.false.) !Get_FillupHeadPermission() + + call Set_PowerLed(.false.) + call Set_IbopLed(.false.) + + call Set_TorqueWrenchLed(0) !Get_TorqueWrenchLed() + + + !TdsPower_REV = 1 + !TdsPower_OFF = 0 + !TdsPower_FWD = -1 + ! + !TdsMu_TORQ = 1 + !TdsMu_SPINE = 0 + !TdsMu_DRILL = -1 + ! + !TdsLinkTilt_TILT = 1 + !TdsLinkTilt_OFF = 0 + !TdsLinkTilt_DRILL = -1 + + !TDS IBOP TopDriveIbop + !TDS LinkTilt TopDriveLinkTiltState + !TDS MU TopDriveDrillTorqueState + !TDS Power TopDriveTdsPowerState + + !TopDriveTorqueWrench PRESSED=True or UNPRESSED=Falses + + !Get_TdsConnectionPossible() + !Get_TdsStemIn() + + !call Set_TdsStemJointHeight(v) !Get_TdsStemJointHeight() + + + !Get_SwingDrillPermission() + !Get_SwingOffPermission() + !Get_SwingTiltPermission() + !Get_FillupHeadPermission() + + call Set_TdsTong(TDS_TONG_BREAKOUT_END) + !Get_TdsTong() + !TDS_TONG_BREAKOUT_BEGIN + !TDS_TONG_BREAKOUT_END + !TDS_TONG_MAKEUP_BEGIN + !TDS_TONG_MAKEUP_END + + + call Set_TdsBackupClamp(BACKUP_CLAMP_OFF_END) + !Get_TdsBackupClamp() + !BACKUP_CLAMP_OFF_END + !BACKUP_CLAMP_OFF_BEGIN + !BACKUP_CLAMP_FW_BEGIN + !BACKUP_CLAMP_FW_END + + + call Set_TdsSwing(TDS_SWING_OFF_END) + !Get_TdsSwing() + !TDS_SWING_NEUTRAL + !TDS_SWING_OFF_BEGIN + !TDS_SWING_OFF_END + !TDS_SWING_DRILL_BEGIN + !TDS_SWING_DRILL_END + !TDS_SWING_TILT_BEGIN + !TDS_SWING_TILT_END + + + + + + call Set_TdsSpine(TDS_SPINE_NEUTRAL) !TDS_SPINE_DISCONNECT_END + !Get_TdsSpine() + !TDS_SPINE_NEUTRAL + !TDS_SPINE_CONNECT_BEGIN + !TDS_SPINE_CONNECT_END + !TDS_SPINE_DISCONNECT_BEGIN + !TDS_SPINE_DISCONNECT_END + + + + + + + + + + + + end subroutine + + subroutine SetDefaults_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: SetDefaults_WN + !DEC$ ATTRIBUTES ALIAS: 'SetDefaults_WN' :: SetDefaults_WN + implicit none + call SetDefaultValues() + end subroutine + +end module COperationScenariosSettings \ No newline at end of file diff --git a/CSharp/OperationScenarios/Common/COperationScenariosVariables.f90 b/CSharp/OperationScenarios/Common/COperationScenariosVariables.f90 new file mode 100644 index 0000000..7cc1547 --- /dev/null +++ b/CSharp/OperationScenarios/Common/COperationScenariosVariables.f90 @@ -0,0 +1,116 @@ +module COperationScenariosVariables + + use CKellyConnectionEnumVariables + use CElevatorConnectionEnumVariables + + use CCloseKellyCockLedNotificationVariables + use CCloseSafetyValveLedNotificationVariables + use CFillMouseHoleLedNotificationVariables + use CIrIBopLedNotificationVariables + use CIrSafetyValveLedNotificationVariables + use CLatchLedNotificationVariables + use COpenKellyCockLedNotificationVariables + use COpenSafetyValveLedNotificationVariables + use CSlipsNotificationVariables + use CSwingLedNotificationVariables + use CTongNotificationVariables + use CUnlatchLedNotificationVariables + + use CInstallFillupHeadPermissionVariables + use CInstallMudBucketPermissionVariables + use CIrIbopPermissionVariables + use CIrSafetyValvePermissionVariables + use CRemoveFillupHeadPermissionVariables + use CRemoveMudBucketPermissionVariables + + use CHookHeight + use CIbopHeight + use CNearFloorConnection + use CSafetyValveHeight + use CSlackOff + use CStandRack + use CStringPressure + use CZeroStringSpeed + + use CStringUpdateVariables + + use CUnityInputs + !, only: Get_OutOfMouseHole,& + ! Get_Unlatch,& + ! Get_Latch,& + ! Get_SlipsUnSet,& + ! Get_SlipsSet,& + ! Get_BreakupTong,& + ! Get_MakeupTong,& + ! Get_NewHookHeight,& + ! Get_ElevatorConnectionPossible,& + ! Get_JointConnectionPossible,& + ! Get_NearMonkeyBoardPosition,& + ! Get_SingleSetInMouseHole,& + ! Get_SwingCenter + use CUnityOutputs, only: GetRotaryRpm + + use CBucketEnumVariables + use CElevatorEnumVariables + use CHeadEnumVariables + use CIbopEnumVariables + use CKellyEnumVariables + use CMouseHoleEnumVariables + use COperationConditionEnumVariables + use CSafetyValveEnumVariables + use CSlipsEnumVariables + use CSwingEnumVariables + use CTongEnumVariables + + use CFillupHeadPermissionVariables + use CSwingDrillPermissionVariables + use CSwingOffPermissionVariables + use CSwingTiltPermissionVariables + use CTdsStemJointHeight + use CTdsConnectionModesEnumVariables + use CTdsElevatorModesEnumVariables + use CTdsSpineEnumVariables + use CTdsSwingEnumVariables + use CTdsTongEnumVariables + use CTdsBackupClampVariables + + use CHoistingVariables + use CTopDrivePanelVariables + + use CTdsPowerLedNotificationVariables + use CTdsIbopLedNotificationVariables + + use CTdsTorqueWrenchLedNotificationVariables + + implicit none + public + + real :: HKL = 63.76 ! Hook And Kelly Length + real :: HL = 17.81 ! Hook Length + real :: PL = 30.0 ! Pipe Length + real :: SL = 90.0 ! Stand Length + real :: LG = 8.0 ! Limit Gap + real :: SG = 3.0 ! Slips Gap + real :: TG = 4.0 ! Tong Gap + real :: RE = 3.0 ! Release + real :: ECG = 2.3 ! Elevator Connection Gap + + contains + + real(8) function TJH() + use TD_DrillStemComponents + implicit none + TJH = TD_TopJointHeight + end function + + real function TL() + implicit none + TL = 26.97 + end function + + real function NFC() + implicit none + NFC = Get_NearFloorConnection() + end function + +end module COperationScenariosVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Enums/CElevatorConnectionEnum.f90 b/CSharp/OperationScenarios/Enums/CElevatorConnectionEnum.f90 new file mode 100644 index 0000000..2dcf844 --- /dev/null +++ b/CSharp/OperationScenarios/Enums/CElevatorConnectionEnum.f90 @@ -0,0 +1,618 @@ +module CElevatorConnectionEnum + use COperationScenariosVariables + use CLog3 + use CLog4 + implicit none + contains + + subroutine Evaluate_ElevatorConnection() + use CCommon, only: SetStandRack + implicit none + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_ElevatorConnection=TopDrive' +#endif + endif + + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'ElevatorConnection=Kelly' +#endif + + !!OPERATION-CODE=83 + !if (Get_OperationCondition() == OPERATION_TRIP .and.& + ! Get_ElevatorConnection() == ELEVATOR_LATCH_STRING .and.& + ! Get_ElevatorPickup() .and.& + ! Get_Slips() == SLIPS_SET_END) then + ! !call Log_4('OPERATION-CODE=83') + ! call Set_ElevatorConnection(ELEVATOR_CONNECTION_STRING) + ! return + !end if + + + + + + + + + + + + + !OPERATION-CODE=78 + if (Get_ElevatorPickup() == .false. .and.& + Get_Tong() == TONG_BREAKOUT_END .and.& + Get_HookHeight() <= (HL + Get_NearFloorConnection() + PL) .and.& + Get_ElevatorConnection() == ELEVATOR_LATCH_STRING) then + call Set_ElevatorConnection(ELEVATOR_LATCH_SINGLE) + return + end if + + !OPERATION-CODE=79 + if (Get_ElevatorPickup() == .false. .and.& + Get_Tong() == TONG_BREAKOUT_END .and.& + Get_HookHeight() >= (HL + Get_NearFloorConnection() + SL - LG) .and.& + Get_ElevatorConnection() == ELEVATOR_LATCH_STRING) then + call Set_ElevatorConnection(ELEVATOR_LATCH_STAND) + return + end if + + + + !OPERATION-CODE=83 + if (Get_ElevatorPickup().and.& + Get_ElevatorConnection() == ELEVATOR_LATCH_SINGLE) then + call Set_ElevatorConnection(ELEVATOR_CONNECTION_SINGLE) + return + end if + + + !OPERATION-CODE=84 + if (Get_ElevatorPickup().and.& + Get_ElevatorConnection() == ELEVATOR_LATCH_STAND) then + call Set_ElevatorConnection(ELEVATOR_CONNECTION_STAND) + return + end if + + + + + + + + + + + !OPERATION-CODE=7 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + !GetRotaryRpm() == 0.0d0 .and.& + !Get_StandRack() > 0 .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .and.& + !Get_Swing() == SWING_WELL_END .and.& + !Get_Slips() == SLIPS_SET_END .and.& + !Get_LatchLed() .and. + Get_Elevator() == ELEVATOR_LATCH_STAND_END) then + !call Log_4('OPERATION-CODE=7') + call Set_ElevatorConnection(ELEVATOR_CONNECTION_STAND) + !call Set_UnlatchLed(.true.) + !call Set_LatchLed(.false.) + call SetStandRack(Get_StandRack() - 1) + call Set_Elevator(ELEVATOR_NEUTRAL) + return + end if + + !OPERATION-CODE=8 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + !Get_HookHeight() >= (HL + Get_NearFloorConnection() + SL - RE) .and. Get_HookHeight() <= (HL + Get_NearFloorConnection() + SL + LG) .and.& + !GetRotaryRpm() == 0.0d0 .and.& + !Get_StandRack() < 80 .and.& + !Get_ElevatorConnectionPossible() .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_STAND .and.& + !Get_Swing() == SWING_WELL_END .and.& + !Get_Slips() == SLIPS_SET_END .and.& + !Get_UnlatchLed() .and.& + Get_Elevator() == ELEVATOR_UNLATCH_STAND_END) then + call Set_ElevatorConnection(ELEVATOR_CONNECTION_NOTHING) + !call Set_UnlatchLed(.false.) + !call Set_LatchLed(.true.) + call SetStandRack(Get_StandRack() + 1) + call Set_Elevator(ELEVATOR_NEUTRAL) + !call Set_Elevator(ELEVATOR_UNLATCH_STAND_BEGIN) + call Log_3('OPERATION-CODE=8') + return + end if + + !OPERATION-CODE=9 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + !Get_HookHeight() >= 18.0 .and. Get_HookHeight() <= 22.0 .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .and.& + !Get_Swing() == SWING_WELL_END .and.& + !Get_Slips() == SLIPS_SET_END .and.& + !Get_LatchLed() .and.& + !Get_ElevatorPickup() .and.& + Get_Elevator() == ELEVATOR_LATCH_STRING_END) then + !call Log_4('OPERATION-CODE=9') + call Set_ElevatorConnection(ELEVATOR_LATCH_STRING) + call Set_Elevator(ELEVATOR_NEUTRAL) + !call Set_UnlatchLed(.true.) + !call Set_LatchLed(.false.) + !call Set_UnlatchLed(.false.) + !call Set_Elevator(ELEVATOR_LATCH_STRING_BEGIN) + return + end if + + !OPERATION-CODE=60 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + !Get_HookHeight() <= (HL + Get_NearFloorConnection() - ECG) .and.& + Get_ElevatorPickup() == .false. .and.& + Get_Slips() == SLIPS_SET_END .and.& + !Get_Tong() /= TONG_MAKEUP_END .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_STRING) then + call Set_ElevatorConnection(ELEVATOR_LATCH_STRING) + !call Set_Elevator(ELEVATOR_NEUTRAL) + return + end if + + !OPERATION-CODE=49 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_ElevatorPickup() .and.& + Get_ElevatorConnection() == ELEVATOR_LATCH_STRING) then + call Set_ElevatorConnection(ELEVATOR_CONNECTION_STRING) + return + end if + + !OPERATION-CODE=10 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + !GetRotaryRpm() == 0.0d0 .and.& + (Get_ElevatorConnection() == ELEVATOR_CONNECTION_STRING .or. Get_ElevatorConnection() == ELEVATOR_LATCH_STRING) .and.& + !Get_Swing() == SWING_WELL_END .and.& + !Get_Slips() == SLIPS_SET_END .and.& + !Get_UnlatchLed() .and.& + Get_Elevator() == ELEVATOR_UNLATCH_STRING_END) then + !call Log_4('OPERATION-CODE=10') + call Set_ElevatorConnection(ELEVATOR_CONNECTION_NOTHING) + call Set_Elevator(ELEVATOR_NEUTRAL) + !call Set_UnlatchLed(.false.) + !call Set_LatchLed(.true.) + !call Set_Elevator(ELEVATOR_UNLATCH_STRING_BEGIN) + return + end if + + !OPERATION-CODE=11 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + !Get_ElevatorConnectionPossible() .and.& + Get_ElevatorPickup().and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .and.& + !Get_Swing() == SWING_MOUSE_HOLE_END .and.& + !Get_LatchLed() .and.& + !Get_FillMouseHoleLed() .and.& + Get_Elevator() == ELEVATOR_LATCH_SINGLE_END) then + + call Set_ElevatorConnection(ELEVATOR_CONNECTION_SINGLE) + !call Set_UnlatchLed(.true.) + call Set_FillMouseHoleLed(.false.) + call Set_MouseHole(MOUSE_HOLE_NEUTRAL) + call Set_Elevator(ELEVATOR_NEUTRAL) + !call Set_Elevator(ELEVATOR_LATCH_SINGLE_BEGIN) + return + end if + + !OPERATION-CODE=12 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_SINGLE .and.& + !Get_Swing() == SWING_MOUSE_HOLE_END .and.& + !Get_UnlatchLed() .and.& + !Get_FillMouseHoleLed() == .false. .and.& + Get_Elevator() == ELEVATOR_UNLATCH_SINGLE_END) then + !call Log_4('OPERATION-CODE=12') + call Set_ElevatorConnection(ELEVATOR_CONNECTION_NOTHING) + !call Set_UnlatchLed(.false.) + !call Set_LatchLed(.true.) + call Set_FillMouseHoleLed(.true.) + call Set_MouseHole(MOUSE_HOLE_NEUTRAL) + call Set_Elevator(ELEVATOR_NEUTRAL) + !call Set_Elevator(ELEVATOR_UNLATCH_SINGLE_BEGIN) + return + end if + + !OPERATION-CODE=13 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() <= (HL + Get_NearFloorConnection() + PL) .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_STRING .and.& + !Get_Swing() == SWING_WELL_END .and.& + !Get_TongNotification() .and.& + Get_ElevatorPickup().and.& + Get_Tong() == TONG_BREAKOUT_END) then + !call Log_4('OPERATION-CODE=13') + call Set_ElevatorConnection(ELEVATOR_CONNECTION_SINGLE) + call Set_StringUpdate(STRING_UPDATE_REMOVE_SINGLE) + !call Set_StringUpdate(STRING_UPDATE_ADD_SINGLE) + call Set_Tong(TONG_NEUTRAL) + return + end if + + !OPERATION-CODE=14 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() <= (HL + Get_NearFloorConnection() + PL) .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_SINGLE .and.& + !Get_Swing() == SWING_WELL_END .and.& + !Get_TongNotification() .and.& + Get_ElevatorPickup().and.& + Get_Tong() == TONG_MAKEUP_END) then + !call Log_4('OPERATION-CODE=14') + call Set_Tong(TONG_NEUTRAL) + call Set_ElevatorConnection(ELEVATOR_CONNECTION_STRING) + call Set_StringUpdate(STRING_UPDATE_ADD_SINGLE) + return + end if + + + !OPERATION-CODE=15 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() >= (HL + Get_NearFloorConnection() + SL - LG) .and.& + !Get_HookHeight() >= (HL + Get_NearFloorConnection() + SL - RE) .and. Get_HookHeight() <= (HL + Get_NearFloorConnection() + SL + LG) .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_STRING .and.& + !Get_Swing() == SWING_WELL_END .and.& + !Get_TongNotification() .and.& + Get_ElevatorPickup().and.& + Get_Tong() == TONG_BREAKOUT_END) then + call Set_Tong(TONG_NEUTRAL) + call Set_ElevatorConnection(ELEVATOR_CONNECTION_STAND) + call Set_StringUpdate(STRING_UPDATE_REMOVE_STAND) + return + end if + + !OPERATION-CODE=16 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + !Get_HookHeight() >= (HL + Get_NearFloorConnection() + SL - RE) .and. Get_HookHeight() <= (HL + Get_NearFloorConnection() + SL + LG) .and.& + !Get_JointConnectionPossible() .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_STAND .and.& + !Get_Swing() == SWING_WELL_END .and.& + !Get_TongNotification() .and.& + Get_ElevatorPickup().and.& + Get_Tong() == TONG_MAKEUP_END) then + !call Log_4('OPERATION-CODE=16') + call Set_Tong(TONG_NEUTRAL) + call Set_ElevatorConnection(ELEVATOR_CONNECTION_STRING) + call Set_StringUpdate(STRING_UPDATE_ADD_STAND) + return + end if + + + + + + !OPERATION-CODE=75 + if (Get_ElevatorPickup() == .false. .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_SINGLE) then + call Set_ElevatorConnection(ELEVATOR_LATCH_SINGLE) + return + end if + + + !OPERATION-CODE=76 + if (Get_ElevatorPickup() == .false. .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_STAND) then + call Set_ElevatorConnection(ELEVATOR_LATCH_STAND) + return + end if + + + + + + + endif + + + + end subroutine + + ! subroutine Subscribe_ElevatorConnection() + ! use CDrillingConsoleVariables + ! implicit none + ! call OnLatchPipePress%Add(ButtonPress_Latch_ElevatorConnection) + ! call OnUnlatchPipePress%Add(ButtonPress_Unlatch_ElevatorConnection) + ! call OnBreakoutLeverPress%Add(ButtonPress_Breakout_ElevatorConnection) + ! call OnMakeupLeverPress%Add(ButtonPress_Makeup_ElevatorConnection) + ! end subroutine + + subroutine ButtonPress_Latch_ElevatorConnection() + use CCommon, only: SetStandRack + implicit none + + + + + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'ButtonPress_Latch_ElevatorConnection=TopDrive' +#endif + + + + + !TOPDRIVE-CODE=73 + if ((Get_HookHeight() >= (TL() + SL - ECG + NFC()) .and. Get_HookHeight() <= (TL() + SL - ECG + NFC() + TG)) .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_NOTHING .and.& + Get_TdsSwing() == TDS_SWING_OFF_END .and.& + Get_LatchLed()) then + + call Set_Elevator(ELEVATOR_LATCH_STAND_BEGIN) + call Set_LatchLed(.false.) + return + end if + + + + + + + + !TOPDRIVE-CODE=74 + if (Get_HookHeight() <= (TL() + NFC() - ECG) .and.& + GetRotaryRpm() == 0.0d0 .and.& + Get_ElevatorConnectionPossible() .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_NOTHING .and.& + Get_TdsSwing() == TDS_SWING_OFF_END .and.& + Get_LatchLed()) then + + call Set_Elevator(ELEVATOR_LATCH_STRING_BEGIN) + call Set_LatchLed(.false.) + return + end if + + + + + + + + !TOPDRIVE-CODE=75 + if (Get_ElevatorConnectionPossible() .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_NOTHING .and.& + Get_TdsSwing() == TDS_SWING_TILT_END .and.& + Get_LatchLed() .and.& + Get_FillMouseHoleLed()) then + + call Set_Elevator(ELEVATOR_LATCH_SINGLE_BEGIN) + call Set_LatchLed(.false.) + return + end if + + + + + + + + endif + + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'ButtonPress_Latch_ElevatorConnection=Kelly' +#endif + + !OPERATION-CODE=86 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() <= (HL + Get_NearFloorConnection() - ECG) .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .and.& + Get_LatchLed() .and.& + GetRotaryRpm() == 0.0d0 .and.& + Get_Swing() == SWING_WELL_END .and.& + Get_ElevatorConnectionPossible() .and.& + Get_HookHeight() <= (HL + Get_NearFloorConnection())) then + + !call Log_4("OPERATION-CODE=ELEVATOR_LATCH_STRING_BEGIN") + call Set_Elevator(ELEVATOR_LATCH_STRING_BEGIN) + call Set_LatchLed(.false.) + return + endif + + !OPERATION-CODE=85 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() >= (HL + SL - ECG + Get_NearFloorConnection()) .and. Get_HookHeight() <= (HL + SL - ECG + Get_NearFloorConnection() + LG) .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .and.& + Get_LatchLed() .and.& + Get_Swing() == SWING_WELL_END) then + !Get_HookHeight() >= (HL + Get_NearFloorConnection() + SL + RE) .and. Get_HookHeight() <= (HL + Get_NearFloorConnection() + SL + LG) + + call Set_Elevator(ELEVATOR_LATCH_STAND_BEGIN) + call Set_LatchLed(.false.) + return + endif + + !OPERATION-CODE=87 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .and.& + Get_LatchLed() .and.& + Get_FillMouseHoleLed() .and.& + Get_ElevatorConnectionPossible() .and.& + Get_Swing() == SWING_MOUSE_HOLE_END) then + + call Set_Elevator(ELEVATOR_LATCH_SINGLE_BEGIN) + call Set_LatchLed(.false.) + return + endif + + + endif + + + + + + + + + + + + + end subroutine + + subroutine ButtonPress_Unlatch_ElevatorConnection() + use CCommon, only: SetStandRack + implicit none + + + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'ButtonPress_Unlatch_ElevatorConnection=TopDrive' +#endif + + + + !TOPDRIVE-CODE=76 + if ((Get_HookHeight() >= (TL() + SL - ECG + NFC()) .and. Get_HookHeight() <= (TL() + SL - ECG + NFC() + TG)) .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_STAND .and.& + Get_TdsSwing() == TDS_SWING_OFF_END .and.& + Get_UnlatchLed()) then + + call Set_Elevator(ELEVATOR_UNLATCH_STAND_BEGIN) + call Set_UnlatchLed(.false.) + return + end if + + + + + + + + + !TOPDRIVE-CODE=77 + if (Get_HookHeight() <= (TL() + NFC() - ECG) .and.& + GetRotaryRpm() == 0.0d0 .and.& + Get_NearFloorConnection() >= 3.0 .and. Get_NearFloorConnection() <= 6.0 .and.& + (Get_TdsElevatorModes() == TDS_ELEVATOR_LATCH_STRING .or. Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_STRING) .and.& + Get_TdsSwing() == TDS_SWING_OFF_END .and.& + Get_UnlatchLed()) then + + call Set_Elevator(ELEVATOR_UNLATCH_STRING_BEGIN) + call Set_UnlatchLed(.false.) + return + end if + + + + + + + + !TOPDRIVE-CODE=78 + if ((Get_HookHeight() > TL() .and. Get_HookHeight() < (TL() + NFC() + SG)) .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_SINGLE .and.& + Get_TdsSwing() == TDS_SWING_TILT_END .and.& + Get_UnlatchLed() .and.& + Get_FillMouseHoleLed() == .false.) then + + call Set_Elevator(ELEVATOR_UNLATCH_SINGLE_BEGIN) + call Set_UnlatchLed(.false.) + return + end if + + + + + + endif + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'ButtonPress_Unlatch_ElevatorConnection=Kelly' +#endif + !OPERATION-CODE=89 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() <= (HL + Get_NearFloorConnection() - ECG) .and.& + (Get_ElevatorConnection() == ELEVATOR_CONNECTION_STRING .or. Get_ElevatorConnection() == ELEVATOR_LATCH_STRING) .and.& + Get_HookHeight() <= (HL + Get_NearFloorConnection()) .and.& + Get_UnlatchLed() .and.& + GetRotaryRpm() == 0.0d0 .and.& + Get_Swing() == SWING_WELL_END .and.& + Get_NearFloorConnection() >= 3.0 .and. Get_NearFloorConnection() <= 6.0) then + !Get_HookHeight() >= (HL + Get_NearFloorConnection() - 4.0) .and. Get_HookHeight() <= (HL + Get_NearFloorConnection() - 2.0)) then + + call Set_Elevator(ELEVATOR_UNLATCH_STRING_BEGIN) + call Set_UnlatchLed(.false.) + return + endif + + !OPERATION-CODE=88 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() >= (HL + SL - ECG + Get_NearFloorConnection()) .and. Get_HookHeight() <= (HL + SL - ECG + Get_NearFloorConnection() + LG) .and.& + !Get_HookHeight() >= (HL + Get_NearFloorConnection() + SL + RE) .and. Get_HookHeight() <= (HL + Get_NearFloorConnection() + SL + LG) + Get_ElevatorConnection() == ELEVATOR_CONNECTION_STAND .and.& + Get_UnlatchLed() .and.& + Get_Swing() == SWING_WELL_END) then + + call Set_Elevator(ELEVATOR_UNLATCH_STAND_BEGIN) + call Set_UnlatchLed(.false.) + return + endif + + !OPERATION-CODE=90 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_SINGLE .and.& + Get_UnlatchLed() .and.& + Get_HookHeight() >= HL .and. Get_HookHeight() <= (HL + Get_NearFloorConnection() + SG) .and.& + !Get_JointConnectionPossible() .and.& + Get_Swing() == SWING_MOUSE_HOLE_END) then + + call Set_Elevator(ELEVATOR_UNLATCH_SINGLE_BEGIN) + call Set_UnlatchLed(.false.) + return + endif + + endif + + + + + + + + end subroutine + + subroutine ButtonPress_Breakout_ElevatorConnection() + implicit none + + end subroutine + + subroutine ButtonPress_Makeup_ElevatorConnection() + implicit none + + end subroutine + +end module CElevatorConnectionEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/Enums/CElevatorConnectionEnumVariables.f90 b/CSharp/OperationScenarios/Enums/CElevatorConnectionEnumVariables.f90 new file mode 100644 index 0000000..eb0158f --- /dev/null +++ b/CSharp/OperationScenarios/Enums/CElevatorConnectionEnumVariables.f90 @@ -0,0 +1,64 @@ +module CElevatorConnectionEnumVariables + use CVoidEventHandlerCollection + implicit none + integer :: ElevatorConnection = 0 + + public + + type(VoidEventHandlerCollection) :: OnElevatorConnectionChange + + enum, bind(c) + enumerator ELEVATOR_CONNECTION_NOTHING + enumerator ELEVATOR_CONNECTION_STRING + enumerator ELEVATOR_CONNECTION_STAND + enumerator ELEVATOR_CONNECTION_SINGLE + enumerator ELEVATOR_LATCH_STRING + enumerator ELEVATOR_LATCH_SINGLE + enumerator ELEVATOR_LATCH_STAND + end enum + + private :: ElevatorConnection + contains + + subroutine Set_ElevatorConnection(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(ElevatorConnection == v) return +#endif + ElevatorConnection = v + +#ifdef deb + print*, 'ElevatorConnection=', ElevatorConnection +#endif + call OnElevatorConnectionChange%RunAll() + end subroutine + + integer function Get_ElevatorConnection() + implicit none + Get_ElevatorConnection = ElevatorConnection + end function + + + + + + + + subroutine Set_ElevatorConnection_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_ElevatorConnection_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_ElevatorConnection_WN' :: Set_ElevatorConnection_WN + implicit none + integer , intent(in) :: v + call Set_ElevatorConnection(v) + end subroutine + + integer function Get_ElevatorConnection_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_ElevatorConnection_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_ElevatorConnection_WN' :: Get_ElevatorConnection_WN + implicit none + Get_ElevatorConnection_WN = ElevatorConnection + end function + + +end module CElevatorConnectionEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Enums/CKellyConnectionEnum.f90 b/CSharp/OperationScenarios/Enums/CKellyConnectionEnum.f90 new file mode 100644 index 0000000..62f53e5 --- /dev/null +++ b/CSharp/OperationScenarios/Enums/CKellyConnectionEnum.f90 @@ -0,0 +1,175 @@ +module CKellyConnectionEnum + use COperationScenariosVariables + use CLog4 + implicit none + contains + + subroutine Evaluate_KellyConnection() + implicit none + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_KellyConnection=TopDrive' +#endif + endif + + + + + + + + + + + + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_KellyConnection=Kelly' +#endif + + + + + !!OPERATION-CODE=4 + !if (Get_OperationCondition() == OPERATION_DRILL .and.& + ! Get_KellyConnection() == KELLY_CONNECTION_SINGLE .and.& + ! Get_Swing() == SWING_MOUSE_HOLE_END .and.& + ! Get_TongNotification() .and.& + ! Get_FillMouseHoleLed() == .false. .and.& + ! Get_Tong() == TONG_BREAKOUT_END) then + ! + ! call Set_FillMouseHoleLed(.true.) + ! return + !end if + + + + !OPERATION-CODE=1 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + !Get_JointConnectionPossible() .and.& + Get_KellyConnection() == KELLY_CONNECTION_NOTHING .and.& + Get_Swing() == SWING_WELL_END .and.& + !Get_TongNotification() .and.& + Get_Tong() == TONG_MAKEUP_END) then + !call Log_4('KELLY_CONNECTION_STRING') + call Set_Tong(TONG_NEUTRAL) + call Set_KellyConnection(KELLY_CONNECTION_STRING) + return + end if + + !OPERATION-CODE=2 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + Get_StringPressure() == 0 .and.& + Get_HookHeight() <= (HKL + Get_NearFloorConnection()) .and.& + Get_KellyConnection() == KELLY_CONNECTION_STRING .and.& + Get_Swing() == SWING_WELL_END .and.& + !Get_TongNotification() .and.& + Get_Tong() == TONG_BREAKOUT_END) then + call Set_Tong(TONG_NEUTRAL) + call Set_KellyConnection(KELLY_CONNECTION_NOTHING) + call Set_SwingLed(.true.) + return + end if + + + !OPERATION-CODE=3 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + !Get_JointConnectionPossible() .and.& + Get_KellyConnection() == KELLY_CONNECTION_NOTHING .and.& + Get_Swing() == SWING_MOUSE_HOLE_END .and.& + !Get_TongNotification() .and.& + Get_FillMouseHoleLed() .and.& + Get_Tong() == TONG_MAKEUP_END) then + call Set_Tong(TONG_NEUTRAL) + call Set_KellyConnection(KELLY_CONNECTION_SINGLE) + call Set_SwingLed(.false.) + call Set_FillMouseHoleLed(.false.) + call Set_MouseHole(MOUSE_HOLE_NEUTRAL) + return + end if + + + !OPERATION-CODE=4 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + Get_KellyConnection() == KELLY_CONNECTION_SINGLE .and.& + Get_Swing() == SWING_MOUSE_HOLE_END .and.& + !Get_TongNotification() .and.& + Get_FillMouseHoleLed() == .false. .and.& + Get_Tong() == TONG_BREAKOUT_END) then + call Set_Tong(TONG_NEUTRAL) + call Set_KellyConnection(KELLY_CONNECTION_NOTHING) + call Set_FillMouseHoleLed(.true.) + call Set_MouseHole(MOUSE_HOLE_NEUTRAL) + return + end if + + !OPERATION-CODE=5 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + !Get_JointConnectionPossible() .and.& + Get_KellyConnection() == KELLY_CONNECTION_SINGLE .and.& + Get_Swing() == SWING_WELL_END .and.& + !Get_TongNotification() .and.& + Get_Tong() == TONG_MAKEUP_END) then + call Set_Tong(TONG_NEUTRAL) + call Set_KellyConnection(KELLY_CONNECTION_STRING) + call Set_StringUpdate(STRING_UPDATE_ADD_SINGLE) + call Set_SwingLed(.false.) + return + end if + + !OPERATION-CODE=6 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + Get_StringPressure() == 0 .and.& + Get_HookHeight() > 70.0 .and.& + Get_KellyConnection() == KELLY_CONNECTION_STRING .and.& + !Get_TongNotification() .and.& + Get_Swing() == SWING_WELL_END .and.& + Get_Tong() == TONG_BREAKOUT_END) then + call Set_Tong(TONG_NEUTRAL) + call Set_KellyConnection(KELLY_CONNECTION_SINGLE) + call Set_StringUpdate(STRING_UPDATE_REMOVE_SINGLE) + return + end if + + endif + + + + + + end subroutine + + ! subroutine Subscribe_KellyConnection() + ! use CDrillingConsoleVariables + ! implicit none + + ! call OnBreakoutLeverPress%Add(ButtonPress_Breakout) + ! call OnMakeupLeverPress%Add(ButtonPress_Makeup) + ! end subroutine + + subroutine ButtonPress_Breakout() + implicit none +#ifdef deb + print*, 'ButtonPress_Breakout on ======> CKellyConnectionEnum' +#endif + end subroutine + + subroutine ButtonPress_Makeup() + implicit none +#ifdef deb + print*, 'ButtonPress_Makeup on ======> CKellyConnectionEnum' +#endif + end subroutine + +end module CKellyConnectionEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/Enums/CKellyConnectionEnumVariables.f90 b/CSharp/OperationScenarios/Enums/CKellyConnectionEnumVariables.f90 new file mode 100644 index 0000000..a05792e --- /dev/null +++ b/CSharp/OperationScenarios/Enums/CKellyConnectionEnumVariables.f90 @@ -0,0 +1,66 @@ +module CKellyConnectionEnumVariables + use CVoidEventHandlerCollection + implicit none + integer :: KellyConnection = 0 + + public + + type(VoidEventHandlerCollection) :: OnKellyConnectionChange + + enum, bind(c) + enumerator KELLY_CONNECTION_NOTHING + enumerator KELLY_CONNECTION_STRING + enumerator KELLY_CONNECTION_SINGLE + end enum + + private :: KellyConnection + contains + + subroutine Set_KellyConnection(v) + use CManifolds, Only: KellyConnected, KellyDisconnected + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(KellyConnection == v) return +#endif + + KellyConnection = v + + if(KellyConnection /= KELLY_CONNECTION_STRING) then + call KellyDisconnected() + else + call KellyConnected() + endif + +#ifdef deb + print*, 'KellyConnection=', KellyConnection +#endif + call OnKellyConnectionChange%RunAll() + end subroutine + + integer function Get_KellyConnection() + implicit none + Get_KellyConnection = KellyConnection + end function + + + + + + + subroutine Set_KellyConnection_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_KellyConnection_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_KellyConnection_WN' :: Set_KellyConnection_WN + implicit none + integer , intent(in) :: v + call Set_KellyConnection(v) + end subroutine + + integer function Get_KellyConnection_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_KellyConnection_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_KellyConnection_WN' :: Get_KellyConnection_WN + implicit none + Get_KellyConnection_WN = KellyConnection + end function + +end module CKellyConnectionEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Enums/CTdsConnectionModesEnum.f90 b/CSharp/OperationScenarios/Enums/CTdsConnectionModesEnum.f90 new file mode 100644 index 0000000..e0bd44a --- /dev/null +++ b/CSharp/OperationScenarios/Enums/CTdsConnectionModesEnum.f90 @@ -0,0 +1,81 @@ +module CTdsConnectionModesEnum + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_TdsConnectionModes() + implicit none + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_TdsConnectionModes=TopDrive' +#endif + + !TOPDRIVE-CODE=3 + if (Get_TdsStemIn() .and.& + Get_TdsSpine() == TDS_SPINE_CONNECT_END .and.& + !TopDriveDrillTorqueState == TdsMu_SPINE + Get_TdsConnectionModes() == TDS_CONNECTION_NOTHING) then + + call Set_TdsConnectionModes(TDS_CONNECTION_SPINE) + return + end if + + + !TOPDRIVE-CODE=4 + if (Get_TdsTong() == TDS_TONG_MAKEUP_END .and.& + Get_TdsConnectionModes() == TDS_CONNECTION_SPINE ) then + + call Set_TdsConnectionModes(TDS_CONNECTION_STRING) + TopDriveTorqueWrenchLed = LED_OFF + return + end if + + + !TOPDRIVE-CODE=5 + if (Get_TdsTong() == TDS_TONG_BREAKOUT_END .and.& + Get_TdsConnectionModes() == TDS_CONNECTION_STRING ) then + + call Set_TdsConnectionModes(TDS_CONNECTION_SPINE) + TopDriveTorqueWrenchLed = LED_OFF + return + end if + + + + !TOPDRIVE-CODE=6 + if (Get_TdsSpine() == TDS_SPINE_DISCONNECT_END .and.& + !Get_TdsStemIn() == .false. .and.& + Get_TdsConnectionModes() == TDS_CONNECTION_SPINE) then + + call Set_TdsConnectionModes(TDS_CONNECTION_NOTHING) + return + end if + + + endif + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_TdsConnectionModes=Kelly' +#endif + endif + + + + + + + end subroutine + + subroutine Subscribe_TdsConnectionModes() + use CDrillingConsoleVariables + implicit none + end subroutine + +end module CTdsConnectionModesEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/Enums/CTdsConnectionModesEnumVariables.f90 b/CSharp/OperationScenarios/Enums/CTdsConnectionModesEnumVariables.f90 new file mode 100644 index 0000000..a1d429d --- /dev/null +++ b/CSharp/OperationScenarios/Enums/CTdsConnectionModesEnumVariables.f90 @@ -0,0 +1,68 @@ +module CTdsConnectionModesEnumVariables + use CVoidEventHandlerCollection + implicit none + integer :: TdsConnectionModes = 0 + + public + + type(VoidEventHandlerCollection) :: OnTdsConnectionModesChange + + enum, bind(c) + enumerator TDS_CONNECTION_NOTHING + enumerator TDS_CONNECTION_STRING + enumerator TDS_CONNECTION_SPINE + end enum + + private :: TdsConnectionModes + contains + + subroutine Set_TdsConnectionModes(v) + use CManifolds, Only: KellyConnected, KellyDisconnected + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(TdsConnectionModes == v) return +#endif + TdsConnectionModes = v + + if(TdsConnectionModes == TDS_CONNECTION_NOTHING) then + call KellyDisconnected() + else + call KellyConnected() + endif + +#ifdef deb + print*, 'TdsConnectionModes=', TdsConnectionModes +#endif + call OnTdsConnectionModesChange%RunAll() + end subroutine + + integer function Get_TdsConnectionModes() + implicit none + Get_TdsConnectionModes = TdsConnectionModes + end function + + + + + subroutine Set_TdsConnectionModes_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_TdsConnectionModes_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_TdsConnectionModes_WN' :: Set_TdsConnectionModes_WN + implicit none + integer , intent(in) :: v + call Set_TdsConnectionModes(v) + end subroutine + + + integer function Get_TdsConnectionModes_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_TdsConnectionModes_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_TdsConnectionModes_WN' :: Get_TdsConnectionModes_WN + implicit none + Get_TdsConnectionModes_WN = TdsConnectionModes + end function + + + + + +end module CTdsConnectionModesEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Enums/CTdsElevatorModesEnum.f90 b/CSharp/OperationScenarios/Enums/CTdsElevatorModesEnum.f90 new file mode 100644 index 0000000..09ed31d --- /dev/null +++ b/CSharp/OperationScenarios/Enums/CTdsElevatorModesEnum.f90 @@ -0,0 +1,330 @@ +module CTdsElevatorModesEnum + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_TdsElevatorModes() + use CCommon, only: SetStandRack + implicit none + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_TdsElevatorModes=TopDrive' +#endif + + + !TOPDRIVE-CODE=7 + if (Get_Elevator() == ELEVATOR_LATCH_STRING_END .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_NOTHING .and.& + Get_TdsSwing() == TDS_SWING_OFF_END ) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_LATCH_STRING) + call Set_Elevator(ELEVATOR_NEUTRAL) + return + end if + + + + !TOPDRIVE-CODE=8 + if (Get_HookHeight() <= (TL() + TJH() - ECG) .and.& + Get_ElevatorPickup() == .false. .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_STRING) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_LATCH_STRING) + return + end if + + + + !TOPDRIVE-CODE=9 + if (Get_ElevatorPickup() .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_LATCH_STRING) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_CONNECTION_STRING) + return + end if + + + !TOPDRIVE-CODE=10 + if (Get_Elevator() == ELEVATOR_UNLATCH_STRING_END .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_LATCH_STRING) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_CONNECTION_NOTHING) + call Set_Elevator(ELEVATOR_NEUTRAL) + return + end if + + + + + !TOPDRIVE-CODE=11 + if (Get_Elevator() == ELEVATOR_UNLATCH_STRING_END .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_LATCH_STRING .and.& + Get_TdsConnectionModes() == TDS_CONNECTION_STRING) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_CONNECTION_NOTHING) + call Set_Elevator(ELEVATOR_NEUTRAL) + return + end if + + + + + + !TOPDRIVE-CODE=12 + if (Get_Elevator() == ELEVATOR_LATCH_STAND_END .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_NOTHING) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_CONNECTION_STAND) + call Set_Elevator(ELEVATOR_NEUTRAL) + call SetStandRack(Get_StandRack() - 1) + return + end if + + + + + !TOPDRIVE-CODE=13 + if (Get_Elevator() == ELEVATOR_UNLATCH_STAND_END .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_STAND) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_CONNECTION_NOTHING) + call Set_Elevator(ELEVATOR_NEUTRAL) + call SetStandRack(Get_StandRack() + 1) + return + end if + + + + + !TOPDRIVE-CODE=14 + if (Get_Elevator() == ELEVATOR_LATCH_SINGLE_END .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_NOTHING .and.& + Get_TdsSwing() == TDS_SWING_TILT_END .and.& + Get_FillMouseHoleLed()) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_CONNECTION_SINGLE) + call Set_Elevator(ELEVATOR_NEUTRAL) + call Set_UnlatchLed(.true.) + call Set_FillMouseHoleLed(.false.) + call Set_MouseHole(MOUSE_HOLE_NEUTRAL) + return + end if + + + + + + !TOPDRIVE-CODE=15 + if (Get_Elevator() == ELEVATOR_UNLATCH_SINGLE_END .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_SINGLE .and.& + Get_TdsSwing() == TDS_SWING_TILT_END .and.& + Get_FillMouseHoleLed() == .false.) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_CONNECTION_NOTHING) + call Set_Elevator(ELEVATOR_NEUTRAL) + call Set_UnlatchLed(.false.) + call Set_FillMouseHoleLed(.true.) + call Set_MouseHole(MOUSE_HOLE_NEUTRAL) + return + end if + + + + !TOPDRIVE-CODE=16 + if (Get_HookHeight() <= (TL() + NFC() + PL - ECG) .and.& + Get_Tong() == TONG_BREAKOUT_END .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_LATCH_STRING .and.& + Get_TdsConnectionModes() == TDS_CONNECTION_NOTHING) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_LATCH_SINGLE) + call Set_Tong(TONG_NEUTRAL) + call Set_StringUpdate(STRING_UPDATE_REMOVE_SINGLE) + return + end if + + + + + !TOPDRIVE-CODE=17 + if (Get_HookHeight() <= (TL() + NFC() + PL - ECG) .and.& + Get_Tong() == TONG_BREAKOUT_END .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_STRING .and.& + Get_TdsConnectionModes() == TDS_CONNECTION_NOTHING) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_CONNECTION_SINGLE) + call Set_Tong(TONG_NEUTRAL) + call Set_StringUpdate(STRING_UPDATE_REMOVE_SINGLE) + return + end if + + + + !TOPDRIVE-CODE=18 + if (Get_ElevatorPickup() .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_LATCH_SINGLE) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_CONNECTION_SINGLE) + return + end if + + + + + !TOPDRIVE-CODE=19 + if (Get_HookHeight() <= (TL() + NFC() + PL - ECG) .and.& + Get_ElevatorPickup() == .false. .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_SINGLE) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_LATCH_SINGLE) + + return + end if + + + + + + + !TOPDRIVE-CODE=20 + if (Get_Tong() == TONG_MAKEUP_END .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_SINGLE) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_CONNECTION_STRING) + call Set_Tong(TONG_NEUTRAL) + call Set_StringUpdate(STRING_UPDATE_ADD_SINGLE) + return + end if + + + + + !TOPDRIVE-CODE=21 + if (Get_Tong() == TONG_MAKEUP_END .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_LATCH_SINGLE) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_LATCH_STRING) + call Set_Tong(TONG_NEUTRAL) + call Set_StringUpdate(STRING_UPDATE_ADD_SINGLE) + return + end if + + + + !TOPDRIVE-CODE=22 + if (Get_HookHeight() <= (TL() + NFC() + SL - ECG) .and.& + Get_Tong() == TONG_BREAKOUT_END .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_LATCH_STRING .and.& + Get_TdsConnectionModes() == TDS_CONNECTION_NOTHING) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_LATCH_STAND) + call Set_Tong(TONG_NEUTRAL) + call Set_StringUpdate(STRING_UPDATE_REMOVE_STAND) + return + end if + + + + !TOPDRIVE-CODE=23 + if (Get_HookHeight() <= (TL() + NFC() + SL - ECG) .and.& + Get_Tong() == TONG_BREAKOUT_END .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_STRING .and.& + Get_TdsConnectionModes() == TDS_CONNECTION_NOTHING) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_CONNECTION_STAND) + call Set_Tong(TONG_NEUTRAL) + call Set_StringUpdate(STRING_UPDATE_REMOVE_STAND) + return + end if + + + + !TOPDRIVE-CODE=24 + if (Get_ElevatorPickup() .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_LATCH_STAND) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_CONNECTION_STAND) + return + end if + + + + + + !TOPDRIVE-CODE=25 + if (Get_HookHeight() <= (TL() + NFC() + SL - ECG) .and.& + Get_ElevatorPickup() == .false. .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_STAND) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_LATCH_STAND) + return + end if + + + + + !TOPDRIVE-CODE=26 + if (Get_Tong() == TONG_MAKEUP_END .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_STAND) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_CONNECTION_STRING) + call Set_Tong(TONG_NEUTRAL) + call Set_StringUpdate(STRING_UPDATE_ADD_STAND) + return + end if + + + + + + + + + + !TOPDRIVE-CODE=27 + if (Get_Tong() == TONG_MAKEUP_END .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_LATCH_STAND) then + + call Set_TdsElevatorModes(TDS_ELEVATOR_LATCH_STRING) + call Set_Tong(TONG_NEUTRAL) + call Set_StringUpdate(STRING_UPDATE_ADD_STAND) + return + end if + + + + + + + + + + + + endif + + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_TdsElevatorModes=Kelly' +#endif + endif + + + + + end subroutine + + subroutine Subscribe_TdsElevatorModes() + use CDrillingConsoleVariables + implicit none + end subroutine + +end module CTdsElevatorModesEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/Enums/CTdsElevatorModesEnumVariables.f90 b/CSharp/OperationScenarios/Enums/CTdsElevatorModesEnumVariables.f90 new file mode 100644 index 0000000..e52213e --- /dev/null +++ b/CSharp/OperationScenarios/Enums/CTdsElevatorModesEnumVariables.f90 @@ -0,0 +1,62 @@ +module CTdsElevatorModesEnumVariables + use CVoidEventHandlerCollection + implicit none + integer :: TdsElevatorModes = 0 + + public + + type(VoidEventHandlerCollection) :: OnTdsElevatorModesChange + + enum, bind(c) + enumerator TDS_ELEVATOR_CONNECTION_NOTHING + enumerator TDS_ELEVATOR_CONNECTION_STRING + enumerator TDS_ELEVATOR_CONNECTION_SINGLE + enumerator TDS_ELEVATOR_CONNECTION_STAND + enumerator TDS_ELEVATOR_LATCH_STRING + enumerator TDS_ELEVATOR_LATCH_SINGLE + enumerator TDS_ELEVATOR_LATCH_STAND + end enum + + private :: TdsElevatorModes + contains + + subroutine Set_TdsElevatorModes(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(TdsElevatorModes == v) return +#endif + TdsElevatorModes = v + call OnTdsElevatorModesChange%RunAll() + end subroutine + + integer function Get_TdsElevatorModes() + implicit none + Get_TdsElevatorModes = TdsElevatorModes + end function + + + + + + + subroutine Set_TdsElevatorModes_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_TdsElevatorModes_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_TdsElevatorModes_WN' :: Set_TdsElevatorModes_WN + implicit none + integer , intent(in) :: v + call Set_TdsElevatorModes(v) + end subroutine + + integer function Get_TdsElevatorModes_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_TdsElevatorModes_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_TdsElevatorModes_WN' :: Get_TdsElevatorModes_WN + implicit none + Get_TdsElevatorModes_WN = TdsElevatorModes + end function + + + + + +end module CTdsElevatorModesEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CCloseKellyCockLedNotification.f90 b/CSharp/OperationScenarios/Notifications/CCloseKellyCockLedNotification.f90 new file mode 100644 index 0000000..0d702db --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CCloseKellyCockLedNotification.f90 @@ -0,0 +1,83 @@ +module CCloseKellyCockLedNotification + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_CloseKellyCockLed() + implicit none + + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_CloseKellyCockLed=TopDrive' +!#endif +! endif +! +! +! +! +! +! +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_CloseKellyCockLed=Kelly' +!#endif +! endif + + + end subroutine + + ! subroutine Subscribe_CloseKellyCockLed() + ! use CDrillingConsoleVariables + ! implicit none + ! call OnCloseKellyCockPress%Add(ButtonPress_CloseKellyCock) + ! end subroutine + + subroutine ButtonPress_CloseKellyCock() + implicit none + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_CloseKellyCockLed=TopDrive' +#endif + endif + + + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_CloseKellyCockLed=Kelly' +#endif + + !OPERATION-CODE=66 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + Get_CloseKellyCockLed() == .false. .and.& + Get_OpenKellyCockLed()) then + call Set_OpenKellyCockLed(.false.) + call Set_CloseKellyCockLed(.true.) + return + end if + + + endif + + + + + + + end subroutine + +end module CCloseKellyCockLedNotification \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CCloseKellyCockLedNotificationVariables.f90 b/CSharp/OperationScenarios/Notifications/CCloseKellyCockLedNotificationVariables.f90 new file mode 100644 index 0000000..bce6bf9 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CCloseKellyCockLedNotificationVariables.f90 @@ -0,0 +1,67 @@ +module CCloseKellyCockLedNotificationVariables + use CVoidEventHandlerCollection + implicit none + logical :: CloseKellyCockLed = .false. + + public + + type(VoidEventHandlerCollection) :: OnCloseKellyCockLedChange + + private :: CloseKellyCockLed + + contains + + subroutine Set_CloseKellyCockLed(v) + use CDrillingConsoleVariables, only: CloseKellyCockLedHw => CloseKellyCockLed + use CManifolds, only: CloseKellyCock + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(CloseKellyCockLed == v) return +#endif + CloseKellyCockLed = v + + if(CloseKellyCockLed) then + call CloseKellyCock() + endif + + !if(CloseKellyCockLed) then + ! CloseKellyCockLedHw = 1 + !else + ! CloseKellyCockLedHw = 0 + !endif + call OnCloseKellyCockLedChange%RunAll() + end subroutine + + logical function Get_CloseKellyCockLed() + implicit none + Get_CloseKellyCockLed = CloseKellyCockLed + end function + + + + + + + + + + + + subroutine Set_CloseKellyCockLed_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_CloseKellyCockLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_CloseKellyCockLed_WN' :: Set_CloseKellyCockLed_WN + implicit none + logical , intent(in) :: v + call Set_CloseKellyCockLed(v) + end subroutine + + + logical function Get_CloseKellyCockLed_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_CloseKellyCockLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_CloseKellyCockLed_WN' :: Get_CloseKellyCockLed_WN + implicit none + Get_CloseKellyCockLed_WN = CloseKellyCockLed + end function + +end module CCloseKellyCockLedNotificationVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CCloseSafetyValveLedNotification.f90 b/CSharp/OperationScenarios/Notifications/CCloseSafetyValveLedNotification.f90 new file mode 100644 index 0000000..b49c748 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CCloseSafetyValveLedNotification.f90 @@ -0,0 +1,109 @@ +module CCloseSafetyValveLedNotification + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_CloseSafetyValveLed() + implicit none + + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_CloseSafetyValveLed=TopDrive' +!#endif +! endif +! +! +! +! +! +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_CloseSafetyValveLed=Kelly' +!#endif +! endif + + + end subroutine + + ! subroutine Subscribe_CloseSafetyValveLed() + ! use CDrillingConsoleVariables + ! implicit none + ! call OnCloseSafetyValvePress%Add(ButtonPress_CloseSafetyValve) + ! call OnOperationConditionChangeInt%Add(Set_Operation_CloseSafetyValveLed) + ! end subroutine + + subroutine Set_Operation_CloseSafetyValveLed(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(operation_CloseSafetyValveLed == v) return +#endif + operation_CloseSafetyValveLed = v +#ifdef deb + print*, 'operation_CloseSafetyValveLed=', operation_CloseSafetyValveLed +#endif + end subroutine + + subroutine ButtonPress_CloseSafetyValve() + implicit none + + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_CloseSafetyValveLed=TopDrive' +#endif + + + !TOPDRIVE-CODE=57 + if (Get_SafetyValveHeight() >= 3.0 .and. Get_SafetyValveHeight() <= 12.0 .and.& + Get_CloseSafetyValveLed() == .false. .and.& + Get_OpenSafetyValveLed()) then + + call Set_OpenSafetyValveLed(.false.) + call Set_CloseSafetyValveLed(.true.) + return + end if + + + endif + + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_CloseSafetyValveLed=Kelly' +#endif + + !OPERATION-CODE=59 + if (Get_SafetyValveHeight() >= 3.0 .and. Get_SafetyValveHeight() <= 12.0 .and.& + Get_CloseSafetyValveLed() == .false. .and.& + Get_OpenSafetyValveLed()) then + call Set_OpenSafetyValveLed(.false.) + call Set_CloseSafetyValveLed(.true.) + return + end if + + + endif + + + + + + + end subroutine + +end module CCloseSafetyValveLedNotification \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CCloseSafetyValveLedNotificationVariables.f90 b/CSharp/OperationScenarios/Notifications/CCloseSafetyValveLedNotificationVariables.f90 new file mode 100644 index 0000000..71571cb --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CCloseSafetyValveLedNotificationVariables.f90 @@ -0,0 +1,67 @@ +module CCloseSafetyValveLedNotificationVariables + use CVoidEventHandlerCollection + implicit none + logical :: CloseSafetyValveLed = .false. + integer :: operation_CloseSafetyValveLed = 0 + + public + type(VoidEventHandlerCollection) :: OnCloseSafetyValveLedChange + + private :: CloseSafetyValveLed + + contains + + subroutine Set_CloseSafetyValveLed(v) + use CDrillingConsoleVariables, only: CloseSafetyValveLedHw => CloseSafetyValveLed + use CManifolds, only: CloseSafetyValve_TopDrive, CloseSafetyValve_KellyMode, CloseSafetyValve_TripMode + use CHoistingVariables, only: DriveType, TopDrive_DriveType, Kelly_DriveType + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(CloseSafetyValveLed == v) return +#endif + CloseSafetyValveLed = v + + if(CloseSafetyValveLed) then + !!call CloseSafetyValve() + if(DriveType == TopDrive_DriveType) call CloseSafetyValve_TopDrive() + if(DriveType == Kelly_DriveType .and. operation_CloseSafetyValveLed == 0) call CloseSafetyValve_KellyMode() + if(DriveType == Kelly_DriveType .and. operation_CloseSafetyValveLed == 1) call CloseSafetyValve_TripMode() + endif + + !if(CloseSafetyValveLed) then + ! CloseSafetyValveLedHw = 1 + !else + ! CloseSafetyValveLedHw = 0 + !endif + call OnCloseSafetyValveLedChange%RunAll() + end subroutine + + logical function Get_CloseSafetyValveLed() + implicit none + Get_CloseSafetyValveLed = CloseSafetyValveLed + end function + + + + + + + subroutine Set_CloseSafetyValveLed_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_CloseSafetyValveLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_CloseSafetyValveLed_WN' :: Set_CloseSafetyValveLed_WN + implicit none + logical , intent(in) :: v + call Set_CloseSafetyValveLed(v) + end subroutine + + logical function Get_CloseSafetyValveLed_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_CloseSafetyValveLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_CloseSafetyValveLed_WN' :: Get_CloseSafetyValveLed_WN + implicit none + Get_CloseSafetyValveLed_WN = CloseSafetyValveLed + end function + + + +end module CCloseSafetyValveLedNotificationVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CFillMouseHoleLedNotification.f90 b/CSharp/OperationScenarios/Notifications/CFillMouseHoleLedNotification.f90 new file mode 100644 index 0000000..ec194ba --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CFillMouseHoleLedNotification.f90 @@ -0,0 +1,114 @@ +module CFillMouseHoleLedNotification + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_FillMouseHoleLed() + implicit none + + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_FillMouseHoleLed=TopDrive' +!#endif +! endif +! +! +! +! +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_FillMouseHoleLed=Kelly' +!#endif +! endif + + + + end subroutine + + ! subroutine Subscribe_FillMouseHoleLed() + ! use CDrillingConsoleVariables + ! implicit none + ! call OnFillMouseHolePress%Add(ButtonPress_FillMouseHole) + ! end subroutine + + subroutine ButtonPress_FillMouseHole() + implicit none + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_FillMouseHoleLed=TopDrive' +#endif + + + + + !TOPDRIVE-CODE=71 + if (Get_FillMouseHoleLed()) then + + call Set_FillMouseHoleLed(.false.) + call Set_MouseHole(MOUSE_HOLE_NEUTRAL) + return + end if + + + !TOPDRIVE-CODE=72 + if (Get_TdsElevatorModes() /= TDS_ELEVATOR_CONNECTION_STRING .and.& + Get_FillMouseHoleLed() == .false.) then + + call Set_FillMouseHoleLed(.true.) + return + end if + + + + + + endif + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_FillMouseHoleLed=Kelly' +#endif + + + !OPERATION-CODE=81 + if (Get_FillMouseHoleLed()) then + call Set_FillMouseHoleLed(.false.) + call Set_MouseHole(MOUSE_HOLE_EMPTY) + return + end if + + !OPERATION-CODE=82 + if (Get_KellyConnection() /= KELLY_CONNECTION_SINGLE .and.& + Get_ElevatorConnection() /= ELEVATOR_CONNECTION_SINGLE .and.& + Get_FillMouseHoleLed() == .false.) then + call Set_FillMouseHoleLed(.true.) + call Set_MouseHole(MOUSE_HOLE_FILL) + return + end if + + + endif + + + + + + + end subroutine + +end module CFillMouseHoleLedNotification \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CFillMouseHoleLedNotificationVariables.f90 b/CSharp/OperationScenarios/Notifications/CFillMouseHoleLedNotificationVariables.f90 new file mode 100644 index 0000000..93270cf --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CFillMouseHoleLedNotificationVariables.f90 @@ -0,0 +1,61 @@ +module CFillMouseHoleLedNotificationVariables + use CVoidEventHandlerCollection + implicit none + logical :: FillMouseHoleLed = .false. + + public + + type(VoidEventHandlerCollection) :: OnFillMouseHoleLedChange + + private :: FillMouseHoleLed + + contains + + subroutine Set_FillMouseHoleLed(v) + use CDrillingConsoleVariables, only: FillMouseHoleLedHw => FillMouseHoleLed + use CMouseHoleEnumVariables + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(FillMouseHoleLed == v) return +#endif + FillMouseHoleLed = v + if(FillMouseHoleLed) then + FillMouseHoleLedHw = 1 + !call Set_MouseHole(MOUSE_HOLE_FILL) + else + FillMouseHoleLedHw = 0 + !call Set_MouseHole(MOUSE_HOLE_EMPTY) + endif + call OnFillMouseHoleLedChange%RunAll() + end subroutine + + logical function Get_FillMouseHoleLed() + implicit none + Get_FillMouseHoleLed = FillMouseHoleLed + end function + + + + + + + subroutine Set_FillMouseHoleLed_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_FillMouseHoleLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_FillMouseHoleLed_WN' :: Set_FillMouseHoleLed_WN + implicit none + logical , intent(in) :: v + call Set_FillMouseHoleLed(v) + end subroutine + + + logical function Get_FillMouseHoleLed_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_FillMouseHoleLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_FillMouseHoleLed_WN' :: Get_FillMouseHoleLed_WN + implicit none + Get_FillMouseHoleLed_WN = FillMouseHoleLed + end function + + + +end module CFillMouseHoleLedNotificationVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CIrIBopLedNotification.f90 b/CSharp/OperationScenarios/Notifications/CIrIBopLedNotification.f90 new file mode 100644 index 0000000..d9a532e --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CIrIBopLedNotification.f90 @@ -0,0 +1,116 @@ +module CIrIBopLedNotification + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_IrIBopLed() + implicit none + + + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_IrIBopLed=TopDrive' +!#endif +! endif +! +! +! +! +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_IrIBopLed=Kelly' +!#endif +! endif + + + + + end subroutine + + ! subroutine Subscribe_IrIBopLed() + ! use CDrillingConsoleVariables + ! implicit none + ! call OnIRIBopPress%Add(ButtonPress_IrIBop) + ! end subroutine + + subroutine ButtonPress_IrIBop() + implicit none + + + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_IrIBopLed=TopDrive' +#endif + + + + !TOPDRIVE-CODE=59 + if (Get_IrIbopPermission() .and.& + Get_IrIBopLed() == .false.) then + + call Set_IrIBopLed(.true.) + return + end if + + + + + !TOPDRIVE-CODE=60 + if (Get_IrIbopPermission() .and.& + Get_IrIBopLed() == .true. .and.& + TopDriveTdsPowerState == TdsPower_OFF) then + + call Set_IrIBopLed(.false.) + return + end if + + + + endif + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_IrIBopLed=Kelly' +#endif + + !OPERATION-CODE=63 + if (Get_IrIbopPermission() .and.& + Get_IrIBopLed() == .false.) then + call Set_IrIBopLed(.true.) + return + end if + + + !OPERATION-CODE=64 + if (Get_IrIbopPermission() .and.& + Get_IrIBopLed()) then + call Set_IrIBopLed(.false.) + return + end if + + endif + + + + + + + + end subroutine + +end module CIrIBopLedNotification \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CIrIBopLedNotificationVariables.f90 b/CSharp/OperationScenarios/Notifications/CIrIBopLedNotificationVariables.f90 new file mode 100644 index 0000000..e9f0809 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CIrIBopLedNotificationVariables.f90 @@ -0,0 +1,63 @@ +module CIrIBopLedNotificationVariables + use CVoidEventHandlerCollection + implicit none + logical :: IrIBopLed = .false. + + public + + type(VoidEventHandlerCollection) :: OnIrIBopLedChange + + private :: IrIBopLed + + contains + + subroutine Set_IrIBopLed(v) + use CDrillingConsoleVariables, only: IRIBopLedHw => IRIBopLed + use CManifolds, only: InstallIBop, RemoveIBop + use CIbopEnumVariables, only: Set_Ibop_Install, Set_Ibop_Remove + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(IrIBopLed == v) return +#endif + IrIBopLed = v + if(IrIBopLed) then + IRIBopLedHw = 1 + call InstallIBop() + call Set_Ibop_Install() + else + IRIBopLedHw = 0 + call RemoveIBop() + call Set_Ibop_Remove() + endif + call OnIrIBopLedChange%RunAll() + end subroutine + + logical function Get_IrIBopLed() + implicit none + Get_IrIBopLed = IrIBopLed + end function + + + + + + subroutine Set_IrIBopLed_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_IrIBopLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_IrIBopLed_WN' :: Set_IrIBopLed_WN + implicit none + logical , intent(in) :: v + call Set_IrIBopLed(v) + end subroutine + + + logical function Get_IrIBopLed_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_IrIBopLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_IrIBopLed_WN' :: Get_IrIBopLed_WN + implicit none + Get_IrIBopLed_WN = IrIBopLed + end function + + + +end module CIrIBopLedNotificationVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CIrSafetyValveLedNotification.f90 b/CSharp/OperationScenarios/Notifications/CIrSafetyValveLedNotification.f90 new file mode 100644 index 0000000..c5bd6f9 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CIrSafetyValveLedNotification.f90 @@ -0,0 +1,162 @@ +module CIrSafetyValveLedNotification + use COperationScenariosVariables + !use COperationConditionEnumVariables + implicit none + contains + + subroutine Evaluate_IrSafetyValveLed() + implicit none + + + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_IrSafetyValveLed=TopDrive' +#endif + + + + + + + + + endif + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_IrSafetyValveLed=Kelly' +#endif + + !OPERATION-CODE=56 + if (Get_OperationCondition() == OPERATION_DRILL) then + call Set_IrSafetyValveLed(.true.) + return + end if + + + + + !call Set_IrSafetyValveLed(.false.) + + endif + + + + + + + + + + + + + end subroutine + + ! subroutine Subscribe_IrSafetyValveLed() + ! use CDrillingConsoleVariables + ! implicit none + ! call OnIRSafetyValvePress%Add(ButtonPress_IrSafetyValve) + ! call OnOperationConditionChangeInt%Add(Set_Operation_IrSafetyValveLed) + ! end subroutine + + subroutine Set_Operation_IrSafetyValveLed(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(operation_IrSafetyValveLed == v) return +#endif + operation_IrSafetyValveLed = v +#ifdef deb + print*, 'operation_IrSafetyValveLed=', operation_IrSafetyValveLed +#endif + end subroutine + + subroutine ButtonPress_IrSafetyValve() + implicit none + + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_IrSafetyValveLed=TopDrive' +#endif + + + + !TOPDRIVE-CODE=53 + if (Get_IrSafetyValvePermission() .and.& + Get_IrSafetyValveLed()) then + + call Set_IrSafetyValveLed(.false.) + return + end if + + + + + + + + + !TOPDRIVE-CODE=54 + if (Get_IrSafetyValvePermission() .and.& + Get_IrSafetyValveLed() == .false.) then + + call Set_IrSafetyValveLed(.true.) + return + end if + + + endif + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_IrSafetyValveLed=Kelly' +#endif + + !OPERATION-CODE=54 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_IrSafetyValvePermission() .and.& + Get_IrSafetyValveLed()) then + call Set_IrSafetyValveLed(.false.) + return + end if + + + !OPERATION-CODE=55 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_IrSafetyValvePermission() .and.& + Get_IrSafetyValveLed() == .false. ) then + call Set_IrSafetyValveLed(.true.) + return + end if + + endif + + + + + + + + + end subroutine + +end module CIrSafetyValveLedNotification \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CIrSafetyValveLedNotificationVariables.f90 b/CSharp/OperationScenarios/Notifications/CIrSafetyValveLedNotificationVariables.f90 new file mode 100644 index 0000000..1aaae43 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CIrSafetyValveLedNotificationVariables.f90 @@ -0,0 +1,90 @@ +module CIrSafetyValveLedNotificationVariables + use CVoidEventHandlerCollection + implicit none + logical :: IrSafetyValveLed = .false. + integer :: operation_IrSafetyValveLed = 0 + + public + + type(VoidEventHandlerCollection) :: OnIrSafetyValveLedChange + + private :: IrSafetyValveLed + contains + + subroutine Set_IrSafetyValveLed(v) + use CDrillingConsoleVariables, only: IRSafetyValveLedHw => IRSafetyValveLed + use CManifolds, only: & + InstallSafetyValve_TopDrive, & + InstallSafetyValve_KellyMode, & + InstallSafetyValve_TripMode, & + RemoveSafetyValve_TopDrive, & + RemoveSafetyValve_KellyMode, & + RemoveSafetyValve_TripMode + use CSafetyValveEnumVariables, only: Set_SafetyValve_Install, Set_SafetyValve_Remove + use CHoistingVariables, only: DriveType, TopDrive_DriveType, Kelly_DriveType + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(IrSafetyValveLed == v) return +#endif + IrSafetyValveLed = v + + if(IrSafetyValveLed) then + IRSafetyValveLedHw = 1 + + if(DriveType == TopDrive_DriveType) call InstallSafetyValve_TopDrive() + if(DriveType == Kelly_DriveType .and. operation_IrSafetyValveLed == 0) call InstallSafetyValve_KellyMode() + if(DriveType == Kelly_DriveType .and. operation_IrSafetyValveLed == 1) call InstallSafetyValve_TripMode() + + call Set_SafetyValve_Install() + else + IRSafetyValveLedHw = 0 + + if(DriveType == TopDrive_DriveType) call RemoveSafetyValve_TopDrive() + if(DriveType == Kelly_DriveType .and. operation_IrSafetyValveLed == 0) call RemoveSafetyValve_KellyMode() + if(DriveType == Kelly_DriveType .and. operation_IrSafetyValveLed == 1) call RemoveSafetyValve_TripMode() + + call Set_SafetyValve_Remove() + endif + + call OnIrSafetyValveLedChange%RunAll() + end subroutine + + logical function Get_IrSafetyValveLed() + implicit none + Get_IrSafetyValveLed = IrSafetyValveLed + end function + + + + + + subroutine Set_IrSafetyValveLed_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_IrSafetyValveLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_IrSafetyValveLed_WN' :: Set_IrSafetyValveLed_WN + implicit none + logical , intent(in) :: v + call Set_IrSafetyValveLed(v) + end subroutine + + + logical function Get_IrSafetyValveLed_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_IrSafetyValveLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_IrSafetyValveLed_WN' :: Get_IrSafetyValveLed_WN + implicit none + Get_IrSafetyValveLed_WN = IrSafetyValveLed + end function + + + subroutine Set_IrSafetyValveLed_off() + implicit none + call Set_IrSafetyValveLed(.false.) + end subroutine + + subroutine Set_IrSafetyValveLed_on() + implicit none + call Set_IrSafetyValveLed(.true.) + end subroutine + + +end module CIrSafetyValveLedNotificationVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CLatchLedNotification.f90 b/CSharp/OperationScenarios/Notifications/CLatchLedNotification.f90 new file mode 100644 index 0000000..97d3639 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CLatchLedNotification.f90 @@ -0,0 +1,251 @@ +module CLatchLedNotification + use COperationScenariosVariables + use CLog4 + implicit none + contains + + subroutine Evaluate_LatchLed() + use CCommon + implicit none + + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_LatchLed=TopDrive' +#endif + + + !TOPDRIVE-CODE=44 + if (Get_HookHeight() <= (TL() + NFC() - ECG) .and.& + Get_ElevatorConnectionPossible() .and.& + (Get_Elevator() /= ELEVATOR_LATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_SINGLE_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_SINGLE_BEGIN) .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_NOTHING .and.& + Get_TdsSwing() == TDS_SWING_OFF_END .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_LatchLed(.true.) + return + end if + + + + + + + + !TOPDRIVE-CODE=45 + if ((Get_HookHeight() >= (TL() + SL - ECG + NFC()) .and. Get_HookHeight() <= (TL() + SL - ECG + NFC() + TG)) .and.& + GetStandRack() > 0 .and.& + Get_JointConnectionPossible() == .false. .and.& + (Get_Elevator() /= ELEVATOR_LATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_SINGLE_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_SINGLE_BEGIN) .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_NOTHING .and.& + Get_TdsSwing() == TDS_SWING_OFF_END .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_LatchLed(.true.) + return + end if + + + + + + + !TOPDRIVE-CODE=46 + if ((Get_HookHeight() >= (TL() + SL - ECG + NFC()) .and. Get_HookHeight() <= (TL() + SL - ECG + NFC() + TG)) .and.& + Get_ElevatorConnectionPossible() .and.& + (Get_Elevator() /= ELEVATOR_LATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_SINGLE_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_SINGLE_BEGIN) .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_NOTHING .and.& + Get_TdsSwing() == TDS_SWING_TILT_END .and.& + Get_FillMouseHoleLed()) then + + call Set_LatchLed(.true.) + return + end if + + + + + + + + + + + + + + + + + + + + endif + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_LatchLed=Kelly' +#endif + + !OPERATION-CODE=36 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() <= (HL + Get_NearFloorConnection() - ECG) .and.& + Get_ElevatorConnectionPossible() .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .and.& + (Get_Elevator() /= ELEVATOR_LATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_SINGLE_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_SINGLE_BEGIN) .and.& + !Get_Elevator() == ELEVATOR_UNLATCH_STRING_END .and.& + !Get_UnlatchLed() .and.& + Get_Swing() == SWING_WELL_END .and.& + Get_Slips() == SLIPS_SET_END) then + + !call Log_4("OPERATION-CODE=36") + call Set_LatchLed(.true.) + !call Set_UnlatchLed(.false.) + return + end if + + + !OPERATION-CODE=37 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_StandRack() > 0 .and.& + Get_HookHeight() >= (HL + SL - ECG + Get_NearFloorConnection()) .and. Get_HookHeight() <= (HL + SL - ECG + Get_NearFloorConnection() + LG) .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .and.& + (Get_Elevator() /= ELEVATOR_LATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_SINGLE_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_SINGLE_BEGIN) .and.& + !Get_Elevator() == ELEVATOR_UNLATCH_STAND_END .and.& + Get_ElevatorConnectionPossible() == .false. .and.& + !Get_UnlatchLed() .and.& + Get_Swing() == SWING_WELL_END .and.& + Get_Slips() == SLIPS_SET_END) then + + !call Log_4("OPERATION-CODE=37") + call Set_LatchLed(.true.) + !call Set_UnlatchLed(.false.) + return + end if + + + + + + + + + + + + + + !OPERATION-CODE=38 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_ElevatorConnectionPossible() .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .and.& + (Get_Elevator() /= ELEVATOR_LATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_SINGLE_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_SINGLE_BEGIN) .and.& + !Get_Elevator() == ELEVATOR_UNLATCH_SINGLE_END .and.& + !Get_UnlatchLed() .and.& + Get_Swing() == SWING_MOUSE_HOLE_END .and.& + Get_FillMouseHoleLed()) then + + !call Log_4("OPERATION-CODE=38") + call Set_LatchLed(.true.) + !call Set_UnlatchLed(.false.) + return + end if + + + + + + + !OPERATION-CODE=39 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() >= 27.41 .and.& + (Get_Elevator() /= ELEVATOR_LATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_SINGLE_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_SINGLE_BEGIN) .and.& + !Get_UnlatchLed() .and.& + Get_Swing() == SWING_RAT_HOLE_END) then + + !call Log_4("OPERATION-CODE=39") + call Set_LatchLed(.true.) + !call Set_UnlatchLed(.false.) + return + end if + + + + call Set_LatchLed(.false.) + + endif + + + + + + + + end subroutine + + ! subroutine Subscribe_LatchLed() + ! use COperationConditionEnumVariables + ! use CStandRack + ! use CUnityInputs, OnElevatorConnectionChangePosibility => OnElevatorConnectionPossibleChange + ! use CSwingEnumVariables + ! use CSlipsEnumVariables + ! use CFillMouseHoleLedNotificationVariables + ! implicit none + + ! call OnOperationConditionChange%Add(Evaluate_LatchLed) + ! call OnStandRackChanged%Add(Evaluate_LatchLed) + ! call OnElevatorConnectionChangePosibility%Add(Evaluate_LatchLed) + ! call OnElevatorPickupChange%Add(Evaluate_LatchLed) + ! call OnNearFloorPositionChange%Add(Evaluate_LatchLed) + ! call OnSwingChange%Add(Evaluate_LatchLed) + ! call OnSlipsChange%Add(Evaluate_LatchLed) + ! call OnFillMouseHoleLedChange%Add(Evaluate_LatchLed) + + + ! end subroutine + +end module CLatchLedNotification \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CLatchLedNotificationVariables.f90 b/CSharp/OperationScenarios/Notifications/CLatchLedNotificationVariables.f90 new file mode 100644 index 0000000..880ab81 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CLatchLedNotificationVariables.f90 @@ -0,0 +1,58 @@ +module CLatchLedNotificationVariables + use CVoidEventHandlerCollection + implicit none + logical :: LatchLed = .false. + + public + + type(VoidEventHandlerCollection) :: OnLatchLedChange + + private :: LatchLed + + contains + + subroutine Set_LatchLed(v) + use CDrillingConsoleVariables, only: LatchPipeLED + !use CUnlatchLedNotification + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(LatchLed == v) return +#endif + LatchLed = v + if(LatchLed) then + LatchPipeLED = 1 + !call Set_UnlatchLed(.false.) + else + LatchPipeLED = 0 + endif + call OnLatchLedChange%RunAll() + end subroutine + + logical function Get_LatchLed() + implicit none + Get_LatchLed = LatchLed + end function + + + + + + + + subroutine Set_LatchLed_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_LatchLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_LatchLed_WN' :: Set_LatchLed_WN + implicit none + logical , intent(in) :: v + call Set_LatchLed(v) + end subroutine + + logical function Get_LatchLed_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_LatchLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_LatchLed_WN' :: Get_LatchLed_WN + implicit none + Get_LatchLed_WN = LatchLed + end function + +end module CLatchLedNotificationVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/COpenKellyCockLedNotification.f90 b/CSharp/OperationScenarios/Notifications/COpenKellyCockLedNotification.f90 new file mode 100644 index 0000000..4a7149b --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/COpenKellyCockLedNotification.f90 @@ -0,0 +1,62 @@ +module COpenKellyCockLedNotification + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_OpenKellyCockLed() + implicit none + + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_OpenKellyCockLed=TopDrive' +!#endif +! endif +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_OpenKellyCockLed=Kelly' +!#endif +! endif + + + + end subroutine + + ! subroutine Subscribe_OpenKellyCockLed() + ! use CDrillingConsoleVariables + ! implicit none + ! call OnOpenKellyCockPress%Add(ButtonPress_OpenKellyCock) + ! end subroutine + + subroutine ButtonPress_OpenKellyCock() + implicit none + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'ButtonPress_OpenKellyCock=TopDrive' +#endif + endif + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'ButtonPress_OpenKellyCock=Kelly' +#endif + !OPERATION-CODE=65 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + Get_OpenKellyCockLed() == .false. .and.& + Get_CloseKellyCockLed()) then + call Set_OpenKellyCockLed(.true.) + call Set_CloseKellyCockLed(.false.) + return + end if + endif + + + + end subroutine + +end module COpenKellyCockLedNotification \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/COpenKellyCockLedNotificationVariables.f90 b/CSharp/OperationScenarios/Notifications/COpenKellyCockLedNotificationVariables.f90 new file mode 100644 index 0000000..991ce97 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/COpenKellyCockLedNotificationVariables.f90 @@ -0,0 +1,63 @@ +module COpenKellyCockLedNotificationVariables + use CVoidEventHandlerCollection + implicit none + logical :: OpenKellyCockLed = .false. + + public + + type(VoidEventHandlerCollection) :: OnOpenKellyCockLedChange + + private :: OpenKellyCockLed + + contains + + subroutine Set_OpenKellyCockLed(v) + use CDrillingConsoleVariables, only: OpenKellyCockLedHw => OpenKellyCockLed + use CManifolds, only: OpenKellyCock + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(OpenKellyCockLed == v) return +#endif + OpenKellyCockLed = v + + if(OpenKellyCockLed) then + call OpenKellyCock() + endif + + ! HAS BEEN IMPLEMENTED IN CMANIFOLD + + !if(OpenKellyCockLed) then + ! OpenKellyCockLedHw = 1 + !else + ! OpenKellyCockLedHw = 0 + !endif + + call OnOpenKellyCockLedChange%RunAll() + end subroutine + + logical function Get_OpenKellyCockLed() + implicit none + Get_OpenKellyCockLed = OpenKellyCockLed + end function + + + + + + subroutine Set_OpenKellyCockLed_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_OpenKellyCockLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_OpenKellyCockLed_WN' :: Set_OpenKellyCockLed_WN + implicit none + logical , intent(in) :: v + call Set_OpenKellyCockLed(v) + end subroutine + + logical function Get_OpenKellyCockLed_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_OpenKellyCockLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_OpenKellyCockLed_WN' :: Get_OpenKellyCockLed_WN + implicit none + Get_OpenKellyCockLed_WN = OpenKellyCockLed + end function + +end module COpenKellyCockLedNotificationVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/COpenSafetyValveLedNotification.f90 b/CSharp/OperationScenarios/Notifications/COpenSafetyValveLedNotification.f90 new file mode 100644 index 0000000..62b4fa3 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/COpenSafetyValveLedNotification.f90 @@ -0,0 +1,106 @@ +module COpenSafetyValveLedNotification + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_OpenSafetyValveLed() + implicit none + + + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_OpenSafetyValveLed=TopDrive' +!#endif +! endif +! +! +! +! +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_OpenSafetyValveLed=Kelly' +!#endif +! endif + + + + end subroutine + + ! subroutine Subscribe_OpenSafetyValveLed() + ! use CDrillingConsoleVariables + ! implicit none + ! call OnOpenSafetyValvePress%Add(ButtonPress_OpenSafetyValve) + ! call OnOperationConditionChangeInt%Add(Set_Operation_OpenSafetyValveLed) + ! end subroutine + + + subroutine Set_Operation_OpenSafetyValveLed(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(operation_OpenSafetyValveLed == v) return +#endif + operation_OpenSafetyValveLed = v +#ifdef deb + print*, 'operation_OpenSafetyValveLed=', operation_OpenSafetyValveLed +#endif + end subroutine + + + subroutine ButtonPress_OpenSafetyValve() + implicit none + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'ButtonPress_OpenSafetyValve=TopDrive' +#endif + + !TOPDRIVE-CODE=56 + if (Get_SafetyValveHeight() >= 3.0 .and. Get_SafetyValveHeight() <= 12.0 .and.& + Get_OpenSafetyValveLed() == .false. .and.& + Get_CloseSafetyValveLed()) then + + call Set_CloseSafetyValveLed(.false.) + call Set_OpenSafetyValveLed(.true.) + return + end if + + endif + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'ButtonPress_OpenSafetyValve=Kelly' +#endif + + + !OPERATION-CODE=58 + if (Get_SafetyValveHeight() >= 3.0 .and. Get_SafetyValveHeight() <= 12.0 .and.& + Get_OpenSafetyValveLed() == .false. .and.& + Get_CloseSafetyValveLed()) then + call Set_OpenSafetyValveLed(.true.) + call Set_CloseSafetyValveLed(.false.) + return + end if + + + endif + + + + + end subroutine + +end module COpenSafetyValveLedNotification \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/COpenSafetyValveLedNotificationVariables.f90 b/CSharp/OperationScenarios/Notifications/COpenSafetyValveLedNotificationVariables.f90 new file mode 100644 index 0000000..573bf47 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/COpenSafetyValveLedNotificationVariables.f90 @@ -0,0 +1,65 @@ +module COpenSafetyValveLedNotificationVariables + use CVoidEventHandlerCollection + implicit none + logical :: OpenSafetyValveLed = .false. + integer :: operation_OpenSafetyValveLed = 0 + + public + type(VoidEventHandlerCollection) :: OnOpenSafetyValveLedChange + + private :: OpenSafetyValveLed + + contains + + subroutine Set_OpenSafetyValveLed(v) + use CDrillingConsoleVariables, only: OpenSafetyValveLedHw => OpenSafetyValveLed + use CManifolds, only: OpenSafetyValve_TopDrive, OpenSafetyValve_KellyMode, OpenSafetyValve_TripMode + use CHoistingVariables, only: DriveType, TopDrive_DriveType, Kelly_DriveType + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(OpenSafetyValveLed == v) return +#endif + OpenSafetyValveLed = v + + if(OpenSafetyValveLed) then + !!call OpenSafetyValve() + if(DriveType == TopDrive_DriveType) call OpenSafetyValve_TopDrive() + if(DriveType == Kelly_DriveType .and. operation_OpenSafetyValveLed == 0) call OpenSafetyValve_KellyMode() + if(DriveType == Kelly_DriveType .and. operation_OpenSafetyValveLed == 1) call OpenSafetyValve_TripMode() + endif + + !if(OpenSafetyValveLed) then + ! OpenSafetyValveLedHw = 1 + !else + ! OpenSafetyValveLedHw = 0 + !endif + + call OnOpenSafetyValveLedChange%RunAll() + end subroutine + + logical function Get_OpenSafetyValveLed() + implicit none + Get_OpenSafetyValveLed = OpenSafetyValveLed + end function + + + + subroutine Set_OpenSafetyValveLed_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_OpenSafetyValveLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_OpenSafetyValveLed_WN' :: Set_OpenSafetyValveLed_WN + implicit none + logical , intent(in) :: v + call Set_OpenSafetyValveLed(v) + end subroutine + + logical function Get_OpenSafetyValveLed_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_OpenSafetyValveLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_OpenSafetyValveLed_WN' :: Get_OpenSafetyValveLed_WN + implicit none + Get_OpenSafetyValveLed_WN = OpenSafetyValveLed + end function + + + +end module COpenSafetyValveLedNotificationVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CSlipsNotification.f90 b/CSharp/OperationScenarios/Notifications/CSlipsNotification.f90 new file mode 100644 index 0000000..9f9ec08 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CSlipsNotification.f90 @@ -0,0 +1,134 @@ +module CSlipsNotification + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_SlipsNotification() + implicit none + + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_SlipsNotification=TopDrive' +#endif + + !TOPDRIVE-CODE=28 + if (Get_ZeroStringSpeed() .and.& + GetRotaryRpm() == 0.0d0 .and.& + Get_Slips() == SLIPS_UNSET_END .and.& + Get_NearFloorConnection() >= 3.0 .and. Get_NearFloorConnection() <= 6.0) then + + call Set_SlipsNotification(.true.) + return + end if + + + + !TOPDRIVE-CODE=29 + if (Get_ZeroStringSpeed() .and.& + GetRotaryRpm() == 0.0d0 .and.& + (Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_STRING .or.& + Get_TdsConnectionModes() == TDS_CONNECTION_STRING) .and.& + Get_Slips() == SLIPS_SET_END .and.& + Get_NearFloorConnection() >= 3.0 .and. Get_NearFloorConnection() <= 6.0) then + + call Set_SlipsNotification(.true.) + return + end if + + + + + endif + + + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_SlipsNotification=Kelly' +#endif + + !OPERATION-CODE=53 + if (Get_ZeroStringSpeed() .and.& + GetRotaryRpm() == 0.0d0 .and.& + !Get_KellyConnection() == KELLY_CONNECTION_STRING + Get_Slips() == SLIPS_UNSET_END .and.& + Get_NearFloorConnection() >= 3.0 .and. Get_NearFloorConnection() <= 6.0) then + call Set_SlipsNotification(.true.) + return + end if + + + + + + !OPERATION-CODE=77 + if (Get_ZeroStringSpeed() .and.& + GetRotaryRpm() == 0.0d0 .and.& + Get_Slips() == SLIPS_SET_END .and.& + Get_IsKellyBushingSetInTable() == .false. .and.& + Get_NearFloorConnection() >= 3.0 .and. Get_NearFloorConnection() <= 6.0 .and.& + (Get_ElevatorConnection() == ELEVATOR_CONNECTION_STRING .or. Get_KellyConnection() == KELLY_CONNECTION_STRING)) then + call Set_SlipsNotification(.true.) + + return + end if + + + + + + !if (Get_OperationCondition() == OPERATION_DRILL .and.& + ! Get_ZeroStringSpeed() .and.& + ! Get_SlackOff() .and.& + ! Get_KellyConnection() == KELLY_CONNECTION_STRING) then + ! call Set_SlipsNotification(.true.) + ! return + !end if + ! + ! + !if (Get_OperationCondition() == OPERATION_TRIP .and.& + ! Get_ZeroStringSpeed() .and.& + ! Get_NearFloorConnection() >= 21 .and. Get_NearFloorConnection() <= 25 .and.& + ! Get_ElevatorConnection() == ELEVATOR_CONNECTION_STRING) then + ! call Set_SlipsNotification(.true.) + ! return + !end if + + + + + call Set_SlipsNotification(.false.) + + endif + + + + + + + end subroutine + + ! subroutine Subscribe_SlipsNotification() + ! implicit none + + ! call OnOperationConditionChange%Add(Evaluate_SlipsNotification) + ! call OnSlackOffChange%Add(Evaluate_SlipsNotification) + ! call OnZeroStringSpeedChange%Add(Evaluate_SlipsNotification) + ! call OnNearFloorConnectionChange%Add(Evaluate_SlipsNotification) + ! call OnElevatorConnectionChange%Add(Evaluate_SlipsNotification) + ! call OnKellyConnectionChange%Add(Evaluate_SlipsNotification) + ! call OnSlipsChange%Add(Evaluate_SlipsNotification) + + ! end subroutine + +end module CSlipsNotification \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CSlipsNotificationVariables.f90 b/CSharp/OperationScenarios/Notifications/CSlipsNotificationVariables.f90 new file mode 100644 index 0000000..c042d95 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CSlipsNotificationVariables.f90 @@ -0,0 +1,65 @@ +module CSlipsNotificationVariables + use CVoidEventHandlerCollection + use CIActionReference + implicit none + logical :: SlipsNotification = .false. + procedure (ActionBool), pointer :: SlipsNotificationPtr + + public + + type(VoidEventHandlerCollection) :: OnSlipsNotificationChange + + private :: SlipsNotification + + contains + + subroutine Set_SlipsNotification(v) + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(SlipsNotification == v) return +#endif + SlipsNotification = v + if(associated(SlipsNotificationPtr)) call SlipsNotificationPtr(SlipsNotification) +#ifdef deb + print*, 'SlipsNotification=', SlipsNotification +#endif + call OnSlipsNotificationChange%RunAll() + end subroutine + + logical function Get_SlipsNotification() + implicit none + Get_SlipsNotification = SlipsNotification + end function + + + + + + subroutine Set_SlipsNotification_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_SlipsNotification_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_SlipsNotification_WN' :: Set_SlipsNotification_WN + implicit none + logical , intent(in) :: v + call Set_SlipsNotification(v) + end subroutine + + logical function Get_SlipsNotification_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_SlipsNotification_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_SlipsNotification_WN' :: Get_SlipsNotification_WN + implicit none + Get_SlipsNotification_WN = SlipsNotification + end function + + + + + subroutine SubscribeSlipsNotification(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSlipsNotification + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSlipsNotification' :: SubscribeSlipsNotification + implicit none + procedure (ActionBool) :: a + SlipsNotificationPtr => a + end subroutine + +end module CSlipsNotificationVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CSwingLedNotification.f90 b/CSharp/OperationScenarios/Notifications/CSwingLedNotification.f90 new file mode 100644 index 0000000..ba47973 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CSwingLedNotification.f90 @@ -0,0 +1,122 @@ +module CSwingLedNotification + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_SwingLed() + implicit none + + + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_SwingLed=TopDrive' +#endif + + + + endif + + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_SwingLed=Kelly' +#endif + + + !OPERATION-CODE=22 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() >= (HL + Get_NearFloorConnection()) .and. Get_HookHeight() <= (HL + Get_NearFloorConnection() + LG) .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .and.& + Get_JointConnectionPossible() == .false. .and.& + (Get_Swing() /= SWING_WELL_BEGIN .and.& + Get_Swing() /= SWING_MOUSE_HOLE_BEGIN .and.& + Get_Swing() /= SWING_RAT_HOLE_BEGIN) .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_SwingLed(.true.) + return + end if + + + !OPERATION-CODE=23 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() >= (HL + Get_NearFloorConnection() + PL) .and. Get_HookHeight() <= (HL + Get_NearFloorConnection() + LG + PL) .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_SINGLE .and.& + Get_JointConnectionPossible() == .false. .and.& + (Get_Swing() /= SWING_WELL_BEGIN .and.& + Get_Swing() /= SWING_MOUSE_HOLE_BEGIN .and.& + Get_Swing() /= SWING_RAT_HOLE_BEGIN) .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_SwingLed(.true.) + return + end if + + + !OPERATION-CODE=24 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + Get_HookHeight() >= (HKL + Get_NearFloorConnection()) .and. Get_HookHeight() <= (HKL + Get_NearFloorConnection() + LG) .and.& + Get_JointConnectionPossible() == .false. .and.& + Get_KellyConnection() == KELLY_CONNECTION_NOTHING .and.& + (Get_Swing() /= SWING_WELL_BEGIN .and.& + Get_Swing() /= SWING_MOUSE_HOLE_BEGIN .and.& + Get_Swing() /= SWING_RAT_HOLE_BEGIN) .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_SwingLed(.true.) + return + end if + + !OPERATION-CODE=25 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + Get_HookHeight() >= (HKL + Get_NearFloorConnection() + PL) .and. Get_HookHeight() <= (HKL + Get_NearFloorConnection() + LG + PL) .and.& + Get_KellyConnection() == KELLY_CONNECTION_SINGLE .and.& + Get_JointConnectionPossible() == .false. .and.& + (Get_Swing() /= SWING_WELL_BEGIN .and.& + Get_Swing() /= SWING_MOUSE_HOLE_BEGIN .and.& + Get_Swing() /= SWING_RAT_HOLE_BEGIN) .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_SwingLed(.true.) + return + end if + + + call Set_SwingLed(.false.) + + + endif + + + + + + + + + end subroutine + + ! subroutine Subscribe_SwingLed() + ! implicit none + + ! call OnOperationConditionChange%Add(Evaluate_SwingLed) + ! call OnHookHeightChange%Add(Evaluate_SwingLed) + ! call OnElevatorConnectionChange%Add(Evaluate_SwingLed) + ! call OnKellyConnectionChange%Add(Evaluate_SwingLed) + ! call OnSwingChange%Add(Evaluate_SwingLed) + ! call OnSlipsChange%Add(Evaluate_SwingLed) + ! call OnFillMouseHoleLedChange%Add(Evaluate_SwingLed) + + ! end subroutine + +end module CSwingLedNotification \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CSwingLedNotificationVariables.f90 b/CSharp/OperationScenarios/Notifications/CSwingLedNotificationVariables.f90 new file mode 100644 index 0000000..0e2640b --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CSwingLedNotificationVariables.f90 @@ -0,0 +1,55 @@ +module CSwingLedNotificationVariables + use CVoidEventHandlerCollection + implicit none + logical :: SwingLed = .false. + + public + + type(VoidEventHandlerCollection) :: OnSwingLedChange + + private :: SwingLed + + contains + + subroutine Set_SwingLed(v) + use CDrillingConsoleVariables, only: SwingLedHw => SwingLed + implicit none + logical , intent(in) :: v + +#ifdef ExcludeExtraChanges + if(SwingLed == v) return +#endif + SwingLed = v + if(SwingLed) then + SwingLedHw = 1 + else + SwingLedHw = 0 + endif + call OnSwingLedChange%RunAll() + end subroutine + + logical function Get_SwingLed() + implicit none + Get_SwingLed = SwingLed + end function + + + + + + subroutine Set_SwingLed_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_SwingLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_SwingLed_WN' :: Set_SwingLed_WN + implicit none + logical , intent(in) :: v + call Set_SwingLed(v) + end subroutine + + logical function Get_SwingLed_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_SwingLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_SwingLed_WN' :: Get_SwingLed_WN + implicit none + Get_SwingLed_WN = SwingLed + end function + +end module CSwingLedNotificationVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CTdsIbopLedNotification.f90 b/CSharp/OperationScenarios/Notifications/CTdsIbopLedNotification.f90 new file mode 100644 index 0000000..abda1a2 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CTdsIbopLedNotification.f90 @@ -0,0 +1,72 @@ +module CTdsIbopLedNotification + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_IbopLed() + use CCommon + implicit none + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_IbopLed=TopDrive' +#endif + + + + + !TOPDRIVE-CODE=61 + if (Get_IbopLed() == .false. .and.& + TopDriveTdsPowerState == TdsPower_OFF .and.& + TopDriveIbop == .false.) then + + call Set_IbopLed(.true.) + TopDriveLinkTiltLed = LED_OFF + return + end if + + + + + !TOPDRIVE-CODE=62 + if (Get_IbopLed() .and.& + TopDriveTdsPowerState == TdsPower_OFF .and.& + TopDriveIbop) then + + call Set_IbopLed(.false.) + TopDriveLinkTiltLed = LED_ON + return + end if + + + + + + endif + + + + + + + + +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_IbopLed=Kelly' +!#endif +! +! endif + + + + + + end subroutine + + ! subroutine Subscribe_IbopLed() + ! implicit none + ! end subroutine + +end module CTdsIbopLedNotification \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CTdsIbopLedNotificationVariables.f90 b/CSharp/OperationScenarios/Notifications/CTdsIbopLedNotificationVariables.f90 new file mode 100644 index 0000000..81b19cb --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CTdsIbopLedNotificationVariables.f90 @@ -0,0 +1,60 @@ +module CTdsIbopLedNotificationVariables + use CVoidEventHandlerCollection + implicit none + logical :: IbopLed = .false. + + public + + type(VoidEventHandlerCollection) :: OnIbopLedChange + + private :: IbopLed + + contains + + subroutine Set_IbopLed(v) + use CTopDrivePanelVariables, only: TopDriveIbopLed + use CManifolds, Only: OpenTopDriveIBop, CloseTopDriveIBop + !use CLatchLedNotification + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(IbopLed == v) return +#endif + IbopLed = v + + if(IbopLed) then + TopDriveIbopLed = 1 + call CloseTopDriveIBop() + else + TopDriveIbopLed = 0 + call OpenTopDriveIBop() + endif + + call OnIbopLedChange%RunAll() + end subroutine + + logical function Get_IbopLed() + implicit none + Get_IbopLed = IbopLed + end function + + + + + + subroutine Set_IbopLed_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_IbopLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_IbopLed_WN' :: Set_IbopLed_WN + implicit none + logical , intent(in) :: v + call Set_IbopLed(v) + end subroutine + + logical function Get_IbopLed_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_IbopLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_IbopLed_WN' :: Get_IbopLed_WN + implicit none + Get_IbopLed_WN = IbopLed + end function + +end module CTdsIbopLedNotificationVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CTdsPowerLedNotification.f90 b/CSharp/OperationScenarios/Notifications/CTdsPowerLedNotification.f90 new file mode 100644 index 0000000..8cc002a --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CTdsPowerLedNotification.f90 @@ -0,0 +1,48 @@ +module CTdsPowerLedNotification + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_PowerLed() + use CCommon + implicit none + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_PowerLed=TopDrive' +#endif + + !TOPDRIVE-CODE=63 + if (TopDriveTdsPowerState == TdsPower_OFF) then + call Set_PowerLed(.true.) + return + end if + + endif + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_PowerLed=Kelly' +#endif + + endif + + + + + + end subroutine + + ! subroutine Subscribe_PowerLed() + ! implicit none + ! end subroutine + +end module CTdsPowerLedNotification \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CTdsPowerLedNotificationVariables.f90 b/CSharp/OperationScenarios/Notifications/CTdsPowerLedNotificationVariables.f90 new file mode 100644 index 0000000..dd39783 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CTdsPowerLedNotificationVariables.f90 @@ -0,0 +1,57 @@ +module CTdsPowerLedNotificationVariables + use CVoidEventHandlerCollection + implicit none + logical :: PowerLed = .false. + + public + + type(VoidEventHandlerCollection) :: OnPowerLedChange + + private :: PowerLed + + contains + + subroutine Set_PowerLed(v) + use CTopDrivePanelVariables, only: TopDriveTdsPowerLed + !use CLatchLedNotification + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(PowerLed == v) return +#endif + PowerLed = v + + if(PowerLed) then + TopDriveTdsPowerLed = 1 + !call Set_LatchLed(.false.) + else + TopDriveTdsPowerLed = 0 + endif + + call OnPowerLedChange%RunAll() + end subroutine + + logical function Get_PowerLed() + implicit none + Get_PowerLed = PowerLed + end function + + + + + subroutine Set_PowerLed_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_PowerLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_PowerLed_WN' :: Set_PowerLed_WN + implicit none + logical , intent(in) :: v + call Set_PowerLed(v) + end subroutine + + logical function Get_PowerLed_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_PowerLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_PowerLed_WN' :: Get_PowerLed_WN + implicit none + Get_PowerLed_WN = PowerLed + end function + +end module CTdsPowerLedNotificationVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CTdsTorqueWrenchLedNotification.f90 b/CSharp/OperationScenarios/Notifications/CTdsTorqueWrenchLedNotification.f90 new file mode 100644 index 0000000..de3ddf9 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CTdsTorqueWrenchLedNotification.f90 @@ -0,0 +1,59 @@ +module CTdsTorqueWrenchLedNotification + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_TorqueWrenchLed() + implicit none + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_TorqueWrenchLed=TopDrive' +#endif + + !TOPDRIVE-CODE=81 + if((Get_TdsBackupClamp() == BACKUP_CLAMP_OFF_BEGIN .or.& + Get_TdsBackupClamp() == BACKUP_CLAMP_FW_BEGIN) .and.& + TopDriveTdsPowerState /= TdsPower_OFF) then + call Set_TorqueWrenchLed(LED_BLINK) + return + endif + + !TOPDRIVE-CODE=81 + if(Get_TdsBackupClamp() == BACKUP_CLAMP_FW_END .and.& + TopDriveTdsPowerState /= TdsPower_OFF) then + call Set_TorqueWrenchLed(LED_ON) + return + endif + + + call Set_TorqueWrenchLed(LED_OFF) + + endif + + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_SwingLed=Kelly' +#endif + + + endif + + + + end subroutine + + ! subroutine Subscribe_TorqueWrenchLed() + ! implicit none + + ! end subroutine + +end module CTdsTorqueWrenchLedNotification \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CTdsTorqueWrenchLedNotificationVariables.f90 b/CSharp/OperationScenarios/Notifications/CTdsTorqueWrenchLedNotificationVariables.f90 new file mode 100644 index 0000000..7df9d67 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CTdsTorqueWrenchLedNotificationVariables.f90 @@ -0,0 +1,50 @@ +module CTdsTorqueWrenchLedNotificationVariables + use CVoidEventHandlerCollection + implicit none + integer :: TorqueWrenchLed = 0 + + public + + type(VoidEventHandlerCollection) :: OnTorqueWrenchLedChange + + private :: TorqueWrenchLed + + contains + + subroutine Set_TorqueWrenchLed(v) + use CTopDrivePanelVariables, only: TopDriveTorqueWrenchLed + implicit none + integer , intent(in) :: v + +#ifdef ExcludeExtraChanges + if(TorqueWrenchLed == v) return +#endif + TorqueWrenchLed = v + TopDriveTorqueWrenchLed = v + call OnTorqueWrenchLedChange%RunAll() + end subroutine + + logical function Get_TorqueWrenchLed() + implicit none + Get_TorqueWrenchLed = TorqueWrenchLed + end function + + + + + subroutine Set_TorqueWrenchLed_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_TorqueWrenchLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_TorqueWrenchLed_WN' :: Set_TorqueWrenchLed_WN + implicit none + integer , intent(in) :: v + call Set_TorqueWrenchLed(v) + end subroutine + + logical function Get_TorqueWrenchLed_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_TorqueWrenchLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_TorqueWrenchLed_WN' :: Get_TorqueWrenchLed_WN + implicit none + Get_TorqueWrenchLed_WN = TorqueWrenchLed + end function + +end module CTdsTorqueWrenchLedNotificationVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CTongNotification.f90 b/CSharp/OperationScenarios/Notifications/CTongNotification.f90 new file mode 100644 index 0000000..4104cff --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CTongNotification.f90 @@ -0,0 +1,287 @@ +module CTongNotification + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_TongNotification() + implicit none + + + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_TongNotification=TopDrive' +#endif + + + + + !TOPDRIVE-CODE=50 + if (((Get_HookHeight() >= (TL() + PL - ECG + NFC() - RE) .and. Get_HookHeight() <= (TL() + NFC() + PL - ECG + TG)) .or.& + (Get_HookHeight() >= (TL() + SL - ECG + NFC() - RE) .and. Get_HookHeight() <= (TL() + NFC() + SL - ECG + TG))).and.& + GetRotaryRpm() == 0.0d0 .and.& + Get_NearFloorConnection() >= 3.0 .and. Get_NearFloorConnection() <= 6.0 .and.& + ((Get_Tong() /= TONG_BREAKOUT_BEGIN .and.& + Get_Tong() /= TONG_MAKEUP_BEGIN) .or.& + Get_Tong() == TONG_NEUTRAL ) .and.& + (Get_TdsElevatorModes() == TDS_ELEVATOR_LATCH_STRING .or. Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_STRING) .and.& + Get_TdsSwing() == TDS_SWING_OFF_END .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_TongNotification(.true.) + return + end if + + + + + + !TOPDRIVE-CODE=51 + if (GetRotaryRpm() == 0.0d0 .and.& + Get_JointConnectionPossible() .and.& + (Get_Tong() /= TONG_BREAKOUT_BEGIN .and.& + Get_Tong() /= TONG_MAKEUP_BEGIN) .and.& + (Get_TdsElevatorModes() == TDS_ELEVATOR_LATCH_SINGLE .or. Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_SINGLE) .and.& + Get_TdsSwing() == TDS_SWING_OFF_END .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_TongNotification(.true.) + return + end if + + + + + + + + + !TOPDRIVE-CODE=52 + if (GetRotaryRpm() == 0.0d0 .and.& + Get_JointConnectionPossible() .and.& + (Get_Tong() /= TONG_BREAKOUT_BEGIN .and.& + Get_Tong() /= TONG_MAKEUP_BEGIN) .and.& + (Get_TdsElevatorModes() == TDS_ELEVATOR_LATCH_STAND .or. Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_STAND) .and.& + Get_TdsSwing() == TDS_SWING_OFF_END .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_TongNotification(.true.) + return + end if + + + + + + endif + + + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_TongNotification=Kelly' +#endif + + !OPERATION-CODE=44 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + !((Get_HookHeight() >= 65.0 .and. Get_HookHeight() <= 70.0) .or.& + ! (Get_HookHeight() >= 96.0 .and. Get_HookHeight() <= 101.0)).and.& + ((Get_HookHeight() >= (HKL + Get_NearFloorConnection() - RE) .and. Get_HookHeight() <= (HKL + Get_NearFloorConnection() + TG)) .or.& + (Get_HookHeight() >= (HKL + Get_NearFloorConnection() + PL -RE) .and. Get_HookHeight() <= (HKL + Get_NearFloorConnection() + TG + PL))).and.& + GetRotaryRpm() == 0.0d0 .and.& + Get_KellyConnection() == KELLY_CONNECTION_STRING .and.& + Get_NearFloorConnection() >= 3.0 .and. Get_NearFloorConnection() <= 6.0 .and.& + Get_Swing() == SWING_WELL_END .and.& + (Get_Tong() /= TONG_BREAKOUT_BEGIN .and.& + Get_Tong() /= TONG_MAKEUP_BEGIN) .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_TongNotification(.true.) + return + end if + + + + + !OPERATION-CODE=45 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + Get_HookHeight() >= 66 .and. Get_HookHeight() <= 69 .and.& + Get_KellyConnection() == KELLY_CONNECTION_SINGLE .and.& + (Get_Tong() /= TONG_BREAKOUT_BEGIN .and.& + Get_Tong() /= TONG_MAKEUP_BEGIN) .and.& + Get_Swing() == SWING_MOUSE_HOLE_END) then + + call Set_TongNotification(.true.) + return + end if + + + + !OPERATION-CODE=46 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + Get_JointConnectionPossible() .and.& + Get_KellyConnection() == KELLY_CONNECTION_NOTHING .and.& + (Get_Tong() /= TONG_BREAKOUT_BEGIN .and.& + Get_Tong() /= TONG_MAKEUP_BEGIN) .and.& + Get_Swing() == SWING_MOUSE_HOLE_END) then + + call Set_TongNotification(.true.) + return + end if + + + + + !OPERATION-CODE=47 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + GetRotaryRpm() == 0.0d0 .and.& + Get_JointConnectionPossible() .and.& + Get_KellyConnection() == KELLY_CONNECTION_NOTHING .and.& + (Get_Tong() /= TONG_BREAKOUT_BEGIN .and.& + Get_Tong() /= TONG_MAKEUP_BEGIN) .and.& + Get_Swing() == SWING_WELL_END .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_TongNotification(.true.) + return + end if + + + + + + !OPERATION-CODE=48 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + GetRotaryRpm() == 0.0d0 .and.& + Get_JointConnectionPossible() .and.& + Get_KellyConnection() == KELLY_CONNECTION_SINGLE .and.& + (Get_Tong() /= TONG_BREAKOUT_BEGIN .and.& + Get_Tong() /= TONG_MAKEUP_BEGIN) .and.& + Get_Swing() == SWING_WELL_END .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_TongNotification(.true.) + return + end if + + + + + + + + + + + + + + + + !OPERATION-CODE=50 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + ((Get_HookHeight() >= (HL + PL - ECG + Get_NearFloorConnection() - RE) .and. Get_HookHeight() <= (HL + Get_NearFloorConnection() + PL - ECG + TG)) .or.& + (Get_HookHeight() >= (HL + SL - ECG + Get_NearFloorConnection() - RE) .and. Get_HookHeight() <= (HL + Get_NearFloorConnection() + TG - ECG + SL))).and.& + Get_NearFloorConnection() >= 3.0 .and. Get_NearFloorConnection() <= 6.0 .and.& + GetRotaryRpm() == 0.0d0 .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_STRING .and.& + (Get_Tong() /= TONG_BREAKOUT_BEGIN .and.& + Get_Tong() /= TONG_MAKEUP_BEGIN) .and.& + Get_Swing() == SWING_WELL_END .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_TongNotification(.true.) + return + end if + + + + + + !OPERATION-CODE=51 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + GetRotaryRpm() == 0.0d0 .and.& + Get_JointConnectionPossible() .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_SINGLE .and.& + (Get_Tong() /= TONG_BREAKOUT_BEGIN .and.& + Get_Tong() /= TONG_MAKEUP_BEGIN) .and.& + Get_Swing() == SWING_WELL_END .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_TongNotification(.true.) + return + end if + + + + + + !OPERATION-CODE=52 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + GetRotaryRpm() == 0.0d0 .and.& + Get_JointConnectionPossible() .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_STAND .and.& + (Get_Tong() /= TONG_BREAKOUT_BEGIN .and.& + Get_Tong() /= TONG_MAKEUP_BEGIN) .and.& + Get_Swing() == SWING_WELL_END .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_TongNotification(.true.) + return + end if + + + + + !if (Get_OperationCondition() == OPERATION_DRILL .and.& + ! Get_KellyConnection() == KELLY_CONNECTION_STRING .and.& + ! Get_Swing() == SWING_WELL_END .and.& + ! Get_Slips() == SLIPS_SET_END) then + ! + ! call Set_TongNotification(.true.) + ! return + !end if + ! + + + call Set_TongNotification(.false.) + + endif + + + + + + + + + + + end subroutine + + subroutine Subscribe_TongNotification() + implicit none + + call OnOperationConditionChange%Add(Evaluate_TongNotification) + call OnHookHeightChange%Add(Evaluate_TongNotification) + call OnJointConnectionPossibleChange%Add(Evaluate_TongNotification) + call OnSingleSetInMouseHoleChange%Add(Evaluate_TongNotification) + call OnElevatorConnectionChange%Add(Evaluate_TongNotification) + call OnKellyConnectionChange%Add(Evaluate_TongNotification) + call OnSwingChange%Add(Evaluate_TongNotification) + call OnSlipsChange%Add(Evaluate_TongNotification) + + end subroutine + + + +end module CTongNotification \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CTongNotificationVariables.f90 b/CSharp/OperationScenarios/Notifications/CTongNotificationVariables.f90 new file mode 100644 index 0000000..b9d0893 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CTongNotificationVariables.f90 @@ -0,0 +1,69 @@ +module CTongNotificationVariables + use CVoidEventHandlerCollection + use CIActionReference + implicit none + logical :: TongNotification = .false. + procedure (ActionBool), pointer :: TongNotificationPtr + + public + + type(VoidEventHandlerCollection) :: OnTongNotificationChange + + private :: TongNotification + + contains + + subroutine Set_TongNotification(v) + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(TongNotification == v) return +#endif + TongNotification = v + if(associated(TongNotificationPtr)) call TongNotificationPtr(TongNotification) +#ifdef deb + print*, 'TongNotification=', TongNotification +#endif + call OnTongNotificationChange%RunAll() + end subroutine + + logical function Get_TongNotification() + implicit none + Get_TongNotification = TongNotification + end function + + + + + subroutine Set_TongNotification_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_TongNotification_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_TongNotification_WN' :: Set_TongNotification_WN + implicit none + logical , intent(in) :: v + call Set_TongNotification(v) + end subroutine + + logical function Get_TongNotification_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_TongNotification_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_TongNotification_WN' :: Get_TongNotification_WN + implicit none + Get_TongNotification_WN = TongNotification + end function + + + + + + + + + + subroutine SubscribeTongNotification(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeTongNotification + !DEC$ ATTRIBUTES ALIAS: 'SubscribeTongNotification' :: SubscribeTongNotification + implicit none + procedure (ActionBool) :: a + TongNotificationPtr => a + end subroutine + +end module CTongNotificationVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CUnlatchLedNotification.f90 b/CSharp/OperationScenarios/Notifications/CUnlatchLedNotification.f90 new file mode 100644 index 0000000..1c6e71c --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CUnlatchLedNotification.f90 @@ -0,0 +1,221 @@ +module CUnlatchLedNotification + use COperationScenariosVariables + use CLog4 + implicit none + contains + + subroutine Evaluate_UnlatchLed() + use CCommon + implicit none + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_UnlatchLed=TopDrive' +#endif + + + + !TOPDRIVE-CODE=47 + if (Get_HookHeight() <= (TL() + NFC() - ECG) .and.& + Get_NearFloorConnection() >= 3.0 .and. Get_NearFloorConnection() <= 6.0 .and.& + (Get_Elevator() /= ELEVATOR_LATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_SINGLE_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_SINGLE_BEGIN) .and.& + Get_ElevatorPickup() == .false. .and.& + (Get_TdsElevatorModes() == TDS_ELEVATOR_LATCH_STRING .or. Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_STRING) .and.& + Get_TdsSwing() == TDS_SWING_OFF_END .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_UnlatchLed(.true.) + return + end if + + + + + !TOPDRIVE-CODE=48 + if ((Get_HookHeight() >= (TL() + SL - ECG + NFC()) .and. Get_HookHeight() <= (TL() + SL - ECG + NFC() + TG)) .and.& + GetStandRack() > 80 .and.& + Get_JointConnectionPossible() == .false. .and.& + (Get_Elevator() /= ELEVATOR_LATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_SINGLE_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_SINGLE_BEGIN) .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_STAND .and.& + Get_TdsSwing() == TDS_SWING_OFF_END .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_UnlatchLed(.true.) + return + end if + + + + + + + !TOPDRIVE-CODE=49 + if ((Get_HookHeight() >= TL() .and. Get_HookHeight() <= (TL() + NFC() + SG)) .and.& + (Get_Elevator() /= ELEVATOR_LATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_SINGLE_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_SINGLE_BEGIN) .and.& + (Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_STRING .or. Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_SINGLE) .and.& + Get_TdsSwing() == TDS_SWING_TILT_END .and.& + Get_FillMouseHoleLed() == .false.) then + + call Set_UnlatchLed(.true.) + return + end if + + + + + + + + + endif + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_UnlatchLed=Kelly' +#endif + + + + !OPERATION-CODE=40 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() <= (HL + Get_NearFloorConnection() - ECG) .and.& + Get_NearFloorConnection() >= 3.0 .and. Get_NearFloorConnection() <= 6.0 .and.& + (Get_Elevator() /= ELEVATOR_LATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_SINGLE_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_SINGLE_BEGIN) .and.& + !Get_Elevator() == ELEVATOR_LATCH_STRING_END .and.& + (Get_ElevatorConnection() == ELEVATOR_LATCH_STRING) .and.& + !(Get_ElevatorConnection() == ELEVATOR_CONNECTION_STRING .or. Get_ElevatorConnection() == ELEVATOR_LATCH_STRING) .and.& + !Get_LatchLed() == .false. + Get_Swing() == SWING_WELL_END .and.& + Get_Slips() == SLIPS_SET_END ) then + + call Set_UnlatchLed(.true.) + !call Set_LatchLed(.false.) + return + end if + + + + + + + + + !OPERATION-CODE=41 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() >= (HL + SL - ECG + Get_NearFloorConnection()) .and. Get_HookHeight() <= (HL + SL - ECG + Get_NearFloorConnection() + LG) .and.& + !Get_HookHeight() >= (HL + Get_NearFloorConnection() + SL + RE) .and. Get_HookHeight() <= (HL + Get_NearFloorConnection() + SL + LG) .and.& + (Get_Elevator() /= ELEVATOR_LATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_SINGLE_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_SINGLE_BEGIN) .and.& + Get_StandRack() < 80 .and.& + Get_JointConnectionPossible() == .false. .and.& + !Get_Elevator() == ELEVATOR_UNLATCH_STAND_END .and.& + !Get_LatchLed() == .false. + Get_ElevatorConnection() == ELEVATOR_CONNECTION_STAND .and.& + Get_Swing() == SWING_WELL_END .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_UnlatchLed(.true.) + !call Set_LatchLed(.false.) + return + end if + + + + + + !OPERATION-CODE=42 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() >= HL .and. Get_HookHeight() <= (HL + Get_NearFloorConnection() + SG) .and.& + (Get_Elevator() /= ELEVATOR_LATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STRING_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_STAND_BEGIN .and.& + Get_Elevator() /= ELEVATOR_LATCH_SINGLE_BEGIN .and.& + Get_Elevator() /= ELEVATOR_UNLATCH_SINGLE_BEGIN) .and.& + !Get_Elevator() == ELEVATOR_UNLATCH_SINGLE_END .and.& + Get_Swing() == SWING_MOUSE_HOLE_END .and.& + !Get_LatchLed() == .false. .and.& + Get_FillMouseHoleLed() == .false.) then + + call Set_UnlatchLed(.true.) + !call Set_LatchLed(.false.) + return + end if + + + + + + !call Log_4('OPERATION-CODE=43-OPERATION_DRILL=', Get_OperationCondition() == OPERATION_DRILL) + !call Log_4('OPERATION-CODE=43-Get_HookHeight=', Get_HookHeight() >= 27.41) + !call Log_4('OPERATION-CODE=43-Get_Swing()=', Get_Swing() == SWING_RAT_HOLE_END) + !call Log_4('OPERATION-CODE=43-Get_LatchLed()=', Get_LatchLed() == .false.) + !OPERATION-CODE=43 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + Get_HookHeight() >= 27.41 .and.& + !Get_LatchLed() == .false. + Get_Swing() == SWING_RAT_HOLE_END) then + !call Log_4('OPERATION-CODE=43-call Set_UnlatchLed(.true.)') + call Set_UnlatchLed(.true.) + !call Set_LatchLed(.false.) + return + end if + + + + call Set_UnlatchLed(.false.) + + endif + + + + + + end subroutine + + subroutine Subscribe_UnlatchLed() + implicit none + + call OnOperationConditionChange%Add(Evaluate_UnlatchLed) + call OnHookHeightChange%Add(Evaluate_UnlatchLed) + call OnStandRackChanged%Add(Evaluate_UnlatchLed) + call OnElevatorConnectionChange%Add(Evaluate_UnlatchLed) + call OnSwingChange%Add(Evaluate_UnlatchLed) + call OnSlipsChange%Add(Evaluate_UnlatchLed) + call OnLatchLedChange%Add(Evaluate_UnlatchLed) + call OnFillMouseHoleLedChange%Add(Evaluate_UnlatchLed) + end subroutine + +end module CUnlatchLedNotification \ No newline at end of file diff --git a/CSharp/OperationScenarios/Notifications/CUnlatchLedNotificationVariables.f90 b/CSharp/OperationScenarios/Notifications/CUnlatchLedNotificationVariables.f90 new file mode 100644 index 0000000..79cd0a0 --- /dev/null +++ b/CSharp/OperationScenarios/Notifications/CUnlatchLedNotificationVariables.f90 @@ -0,0 +1,62 @@ +module CUnlatchLedNotificationVariables + use CVoidEventHandlerCollection + implicit none + logical :: UnlatchLed = .false. + + public + + type(VoidEventHandlerCollection) :: OnUnlatchLedChange + + private :: UnlatchLed + + contains + + subroutine Set_UnlatchLed(v) + use CDrillingConsoleVariables, only: UnlatchPipeLED + !use CLatchLedNotification + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(UnlatchLed == v) return +#endif + UnlatchLed = v + + if(UnlatchLed) then + UnlatchPipeLED = 1 + !call Set_LatchLed(.false.) + else + UnlatchPipeLED = 0 + endif + + call OnUnlatchLedChange%RunAll() + end subroutine + + logical function Get_UnlatchLed() + implicit none + Get_UnlatchLed = UnlatchLed + end function + + + + + + + subroutine Set_UnlatchLed_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_UnlatchLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_UnlatchLed_WN' :: Set_UnlatchLed_WN + implicit none + logical , intent(in) :: v + call Set_UnlatchLed(v) + end subroutine + + logical function Get_UnlatchLed_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_UnlatchLed_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_UnlatchLed_WN' :: Get_UnlatchLed_WN + implicit none + Get_UnlatchLed_WN = UnlatchLed + end function + + + + +end module CUnlatchLedNotificationVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CFillupHeadPermission.f90 b/CSharp/OperationScenarios/Permissions/CFillupHeadPermission.f90 new file mode 100644 index 0000000..4b4df41 --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CFillupHeadPermission.f90 @@ -0,0 +1,55 @@ +module CFillupHeadPermission + use COperationScenariosVariables + implicit none + + contains + + subroutine Evaluate_FillupHeadPermission() + implicit none + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_FillupHeadPermission=TopDrive' +#endif + + + !TOPDRIVE-CODE=66 + if (Get_NearFloorConnection() >= 3 .and. Get_NearFloorConnection() <= 10 .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_NOTHING .and.& + Get_TdsConnectionModes() == TDS_CONNECTION_NOTHING) then + + call Set_FillupHeadPermission(.true.) + return + end if + + + call Set_FillupHeadPermission(.false.) + + + endif + + + + + + + + + +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_FillupHeadPermission=Kelly' +!#endif +! endif + + + + end subroutine + + subroutine Subscribe_FillupHeadPermission() + implicit none + end subroutine + +end module CFillupHeadPermission \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CFillupHeadPermissionVariables.f90 b/CSharp/OperationScenarios/Permissions/CFillupHeadPermissionVariables.f90 new file mode 100644 index 0000000..6d6261b --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CFillupHeadPermissionVariables.f90 @@ -0,0 +1,50 @@ +module CFillupHeadPermissionVariables + use CVoidEventHandlerCollection + implicit none + logical :: FillupHeadPermission = .false. + + public + + type(VoidEventHandlerCollection) :: OnFillupHeadPermissionChange + + private :: FillupHeadPermission + + contains + + subroutine Set_FillupHeadPermission(v) + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(FillupHeadPermission == v) return +#endif + FillupHeadPermission = v +#ifdef deb + print*, 'FillupHeadPermission=', FillupHeadPermission +#endif + call OnFillupHeadPermissionChange%RunAll() + end subroutine + + logical function Get_FillupHeadPermission() + implicit none + Get_FillupHeadPermission = FillupHeadPermission + end function + + + + + subroutine Set_FillupHeadPermission_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_FillupHeadPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_FillupHeadPermission_WN' :: Set_FillupHeadPermission_WN + implicit none + logical , intent(in) :: v + call Set_FillupHeadPermission(v) + end subroutine + + logical function Get_FillupHeadPermission_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_FillupHeadPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_FillupHeadPermission_WN' :: Get_FillupHeadPermission_WN + implicit none + Get_FillupHeadPermission_WN = FillupHeadPermission + end function + +end module CFillupHeadPermissionVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CInstallFillupHeadPermission.f90 b/CSharp/OperationScenarios/Permissions/CInstallFillupHeadPermission.f90 new file mode 100644 index 0000000..aa429ee --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CInstallFillupHeadPermission.f90 @@ -0,0 +1,76 @@ +module CInstallFillupHeadPermission + use COperationScenariosVariables + implicit none + + contains + + subroutine Evaluate_InstallFillupHeadPermission() + use TD_DrillStemComponents + implicit none + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_InstallFillupHeadPermission=TopDrive' +#endif + endif + + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_InstallFillupHeadPermission=Kelly' +#endif + + + !!OPERATION-CODE=69 + !if (Get_OperationCondition() == OPERATION_DRILL .and.& + ! Get_NearFloorConnection() >= 3.0 .and. Get_NearFloorConnection() <= 6.0 .and.& + ! Get_JointConnectionPossible() == .false. .and.& + ! Get_KellyConnection() /= KELLY_CONNECTION_STRING .and.& + ! Get_Slips() == SLIPS_SET_END) then + ! + ! call Set_InstallFillupHeadPermission(.true.) + ! return + !end if + + + + !OPERATION-CODE=70 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + TD_TopJointHeight >= 3.0 .and. TD_TopJointHeight <= 9.0 .and.& + Get_JointConnectionPossible() == .false. .and.& + !Get_ElevatorConnectionPossible() == .false. .and.& + !Get_ElevatorConnection() /= ELEVATOR_CONNECTION_STRING .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING) then + + call Set_InstallFillupHeadPermission(.true.) + return + end if + + + + + call Set_InstallFillupHeadPermission(.false.) + + endif + + + + + + end subroutine + + subroutine Subscribe_InstallFillupHeadPermission() + implicit none + ! imp me... + end subroutine + +end module CInstallFillupHeadPermission \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CInstallFillupHeadPermissionVariables.f90 b/CSharp/OperationScenarios/Permissions/CInstallFillupHeadPermissionVariables.f90 new file mode 100644 index 0000000..f57497e --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CInstallFillupHeadPermissionVariables.f90 @@ -0,0 +1,53 @@ +module CInstallFillupHeadPermissionVariables + use CVoidEventHandlerCollection + implicit none + logical :: InstallFillupHeadPermission = .false. + + public + + type(VoidEventHandlerCollection) :: OnInstallFillupHeadPermissionChange + + private :: InstallFillupHeadPermission + + contains + + subroutine Set_InstallFillupHeadPermission(v) + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(InstallFillupHeadPermission == v) return +#endif + InstallFillupHeadPermission = v +#ifdef deb + print*, 'InstallFillupHeadPermission=', InstallFillupHeadPermission +#endif + call OnInstallFillupHeadPermissionChange%RunAll() + end subroutine + + logical function Get_InstallFillupHeadPermission() + implicit none + Get_InstallFillupHeadPermission = InstallFillupHeadPermission + end function + + + + subroutine Set_InstallFillupHeadPermission_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_InstallFillupHeadPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_InstallFillupHeadPermission_WN' :: Set_InstallFillupHeadPermission_WN + implicit none + logical , intent(in) :: v + call Set_InstallFillupHeadPermission(v) + end subroutine + + + logical function Get_InstallFillupHeadPermission_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_InstallFillupHeadPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_InstallFillupHeadPermission_WN' :: Get_InstallFillupHeadPermission_WN + implicit none + Get_InstallFillupHeadPermission_WN = InstallFillupHeadPermission + end function + + + + +end module CInstallFillupHeadPermissionVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CInstallMudBucketPermission.f90 b/CSharp/OperationScenarios/Permissions/CInstallMudBucketPermission.f90 new file mode 100644 index 0000000..56a4a4d --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CInstallMudBucketPermission.f90 @@ -0,0 +1,36 @@ +module CInstallMudBucketPermission + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_InstallMudBucketPermission() + implicit none + + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_InstallMudBucketPermission=TopDrive' +!#endif +! endif +! +! +! +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_InstallMudBucketPermission=Kelly' +!#endif +! endif + + + end subroutine + + subroutine Subscribe_InstallMudBucketPermission() + implicit none + ! imp me... + end subroutine + +end module CInstallMudBucketPermission \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CInstallMudBucketPermissionVariables.f90 b/CSharp/OperationScenarios/Permissions/CInstallMudBucketPermissionVariables.f90 new file mode 100644 index 0000000..6f716f0 --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CInstallMudBucketPermissionVariables.f90 @@ -0,0 +1,51 @@ +module CInstallMudBucketPermissionVariables + use CVoidEventHandlerCollection + implicit none + logical :: InstallMudBucketPermission = .false. + + public + + type(VoidEventHandlerCollection) :: OnInstallMudBucketPermissionChange + + private :: InstallMudBucketPermission + + contains + + subroutine Set_InstallMudBucketPermission(v) + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(InstallMudBucketPermission == v) return +#endif + InstallMudBucketPermission = v +#ifdef deb + print*, 'InstallMudBucketPermission=', InstallMudBucketPermission +#endif + call OnInstallMudBucketPermissionChange%RunAll() + end subroutine + + logical function Get_InstallMudBucketPermission() + implicit none + Get_InstallMudBucketPermission = InstallMudBucketPermission + end function + + + + + subroutine Set_InstallMudBucketPermission_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_InstallMudBucketPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_InstallMudBucketPermission_WN' :: Set_InstallMudBucketPermission_WN + implicit none + logical , intent(in) :: v + call Set_InstallMudBucketPermission(v) + end subroutine + + + logical function Get_InstallMudBucketPermission_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_InstallMudBucketPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_InstallMudBucketPermission_WN' :: Get_InstallMudBucketPermission_WN + implicit none + Get_InstallMudBucketPermission_WN = InstallMudBucketPermission + end function + +end module CInstallMudBucketPermissionVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CIrIbopPermission.f90 b/CSharp/OperationScenarios/Permissions/CIrIbopPermission.f90 new file mode 100644 index 0000000..a603ca9 --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CIrIbopPermission.f90 @@ -0,0 +1,92 @@ +module CIrIbopPermission + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_IrIbopPermission() + use TD_DrillStemComponents + use CStudentStationVariables, only: FillupHeadInstallation + implicit none + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_IrIbopPermission=TopDrive' +#endif + + + !TOPDRIVE-CODE=58 + if (GetRotaryRpm() == 0.0d0 .and.& + Get_NearFloorConnection() >= 3 .and. Get_NearFloorConnection() <= 10 .and.& + Get_JointConnectionPossible() == .false. .and.& + Get_TdsConnectionModes() == TDS_CONNECTION_NOTHING .and.& + FillupHeadInstallation == .false.) then + + call Set_IrIbopPermission(.true.) + return + end if + + + + + call Set_IrIbopPermission(.false.) + + + + endif + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_IrIbopPermission=Kelly' +#endif + + !OPERATION-CODE=62 + if (GetRotaryRpm() == 0.0d0 .and.& + Get_OperationCondition() == OPERATION_TRIP .and.& + !(Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .or. Get_ElevatorConnection() == ELEVATOR_LATCH_STRING) .and.& + TD_TopJointHeight >= 3.0 .and. TD_TopJointHeight <= 10.0 .and.& + !Get_IbopHeight() >= 22.0 .and. Get_IbopHeight() <= 35.0 .and.& + Get_JointConnectionPossible() == .false. .and.& + Get_Swing() == SWING_WELL_END .and.& + Get_FillupHead() == FILLUP_HEAD_REMOVE) then + call Set_IrIbopPermission(.true.) + return + end if + + + !if (Get_OperationCondition() == OPERATION_DRILL .and.& + ! Get_IbopHeight() >= 1 .and. Get_IbopHeight() <= 8 .and.& + ! Get_NearFloorConnection() >= 1 .and. Get_NearFloorConnection() <= 8 .and.& + ! Get_JointConnectionPossible() == .false. .and.& + ! Get_KellyConnection() /= KELLY_CONNECTION_STRING .and.& + ! Get_Swing() == SWING_WELL_END .and.& + ! Get_Slips() == SLIPS_SET_END) then + ! call Set_IrIbopPermission(.true.) + ! return + !end if + + + + + call Set_IrIbopPermission(.false.) + + + + endif + + + + + + + end subroutine + + subroutine Subscribe_IrIbopPermission() + implicit none + end subroutine + +end module CIrIbopPermission \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CIrIbopPermissionVariables.f90 b/CSharp/OperationScenarios/Permissions/CIrIbopPermissionVariables.f90 new file mode 100644 index 0000000..a86ca3c --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CIrIbopPermissionVariables.f90 @@ -0,0 +1,49 @@ +module CIrIbopPermissionVariables + use CVoidEventHandlerCollection + implicit none + logical :: IrIbopPermission = .false. + + public + + type(VoidEventHandlerCollection) :: OnIrIbopPermissionChange + + private :: IrIbopPermission + + contains + + subroutine Set_IrIbopPermission(v) + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(IrIbopPermission == v) return +#endif + IrIbopPermission = v +#ifdef deb + print*, 'IrIbopPermission=', IrIbopPermission +#endif + call OnIrIbopPermissionChange%RunAll() + end subroutine + + logical function Get_IrIbopPermission() + implicit none + Get_IrIbopPermission = IrIbopPermission + end function + + + + subroutine Set_IrIbopPermission_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_IrIbopPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_IrIbopPermission_WN' :: Set_IrIbopPermission_WN + implicit none + logical , intent(in) :: v + call Set_IrIbopPermission(v) + end subroutine + + logical function Get_IrIbopPermission_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_IrIbopPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_IrIbopPermission_WN' :: Get_IrIbopPermission_WN + implicit none + Get_IrIbopPermission_WN = IrIbopPermission + end function + +end module CIrIbopPermissionVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CIrSafetyValvePermission.f90 b/CSharp/OperationScenarios/Permissions/CIrSafetyValvePermission.f90 new file mode 100644 index 0000000..fc930e9 --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CIrSafetyValvePermission.f90 @@ -0,0 +1,87 @@ +module CIrSafetyValvePermission + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_IrSafetyValvePermission() + use TD_DrillStemComponents + use CStudentStationVariables, only: FillupHeadInstallation + implicit none + + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_IrSafetyValvePermission=TopDrive' +#endif + + + + !TOPDRIVE-CODE=55 + if (GetRotaryRpm() == 0.0d0 .and.& + (Get_NearFloorConnection() >= 3.0 .and. Get_NearFloorConnection() <= 10.0) .and.& + Get_JointConnectionPossible() == .false. .and.& + Get_TdsConnectionModes() == TDS_CONNECTION_NOTHING .and.& + FillupHeadInstallation == .false.) then + + call Set_IrSafetyValvePermission(.true.) + return + end if + + + + endif + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_IrSafetyValvePermission=Kelly' +#endif + + + !OPERATION-CODE=57 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + GetRotaryRpm() == 0.0d0 .and.& + !(Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .or. Get_ElevatorConnection() == ELEVATOR_LATCH_STRING) .and.& + !Get_NearFloorConnection() >= 3.0 .and. Get_NearFloorConnection() <= 10.0 .and.& + TD_TopJointHeight >= 3.0 .and. TD_TopJointHeight <= 10.0 .and.& + !Get_SafetyValveHeight() >= 22.0 .and. Get_SafetyValveHeight() <= 35.0 .and.& + Get_JointConnectionPossible() == .false. .and.& + Get_FillupHead() == FILLUP_HEAD_REMOVE .and.& + Get_Swing() == SWING_WELL_END) then + call Set_IrSafetyValvePermission(.true.) + return + end if + + + + + + call Set_IrSafetyValvePermission(.false.) + + endif + + + + + + + + + + + end subroutine + + subroutine Subscribe_IrSafetyValvePermission() + implicit none + ! imp me... + end subroutine + +end module CIrSafetyValvePermission \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CIrSafetyValvePermissionVariables.f90 b/CSharp/OperationScenarios/Permissions/CIrSafetyValvePermissionVariables.f90 new file mode 100644 index 0000000..ad65d98 --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CIrSafetyValvePermissionVariables.f90 @@ -0,0 +1,51 @@ +module CIrSafetyValvePermissionVariables + use CVoidEventHandlerCollection + implicit none + logical :: IrSafetyValvePermission = .false. + + public + + type(VoidEventHandlerCollection) :: OnIrSafetyValvePermissionChange + + private :: IrSafetyValvePermission + + contains + + subroutine Set_IrSafetyValvePermission(v) + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(IrSafetyValvePermission == v) return +#endif + IrSafetyValvePermission = v +#ifdef deb + print*, 'IrSafetyValvePermission=', IrSafetyValvePermission +#endif + call OnIrSafetyValvePermissionChange%RunAll() + end subroutine + + logical function Get_IrSafetyValvePermission() + implicit none + Get_IrSafetyValvePermission = IrSafetyValvePermission + end function + + + + + subroutine Set_IrSafetyValvePermission_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_IrSafetyValvePermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_IrSafetyValvePermission_WN' :: Set_IrSafetyValvePermission_WN + implicit none + logical , intent(in) :: v + call Set_IrSafetyValvePermission(v) + end subroutine + + logical function Get_IrSafetyValvePermission_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_IrSafetyValvePermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_IrSafetyValvePermission_WN' :: Get_IrSafetyValvePermission_WN + implicit none + Get_IrSafetyValvePermission_WN = IrSafetyValvePermission + end function + + +end module CIrSafetyValvePermissionVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CRemoveFillupHeadPermission.f90 b/CSharp/OperationScenarios/Permissions/CRemoveFillupHeadPermission.f90 new file mode 100644 index 0000000..3317c23 --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CRemoveFillupHeadPermission.f90 @@ -0,0 +1,36 @@ +module CRemoveFillupHeadPermission + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_RemoveFillupHeadPermission() + implicit none + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_RemoveFillupHeadPermission=TopDrive' +!#endif +! endif +! +! +! +! +! +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_RemoveFillupHeadPermission=Kelly' +!#endif +! endif + + end subroutine + + subroutine Subscribe_RemoveFillupHeadPermission() + implicit none + ! imp me... + end subroutine + +end module CRemoveFillupHeadPermission \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CRemoveFillupHeadPermissionVariables.f90 b/CSharp/OperationScenarios/Permissions/CRemoveFillupHeadPermissionVariables.f90 new file mode 100644 index 0000000..ff22333 --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CRemoveFillupHeadPermissionVariables.f90 @@ -0,0 +1,51 @@ +module CRemoveFillupHeadPermissionVariables + use CVoidEventHandlerCollection + implicit none + logical :: RemoveFillupHeadPermission = .false. + + public + + type(VoidEventHandlerCollection) :: OnRemoveFillupHeadPermissionChange + + private :: RemoveFillupHeadPermission + + contains + + subroutine Set_RemoveFillupHeadPermission(v) + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(RemoveFillupHeadPermission == v) return +#endif + RemoveFillupHeadPermission = v +#ifdef deb + print*, 'RemoveFillupHeadPermission=', RemoveFillupHeadPermission +#endif + call OnRemoveFillupHeadPermissionChange%RunAll() + end subroutine + + logical function Get_RemoveFillupHeadPermission() + implicit none + Get_RemoveFillupHeadPermission = RemoveFillupHeadPermission + end function + + + + + subroutine Set_RemoveFillupHeadPermission_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_RemoveFillupHeadPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_RemoveFillupHeadPermission_WN' :: Set_RemoveFillupHeadPermission_WN + implicit none + logical , intent(in) :: v + call Set_RemoveFillupHeadPermission(v) + end subroutine + + logical function Get_RemoveFillupHeadPermission_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_RemoveFillupHeadPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_RemoveFillupHeadPermission_WN' :: Get_RemoveFillupHeadPermission_WN + implicit none + Get_RemoveFillupHeadPermission_WN = RemoveFillupHeadPermission + end function + + +end module CRemoveFillupHeadPermissionVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CRemoveMudBucketPermission.f90 b/CSharp/OperationScenarios/Permissions/CRemoveMudBucketPermission.f90 new file mode 100644 index 0000000..4f1ab9b --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CRemoveMudBucketPermission.f90 @@ -0,0 +1,34 @@ +module CRemoveMudBucketPermission + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_RemoveMudBucketPermission() + implicit none + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_RemoveMudBucketPermission=TopDrive' +!#endif +! endif +! +! +! +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_RemoveMudBucketPermission=Kelly' +!#endif +! endif + + end subroutine + + subroutine Subscribe_RemoveMudBucketPermission() + implicit none + ! imp me... + end subroutine + +end module CRemoveMudBucketPermission \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CRemoveMudBucketPermissionVariables.f90 b/CSharp/OperationScenarios/Permissions/CRemoveMudBucketPermissionVariables.f90 new file mode 100644 index 0000000..a2bd728 --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CRemoveMudBucketPermissionVariables.f90 @@ -0,0 +1,51 @@ +module CRemoveMudBucketPermissionVariables + use CVoidEventHandlerCollection + implicit none + logical :: RemoveMudBucketPermission = .false. + + public + + type(VoidEventHandlerCollection) :: OnRemoveMudBucketPermissionChange + + private :: RemoveMudBucketPermission + + contains + + subroutine Set_RemoveMudBucketPermission(v) + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(RemoveMudBucketPermission == v) return +#endif + RemoveMudBucketPermission = v +#ifdef deb + print*, 'RemoveMudBucketPermission=', RemoveMudBucketPermission +#endif + call OnRemoveMudBucketPermissionChange%RunAll() + end subroutine + + logical function Get_RemoveMudBucketPermission() + implicit none + Get_RemoveMudBucketPermission = RemoveMudBucketPermission + end function + + + + + subroutine Set_RemoveMudBucketPermission_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_RemoveMudBucketPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_RemoveMudBucketPermission_WN' :: Set_RemoveMudBucketPermission_WN + implicit none + logical , intent(in) :: v + call Set_RemoveMudBucketPermission(v) + end subroutine + + logical function Get_RemoveMudBucketPermission_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_RemoveMudBucketPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_RemoveMudBucketPermission_WN' :: Get_RemoveMudBucketPermission_WN + implicit none + Get_RemoveMudBucketPermission_WN = RemoveMudBucketPermission + end function + + +end module CRemoveMudBucketPermissionVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CSwingDrillPermission.f90 b/CSharp/OperationScenarios/Permissions/CSwingDrillPermission.f90 new file mode 100644 index 0000000..5b98892 --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CSwingDrillPermission.f90 @@ -0,0 +1,59 @@ +module CSwingDrillPermission + use COperationScenariosVariables + implicit none + + contains + + subroutine Evaluate_SwingDrillPermission() + implicit none + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_SwingDrillPermission=TopDrive' +#endif + + !TOPDRIVE-CODE=33 + if (Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_NOTHING .and.& + Get_TdsSwing() == TDS_SWING_OFF_END .and.& + TopDriveTdsPowerState /= TdsPower_OFF) then + + call Set_SwingDrillPermission(.true.) + return + end if + + + + + + + call Set_SwingDrillPermission(.false.) + + + + + + endif + + + + + + + + + +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_SwingDrillPermission=Kelly' +!#endif +! endif + + + end subroutine + + subroutine Subscribe_SwingDrillPermission() + implicit none + end subroutine + +end module CSwingDrillPermission \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CSwingDrillPermissionVariables.f90 b/CSharp/OperationScenarios/Permissions/CSwingDrillPermissionVariables.f90 new file mode 100644 index 0000000..2905b52 --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CSwingDrillPermissionVariables.f90 @@ -0,0 +1,49 @@ +module CSwingDrillPermissionVariables + use CVoidEventHandlerCollection + implicit none + logical :: SwingDrillPermission = .false. + + public + + type(VoidEventHandlerCollection) :: OnSwingDrillPermissionChange + + private :: SwingDrillPermission + + contains + + subroutine Set_SwingDrillPermission(v) + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(SwingDrillPermission == v) return +#endif + SwingDrillPermission = v +#ifdef deb + print*, 'SwingDrillPermission=', SwingDrillPermission +#endif + call OnSwingDrillPermissionChange%RunAll() + end subroutine + + logical function Get_SwingDrillPermission() + implicit none + Get_SwingDrillPermission = SwingDrillPermission + end function + + + + subroutine Set_SwingDrillPermission_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_SwingDrillPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_SwingDrillPermission_WN' :: Set_SwingDrillPermission_WN + implicit none + logical , intent(in) :: v + call Set_SwingDrillPermission(v) + end subroutine + + logical function Get_SwingDrillPermission_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_SwingDrillPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_SwingDrillPermission_WN' :: Get_SwingDrillPermission_WN + implicit none + Get_SwingDrillPermission_WN = SwingDrillPermission + end function + +end module CSwingDrillPermissionVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CSwingOffPermission.f90 b/CSharp/OperationScenarios/Permissions/CSwingOffPermission.f90 new file mode 100644 index 0000000..c219d50 --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CSwingOffPermission.f90 @@ -0,0 +1,67 @@ +module CSwingOffPermission + use COperationScenariosVariables + implicit none + + contains + + subroutine Evaluate_SwingOffPermission() + implicit none + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_SwingOffPermission=TopDrive' +#endif + + + + !TOPDRIVE-CODE=35 + if (Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_NOTHING .and.& + Get_TdsConnectionModes() == TDS_CONNECTION_NOTHING .and.& + Get_TdsSwing() == TDS_SWING_TILT_END .and.& + Get_Slips() == SLIPS_SET_END .and.& + TopDriveTdsPowerState /= TdsPower_OFF) then + + call Set_SwingOffPermission(.true.) + return + end if + + + + + !TOPDRIVE-CODE=36 + if (Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_NOTHING .and.& + Get_TdsConnectionModes() == TDS_CONNECTION_NOTHING .and.& + Get_TdsSwing() == TDS_SWING_DRILL_END .and.& + TopDriveTdsPowerState /= TdsPower_OFF) then + + call Set_SwingOffPermission(.true.) + return + end if + + + + call Set_SwingOffPermission(.false.) + + endif + + + + + + + + +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_SwingOffPermission=Kelly' +!#endif +! endif + + end subroutine + + subroutine Subscribe_SwingOffPermission() + implicit none + end subroutine + +end module CSwingOffPermission \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CSwingOffPermissionVariables.f90 b/CSharp/OperationScenarios/Permissions/CSwingOffPermissionVariables.f90 new file mode 100644 index 0000000..edf39aa --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CSwingOffPermissionVariables.f90 @@ -0,0 +1,48 @@ +module CSwingOffPermissionVariables + use CVoidEventHandlerCollection + implicit none + logical :: SwingOffPermission = .false. + + public + + type(VoidEventHandlerCollection) :: OnSwingOffPermissionChange + + private :: SwingOffPermission + + contains + + subroutine Set_SwingOffPermission(v) + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(SwingOffPermission == v) return +#endif + SwingOffPermission = v +#ifdef deb + print*, 'SwingOffPermission=', SwingOffPermission +#endif + call OnSwingOffPermissionChange%RunAll() + end subroutine + + logical function Get_SwingOffPermission() + implicit none + Get_SwingOffPermission = SwingOffPermission + end function + + + subroutine Set_SwingOffPermission_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_SwingOffPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_SwingOffPermission_WN' :: Set_SwingOffPermission_WN + implicit none + logical , intent(in) :: v + call Set_SwingOffPermission(v) + end subroutine + + logical function Get_SwingOffPermission_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_SwingOffPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_SwingOffPermission_WN' :: Get_SwingOffPermission_WN + implicit none + Get_SwingOffPermission_WN = SwingOffPermission + end function + +end module CSwingOffPermissionVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CSwingTiltPermission.f90 b/CSharp/OperationScenarios/Permissions/CSwingTiltPermission.f90 new file mode 100644 index 0000000..8aca7c9 --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CSwingTiltPermission.f90 @@ -0,0 +1,52 @@ +module CSwingTiltPermission + use COperationScenariosVariables + implicit none + + contains + + subroutine Evaluate_SwingTiltPermission() + implicit none + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_SwingTiltPermission=TopDrive' +#endif + + + !TOPDRIVE-CODE=34 + if (Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_NOTHING .and.& + Get_TdsConnectionModes() == TDS_CONNECTION_NOTHING .and.& + Get_TdsSwing() == TDS_SWING_OFF_END .and.& + Get_Slips() == SLIPS_SET_END .and.& + TopDriveTdsPowerState /= TdsPower_OFF) then + + call Set_SwingTiltPermission(.true.) + return + end if + + + call Set_SwingTiltPermission(.false.) + + endif + + + + + + + + + +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_SwingTiltPermission=Kelly' +!#endif +! endif + + end subroutine + + subroutine Subscribe_SwingTiltPermission() + implicit none + end subroutine + +end module CSwingTiltPermission \ No newline at end of file diff --git a/CSharp/OperationScenarios/Permissions/CSwingTiltPermissionVariables.f90 b/CSharp/OperationScenarios/Permissions/CSwingTiltPermissionVariables.f90 new file mode 100644 index 0000000..3253480 --- /dev/null +++ b/CSharp/OperationScenarios/Permissions/CSwingTiltPermissionVariables.f90 @@ -0,0 +1,50 @@ +module CSwingTiltPermissionVariables + use CVoidEventHandlerCollection + implicit none + logical :: SwingTiltPermission = .false. + + public + + type(VoidEventHandlerCollection) :: OnSwingTiltPermissionChange + + private :: SwingTiltPermission + + contains + + subroutine Set_SwingTiltPermission(v) + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(SwingTiltPermission == v) return +#endif + SwingTiltPermission = v +#ifdef deb + print*, 'SwingTiltPermission=', SwingTiltPermission +#endif + call OnSwingTiltPermissionChange%RunAll() + end subroutine + + logical function Get_SwingTiltPermission() + implicit none + Get_SwingTiltPermission = SwingTiltPermission + end function + + + + subroutine Set_SwingTiltPermission_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_SwingTiltPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_SwingTiltPermission_WN' :: Set_SwingTiltPermission_WN + implicit none + logical , intent(in) :: v + call Set_SwingTiltPermission(v) + end subroutine + + + logical function Get_SwingTiltPermission_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_SwingTiltPermission_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_SwingTiltPermission_WN' :: Get_SwingTiltPermission_WN + implicit none + Get_SwingTiltPermission_WN = SwingTiltPermission + end function + +end module CSwingTiltPermissionVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/SoftwareInputs/CHookHeight.f90 b/CSharp/OperationScenarios/SoftwareInputs/CHookHeight.f90 new file mode 100644 index 0000000..360e7d7 --- /dev/null +++ b/CSharp/OperationScenarios/SoftwareInputs/CHookHeight.f90 @@ -0,0 +1,37 @@ +module CHookHeight + use CVoidEventHandlerCollection + implicit none + real :: HookHeight = 0 + + public + type(VoidEventHandlerCollection) :: OnHookHeightChange + + private :: HookHeight + + contains + + subroutine Set_HookHeight(v) + implicit none + real , intent(in) :: v +#ifdef ExcludeExtraChanges + if(HookHeight == v) return +#endif + HookHeight = v +#ifdef deb + print*, 'HookHeight=', HookHeight +#endif + call OnHookHeightChange%RunAll() + end subroutine + + real function Get_HookHeight() + implicit none + Get_HookHeight = HookHeight + end function + + subroutine Subscribe_HookHeight() + use CHookVariables, only: OnHookHeight => OnHookHeightChange + implicit none + call OnHookHeight%Add(Set_HookHeight) + end subroutine + +end module CHookHeight \ No newline at end of file diff --git a/CSharp/OperationScenarios/SoftwareInputs/CIbopHeight.f90 b/CSharp/OperationScenarios/SoftwareInputs/CIbopHeight.f90 new file mode 100644 index 0000000..b0d62a4 --- /dev/null +++ b/CSharp/OperationScenarios/SoftwareInputs/CIbopHeight.f90 @@ -0,0 +1,58 @@ +module CIbopHeight + use CVoidEventHandlerCollection + implicit none + real :: IbopHeight = 0 + + public + + type(VoidEventHandlerCollection) :: OnIbopHeightChange + + private :: IbopHeight + + contains + + + subroutine Set_IbopHeight(v) + implicit none + real , intent(in) :: v +#ifdef ExcludeExtraChanges + if(IbopHeight == v) return +#endif + IbopHeight = v +#ifdef deb + print*, 'IbopHeight=', IbopHeight +#endif + call OnIbopHeightChange%RunAll() + end subroutine + + real function Get_IbopHeight() + implicit none + Get_IbopHeight = IbopHeight + !Get_IbopHeight = 23.0 + end function + + + + + subroutine Set_IbopHeight_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_IbopHeight_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_IbopHeight_WN' :: Set_IbopHeight_WN + implicit none + real , intent(in) :: v + call Set_IbopHeight(v) + end subroutine + real function Get_IbopHeight_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_IbopHeight_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_IbopHeight_WN' :: Get_IbopHeight_WN + implicit none + Get_IbopHeight_WN = IbopHeight + !Get_IbopHeight_WN = 23.0 + end function + + + subroutine Subscribe_IbopHeight() + implicit none + end subroutine + + +end module CIbopHeight \ No newline at end of file diff --git a/CSharp/OperationScenarios/SoftwareInputs/CNearFloorConnection.f90 b/CSharp/OperationScenarios/SoftwareInputs/CNearFloorConnection.f90 new file mode 100644 index 0000000..336b4e4 --- /dev/null +++ b/CSharp/OperationScenarios/SoftwareInputs/CNearFloorConnection.f90 @@ -0,0 +1,60 @@ +module CNearFloorConnection + use CVoidEventHandlerCollection + implicit none + real :: NearFloorConnection = 0 + + public + + type(VoidEventHandlerCollection) :: OnNearFloorConnectionChange + + private :: NearFloorConnection + + contains + + + subroutine Set_NearFloorConnection(v) + implicit none + real , intent(in) :: v +#ifdef ExcludeExtraChanges + if(NearFloorConnection == v) return +#endif + NearFloorConnection = v +#ifdef deb + print*, 'NearFloorConnection=', NearFloorConnection +#endif + call OnNearFloorConnectionChange%RunAll() + end subroutine + + real function Get_NearFloorConnection() + implicit none + Get_NearFloorConnection = NearFloorConnection + !Get_NearFloorConnection = 4 + end function + + + + + subroutine Set_NearFloorConnection_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_NearFloorConnection_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_NearFloorConnection_WN' :: Set_NearFloorConnection_WN + implicit none + real , intent(in) :: v + call Set_NearFloorConnection(v) + end subroutine + + + real function Get_NearFloorConnection_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_NearFloorConnection_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_NearFloorConnection_WN' :: Get_NearFloorConnection_WN + implicit none + Get_NearFloorConnection_WN = NearFloorConnection + !Get_NearFloorConnection_WN = 4 + end function + + + + subroutine Subscribe_NearFloorConnection() + implicit none + end subroutine + +end module CNearFloorConnection \ No newline at end of file diff --git a/CSharp/OperationScenarios/SoftwareInputs/CSafetyValveHeight.f90 b/CSharp/OperationScenarios/SoftwareInputs/CSafetyValveHeight.f90 new file mode 100644 index 0000000..6941606 --- /dev/null +++ b/CSharp/OperationScenarios/SoftwareInputs/CSafetyValveHeight.f90 @@ -0,0 +1,59 @@ +module CSafetyValveHeight + use CVoidEventHandlerCollection + implicit none + real :: SafetyValveHeight = 0 + + public + + type(VoidEventHandlerCollection) :: OnSafetyValveHeightChange + + private :: SafetyValveHeight + + contains + + + subroutine Set_SafetyValveHeight(v) + implicit none + real , intent(in) :: v +#ifdef ExcludeExtraChanges + if(SafetyValveHeight == v) return +#endif + SafetyValveHeight = v +#ifdef deb + print*, 'SafetyValveHeight=', SafetyValveHeight +#endif + call OnSafetyValveHeightChange%RunAll() + end subroutine + + real function Get_SafetyValveHeight() + implicit none + Get_SafetyValveHeight = SafetyValveHeight + !Get_SafetyValveHeight = 23 + end function + + + + + + subroutine Set_SafetyValveHeight_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_SafetyValveHeight_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_SafetyValveHeight_WN' :: Set_SafetyValveHeight_WN + implicit none + real , intent(in) :: v + call Set_SafetyValveHeight(v) + end subroutine + + real function Get_SafetyValveHeight_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_SafetyValveHeight_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_SafetyValveHeight_WN' :: Get_SafetyValveHeight_WN + implicit none + Get_SafetyValveHeight_WN = SafetyValveHeight + !Get_SafetyValveHeight_WN = 23 + end function + + + subroutine Subscribe_SafetyValveHeight() + implicit none + end subroutine + +end module CSafetyValveHeight \ No newline at end of file diff --git a/CSharp/OperationScenarios/SoftwareInputs/CSlackOff.f90 b/CSharp/OperationScenarios/SoftwareInputs/CSlackOff.f90 new file mode 100644 index 0000000..f6c0cbc --- /dev/null +++ b/CSharp/OperationScenarios/SoftwareInputs/CSlackOff.f90 @@ -0,0 +1,54 @@ +module CSlackOff + use CVoidEventHandlerCollection + implicit none + logical :: SlackOff = .false. + + public + + type(VoidEventHandlerCollection) :: OnSlackOffChange + + private :: SlackOff + + contains + + + subroutine Set_SlackOff(v) + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(SlackOff == v) return +#endif + SlackOff = v +#ifdef deb + print*, 'SlackOff=', SlackOff +#endif + call OnSlackOffChange%RunAll() + end subroutine + + logical function Get_SlackOff() + implicit none + Get_SlackOff = SlackOff + end function + + + + subroutine Set_SlackOff_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_SlackOff_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_SlackOff_WN' :: Set_SlackOff_WN + implicit none + logical , intent(in) :: v + call Set_SlackOff(v) + end subroutine + + logical function Get_SlackOff_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_SlackOff_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_SlackOff_WN' :: Get_SlackOff_WN + implicit none + Get_SlackOff_WN = SlackOff + end function + + subroutine Subscribe_SlackOff() + implicit none + end subroutine + +end module CSlackOff \ No newline at end of file diff --git a/CSharp/OperationScenarios/SoftwareInputs/CStandRack.f90 b/CSharp/OperationScenarios/SoftwareInputs/CStandRack.f90 new file mode 100644 index 0000000..cc6b70d --- /dev/null +++ b/CSharp/OperationScenarios/SoftwareInputs/CStandRack.f90 @@ -0,0 +1,38 @@ +module CStandRack + use CVoidEventHandlerCollection + implicit none + integer :: StandRack = 0 + + public + + type(VoidEventHandlerCollection) :: OnStandRackChanged + + private :: StandRack + + contains + + subroutine Set_StandRack(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(StandRack == v) return +#endif + StandRack = v +#ifdef deb + print*, 'StandRack=', StandRack +#endif + call OnStandRackChanged%RunAll() + end subroutine + + integer function Get_StandRack() + implicit none + Get_StandRack = StandRack + end function + + subroutine Subscribe_StandRack() + use CCommonVariables + implicit none + call OnStandRackChange%AssignTo(Set_StandRack) + end subroutine + +end module CStandRack \ No newline at end of file diff --git a/CSharp/OperationScenarios/SoftwareInputs/CStringPressure.f90 b/CSharp/OperationScenarios/SoftwareInputs/CStringPressure.f90 new file mode 100644 index 0000000..6fbda76 --- /dev/null +++ b/CSharp/OperationScenarios/SoftwareInputs/CStringPressure.f90 @@ -0,0 +1,57 @@ +module CStringPressure + use CVoidEventHandlerCollection + implicit none + real :: StringPressure = 0 + + public + + type(VoidEventHandlerCollection) :: OnStringPressureChange + + private :: StringPressure + + contains + + + subroutine Set_StringPressure(v) + implicit none + real , intent(in) :: v +#ifdef ExcludeExtraChanges + if(StringPressure == v) return +#endif + StringPressure = v +#ifdef deb + print*, 'StringPressure=', StringPressure +#endif + call OnStringPressureChange%RunAll() + end subroutine + + real function Get_StringPressure() + implicit none + Get_StringPressure = StringPressure + end function + + + + + subroutine Set_StringPressure_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_StringPressure_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_StringPressure_WN' :: Set_StringPressure_WN + implicit none + real , intent(in) :: v + call Set_StringPressure(v) + end subroutine + + real function Get_StringPressure_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_StringPressure_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_StringPressure_WN' :: Get_StringPressure_WN + implicit none + Get_StringPressure_WN = StringPressure + end function + + + + subroutine Subscribe_StringPressure() + implicit none + end subroutine + +end module CStringPressure \ No newline at end of file diff --git a/CSharp/OperationScenarios/SoftwareInputs/CTdsStemJointHeight.f90 b/CSharp/OperationScenarios/SoftwareInputs/CTdsStemJointHeight.f90 new file mode 100644 index 0000000..ae5f883 --- /dev/null +++ b/CSharp/OperationScenarios/SoftwareInputs/CTdsStemJointHeight.f90 @@ -0,0 +1,55 @@ +module CTdsStemJointHeight + use CVoidEventHandlerCollection + implicit none + real :: TdsStemJointHeight = 0 + + public + type(VoidEventHandlerCollection) :: OnTdsStemJointHeightChange + + private :: TdsStemJointHeight + + contains + + subroutine Set_TdsStemJointHeight(v) + implicit none + real , intent(in) :: v +#ifdef ExcludeExtraChanges + if(TdsStemJointHeight == v) return +#endif + TdsStemJointHeight = v +#ifdef deb + print*, 'TdsStemJointHeight=', TdsStemJointHeight +#endif + call OnTdsStemJointHeightChange%RunAll() + end subroutine + + real function Get_TdsStemJointHeight() + implicit none + Get_TdsStemJointHeight = TdsStemJointHeight + end function + + + + + subroutine Set_TdsStemJointHeight_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_TdsStemJointHeight_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_TdsStemJointHeight_WN' :: Set_TdsStemJointHeight_WN + implicit none + real , intent(in) :: v + call Set_TdsStemJointHeight(v) + end subroutine + + real function Get_TdsStemJointHeight_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_TdsStemJointHeight_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_TdsStemJointHeight_WN' :: Get_TdsStemJointHeight_WN + implicit none + Get_TdsStemJointHeight_WN = TdsStemJointHeight + end function + + + + subroutine Subscribe_TdsStemJointHeight() + implicit none + end subroutine + +end module CTdsStemJointHeight \ No newline at end of file diff --git a/CSharp/OperationScenarios/SoftwareInputs/CZeroStringSpeed.f90 b/CSharp/OperationScenarios/SoftwareInputs/CZeroStringSpeed.f90 new file mode 100644 index 0000000..d62ca14 --- /dev/null +++ b/CSharp/OperationScenarios/SoftwareInputs/CZeroStringSpeed.f90 @@ -0,0 +1,60 @@ +module CZeroStringSpeed + use CVoidEventHandlerCollection + implicit none + logical :: ZeroStringSpeed = .false. + + public + + type(VoidEventHandlerCollection) :: OnZeroStringSpeedChange + + private :: ZeroStringSpeed + + contains + + + subroutine Set_ZeroStringSpeed(v) + implicit none + logical , intent(in) :: v +#ifdef ExcludeExtraChanges + if(ZeroStringSpeed == v) return +#endif + ZeroStringSpeed = v +#ifdef deb + print*, 'ZeroStringSpeed=', ZeroStringSpeed +#endif + call OnZeroStringSpeedChange%RunAll() + end subroutine + + logical function Get_ZeroStringSpeed() + implicit none + Get_ZeroStringSpeed = ZeroStringSpeed + !Get_ZeroStringSpeed = .true. + end function + + + + + subroutine Set_ZeroStringSpeed_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_ZeroStringSpeed_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_ZeroStringSpeed_WN' :: Set_ZeroStringSpeed_WN + implicit none + logical , intent(in) :: v + call Set_ZeroStringSpeed(v) + end subroutine + + logical function Get_ZeroStringSpeed_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_ZeroStringSpeed_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_ZeroStringSpeed_WN' :: Get_ZeroStringSpeed_WN + implicit none + Get_ZeroStringSpeed_WN = ZeroStringSpeed + !Get_ZeroStringSpeed_WN = .true. + end function + + + + subroutine Subscribe_ZeroStringSpeed() + implicit none + + end subroutine + +end module CZeroStringSpeed \ No newline at end of file diff --git a/CSharp/OperationScenarios/SoftwareOutputs/CStringUpdate.f90 b/CSharp/OperationScenarios/SoftwareOutputs/CStringUpdate.f90 new file mode 100644 index 0000000..0b97c52 --- /dev/null +++ b/CSharp/OperationScenarios/SoftwareOutputs/CStringUpdate.f90 @@ -0,0 +1,33 @@ +module CStringUpdate + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_StringUpdate() + implicit none + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_StringUpdate=TopDrive' +!#endif +! endif +! +! +! +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_StringUpdate=Kelly' +!#endif +! endif +! + end subroutine + + subroutine Subscribe_StringUpdate() + implicit none + end subroutine + +end module CStringUpdate \ No newline at end of file diff --git a/CSharp/OperationScenarios/SoftwareOutputs/CStringUpdateVariables.f90 b/CSharp/OperationScenarios/SoftwareOutputs/CStringUpdateVariables.f90 new file mode 100644 index 0000000..ed1a071 --- /dev/null +++ b/CSharp/OperationScenarios/SoftwareOutputs/CStringUpdateVariables.f90 @@ -0,0 +1,70 @@ +module CStringUpdateVariables + use CIntegerEventHandlerCollection + implicit none + integer :: StringUpdate = 0 + + public + + type(IntegerEventHandlerCollection) :: OnStringUpdateChange + + enum, bind(c) + enumerator STRING_UPDATE_NEUTRAL + enumerator STRING_UPDATE_ADD_SINGLE + enumerator STRING_UPDATE_ADD_STAND + enumerator STRING_UPDATE_REMOVE_SINGLE + enumerator STRING_UPDATE_REMOVE_STAND + end enum + + private :: StringUpdate + + contains + + subroutine Set_StringUpdate(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(StringUpdate == v) return +#endif + StringUpdate = v +#ifdef deb + !if(StringUpdate==STRING_UPDATE_NEUTRAL) then + ! print*, 'StringUpdate=STRING_UPDATE_NEUTRAL' + !else if(StringUpdate==STRING_UPDATE_ADD_SINGLE) then + ! print*, 'StringUpdate=STRING_UPDATE_ADD_SINGLE' + !else if(StringUpdate==STRING_UPDATE_ADD_STAND) then + ! print*, 'StringUpdate=STRING_UPDATE_ADD_STAND' + !else if(StringUpdate==STRING_UPDATE_REMOVE_SINGLE) then + ! print*, 'StringUpdate=STRING_UPDATE_REMOVE_SINGLE' + !else if(StringUpdate==STRING_UPDATE_REMOVE_STAND) then + ! print*, 'StringUpdate=STRING_UPDATE_REMOVE_STAND' + !endif + !print*, 'StringUpdate=', StringUpdate +#endif + call OnStringUpdateChange%RunAll(v) + end subroutine + + integer function Get_StringUpdate() + implicit none + Get_StringUpdate = StringUpdate + end function + + + + + subroutine Set_StringUpdate_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_StringUpdate_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_StringUpdate_WN' :: Set_StringUpdate_WN + implicit none + integer , intent(in) :: v + call Set_StringUpdate(v) + end subroutine + + integer function Get_StringUpdate_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_StringUpdate_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_StringUpdate_WN' :: Get_StringUpdate_WN + implicit none + Get_StringUpdate_WN = StringUpdate + end function + + +end module CStringUpdateVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Test/TestOperationScenarios.f90 b/CSharp/OperationScenarios/Test/TestOperationScenarios.f90 new file mode 100644 index 0000000..903a2ff --- /dev/null +++ b/CSharp/OperationScenarios/Test/TestOperationScenarios.f90 @@ -0,0 +1,831 @@ +module TestOperationScenarios + use CKellyConnectionEnumVariables + use CElevatorConnectionEnumVariables + + use CCloseKellyCockLedNotificationVariables + use CCloseSafetyValveLedNotificationVariables + use CFillMouseHoleLedNotificationVariables + use CIrIBopLedNotificationVariables + use CIrSafetyValveLedNotificationVariables + use CLatchLedNotificationVariables + use COpenKellyCockLedNotificationVariables + use COpenSafetyValveLedNotificationVariables + use CSlipsNotificationVariables + use CSwingLedNotificationVariables + use CTongNotificationVariables + use CUnlatchLedNotificationVariables + + use CInstallFillupHeadPermissionVariables + use CInstallMudBucketPermissionVariables + use CIrIbopPermissionVariables + use CIrSafetyValvePermissionVariables + use CRemoveFillupHeadPermissionVariables + use CRemoveMudBucketPermissionVariables + + use CHookHeight + use CIbopHeight + use CNearFloorConnection + use CSafetyValveHeight + use CSlackOff + use CStandRack + use CStringPressure + use CZeroStringSpeed + + use CUnityInputs + !, only: & + ! Get_ElevatorConnectionPossible, & + ! Get_JointConnectionPossible, & + ! Get_NearMonkeyBoardPosition, & + ! Get_NearFloorPosition, & + ! Get_SingleSetInMouseHole, & + ! Get_SwingCenter, & + ! Get_NewHookHeight + use CUnityOutputs + + use CBucketEnumVariables + use CElevatorEnumVariables + use CHeadEnumVariables + use CIbopEnumVariables + use CKellyEnumVariables + use CMouseHoleEnumVariables + use COperationConditionEnumVariables + use CSafetyValveEnumVariables + use CSlipsEnumVariables + use CSwingEnumVariables + use CTongEnumVariables + + use CRigSizeVariables + use CHoistingVariables + + use CFlowPipeDisconnectEnumVariables + use CFlowKellyDisconnectEnumVariables + + use CStringUpdateVariables + + implicit none + public + contains + + + integer function GetElevatorConnection() + !DEC$ ATTRIBUTES DLLEXPORT :: GetElevatorConnection + !DEC$ ATTRIBUTES ALIAS: 'GetElevatorConnection' :: GetElevatorConnection + implicit none + GetElevatorConnection = Get_ElevatorConnection() + + end function + + integer function GetKellyConnection() + !DEC$ ATTRIBUTES DLLEXPORT :: GetKellyConnection + !DEC$ ATTRIBUTES ALIAS: 'GetKellyConnection' :: GetKellyConnection + implicit none + GetKellyConnection = Get_KellyConnection() + end function + + + + logical function GetCloseKellyCockLedU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetCloseKellyCockLedU + !DEC$ ATTRIBUTES ALIAS: 'GetCloseKellyCockLedU' :: GetCloseKellyCockLedU + implicit none + GetCloseKellyCockLedU = Get_CloseKellyCockLed() + end function + + logical function GetCloseSafetyValveLedU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetCloseSafetyValveLedU + !DEC$ ATTRIBUTES ALIAS: 'GetCloseSafetyValveLedU' :: GetCloseSafetyValveLedU + implicit none + GetCloseSafetyValveLedU = Get_CloseSafetyValveLed() + end function + + logical function GetFillMouseHoleLedU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetFillMouseHoleLedU + !DEC$ ATTRIBUTES ALIAS: 'GetFillMouseHoleLedU' :: GetFillMouseHoleLedU + implicit none + GetFillMouseHoleLedU = Get_FillMouseHoleLed() + end function + + logical function GetIrIBopLedU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetIrIBopLedU + !DEC$ ATTRIBUTES ALIAS: 'GetIrIBopLedU' :: GetIrIBopLedU + implicit none + GetIrIBopLedU = Get_IrIBopLed() + end function + + logical function GetIrSafetyValveLedU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetIrSafetyValveLedU + !DEC$ ATTRIBUTES ALIAS: 'GetIrSafetyValveLedU' :: GetIrSafetyValveLedU + implicit none + GetIrSafetyValveLedU = Get_IrSafetyValveLed() + end function + + logical function GetLatchLedU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetLatchLedU + !DEC$ ATTRIBUTES ALIAS: 'GetLatchLedU' :: GetLatchLedU + implicit none + GetLatchLedU = Get_LatchLed() + end function + + logical function GetOpenKellyCockLedU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetOpenKellyCockLedU + !DEC$ ATTRIBUTES ALIAS: 'GetOpenKellyCockLedU' :: GetOpenKellyCockLedU + implicit none + GetOpenKellyCockLedU = Get_OpenKellyCockLed() + end function + + logical function GetOpenSafetyValveLedU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetOpenSafetyValveLedU + !DEC$ ATTRIBUTES ALIAS: 'GetOpenSafetyValveLedU' :: GetOpenSafetyValveLedU + implicit none + GetOpenSafetyValveLedU = Get_OpenSafetyValveLed() + end function + + logical function GetSlipsNotification() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSlipsNotification + !DEC$ ATTRIBUTES ALIAS: 'GetSlipsNotification' :: GetSlipsNotification + implicit none + GetSlipsNotification = Get_SlipsNotification() + end function + + logical function GetSwingLedU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSwingLedU + !DEC$ ATTRIBUTES ALIAS: 'GetSwingLedU' :: GetSwingLedU + implicit none + GetSwingLedU = Get_SwingLed() + end function + + logical function GetTongNotification() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTongNotification + !DEC$ ATTRIBUTES ALIAS: 'GetTongNotification' :: GetTongNotification + implicit none + GetTongNotification = Get_TongNotification() + end function + + logical function GetUnlatchLed() + !DEC$ ATTRIBUTES DLLEXPORT :: GetUnlatchLed + !DEC$ ATTRIBUTES ALIAS: 'GetUnlatchLed' :: GetUnlatchLed + implicit none + GetUnlatchLed = Get_UnlatchLed() + end function + + logical function GetInstallFillupHeadPermission() + !DEC$ ATTRIBUTES DLLEXPORT :: GetInstallFillupHeadPermission + !DEC$ ATTRIBUTES ALIAS: 'GetInstallFillupHeadPermission' :: GetInstallFillupHeadPermission + implicit none + GetInstallFillupHeadPermission = Get_InstallFillupHeadPermission() + end function + + logical function GetInstallMudBucketPermission() + !DEC$ ATTRIBUTES DLLEXPORT :: GetInstallMudBucketPermission + !DEC$ ATTRIBUTES ALIAS: 'GetInstallMudBucketPermission' :: GetInstallMudBucketPermission + implicit none + GetInstallMudBucketPermission = Get_InstallMudBucketPermission() + end function + + logical function GetIrIbopPermission() + !DEC$ ATTRIBUTES DLLEXPORT :: GetIrIbopPermission + !DEC$ ATTRIBUTES ALIAS: 'GetIrIbopPermission' :: GetIrIbopPermission + implicit none + GetIrIbopPermission = Get_IrIbopPermission() + end function + + logical function GetIrSafetyValvePermission() + !DEC$ ATTRIBUTES DLLEXPORT :: GetIrSafetyValvePermission + !DEC$ ATTRIBUTES ALIAS: 'GetIrSafetyValvePermission' :: GetIrSafetyValvePermission + implicit none + GetIrSafetyValvePermission = Get_IrSafetyValvePermission() + end function + + logical function GetRemoveFillupHeadPermission() + !DEC$ ATTRIBUTES DLLEXPORT :: GetRemoveFillupHeadPermission + !DEC$ ATTRIBUTES ALIAS: 'GetRemoveFillupHeadPermission' :: GetRemoveFillupHeadPermission + implicit none + GetRemoveFillupHeadPermission = Get_RemoveFillupHeadPermission() + end function + + logical function GetRemoveMudBucketPermission() + !DEC$ ATTRIBUTES DLLEXPORT :: GetRemoveMudBucketPermission + !DEC$ ATTRIBUTES ALIAS: 'GetRemoveMudBucketPermission' :: GetRemoveMudBucketPermission + implicit none + GetRemoveMudBucketPermission = Get_RemoveMudBucketPermission() + end function + + real function GetHookHeightU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetHookHeightU + !DEC$ ATTRIBUTES ALIAS: 'GetHookHeightU' :: GetHookHeightU + implicit none + GetHookHeightU = Get_HookHeight() + end function + + real(8) function GetIbopHeight() + !DEC$ ATTRIBUTES DLLEXPORT :: GetIbopHeight + !DEC$ ATTRIBUTES ALIAS: 'GetIbopHeight' :: GetIbopHeight + implicit none + GetIbopHeight = Get_IbopHeight() + end function + + real(8) function GetNearFloorConnection() + !DEC$ ATTRIBUTES DLLEXPORT :: GetNearFloorConnection + !DEC$ ATTRIBUTES ALIAS: 'GetNearFloorConnection' :: GetNearFloorConnection + implicit none + GetNearFloorConnection = Get_NearFloorConnection() + end function + + real(8) function GetSafetyValveHeight() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSafetyValveHeight + !DEC$ ATTRIBUTES ALIAS: 'GetSafetyValveHeight' :: GetSafetyValveHeight + implicit none + GetSafetyValveHeight = Get_SafetyValveHeight() + end function + + logical function GetSlackOff() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSlackOff + !DEC$ ATTRIBUTES ALIAS: 'GetSlackOff' :: GetSlackOff + implicit none + GetSlackOff = Get_SlackOff() + end function + + integer function GetStandRackU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetStandRackU + !DEC$ ATTRIBUTES ALIAS: 'GetStandRackU' :: GetStandRackU + implicit none + GetStandRackU = Get_StandRack() + end function + + real(8) function GetRotaryRpmU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetRotaryRpmU + !DEC$ ATTRIBUTES ALIAS: 'GetRotaryRpmU' :: GetRotaryRpmU + implicit none + GetRotaryRpmU = GetRotaryRpm() + end function + + real(8) function GetStringPressure() + !DEC$ ATTRIBUTES DLLEXPORT :: GetStringPressure + !DEC$ ATTRIBUTES ALIAS: 'GetStringPressure' :: GetStringPressure + implicit none + GetStringPressure = Get_StringPressure() + end function + + logical function GetZeroStringSpeed() + !DEC$ ATTRIBUTES DLLEXPORT :: GetZeroStringSpeed + !DEC$ ATTRIBUTES ALIAS: 'GetZeroStringSpeed' :: GetZeroStringSpeed + implicit none + GetZeroStringSpeed = Get_ZeroStringSpeed() + end function + + real(8) function GetFlowRateU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetFlowRateU + !DEC$ ATTRIBUTES ALIAS: 'GetFlowRateU' :: GetFlowRateU + implicit none + GetFlowRateU = GetFlowRate() + end function + + real(8) function GetPedalU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetPedalU + !DEC$ ATTRIBUTES ALIAS: 'GetPedalU' :: GetPedalU + implicit none + GetPedalU = GetPedal() + end function + + real(8) function GetFloorHeightU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetFloorHeightU + !DEC$ ATTRIBUTES ALIAS: 'GetFloorHeightU' :: GetFloorHeightU + implicit none + GetFloorHeightU = RigFloorHeight + end function + + real(8) function GetCrownHeightU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetCrownHeightU + !DEC$ ATTRIBUTES ALIAS: 'GetCrownHeightU' :: GetCrownHeightU + implicit none + GetCrownHeightU = CrownHeight + end function + + real(8) function GetKellyHoseVibrationRateU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetKellyHoseVibrationRateU + !DEC$ ATTRIBUTES ALIAS: 'GetKellyHoseVibrationRateU' :: GetKellyHoseVibrationRateU + implicit none + GetKellyHoseVibrationRateU = GetKellyHoseVibrationRate() + end function + + integer function GetDriveTypeU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetDriveTypeU + !DEC$ ATTRIBUTES ALIAS: 'GetDriveTypeU' :: GetDriveTypeU + implicit none + + GetDriveTypeU = DriveType + end function + + logical function GetElevatorConnectionPossibility() + !DEC$ ATTRIBUTES DLLEXPORT :: GetElevatorConnectionPossibility + !DEC$ ATTRIBUTES ALIAS: 'GetElevatorConnectionPossibility' :: GetElevatorConnectionPossibility + implicit none + GetElevatorConnectionPossibility = Get_ElevatorConnectionPossible() + end function + + logical function GetJointConnectionPossibility() + !DEC$ ATTRIBUTES DLLEXPORT :: GetJointConnectionPossibility + !DEC$ ATTRIBUTES ALIAS: 'GetJointConnectionPossibility' :: GetJointConnectionPossibility + implicit none + GetJointConnectionPossibility = Get_JointConnectionPossible() + end function + + logical function GetElevatorPickup() + !DEC$ ATTRIBUTES DLLEXPORT :: GetElevatorPickup + !DEC$ ATTRIBUTES ALIAS: 'GetElevatorPickup' :: GetElevatorPickup + implicit none + GetElevatorPickup = Get_ElevatorPickup() + end function + + logical function GetNearFloorPosition() + !DEC$ ATTRIBUTES DLLEXPORT :: GetNearFloorPosition + !DEC$ ATTRIBUTES ALIAS: 'GetNearFloorPosition' :: GetNearFloorPosition + implicit none + GetNearFloorPosition = Get_NearFloorPosition() + end function + + logical function GetSingleSetInMouseHole() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSingleSetInMouseHole + !DEC$ ATTRIBUTES ALIAS: 'GetSingleSetInMouseHole' :: GetSingleSetInMouseHole + implicit none + GetSingleSetInMouseHole = Get_SingleSetInMouseHole() + end function + + logical function GetSwingCenter() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSwingCenter + !DEC$ ATTRIBUTES ALIAS: 'GetSwingCenter' :: GetSwingCenter + implicit none + !GetSwingCenter = Get_SwingCenter() + GetSwingCenter = .false. + end function + + integer function GetMudBucket() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMudBucket + !DEC$ ATTRIBUTES ALIAS: 'GetMudBucket' :: GetMudBucket + implicit none + GetMudBucket = Get_MudBucket() + end function + + integer function GetElevator() + !DEC$ ATTRIBUTES DLLEXPORT :: GetElevator + !DEC$ ATTRIBUTES ALIAS: 'GetElevator' :: GetElevator + implicit none + GetElevator = Get_Elevator() + end function + + integer function GetFlow() + !DEC$ ATTRIBUTES DLLEXPORT :: GetFlow + !DEC$ ATTRIBUTES ALIAS: 'GetFlow' :: GetFlow + implicit none + GetFlow = 0 + end function + + integer function GetFillupHead() + !DEC$ ATTRIBUTES DLLEXPORT :: GetFillupHead + !DEC$ ATTRIBUTES ALIAS: 'GetFillupHead' :: GetFillupHead + implicit none + GetFillupHead = Get_FillupHead() + end function + + integer function GetIbop() + !DEC$ ATTRIBUTES DLLEXPORT :: GetIbop + !DEC$ ATTRIBUTES ALIAS: 'GetIbop' :: GetIbop + implicit none + GetIbop = Get_Ibop() + end function + + integer function GetKelly() + !DEC$ ATTRIBUTES DLLEXPORT :: GetKelly + !DEC$ ATTRIBUTES ALIAS: 'GetKelly' :: GetKelly + implicit none + GetKelly = Get_Kelly() + end function + + integer function GetMouseHole() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMouseHole + !DEC$ ATTRIBUTES ALIAS: 'GetMouseHole' :: GetMouseHole + implicit none + GetMouseHole = Get_MouseHole() + end function + + integer function GetOperationCondition() + !DEC$ ATTRIBUTES DLLEXPORT :: GetOperationCondition + !DEC$ ATTRIBUTES ALIAS: 'GetOperationCondition' :: GetOperationCondition + implicit none + GetOperationCondition = Get_OperationCondition() + end function + + integer function GetSafetyValve() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSafetyValve + !DEC$ ATTRIBUTES ALIAS: 'GetSafetyValve' :: GetSafetyValve + implicit none + GetSafetyValve = Get_SafetyValve() + end function + + integer function GetSlips() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSlips + !DEC$ ATTRIBUTES ALIAS: 'GetSlips' :: GetSlips + implicit none + GetSlips = Get_Slips() + end function + + integer function GetSwing() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSwing + !DEC$ ATTRIBUTES ALIAS: 'GetSwing' :: GetSwing + implicit none + GetSwing = Get_Swing() + end function + + + + + integer function GetTong() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTong + !DEC$ ATTRIBUTES ALIAS: 'GetTong' :: GetTong + implicit none + GetTong = Get_Tong() + end function + + integer function GetStringUpdateU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetStringUpdateU + !DEC$ ATTRIBUTES ALIAS: 'GetStringUpdateU' :: GetStringUpdateU + implicit none + GetStringUpdateU = Get_StringUpdate() + end function + + + + real(8) function GetNewHookHeightU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetNewHookHeightU + !DEC$ ATTRIBUTES ALIAS: 'GetNewHookHeightU' :: GetNewHookHeightU + implicit none + !GetNewHookHeightU = Get_NewHookHeight() + GetNewHookHeightU = 0d0 + end function + + real(8) function GetBlowoutFromStringPercentU() + !DEC$ ATTRIBUTES DLLEXPORT :: GetBlowoutFromStringPercentU + !DEC$ ATTRIBUTES ALIAS: 'GetBlowoutFromStringPercentU' :: GetBlowoutFromStringPercentU + implicit none + GetBlowoutFromStringPercentU = GetBlowoutFromStringPercent() + end function + + + + + + logical function GetMakeupTong() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMakeupTong + !DEC$ ATTRIBUTES ALIAS: 'GetMakeupTong' :: GetMakeupTong + implicit none + !GetMakeupTong = Get_MakeupTong() + GetMakeupTong = .false. + end function + + logical function GetBreakupTong() + !DEC$ ATTRIBUTES DLLEXPORT :: GetBreakupTong + !DEC$ ATTRIBUTES ALIAS: 'GetBreakupTong' :: GetBreakupTong + implicit none + !GetBreakupTong = Get_BreakupTong() + GetBreakupTong = .false. + end function + + logical function GetSlipsSet() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSlipsSet + !DEC$ ATTRIBUTES ALIAS: 'GetSlipsSet' :: GetSlipsSet + implicit none + !GetSlipsSet = Get_SlipsSetU() + GetSlipsSet = .false. + end function + + logical function GetSlipsUnSet() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSlipsUnSet + !DEC$ ATTRIBUTES ALIAS: 'GetSlipsUnSet' :: GetSlipsUnSet + implicit none + !GetSlipsUnSet = Get_SlipsUnSetU() + GetSlipsUnSet = .false. + end function + + logical function GetLatch() + !DEC$ ATTRIBUTES DLLEXPORT :: GetLatch + !DEC$ ATTRIBUTES ALIAS: 'GetLatch' :: GetLatch + implicit none + !GetLatch = Get_Latch() + GetLatch = .false. + end function + + logical function GetUnlatch() + !DEC$ ATTRIBUTES DLLEXPORT :: GetUnlatch + !DEC$ ATTRIBUTES ALIAS: 'GetUnlatch' :: GetUnlatch + implicit none + !GetUnlatch = Get_Unlatch() + GetUnlatch = .false. + end function + + logical function GetOutOfMouseHole() + !DEC$ ATTRIBUTES DLLEXPORT :: GetOutOfMouseHole + !DEC$ ATTRIBUTES ALIAS: 'GetOutOfMouseHole' :: GetOutOfMouseHole + implicit none + !GetOutOfMouseHole = Get_OutOfMouseHole() + GetOutOfMouseHole = .false. + end function + + logical function GetIsKellyBushingSetInTable() + !DEC$ ATTRIBUTES DLLEXPORT :: GetIsKellyBushingSetInTable + !DEC$ ATTRIBUTES ALIAS: 'GetIsKellyBushingSetInTable' :: GetIsKellyBushingSetInTable + implicit none + GetIsKellyBushingSetInTable = Get_IsKellyBushingSetInTable() + end function + + + + + + + + + + ! TempVars + logical function GetSignal1U() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal1U + !DEC$ ATTRIBUTES ALIAS: 'GetSignal1U' :: GetSignal1U + implicit none + !GetSignal1U = GetSignal1() + GetSignal1U = .false. + end function + + logical function GetSignal2U() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal2U + !DEC$ ATTRIBUTES ALIAS: 'GetSignal2U' :: GetSignal2U + implicit none + !GetSignal2U = GetSignal2() + GetSignal2U = .false. + end function + + logical function GetSignal3U() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal3U + !DEC$ ATTRIBUTES ALIAS: 'GetSignal3U' :: GetSignal3U + implicit none + !GetSignal3U = GetSignal3() + GetSignal3U = .false. + end function + + logical function GetSignal4U() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal4U + !DEC$ ATTRIBUTES ALIAS: 'GetSignal4U' :: GetSignal4U + implicit none + !GetSignal4U = GetSignal4() + GetSignal4U = .false. + end function + + logical function GetSignal5U() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal5U + !DEC$ ATTRIBUTES ALIAS: 'GetSignal5U' :: GetSignal5U + implicit none + !GetSignal5U = GetSignal5() + GetSignal5U = .false. + end function + + logical function GetSignal6U() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal6U + !DEC$ ATTRIBUTES ALIAS: 'GetSignal6U' :: GetSignal6U + implicit none + !GetSignal6U = GetSignal6() + GetSignal6U = .false. + end function + + logical function GetSignal7U() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal7U + !DEC$ ATTRIBUTES ALIAS: 'GetSignal7U' :: GetSignal7U + implicit none + !GetSignal7U = GetSignal7() + GetSignal7U = .false. + end function + + logical function GetSignal8U() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal8U + !DEC$ ATTRIBUTES ALIAS: 'GetSignal8U' :: GetSignal8U + implicit none + !GetSignal8U = GetSignal8() + GetSignal8U = .false. + end function + + logical function GetSignal9U() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal9U + !DEC$ ATTRIBUTES ALIAS: 'GetSignal9U' :: GetSignal9U + implicit none + !GetSignal9U = GetSignal9() + GetSignal9U = .false. + end function + + logical function GetSignal10U() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal10U + !DEC$ ATTRIBUTES ALIAS: 'GetSignal10U' :: GetSignal10U + implicit none + !GetSignal10U = GetSignal10() + GetSignal10U = .false. + end function + + + real(8) function GetTopJiontHeight() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTopJiontHeight + !DEC$ ATTRIBUTES ALIAS: 'GetTopJiontHeight' :: GetTopJiontHeight + use TD_DrillStemComponents + implicit none + GetTopJiontHeight = TD_TopJointHeight + end function + + + + logical function GetBlowoutFromStringT() + !DEC$ ATTRIBUTES DLLEXPORT :: GetBlowoutFromStringT + !DEC$ ATTRIBUTES ALIAS: 'GetBlowoutFromStringT' :: GetBlowoutFromStringT + implicit none + GetBlowoutFromStringT = Get_BlowoutFromString() + end function + + logical function GetBlowoutFromAnnularT() + !DEC$ ATTRIBUTES DLLEXPORT :: GetBlowoutFromAnnularT + !DEC$ ATTRIBUTES ALIAS: 'GetBlowoutFromAnnularT' :: GetBlowoutFromAnnularT + implicit none + GetBlowoutFromAnnularT = Get_BlowoutFromAnnular() + end function + + logical function GetFlowFromReturnLineT() + !DEC$ ATTRIBUTES DLLEXPORT :: GetFlowFromReturnLineT + !DEC$ ATTRIBUTES ALIAS: 'GetFlowFromReturnLineT' :: GetFlowFromReturnLineT + implicit none + GetFlowFromReturnLineT = Get_FlowFromReturnLine() + end function + + real function GetFlowFromKellyT() + !DEC$ ATTRIBUTES DLLEXPORT :: GetFlowFromKellyT + !DEC$ ATTRIBUTES ALIAS: 'GetFlowFromKellyT' :: GetFlowFromKellyT + implicit none + GetFlowFromKellyT = Get_FlowFromKelly() + end function + + logical function GetFlowKellyDisconnectT() + !DEC$ ATTRIBUTES DLLEXPORT :: GetFlowKellyDisconnectT + !DEC$ ATTRIBUTES ALIAS: 'GetFlowKellyDisconnectT' :: GetFlowKellyDisconnectT + implicit none + GetFlowKellyDisconnectT = Get_FlowKellyDisconnect() + end function + + logical function GetFlowPipeDisconnectT() + !DEC$ ATTRIBUTES DLLEXPORT :: GetFlowPipeDisconnectT + !DEC$ ATTRIBUTES ALIAS: 'GetFlowPipeDisconnectT' :: GetFlowPipeDisconnectT + implicit none + GetFlowPipeDisconnectT = Get_FlowPipeDisconnect() + end function + + + !integer function GetFlowKellyDisconnectT2() + !!DEC$ ATTRIBUTES DLLEXPORT :: GetFlowKellyDisconnectT2 + !!DEC$ ATTRIBUTES ALIAS: 'GetFlowKellyDisconnectT2' :: GetFlowKellyDisconnectT2 + ! implicit none + ! GetFlowKellyDisconnectT2 = Get_FlowKellyDisconnect2() + !end function + + !integer function GetFlowPipeDisconnectT2() + !!DEC$ ATTRIBUTES DLLEXPORT :: GetFlowPipeDisconnectT2 + !!DEC$ ATTRIBUTES ALIAS: 'GetFlowPipeDisconnectT2' :: GetFlowPipeDisconnectT2 + ! implicit none + ! GetFlowPipeDisconnectT2 = Get_FlowPipeDisconnect2() + !end function + + + logical function GetSingleOutOfMouseHole() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSingleOutOfMouseHole + !DEC$ ATTRIBUTES ALIAS: 'GetSingleOutOfMouseHole' :: GetSingleOutOfMouseHole + implicit none + GetSingleOutOfMouseHole = .true. !Get_SingleOutOfMouseHole() + end function + + + + + + + + + + + + + + + + + + integer function GetTdsSwing() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTdsSwing + !DEC$ ATTRIBUTES ALIAS: 'GetTdsSwing' :: GetTdsSwing + use CTdsSwingEnumVariables + implicit none + GetTdsSwing = Get_TdsSwing() + end function + + integer function GetTdsSpine() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTdsSpine + !DEC$ ATTRIBUTES ALIAS: 'GetTdsSpine' :: GetTdsSpine + use CTdsSpineEnumVariables + implicit none + GetTdsSpine = Get_TdsSpine() + end function + + integer function GetTdsTong() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTdsTong + !DEC$ ATTRIBUTES ALIAS: 'GetTdsTong' :: GetTdsTong + use CTdsTongEnumVariables + implicit none + GetTdsTong = Get_TdsTong() + end function + + integer function GetTdsBackupClamp() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTdsBackupClamp + !DEC$ ATTRIBUTES ALIAS: 'GetTdsBackupClamp' :: GetTdsBackupClamp + use CTdsBackupClampVariables + implicit none + GetTdsBackupClamp = Get_TdsBackupClamp() + end function + + + + + + logical function GetTdsConnectionPossibility() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTdsConnectionPossibility + !DEC$ ATTRIBUTES ALIAS: 'GetTdsConnectionPossibility' :: GetTdsConnectionPossibility + implicit none + GetTdsConnectionPossibility = Get_TdsConnectionPossible() + end function + + logical function GetTdsStemIn() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTdsStemIn + !DEC$ ATTRIBUTES ALIAS: 'GetTdsStemIn' :: GetTdsStemIn + implicit none + GetTdsStemIn = Get_TdsStemIn() + end function + + + + logical function GetFillupHeadPermission() + !DEC$ ATTRIBUTES DLLEXPORT :: GetFillupHeadPermission + !DEC$ ATTRIBUTES ALIAS: 'GetFillupHeadPermission' :: GetFillupHeadPermission + use CFillupHeadPermissionVariables + implicit none + GetFillupHeadPermission = Get_FillupHeadPermission() + end function + + logical function GetSwingDrillPermission() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSwingDrillPermission + !DEC$ ATTRIBUTES ALIAS: 'GetSwingDrillPermission' :: GetSwingDrillPermission + use CSwingDrillPermissionVariables + implicit none + GetSwingDrillPermission = Get_SwingDrillPermission() + end function + + logical function GetSwingOffPermission() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSwingOffPermission + !DEC$ ATTRIBUTES ALIAS: 'GetSwingOffPermission' :: GetSwingOffPermission + use CSwingOffPermissionVariables + implicit none + GetSwingOffPermission = Get_SwingOffPermission() + end function + + logical function GetSwingTiltPermission() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSwingTiltPermission + !DEC$ ATTRIBUTES ALIAS: 'GetSwingTiltPermission' :: GetSwingTiltPermission + use CSwingTiltPermissionVariables + implicit none + GetSwingTiltPermission = Get_SwingTiltPermission() + end function + + + real(8) function GetTdsStemJointHeight() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTdsStemJointHeight + !DEC$ ATTRIBUTES ALIAS: 'GetTdsStemJointHeight' :: GetTdsStemJointHeight + implicit none + GetTdsStemJointHeight = 10.0 + end function + + + + integer function GetTdsConnectionModes() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTdsConnectionModes + !DEC$ ATTRIBUTES ALIAS: 'GetTdsConnectionModes' :: GetTdsConnectionModes + use CTdsConnectionModesEnumVariables + implicit none + GetTdsConnectionModes = Get_TdsConnectionModes() + end function + + integer function GetTdsElevatorModes() + !DEC$ ATTRIBUTES DLLEXPORT :: GetTdsElevatorModes + !DEC$ ATTRIBUTES ALIAS: 'GetTdsElevatorModes' :: GetTdsElevatorModes + use CTdsElevatorModesEnumVariables + implicit none + GetTdsElevatorModes = Get_TdsElevatorModes() + end function + +end module TestOperationScenarios \ No newline at end of file diff --git a/CSharp/OperationScenarios/Test/TestOperationScenariosVariables.f90 b/CSharp/OperationScenarios/Test/TestOperationScenariosVariables.f90 new file mode 100644 index 0000000..06b1f52 --- /dev/null +++ b/CSharp/OperationScenarios/Test/TestOperationScenariosVariables.f90 @@ -0,0 +1,96 @@ +module TestOperationScenariosVariables + implicit none + public + + ! Input vars + + ! Output vars + integer :: ElevatorConnection + integer :: KellyConnection + logical :: CloseKellyCockLed + logical :: CloseSafetyValveLed + logical :: FillMouseHoleLed + logical :: IrIBopLed + logical :: IrSafetyValveLed + logical :: LatchLed + logical :: OpenKellyCockLed + logical :: OpenSafetyValveLed + logical :: SlipsNotification + logical :: SwingLed + logical :: TongNotification + logical :: UnlatchLed + logical :: InstallFillupHeadPermission + logical :: InstallMudBucketPermission + logical :: IrIbopPermission + logical :: IrSafetyValvePermission + logical :: RemoveFillupHeadPermission + logical :: RemoveMudBucketPermission + real(8) :: HookHeightU + real(8) :: IbopHeight + real(8) :: NearFloorConnection + real(8) :: SafetyValveHeight + logical :: SlackOff + integer :: StandRackU + real(8) :: RotaryRpmU + real(8) :: StringPressure + logical :: ZeroStringSpeed + real(8) :: FlowRateU + real(8) :: PedalU + real(8) :: FloorHeightU + real(8) :: CrownHeightU + real(8) :: KellyHoseVibrationRateU + integer :: DriveTypeU + logical :: ElevatorConnected + logical :: JointConnectionPossibility + logical :: NearMonkeyBoardPosition + logical :: NearFloorPosition + logical :: SingleSetInMouseHole + logical :: SwingCenter + integer :: MudBucket + integer :: Elevator + integer :: Flow + integer :: FillupHead + integer :: Ibop + integer :: Kelly + integer :: MouseHole + integer :: OperationCondition + integer :: SafetyValve + integer :: Slips + integer :: Swing + integer :: Tong + integer :: StringUpdateU + integer :: NewHookHeightU + integer :: BlowoutFromStringPercentU + logical :: MakeupTong + logical :: BreakupTong + logical :: SlipsSet + logical :: SlipsUnSet + logical :: Latch + logical :: Unlatch + logical :: OutOfMouseHole + logical :: IsKellyBushingSetInTable + + + logical :: Signal1U + logical :: Signal2U + logical :: Signal3U + logical :: Signal4U + logical :: Signal5U + logical :: Signal6U + logical :: Signal7U + logical :: Signal8U + logical :: Signal9U + logical :: Signal10U + + logical :: BlowoutFromStringT + logical :: BlowoutFromAnnularT + logical :: FlowFromReturnLineT + logical :: FlowFromKellyT + logical :: FlowKellyDisconnectT + logical :: FlowPipeDisconnectT + + logical :: SingleOutOfMouseHole + + + contains +end module TestOperationScenariosVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/Unity/CUnityInputs.f90 b/CSharp/OperationScenarios/Unity/CUnityInputs.f90 new file mode 100644 index 0000000..2025c2a --- /dev/null +++ b/CSharp/OperationScenarios/Unity/CUnityInputs.f90 @@ -0,0 +1,632 @@ +module CUnityInputs + use CVoidEventHandlerCollection + implicit none + + logical :: ElevatorConnectionPossible + logical :: JointConnectionPossible + logical :: IsKellyBushingSetInTable + logical :: ElevatorPickup + logical :: NearFloorPosition + logical :: SingleSetInMouseHole + !logical :: SwingCenter + !logical :: MakeupTong + !logical :: BreakupTong + !logical :: SlipsSet + !logical :: SlipsUnSet + !logical :: Latch + !logical :: Unlatch + !logical :: OutOfMouseHole + !real(8) :: NewHookHeight + logical :: TdsConnectionPossible + logical :: TdsStemIn + + + private :: ElevatorConnectionPossible + private :: JointConnectionPossible + private :: IsKellyBushingSetInTable + private :: ElevatorPickup + private :: NearFloorPosition + private :: singleSetInMouseHole + !private :: SwingCenter + !private :: MakeupTong + !private :: BreakupTong + !private :: SlipsSet + !private :: SlipsUnSet + !private :: Latch + !private :: Unlatch + !private :: OutOfMouseHole + !private :: NewHookHeight + private :: TdsConnectionPossible + private :: TdsStemIn + + public + + type(VoidEventHandlerCollection) :: OnElevatorConnectionPossibleChange + type(VoidEventHandlerCollection) :: OnJointConnectionPossibleChange + type(VoidEventHandlerCollection) :: OnIsKellyBushingSetInTableChange + type(VoidEventHandlerCollection) :: OnElevatorPickupChange + type(VoidEventHandlerCollection) :: OnNearFloorPositionChange + type(VoidEventHandlerCollection) :: OnSingleSetInMouseHoleChange + !type(VoidEventHandlerCollection) :: OnSwingCenterChange + !type(VoidEventHandlerCollection) :: OnNewHookHeightChange + + !type(VoidEventHandlerCollection) :: OnMakeupTongChange + !type(VoidEventHandlerCollection) :: OnBreakupTongChange + !type(VoidEventHandlerCollection) :: OnSlipsSetChange + !type(VoidEventHandlerCollection) :: OnSlipsUnSetChange + !type(VoidEventHandlerCollection) :: OnLatchChange + !type(VoidEventHandlerCollection) :: OnUnlatchChange + !type(VoidEventHandlerCollection) :: OnOutOfMouseHoleChange + + type(VoidEventHandlerCollection) :: OnTdsConnectionPossibleChange + type(VoidEventHandlerCollection) :: OnTdsStemInChange + + contains + + ! Input routines + + + subroutine Set_OutOfMouseHole(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_OutOfMouseHole + !DEC$ ATTRIBUTES ALIAS: 'Set_OutOfMouseHole' :: Set_OutOfMouseHole + implicit none + logical, intent(in) :: v +!#ifdef ExcludeExtraChanges +! if(OutOfMouseHole == v) return +!#endif +! OutOfMouseHole = v +! call OnOutOfMouseHoleChange%RunAll() +!#ifdef deb +! print*, 'OutOfMouseHole=', OutOfMouseHole +!#endif + end subroutine + + !logical function Get_OutOfMouseHole() + ! implicit none + ! Get_OutOfMouseHole = OutOfMouseHole + !end function + + + + + + + + + + + + + subroutine Set_Unlatch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_Unlatch + !DEC$ ATTRIBUTES ALIAS: 'Set_Unlatch' :: Set_Unlatch + implicit none + logical, intent(in) :: v +!#ifdef ExcludeExtraChanges +! if(Unlatch == v) return +!#endif +! Unlatch = v +! call OnUnlatchChange%RunAll() +!#ifdef deb +! print*, 'Unlatch=', Unlatch +!#endif + end subroutine + + !logical function Get_Unlatch() + ! implicit none + ! Get_Unlatch = Unlatch + !end function + + + + + + + + + + + + + + + subroutine Set_Latch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_Latch + !DEC$ ATTRIBUTES ALIAS: 'Set_Latch' :: Set_Latch + implicit none + logical, intent(in) :: v +!#ifdef ExcludeExtraChanges +! if(Latch == v) return +!#endif +! Latch = v +! call OnLatchChange%RunAll() +!#ifdef deb +! print*, 'Latch=', Latch +!#endif + end subroutine + + !logical function Get_Latch() + ! implicit none + ! Get_Latch = Latch + !end function + + + + + + + + + + + + + + + + + subroutine Set_SlipsUnSet(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_SlipsUnSet + !DEC$ ATTRIBUTES ALIAS: 'Set_SlipsUnSet' :: Set_SlipsUnSet + implicit none + logical, intent(in) :: v +!#ifdef ExcludeExtraChanges +! if(SlipsUnSet == v) return +!#endif +! SlipsUnSet = v +! call OnSlipsUnSetChange%RunAll() +!#ifdef deb +! print*, 'SlipsUnSet=', SlipsUnSet +!#endif + end subroutine + + !logical function Get_SlipsUnSet() + ! implicit none + ! Get_SlipsUnSet = SlipsUnSet + !end function + + + + + + + + + + + + + + subroutine Set_SlipsSet(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_SlipsSet + !DEC$ ATTRIBUTES ALIAS: 'Set_SlipsSet' :: Set_SlipsSet + implicit none + logical, intent(in) :: v +!#ifdef ExcludeExtraChanges +! if(SlipsSet == v) return +!#endif +! SlipsSet = v +! call OnSlipsSetChange%RunAll() +!#ifdef deb +! print*, 'SlipsSet=', SlipsSet +!#endif + end subroutine + + !logical function Get_SlipsSet() + ! implicit none + ! Get_SlipsSet = SlipsSet + !end function + + + + + + + + + + + + subroutine Set_BreakupTong(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_BreakupTong + !DEC$ ATTRIBUTES ALIAS: 'Set_BreakupTong' :: Set_BreakupTong + implicit none + logical, intent(in) :: v +!#ifdef ExcludeExtraChanges +! if(BreakupTong == v) return +!#endif +! BreakupTong = v +! call OnBreakupTongChange%RunAll() +!#ifdef deb +! print*, 'BreakupTong=', BreakupTong +!#endif + end subroutine + + !logical function Get_BreakupTong() + ! implicit none + ! Get_BreakupTong = BreakupTong + !end function + + + + + + + + + + subroutine Set_MakeupTong(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_MakeupTong + !DEC$ ATTRIBUTES ALIAS: 'Set_MakeupTong' :: Set_MakeupTong + implicit none + logical, intent(in) :: v +!#ifdef ExcludeExtraChanges +! if(MakeupTong == v) return +!#endif +! MakeupTong = v +! call OnMakeupTongChange%RunAll() +!#ifdef deb +! print*, 'MakeupTong=', MakeupTong +!#endif + end subroutine + + !logical function Get_MakeupTong() + ! implicit none + ! Get_MakeupTong = MakeupTong + !end function + + + + + + + + + + + + + + + + + + + + + + subroutine Set_NewHookHeight(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_NewHookHeight + !DEC$ ATTRIBUTES ALIAS: 'Set_NewHookHeight' :: Set_NewHookHeight + implicit none + real(8), intent(in) :: v +!#ifdef ExcludeExtraChanges +! if(NewHookHeight == v) return +!#endif +! NewHookHeight = v +! call OnNewHookHeightChange%RunAll() +!#ifdef deb +! print*, 'NewHookHeight=', NewHookHeight +!#endif + end subroutine + + !real(8) function Get_NewHookHeight() + ! implicit none + ! Get_NewHookHeight = NewHookHeight + !end function + + + + + + + + + + subroutine Set_ElevatorConnectionPossible(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_ElevatorConnectionPossible + !DEC$ ATTRIBUTES ALIAS: 'Set_ElevatorConnectionPossible' :: Set_ElevatorConnectionPossible + implicit none + logical, intent(in) :: v +#ifdef ExcludeExtraChanges + if(ElevatorConnectionPossible == v) return +#endif + ElevatorConnectionPossible = v + call OnElevatorConnectionPossibleChange%RunAll() +#ifdef deb + print*, 'ElevatorConnectionPossible=', ElevatorConnectionPossible +#endif + end subroutine + + logical function Get_ElevatorConnectionPossible() + implicit none + Get_ElevatorConnectionPossible = ElevatorConnectionPossible + end function + + logical function Get_ElevatorConnectionPossible_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_ElevatorConnectionPossible_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_ElevatorConnectionPossible_WN' :: Get_ElevatorConnectionPossible_WN + implicit none + Get_ElevatorConnectionPossible_WN = ElevatorConnectionPossible + !Get_ElevatorConnectionPossible_WN = .true. + end function + + + + + + + + + subroutine Set_JointConnectionPossible(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_JointConnectionPossible + !DEC$ ATTRIBUTES ALIAS: 'Set_JointConnectionPossible' :: Set_JointConnectionPossible + implicit none + logical, intent(in) :: v +#ifdef ExcludeExtraChanges + if(JointConnectionPossible == v) return +#endif + JointConnectionPossible = v + call OnJointConnectionPossibleChange%RunAll() +#ifdef deb + print*, 'JointConnectionPossible=', JointConnectionPossible +#endif + end subroutine + + logical function Get_JointConnectionPossible() + implicit none + Get_JointConnectionPossible = JointConnectionPossible + end function + + + logical function Get_JointConnectionPossible_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_JointConnectionPossible_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_JointConnectionPossible_WN' :: Get_JointConnectionPossible_WN + implicit none + Get_JointConnectionPossible_WN = JointConnectionPossible + end function + + + + + + subroutine Set_IsKellyBushingSetInTable(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_IsKellyBushingSetInTable + !DEC$ ATTRIBUTES ALIAS: 'Set_IsKellyBushingSetInTable' :: Set_IsKellyBushingSetInTable + implicit none + logical, intent(in) :: v +#ifdef ExcludeExtraChanges + if(IsKellyBushingSetInTable == v) return +#endif + IsKellyBushingSetInTable = v + call OnIsKellyBushingSetInTableChange%RunAll() +#ifdef deb + print*, 'IsKellyBushingSetInTable=', IsKellyBushingSetInTable +#endif + end subroutine + + logical function Get_IsKellyBushingSetInTable() + implicit none + Get_IsKellyBushingSetInTable = IsKellyBushingSetInTable + end function + + logical function Get_IsKellyBushingSetInTable_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_IsKellyBushingSetInTable_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_IsKellyBushingSetInTable_WN' :: Get_IsKellyBushingSetInTable_WN + implicit none + Get_IsKellyBushingSetInTable_WN = IsKellyBushingSetInTable + end function + + + + + + + + subroutine Set_ElevatorPickup(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_ElevatorPickup + !DEC$ ATTRIBUTES ALIAS: 'Set_ElevatorPickup' :: Set_ElevatorPickup + implicit none + logical, intent(in) :: v +#ifdef ExcludeExtraChanges + if(ElevatorPickup == v) return +#endif + ElevatorPickup = v + call OnElevatorPickupChange%RunAll() +#ifdef deb + print*, 'ElevatorPickup =', ElevatorPickup +#endif + end subroutine + + logical function Get_ElevatorPickup() + implicit none + Get_ElevatorPickup = ElevatorPickup + end function + + + logical function Get_ElevatorPickup_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_ElevatorPickup_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_ElevatorPickup_WN' :: Get_ElevatorPickup_WN + implicit none + Get_ElevatorPickup_WN = ElevatorPickup + end function + + + + + + + + subroutine Set_NearFloorPosition(v) + implicit none + logical, intent(in) :: v +#ifdef ExcludeExtraChanges + if(NearFloorPosition == v) return +#endif + NearFloorPosition = v + call OnNearFloorPositionChange%RunAll() +#ifdef deb + print*, 'NearFloorPosition =', NearFloorPosition +#endif + end subroutine + + subroutine Set_NearFloorPosition_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_NearFloorPosition_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_NearFloorPosition_WN' :: Set_NearFloorPosition_WN + implicit none + logical, intent(in) :: v + call Set_NearFloorPosition(v) + end subroutine + + logical function Get_NearFloorPosition() + implicit none + Get_NearFloorPosition = NearFloorPosition + end function + + + logical function Get_NearFloorPosition_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_NearFloorPosition_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_NearFloorPosition_WN' :: Get_NearFloorPosition_WN + implicit none + Get_NearFloorPosition_WN = NearFloorPosition + end function + + + + + + + + + + subroutine Set_SingleSetInMouseHole(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_SingleSetInMouseHole + !DEC$ ATTRIBUTES ALIAS: 'Set_SingleSetInMouseHole' :: Set_SingleSetInMouseHole + implicit none + logical, intent(in) :: v +#ifdef ExcludeExtraChanges + if(SingleSetInMouseHole == v) return +#endif + SingleSetInMouseHole = v + call OnSingleSetInMouseHoleChange%RunAll() +#ifdef deb + print*, 'singleSetInMouseHole=', SingleSetInMouseHole +#endif + end subroutine + + logical function Get_SingleSetInMouseHole() + implicit none + Get_SingleSetInMouseHole = SingleSetInMouseHole + end function + + + logical function Get_SingleSetInMouseHole_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_SingleSetInMouseHole_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_SingleSetInMouseHole_WN' :: Get_SingleSetInMouseHole_WN + implicit none + Get_SingleSetInMouseHole_WN = SingleSetInMouseHole + end function + + + + + + + + + subroutine Set_SwingCenter(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_SwingCenter + !DEC$ ATTRIBUTES ALIAS: 'Set_SwingCenter' :: Set_SwingCenter + !USE CSwingEnum + implicit none + logical, intent(in) :: v +!#ifdef ExcludeExtraChanges +! if(SwingCenter == v) return +!#endif +! SwingCenter = v +! call OnSwingCenterChange%RunAll() +! !if(SwingCenter .and. Get_Swing() /= SWING_WELL ) call Set_Swing(SWING_WELL) +!#ifdef deb +! print*, 'SwingCenter=', SwingCenter +!#endif + end subroutine + + !logical function Get_SwingCenter() + ! implicit none + ! Get_SwingCenter = SwingCenter + !end function + + + + + + + + + + + + + !top drive + subroutine Set_TdsConnectionPossible(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_TdsConnectionPossible + !DEC$ ATTRIBUTES ALIAS: 'Set_TdsConnectionPossible' :: Set_TdsConnectionPossible + implicit none + logical, intent(in) :: v +#ifdef ExcludeExtraChanges + if(TdsConnectionPossible == v) return +#endif + TdsConnectionPossible = v + call OnTdsConnectionPossibleChange%RunAll() +#ifdef deb + print*, 'TdsConnectionPossible=', TdsConnectionPossible +#endif + end subroutine + + logical function Get_TdsConnectionPossible() + implicit none + Get_TdsConnectionPossible = TdsConnectionPossible + end function + + logical function Get_TdsConnectionPossible_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_TdsConnectionPossible_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_TdsConnectionPossible_WN' :: Get_TdsConnectionPossible_WN + implicit none + Get_TdsConnectionPossible_WN = TdsConnectionPossible + !Get_TdsConnectionPossible_WN = .true. + end function + + + + subroutine Set_TdsStemIn(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_TdsStemIn + !DEC$ ATTRIBUTES ALIAS: 'Set_TdsStemIn' :: Set_TdsStemIn + implicit none + logical, intent(in) :: v +#ifdef ExcludeExtraChanges + if(TdsStemIn == v) return +#endif + TdsStemIn = v + call OnTdsStemInChange%RunAll() +#ifdef deb + print*, 'TdsStemIn=', TdsStemIn +#endif + end subroutine + + logical function Get_TdsStemIn() + implicit none + Get_TdsStemIn = TdsStemIn + end function + + logical function Get_TdsStemIn_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_TdsStemIn_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_TdsStemIn_WN' :: Get_TdsStemIn_WN + implicit none + Get_TdsStemIn_WN = TdsStemIn + !Get_TdsStemIn_WN = .true. + end function + + + + +end module CUnityInputs diff --git a/CSharp/OperationScenarios/Unity/CUnityOutputs.f90 b/CSharp/OperationScenarios/Unity/CUnityOutputs.f90 new file mode 100644 index 0000000..60e559a --- /dev/null +++ b/CSharp/OperationScenarios/Unity/CUnityOutputs.f90 @@ -0,0 +1,627 @@ +module CUnityOutputs + implicit none + + real(8) :: KellyHoseVibrationRate + real(8) :: BlowoutFromStringPercent + real(8) :: Pedal + real(8) :: FlowRate + real(8) :: RotaryRpm + !logical :: Signal1 + !logical :: Signal2 + !logical :: Signal3 + !logical :: Signal4 + !logical :: Signal5 + !logical :: Signal6 + !logical :: Signal7 + !logical :: Signal8 + !logical :: Signal9 + !logical :: Signal10 + logical :: BlowoutFromString + logical :: BlowoutFromAnnular + logical :: FlowFromReturnLine + real :: FlowFromKelly + real :: FlowFromFillupHead + logical :: FlowKellyDisconnect + logical :: FlowPipeDisconnect + + + private :: KellyHoseVibrationRate + private :: BlowoutFromStringPercent + private :: Pedal + private :: FlowRate + private :: RotaryRpm + !private :: Signal1 + !private :: Signal2 + !private :: Signal3 + !private :: Signal4 + !private :: Signal5 + !private :: Signal6 + !private :: Signal7 + !private :: Signal8 + !private :: Signal9 + !private :: Signal10 + private :: BlowoutFromString + private :: BlowoutFromAnnular + private :: FlowFromReturnLine + private :: FlowFromKelly + private :: FlowFromFillupHead + private :: FlowKellyDisconnect + private :: FlowPipeDisconnect + + public + + contains + + subroutine Setup() + use CDataDisplayConsoleVariables + implicit none + PumpsSpmChanges => Calc_KellyHoseVibrationRate + call OnRotaryRpmChange%Add(Set_RotaryRpm) + end subroutine + + + + + + + + + + + subroutine Set_BlowoutFromString(v) + implicit none + logical, intent (in) :: v + BlowoutFromString = v +#ifdef deb + print*, 'BlowoutFromString=', v +#endif + end subroutine + + logical function Get_BlowoutFromString() + implicit none + Get_BlowoutFromString = BlowoutFromString + end function + + subroutine Set_BlowoutFromString_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_BlowoutFromString_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_BlowoutFromString_WN' :: Set_BlowoutFromString_WN + implicit none + logical, intent (in) :: v + call Set_BlowoutFromString(v) + end subroutine + + logical function Get_BlowoutFromString_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_BlowoutFromString_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_BlowoutFromString_WN' :: Get_BlowoutFromString_WN + implicit none + Get_BlowoutFromString_WN = BlowoutFromString + !Get_BlowoutFromString = .TRUE. + end function + + + + subroutine Set_BlowoutFromAnnular(v) + implicit none + logical, intent (in) :: v + BlowoutFromAnnular = v +#ifdef deb + print*, 'BlowoutFromAnnular=', v +#endif + end subroutine + + logical function Get_BlowoutFromAnnular() + implicit none + Get_BlowoutFromAnnular = BlowoutFromAnnular + end function + + subroutine Set_BlowoutFromAnnular_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_BlowoutFromAnnular_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_BlowoutFromAnnular_WN' :: Set_BlowoutFromAnnular_WN + implicit none + logical, intent (in) :: v + call Set_BlowoutFromAnnular(v) + end subroutine + + logical function Get_BlowoutFromAnnular_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_BlowoutFromAnnular_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_BlowoutFromAnnular_WN' :: Get_BlowoutFromAnnular_WN + implicit none + Get_BlowoutFromAnnular_WN = BlowoutFromAnnular + end function + + + + + + subroutine Set_FlowFromReturnLine(v) + implicit none + logical, intent (in) :: v + FlowFromReturnLine = v +#ifdef deb + print*, 'FlowFromReturnLine=', v +#endif + end subroutine + + logical function Get_FlowFromReturnLine() + implicit none + Get_FlowFromReturnLine = FlowFromReturnLine + end function + + + subroutine Set_FlowFromReturnLine_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_FlowFromReturnLine_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_FlowFromReturnLine_WN' :: Set_FlowFromReturnLine_WN + implicit none + logical, intent (in) :: v + call Set_FlowFromReturnLine(v) + end subroutine + + logical function Get_FlowFromReturnLine_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_FlowFromReturnLine_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_FlowFromReturnLine_WN' :: Get_FlowFromReturnLine_WN + implicit none + Get_FlowFromReturnLine_WN = FlowFromReturnLine + !Get_FlowFromReturnLine_WN = .FALSE. + end function + + + + subroutine Set_FlowFromKelly(v) + implicit none + real, intent (in) :: v + FlowFromKelly = v +#ifdef deb + print*, 'FlowFromKelly=', v +#endif + end subroutine + + real function Get_FlowFromKelly() + implicit none + Get_FlowFromKelly = FlowFromKelly + end function + + + subroutine Set_FlowFromKelly_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_FlowFromKelly_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_FlowFromKelly_WN' :: Set_FlowFromKelly_WN + implicit none + real, intent (in) :: v + call Set_FlowFromKelly(v) + end subroutine + + real function Get_FlowFromKelly_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_FlowFromKelly_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_FlowFromKelly_WN' :: Get_FlowFromKelly_WN + implicit none +#ifdef deb + print*, 'FlowFromKellyR=', FlowFromKelly +#endif + Get_FlowFromKelly_WN = FlowFromKelly + !Get_FlowFromKelly = .FALSE. + end function + + + + + subroutine Set_FlowFromFillupHead(v) + implicit none + real, intent (in) :: v + FlowFromFillupHead = v +#ifdef deb + print*, 'FlowFromFillupHead=', v +#endif + end subroutine + + real function Get_FlowFromFillupHead() + implicit none + Get_FlowFromFillupHead = FlowFromFillupHead + end function + + + subroutine Set_FlowFromFillupHead_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_FlowFromFillupHead_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_FlowFromFillupHead_WN' :: Set_FlowFromFillupHead_WN + implicit none + real, intent (in) :: v + call Set_FlowFromFillupHead(v) + end subroutine + + real function Get_FlowFromFillupHead_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_FlowFromFillupHead_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_FlowFromFillupHead_WN' :: Get_FlowFromFillupHead_WN + implicit none +#ifdef deb + print*, 'FlowFromFillupHeadR=', FlowFromFillupHead +#endif + Get_FlowFromFillupHead_WN = FlowFromFillupHead + !Get_FlowFromFillupHead = .FALSE. + end function + + + + + + subroutine Set_FlowKellyDisconnect(v) + implicit none + logical, intent (in) :: v + FlowKellyDisconnect = v +#ifdef deb + print*, 'FlowKellyDisconnect=', v +#endif + end subroutine + + logical function Get_FlowKellyDisconnect() + implicit none + Get_FlowKellyDisconnect = FlowKellyDisconnect + end function + + + subroutine Set_FlowKellyDisconnect_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_FlowKellyDisconnect_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_FlowKellyDisconnect_WN' :: Set_FlowKellyDisconnect_WN + implicit none + logical, intent (in) :: v + call Set_FlowKellyDisconnect(v) + end subroutine + + logical function Get_FlowKellyDisconnect_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_FlowKellyDisconnect_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_FlowKellyDisconnect_WN' :: Get_FlowKellyDisconnect_WN + implicit none + Get_FlowKellyDisconnect_WN = FlowKellyDisconnect + !Get_FlowKellyDisconnect_WN = .false. + end function + + + + + subroutine Set_FlowPipeDisconnect(v) + implicit none + logical, intent (in) :: v + FlowPipeDisconnect = v +#ifdef deb + print*, 'FlowPipeDisconnect=', v +#endif + end subroutine + + logical function Get_FlowPipeDisconnect() + implicit none + Get_FlowPipeDisconnect = FlowPipeDisconnect + end function + + + subroutine Set_FlowPipeDisconnect_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_FlowPipeDisconnect_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_FlowPipeDisconnect_WN' :: Set_FlowPipeDisconnect_WN + implicit none + logical, intent (in) :: v + call Set_FlowPipeDisconnect(v) + end subroutine + + logical function Get_FlowPipeDisconnect_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_FlowPipeDisconnect_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_FlowPipeDisconnect_WN' :: Get_FlowPipeDisconnect_WN + implicit none + Get_FlowPipeDisconnect_WN = FlowPipeDisconnect + !Get_FlowPipeDisconnect_WN = .false. + end function + + + + + + + + + + + + + + + + + + + + + + + + + + + + subroutine Set_BlowoutFromStringPercent(v) + implicit none + real(8), intent (in) :: v + BlowoutFromStringPercent = v +#ifdef deb + print*, 'BlowoutFromStringPercent=', v +#endif + end subroutine + + real(8) function GetBlowoutFromStringPercent() + implicit none + GetBlowoutFromStringPercent = BlowoutFromStringPercent + end function + + + + subroutine Set_BlowoutFromStringPercent_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_BlowoutFromStringPercent_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_BlowoutFromStringPercent_WN' :: Set_BlowoutFromStringPercent_WN + implicit none + real(8), intent (in) :: v + call Set_BlowoutFromStringPercent(v) + end subroutine + + real(8) function GetBlowoutFromStringPercent_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: GetBlowoutFromStringPercent_WN + !DEC$ ATTRIBUTES ALIAS: 'GetBlowoutFromStringPercent_WN' :: GetBlowoutFromStringPercent_WN + implicit none + GetBlowoutFromStringPercent_WN = BlowoutFromStringPercent + !GetBlowoutFromStringPercent_WN = 0d0 + end function + + + + + + + + + subroutine Calc_KellyHoseVibrationRate(spm1, spm2) + use CScaleRange + implicit none + real(8), intent (in) :: spm1, spm2 + real :: total + total = (spm1 + spm2)/2 + KellyHoseVibrationRate = ScaleRange(total, 0.0, 10.0, 0.0, 120.0) +#ifdef deb + print*, 'KellyHoseVibrationRate=', KellyHoseVibrationRate +#endif + end subroutine + + real(8) function GetKellyHoseVibrationRate() + implicit none + GetKellyHoseVibrationRate = KellyHoseVibrationRate + end function + + real(8) function GetKellyHoseVibrationRate_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: GetKellyHoseVibrationRate_WN + !DEC$ ATTRIBUTES ALIAS: 'GetKellyHoseVibrationRate_WN' :: GetKellyHoseVibrationRate_WN + implicit none + GetKellyHoseVibrationRate_WN = KellyHoseVibrationRate + end function + + + + + subroutine Set_Pedal(v) + implicit none + real(8), intent (in) :: v + Pedal = v +#ifdef deb + print*, 'Pedal=', v +#endif + end subroutine + + real(8) function GetPedal() + implicit none + GetPedal = Pedal + end function + + subroutine Set_Pedal_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_Pedal_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_Pedal_WN' :: Set_Pedal_WN + implicit none + real(8), intent (in) :: v + call Set_Pedal(v) + end subroutine + + real(8) function GetPedal_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: GetPedal_WN + !DEC$ ATTRIBUTES ALIAS: 'GetPedal_WN' :: GetPedal_WN + implicit none + GetPedal_WN = Pedal + !GetPedal = 50d0 + end function + + + + + + subroutine Set_FlowRate(v) + implicit none + real(8), intent (in) :: v + FlowRate = v +#ifdef deb + print*, 'FlowRate=', v +#endif + end subroutine + + + real(8) function GetFlowRate() + implicit none + GetFlowRate = FlowRate + end function + + + subroutine Set_FlowRate_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_FlowRate_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_FlowRate_WN' :: Set_FlowRate_WN + implicit none + real(8), intent (in) :: v + call Set_FlowRate(v) + end subroutine + + real(8) function GetFlowRate_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: GetFlowRate_WN + !DEC$ ATTRIBUTES ALIAS: 'GetFlowRate_WN' :: GetFlowRate_WN + implicit none + GetFlowRate_WN = FlowRate + !GetFlowRate_WN = 50d0 + end function + + + + + subroutine Set_RotaryRpm(v) + implicit none + real(8), intent (in) :: v + RotaryRpm = v +#ifdef deb + print*, 'RotaryRpm=', v +#endif + end subroutine + + real(8) function GetRotaryRpm() + implicit none + GetRotaryRpm = RotaryRpm + end function + + + subroutine Set_RotaryRpm_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_RotaryRpm_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_RotaryRpm_WN' :: Set_RotaryRpm_WN + implicit none + real(8), intent (in) :: v + call Set_RotaryRpm(v) + end subroutine + + real(8) function GetRotaryRpm_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: GetRotaryRpm_WN + !DEC$ ATTRIBUTES ALIAS: 'GetRotaryRpm_WN' :: GetRotaryRpm_WN + implicit none + GetRotaryRpm_WN = RotaryRpm + end function + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + logical function GetSignal1() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal1 + !DEC$ ATTRIBUTES ALIAS: 'GetSignal1' :: GetSignal1 + implicit none + !GetSignal1 = Signal1 + GetSignal1 = .false. + end function + + logical function GetSignal2() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal2 + !DEC$ ATTRIBUTES ALIAS: 'GetSignal2' :: GetSignal2 + implicit none + !GetSignal2 = Signal2 + GetSignal2 = .false. + end function + + logical function GetSignal3() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal3 + !DEC$ ATTRIBUTES ALIAS: 'GetSignal3' :: GetSignal3 + implicit none + !GetSignal3 = Signal3 + GetSignal3 = .false. + end function + + logical function GetSignal4() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal4 + !DEC$ ATTRIBUTES ALIAS: 'GetSignal4' :: GetSignal4 + implicit none + !GetSignal4 = Signal4 + GetSignal4 = .false. + end function + + logical function GetSignal5() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal5 + !DEC$ ATTRIBUTES ALIAS: 'GetSignal5' :: GetSignal5 + implicit none + !GetSignal5 = Signal5 + GetSignal5 = .false. + end function + + logical function GetSignal6() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal6 + !DEC$ ATTRIBUTES ALIAS: 'GetSignal6' :: GetSignal6 + implicit none + !GetSignal6 = Signal6 + GetSignal6 = .false. + end function + + logical function GetSignal7() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal7 + !DEC$ ATTRIBUTES ALIAS: 'GetSignal7' :: GetSignal7 + implicit none + !GetSignal7 = Signal7 + GetSignal7 = .false. + end function + + logical function GetSignal8() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal8 + !DEC$ ATTRIBUTES ALIAS: 'GetSignal8' :: GetSignal8 + implicit none + !GetSignal8 = Signal8 + GetSignal8 = .false. + end function + + logical function GetSignal9() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal9 + !DEC$ ATTRIBUTES ALIAS: 'GetSignal9' :: GetSignal9 + implicit none + !GetSignal9 = Signal9 + GetSignal9 = .false. + end function + + logical function GetSignal10() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSignal10 + !DEC$ ATTRIBUTES ALIAS: 'GetSignal10' :: GetSignal10 + implicit none + !GetSignal10 = Signal10 + GetSignal10 = .false. + end function + + + +end module CUnityOutputs diff --git a/CSharp/OperationScenarios/UnitySignals/CBucketEnum.f90 b/CSharp/OperationScenarios/UnitySignals/CBucketEnum.f90 new file mode 100644 index 0000000..fbaf3fb --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CBucketEnum.f90 @@ -0,0 +1,93 @@ +module CBucketEnum + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_MudBucket() + use CStudentStationVariables, only: MudBoxInstallation + implicit none + + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_MudBucket=TopDrive' +!#endif +! endif +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_MudBucket=Kelly' +!#endif +! endif + + + if (Get_MudBucket() == MUD_BUCKET_INSTALL) then + MudBoxInstallation = .true. + else if (Get_MudBucket() == MUD_BUCKET_REMOVE) then + MudBoxInstallation = .false. + endif + + end subroutine + + ! subroutine Subscribe_MudBucket() + ! use CStudentStationVariables + ! implicit none + ! call OnMudBoxInstallationPress%Add(ButtonPress_MudBoxInstallation) + ! call OnMudBoxRemovePress%Add(ButtonPress_MudBoxRemove) + ! end subroutine + + subroutine ButtonPress_MudBoxInstallation() + implicit none + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'ButtonPress_MudBoxInstallation=TopDrive' +#endif + endif + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'ButtonPress_MudBoxInstallation=Kelly' +#endif + + + call Set_MudBucket(MUD_BUCKET_INSTALL) + + endif + + + + + + end subroutine + + subroutine ButtonPress_MudBoxRemove() + implicit none + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'ButtonPress_MudBoxRemove=TopDrive' +#endif + endif + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'ButtonPress_MudBoxRemove=Kelly' +#endif + + + call Set_MudBucket(MUD_BUCKET_REMOVE) + + endif + + + + + + + end subroutine + +end module CBucketEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CBucketEnumVariables.f90 b/CSharp/OperationScenarios/UnitySignals/CBucketEnumVariables.f90 new file mode 100644 index 0000000..7b3e5be --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CBucketEnumVariables.f90 @@ -0,0 +1,79 @@ +module CBucketEnumVariables + use CVoidEventHandlerCollection + implicit none + integer :: MudBucket = 0 + + public + + type(VoidEventHandlerCollection) :: OnMudBucketChange + + enum, bind(c) + !enumerator MUD_BUCKET_NEUTRAL + enumerator MUD_BUCKET_REMOVE + enumerator MUD_BUCKET_INSTALL + end enum + + private :: MudBucket + + contains + + subroutine Set_MudBucket(v) + use CManifolds, only: ToggleMudBox + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(MudBucket == v) return +#endif + MudBucket = v + if (MudBucket == MUD_BUCKET_INSTALL) then + call ToggleMudBox(.true.) + else if (MudBucket == MUD_BUCKET_REMOVE) then + call ToggleMudBox(.false.) + endif +#ifdef deb + print*, 'MudBucket=', MudBucket +#endif + call OnMudBucketChange%RunAll() + end subroutine + + integer function Get_MudBucket() + implicit none + Get_MudBucket = MudBucket + end function + + + + subroutine Set_MudBucket_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_MudBucket_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_MudBucket_WN' :: Set_MudBucket_WN + implicit none + integer , intent(in) :: v + call Set_MudBucket(v) + end subroutine + + integer function Get_MudBucket_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_MudBucket_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_MudBucket_WN' :: Get_MudBucket_WN + implicit none + Get_MudBucket_WN = MudBucket + end function + + + + + + logical function Get_RemoveMudBucket() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_RemoveMudBucket + !DEC$ ATTRIBUTES ALIAS: 'Get_RemoveMudBucket' :: Get_RemoveMudBucket + implicit none + Get_RemoveMudBucket = .false. ! MudBucket == REMOVE_MUD_BUCKET + end function + + logical function Get_InstallMudBucket() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_InstallMudBucket + !DEC$ ATTRIBUTES ALIAS: 'Get_InstallMudBucket' :: Get_InstallMudBucket + implicit none + Get_InstallMudBucket = .false. ! MudBucket == INSTALL_MUD_BUCKET + end function + +end module CBucketEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CElevatorEnum.f90 b/CSharp/OperationScenarios/UnitySignals/CElevatorEnum.f90 new file mode 100644 index 0000000..7f7a0c0 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CElevatorEnum.f90 @@ -0,0 +1,48 @@ +module CElevatorEnum + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_Elevator() + implicit none + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_Elevator=TopDrive' +!#endif +! +! +! +! +! +! +! +! +! +! +! +! +! +! +! +! +! +! endif +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_Elevator=Kelly' +!#endif +! endif + + end subroutine + + subroutine Subscribe_Elevator() + implicit none + ! imp me... + end subroutine + +end module CElevatorEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CElevatorEnumVariables.f90 b/CSharp/OperationScenarios/UnitySignals/CElevatorEnumVariables.f90 new file mode 100644 index 0000000..c42bcc6 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CElevatorEnumVariables.f90 @@ -0,0 +1,220 @@ +module CElevatorEnumVariables + use CVoidEventHandlerCollection + implicit none + integer :: Elevator = 0 + + public + + type(VoidEventHandlerCollection) :: OnElevatorChange + + enum, bind(c) + enumerator ELEVATOR_NEUTRAL + + enumerator ELEVATOR_LATCH_STRING_BEGIN + enumerator ELEVATOR_LATCH_STRING_END + + enumerator ELEVATOR_UNLATCH_STRING_BEGIN + enumerator ELEVATOR_UNLATCH_STRING_END + + enumerator ELEVATOR_LATCH_STAND_BEGIN + enumerator ELEVATOR_LATCH_STAND_END + + enumerator ELEVATOR_UNLATCH_STAND_BEGIN + enumerator ELEVATOR_UNLATCH_STAND_END + + enumerator ELEVATOR_LATCH_SINGLE_BEGIN + enumerator ELEVATOR_LATCH_SINGLE_END + + enumerator ELEVATOR_UNLATCH_SINGLE_BEGIN + enumerator ELEVATOR_UNLATCH_SINGLE_END + end enum + + private :: Elevator + contains + + subroutine Set_Elevator(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(Elevator == v) return +#endif + Elevator = v +#ifdef deb + print*, 'Elevator=', Elevator +#endif + call OnElevatorChange%RunAll() + end subroutine + + integer function Get_Elevator() + implicit none + Get_Elevator = Elevator + end function + + + subroutine Set_Elevator_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_Elevator_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_Elevator_WN' :: Set_Elevator_WN + implicit none + integer , intent(in) :: v + call Set_Elevator(v) + end subroutine + + integer function Get_Elevator_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_Elevator_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_Elevator_WN' :: Get_Elevator_WN + implicit none + Get_Elevator_WN = Elevator + end function + + + + + + + + + + subroutine ElevatorLatchStringEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: ElevatorLatchStringEnd + !DEC$ ATTRIBUTES ALIAS: 'ElevatorLatchStringEnd' :: ElevatorLatchStringEnd + implicit none +#ifdef deb + print*, 'ElevatorLatchStringEnd' +#endif + !if(Elevator /= ELEVATOR_LATCH_STRING_END) Elevator = ELEVATOR_LATCH_STRING_END + call Set_Elevator(ELEVATOR_LATCH_STRING_END) + end subroutine + + + subroutine ElevatorUnLatchStringEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: ElevatorUnLatchStringEnd + !DEC$ ATTRIBUTES ALIAS: 'ElevatorUnLatchStringEnd' :: ElevatorUnLatchStringEnd + implicit none +#ifdef deb + print*, 'ElevatorUnLatchStringEnd' +#endif + !if(Elevator /= ELEVATOR_UNLATCH_STRING_END) Elevator = ELEVATOR_UNLATCH_STRING_END + call Set_Elevator(ELEVATOR_UNLATCH_STRING_END) + end subroutine + + + subroutine ElevatorLatchStandEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: ElevatorLatchStandEnd + !DEC$ ATTRIBUTES ALIAS: 'ElevatorLatchStandEnd' :: ElevatorLatchStandEnd + !use CCommon, only: SetStandRack + !use CStandRack + implicit none +#ifdef deb + print*, 'ElevatorLatchStandEnd' +#endif + !if(Elevator /= ELEVATOR_LATCH_STAND_END) then + ! Elevator = ELEVATOR_LATCH_STAND_END + ! !call SetStandRack(Get_StandRack() - 1) + !endif + call Set_Elevator(ELEVATOR_LATCH_STAND_END) + end subroutine + + subroutine ElevatorUnLatchStandEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: ElevatorUnLatchStandEnd + !DEC$ ATTRIBUTES ALIAS: 'ElevatorUnLatchStandEnd' :: ElevatorUnLatchStandEnd + !use CCommon, only: SetStandRack + !use CStandRack + implicit none +#ifdef deb + print*, 'ElevatorUnLatchStandEnd' +#endif + !if(Elevator /= ELEVATOR_UNLATCH_STAND_END) then + ! Elevator = ELEVATOR_UNLATCH_STAND_END + ! !call SetStandRack(Get_StandRack() + 1) + !endif + call Set_Elevator(ELEVATOR_UNLATCH_STAND_END) + end subroutine + + subroutine ElevatorLatchSingleEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: ElevatorLatchSingleEnd + !DEC$ ATTRIBUTES ALIAS: 'ElevatorLatchSingleEnd' :: ElevatorLatchSingleEnd + implicit none +#ifdef deb + print*, 'ElevatorLatchSingleEnd' +#endif + !if(Elevator /= ELEVATOR_LATCH_SINGLE_END) Elevator = ELEVATOR_LATCH_SINGLE_END + call Set_Elevator(ELEVATOR_LATCH_SINGLE_END) + end subroutine + + subroutine ElevatorUnLatchSingleEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: ElevatorUnLatchSingleEnd + !DEC$ ATTRIBUTES ALIAS: 'ElevatorUnLatchSingleEnd' :: ElevatorUnLatchSingleEnd + implicit none +#ifdef deb + print*, 'ElevatorUnLatchSingleEnd' +#endif + !if(Elevator /= ELEVATOR_UNLATCH_SINGLE_END) Elevator = ELEVATOR_UNLATCH_SINGLE_END + call Set_Elevator(ELEVATOR_UNLATCH_SINGLE_END) + end subroutine + + + + + + + + + + + + + + + + + + + + + + + + + logical function Get_EvelatorLatchString() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_EvelatorLatchString + !DEC$ ATTRIBUTES ALIAS: 'Get_EvelatorLatchString' :: Get_EvelatorLatchString + implicit none + Get_EvelatorLatchString = .false. ! Elevator == ELEVATOR_LATCH_STRING + end function + + logical function Get_EvelatorLatchStand() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_EvelatorLatchStand + !DEC$ ATTRIBUTES ALIAS: 'Get_EvelatorLatchStand' :: Get_EvelatorLatchStand + implicit none + Get_EvelatorLatchStand = .false. ! Elevator == ELEVATOR_LATCH_STAND + end function + + logical function Get_EvelatorLatchSingle() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_EvelatorLatchSingle + !DEC$ ATTRIBUTES ALIAS: 'Get_EvelatorLatchSingle' :: Get_EvelatorLatchSingle + implicit none + Get_EvelatorLatchSingle = .false. ! Elevator == ELEVATOR_LATCH_SINGLE + end function + + logical function Get_EvelatorUnlatchString() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_EvelatorUnlatchString + !DEC$ ATTRIBUTES ALIAS: 'Get_EvelatorUnlatchString' :: Get_EvelatorUnlatchString + implicit none + Get_EvelatorUnlatchString = .false. ! Elevator == ELEVATOR_UNLATCH_STRING + end function + + logical function Get_EvelatorUnlatchStand() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_EvelatorUnlatchStand + !DEC$ ATTRIBUTES ALIAS: 'Get_EvelatorUnlatchStand' :: Get_EvelatorUnlatchStand + implicit none + Get_EvelatorUnlatchStand = .false. ! Elevator == ELEVATOR_UNLATCH_STAND + end function + + logical function Get_EvelatorUnlatchSingle() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_EvelatorUnlatchSingle + !DEC$ ATTRIBUTES ALIAS: 'Get_EvelatorUnlatchSingle' :: Get_EvelatorUnlatchSingle + implicit none + Get_EvelatorUnlatchSingle = .false. ! Elevator == ELEVATOR_UNLATCH_SINGLE + end function + +end module CElevatorEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CFlowKellyDisconnectEnum.f90 b/CSharp/OperationScenarios/UnitySignals/CFlowKellyDisconnectEnum.f90 new file mode 100644 index 0000000..dee6e29 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CFlowKellyDisconnectEnum.f90 @@ -0,0 +1,29 @@ +module CFlowKellyDisconnectEnum + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_FlowKellyDisconnect() + implicit none + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_FlowKellyDisconnect=TopDrive' +!#endif +! endif +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_FlowKellyDisconnect=Kelly' +!#endif +! endif + + end subroutine + + subroutine Subscribe_FlowKellyDisconnect() + implicit none + end subroutine + +end module CFlowKellyDisconnectEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CFlowKellyDisconnectEnumVariables.f90 b/CSharp/OperationScenarios/UnitySignals/CFlowKellyDisconnectEnumVariables.f90 new file mode 100644 index 0000000..15a5f46 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CFlowKellyDisconnectEnumVariables.f90 @@ -0,0 +1,60 @@ +module CFlowKellyDisconnectEnumVariables + use CVoidEventHandlerCollection + implicit none +! integer :: FlowKellyDisconnect = 0 +! +! public +! +! type(VoidEventHandlerCollection) :: OnFlowKellyDisconnectChange +! +! enum, bind(c) +! enumerator FLOW_KELLY_DISCONNECT_NEUTRAL +! enumerator FLOW_KELLY_DISCONNECT_BEGIN +! enumerator FLOW_KELLY_DISCONNECT_END +! end enum +! +! private :: FlowKellyDisconnect +! +! contains +! +! subroutine Set_FlowKellyDisconnect(v) +! implicit none +! integer , intent(in) :: v +!#ifdef ExcludeExtraChanges +! if(FlowKellyDisconnect == v) return +!#endif +! FlowKellyDisconnect = v +!#ifdef deb +! print*, 'FlowKellyDisconnect=', FlowKellyDisconnect +!#endif +! call OnFlowKellyDisconnectChange%RunAll() +! end subroutine +! +! integer function Get_FlowKellyDisconnect2() +! implicit none +! Get_FlowKellyDisconnect2 = FlowKellyDisconnect +! end function + + + +! integer function Get_FlowKellyDisconnect_deprecated() +! !DEC$ ATTRIBUTES DLLEXPORT :: Get_FlowKellyDisconnect_deprecated +! !DEC$ ATTRIBUTES ALIAS: 'Get_FlowKellyDisconnect_deprecated' :: Get_FlowKellyDisconnect_deprecated +! implicit none +! !Get_FlowKellyDisconnect_WN = FlowKellyDisconnect +! end function +! +! +! subroutine FlowKellyDisconnectEnd() +! !DEC$ ATTRIBUTES DLLEXPORT :: FlowKellyDisconnectEnd +! !DEC$ ATTRIBUTES ALIAS: 'FlowKellyDisconnectEnd' :: FlowKellyDisconnectEnd +! implicit none +! call Set_FlowKellyDisconnect(FLOW_KELLY_DISCONNECT_END) +!#ifdef deb +! print*, 'FLOW_KELLY_DISCONNECT_END' +!#endif +! end subroutine + + + +end module CFlowKellyDisconnectEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CFlowPipeDisconnectEnum.f90 b/CSharp/OperationScenarios/UnitySignals/CFlowPipeDisconnectEnum.f90 new file mode 100644 index 0000000..95c8572 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CFlowPipeDisconnectEnum.f90 @@ -0,0 +1,29 @@ +module CFlowPipeDisconnectEnum + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_FlowPipeDisconnect() + implicit none + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_FlowPipeDisconnect=TopDrive' +!#endif +! endif +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_FlowPipeDisconnect=Kelly' +!#endif +! endif + + end subroutine + + subroutine Subscribe_FlowPipeDisconnect() + implicit none + end subroutine + +end module CFlowPipeDisconnectEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CFlowPipeDisconnectEnumVariables.f90 b/CSharp/OperationScenarios/UnitySignals/CFlowPipeDisconnectEnumVariables.f90 new file mode 100644 index 0000000..e022c90 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CFlowPipeDisconnectEnumVariables.f90 @@ -0,0 +1,70 @@ +module CFlowPipeDisconnectEnumVariables + use CVoidEventHandlerCollection + implicit none +! integer :: FlowPipeDisconnect = 0 +! +! public +! +! type(VoidEventHandlerCollection) :: OnFlowPipeDisconnectChange +! +! enum, bind(c) +! enumerator FLOW_PIPE_DISCONNECT_NEUTRAL +! enumerator FLOW_PIPE_DISCONNECT_BEGIN +! enumerator FLOW_PIPE_DISCONNECT_END +! end enum +! +! private :: FlowPipeDisconnect +! +! contains +! +! subroutine Set_FlowPipeDisconnect(v) +! implicit none +! integer , intent(in) :: v +!#ifdef ExcludeExtraChanges +! if(FlowPipeDisconnect == v) return +!#endif +! FlowPipeDisconnect = v +!#ifdef deb +! print*, 'FlowPipeDisconnect=', FlowPipeDisconnect +!#endif +! call OnFlowPipeDisconnectChange%RunAll() +! end subroutine +! +! integer function Get_FlowPipeDisconnect2() +! implicit none +! Get_FlowPipeDisconnect2 = FlowPipeDisconnect +! end function + + + +! subroutine Set_FlowPipeDisconnect_deprecated(v) +! !DEC$ ATTRIBUTES DLLEXPORT :: Set_FlowPipeDisconnect_deprecated +! !DEC$ ATTRIBUTES ALIAS: 'Set_FlowPipeDisconnect_deprecated' :: Set_FlowPipeDisconnect_deprecated +! implicit none +! integer , intent(in) :: v +! call Set_FlowPipeDisconnect(v) +! end subroutine +! +! +! integer function Get_FlowPipeDisconnect_deprecated() +! !DEC$ ATTRIBUTES DLLEXPORT :: Get_FlowPipeDisconnect_deprecated +! !DEC$ ATTRIBUTES ALIAS: 'Get_FlowPipeDisconnect_deprecated' :: Get_FlowPipeDisconnect_deprecated +! implicit none +! Get_FlowPipeDisconnect_WN = FlowPipeDisconnect +! end function +! +! +! +! subroutine FlowPipeDisconnectEnd() +! !DEC$ ATTRIBUTES DLLEXPORT :: FlowPipeDisconnectEnd +! !DEC$ ATTRIBUTES ALIAS: 'FlowPipeDisconnectEnd' :: FlowPipeDisconnectEnd +! implicit none +! call Set_FlowPipeDisconnect(FLOW_PIPE_DISCONNECT_END) +!#ifdef deb +! print*, 'FLOW_PIPE_DISCONNECT_END' +!#endif +! end subroutine + + + +end module CFlowPipeDisconnectEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CHeadEnum.f90 b/CSharp/OperationScenarios/UnitySignals/CHeadEnum.f90 new file mode 100644 index 0000000..869e1f4 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CHeadEnum.f90 @@ -0,0 +1,150 @@ +module CHeadEnum + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_FillupHead() + use CStudentStationVariables, only: FillupHeadInstallation + implicit none + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_FillupHead=TopDrive' +#endif + endif + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_FillupHead=Kelly' +#endif + endif + + + if (Get_FillupHead() == FILLUP_HEAD_INSTALL) then + FillupHeadInstallation = .true. + else if (Get_FillupHead() == FILLUP_HEAD_REMOVE) then + FillupHeadInstallation = .false. + endif + + end subroutine + + ! subroutine Subscribe_FillupHead() + ! use CStudentStationVariables + ! implicit none + ! call OnFillupHeadInstallationPress%Add(ButtonPress_FillupHeadInstallation) + ! call OnFillupHeadRemovePress%Add(ButtonPress_FillupHeadRemove) + ! end subroutine + + subroutine ButtonPress_FillupHeadInstallation() + implicit none + + + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'ButtonPress_FillupHeadInstallation=TopDrive' +#endif + + + + !TOPDRIVE-CODE=67 + if (Get_FillupHeadPermission()) then + call Set_FillupHead(FILLUP_HEAD_INSTALL) + + return + end if + + + endif + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'ButtonPress_FillupHeadInstallation=Kelly' +#endif + + + !OPERATION-CODE=71 + if (Get_InstallFillupHeadPermission()) then + call Set_FillupHead(FILLUP_HEAD_INSTALL) + + return + end if + + + endif + + + + + + + + end subroutine + + + subroutine ButtonPress_FillupHeadRemove() + implicit none + + + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'ButtonPress_FillupHeadRemove=TopDrive' +#endif + + + !TOPDRIVE-CODE=68 + if (Get_FillupHeadPermission()) then + call Set_FillupHead(FILLUP_HEAD_REMOVE) + + return + end if + + + endif + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'ButtonPress_FillupHeadRemove=Kelly' +#endif + + + !OPERATION-CODE=72 + if (Get_InstallFillupHeadPermission()) then + call Set_FillupHead(FILLUP_HEAD_REMOVE) + return + end if + + + + + endif + + + + + + + end subroutine + +end module CHeadEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CHeadEnumVariables.f90 b/CSharp/OperationScenarios/UnitySignals/CHeadEnumVariables.f90 new file mode 100644 index 0000000..280a6d8 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CHeadEnumVariables.f90 @@ -0,0 +1,90 @@ +module CHeadEnumVariables + use CVoidEventHandlerCollection + implicit none + integer :: FillupHead = 0 + + public + + type(VoidEventHandlerCollection) :: OnFillupHeadChange + + enum, bind(c) + !enumerator FILLUP_HEAD_NEUTRAL + enumerator FILLUP_HEAD_REMOVE + enumerator FILLUP_HEAD_INSTALL + end enum + + private :: FillupHead + + contains + + subroutine Set_FillupHead(v) + use CManifolds, only: ToggleFillupHead + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(FillupHead == v) return +#endif + FillupHead = v + + if (FillupHead == FILLUP_HEAD_INSTALL) then + call ToggleFillupHead(.true.) + else if (FillupHead == FILLUP_HEAD_REMOVE) then + call ToggleFillupHead(.false.) + endif + +#ifdef deb + print*, 'FillupHead=', FillupHead +#endif + call OnFillupHeadChange%RunAll() + end subroutine + + integer function Get_FillupHead() + implicit none + Get_FillupHead = FillupHead + end function + + + + + subroutine Set_FillupHead_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_FillupHead_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_FillupHead_WN' :: Set_FillupHead_WN + implicit none + integer , intent(in) :: v + call Set_FillupHead(v) + end subroutine + + integer function Get_FillupHead_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_FillupHead_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_FillupHead_WN' :: Get_FillupHead_WN + implicit none + Get_FillupHead_WN = FillupHead + end function + + + + + + + + + + + + + + logical function Get_RemoveFillupHead() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_RemoveFillupHead + !DEC$ ATTRIBUTES ALIAS: 'Get_RemoveFillupHead' :: Get_RemoveFillupHead + implicit none + Get_RemoveFillupHead = .false. ! FillupHead == REMOVE_FILLUP_HEAD + end function + + logical function Get_InstallFillupHead() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_InstallFillupHead + !DEC$ ATTRIBUTES ALIAS: 'Get_InstallFillupHead' :: Get_InstallFillupHead + implicit none + Get_InstallFillupHead = .false. ! FillupHead == INSTALL_FILLUP_HEAD + end function + +end module CHeadEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CIbopEnum.f90 b/CSharp/OperationScenarios/UnitySignals/CIbopEnum.f90 new file mode 100644 index 0000000..8962f07 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CIbopEnum.f90 @@ -0,0 +1,33 @@ +module CIbopEnum + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_Ibop() + implicit none + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_Ibop=TopDrive' +!#endif +! endif +! +! +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_Ibop=Kelly' +!#endif +! endif + + end subroutine + + subroutine Subscribe_Ibop() + implicit none + ! imp me... + end subroutine + +end module CIbopEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CIbopEnumVariables.f90 b/CSharp/OperationScenarios/UnitySignals/CIbopEnumVariables.f90 new file mode 100644 index 0000000..89449d2 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CIbopEnumVariables.f90 @@ -0,0 +1,85 @@ +module CIbopEnumVariables + use CVoidEventHandlerCollection + implicit none + integer :: Ibop = 0 + + public + + type(VoidEventHandlerCollection) :: OnIbopChange + + enum, bind(c) + !enumerator IBOP_NEUTRAL + enumerator IBOP_REMOVE + enumerator IBOP_INSTALL + end enum + + private :: Ibop + + contains + + subroutine Set_Ibop(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(Ibop == v) return +#endif + Ibop = v +#ifdef deb + print*, 'Ibop=', Ibop +#endif + call OnIbopChange%RunAll() + end subroutine + + integer function Get_Ibop() + implicit none + Get_Ibop = Ibop + end function + + + + + subroutine Set_Ibop_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_Ibop_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_Ibop_WN' :: Set_Ibop_WN + implicit none + integer , intent(in) :: v + call Set_Ibop(v) + end subroutine + + integer function Get_Ibop_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_Ibop_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_Ibop_WN' :: Get_Ibop_WN + implicit none + Get_Ibop_WN = Ibop + end function + + + + subroutine Set_Ibop_Install() + implicit none + call Set_Ibop(IBOP_INSTALL) + end subroutine + + subroutine Set_Ibop_Remove() + implicit none + call Set_Ibop(IBOP_REMOVE) + end subroutine + + + + + logical function Get_RemoveIbop() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_RemoveIbop + !DEC$ ATTRIBUTES ALIAS: 'Get_RemoveIbop' :: Get_RemoveIbop + implicit none + Get_RemoveIBop = .false. ! Ibop == REMOVE_IBOP + end function + + logical function Get_InstallIbop() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_InstallIbop + !DEC$ ATTRIBUTES ALIAS: 'Get_InstallIbop' :: Get_InstallIbop + implicit none + Get_InstallIbop = .false. ! Ibop == INSTALL_IBOP + end function + +end module CIbopEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CKellyEnum.f90 b/CSharp/OperationScenarios/UnitySignals/CKellyEnum.f90 new file mode 100644 index 0000000..b348d7b --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CKellyEnum.f90 @@ -0,0 +1,69 @@ +module CKellyEnum + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_Kelly() + !use COperationConditionEnum + implicit none + + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_Kelly=TopDrive' +!#endif +! endif +! +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_Kelly=Kelly' +!#endif +! endif + + + + + +! if(OperationCondition == OPERATION_DRILL) then +! call Set_Kelly(INSTALL_KELLY) +!#ifdef deb +! print*, 'KELLY=INSTALL_KELLY' +!#endif +! endif +! if(OperationCondition == OPERATION_TRIP) then +! call Set_Kelly(KELLY_BACK) +!#ifdef deb +! print*, 'KELLY=KELLY_BACK' +!#endif +! endif + + end subroutine + + subroutine Subscribe_Kelly() + implicit none + !call OnOperationConditionChangeInt%Add(On_OperationCondition) + end subroutine +! +! subroutine On_OperationCondition(v) +! implicit none +! integer , intent(in) :: v +! if(v == OPERATION_DRILL) then +! call Set_Kelly(KELLY_INSTALL) +!#ifdef deb +! print*, 'KELLY=INSTALL_KELLY' +!#endif +! endif +! if(v == OPERATION_TRIP) then +! call Set_Kelly(KELLY_REMOVE) +!#ifdef deb +! print*, 'KELLY=KELLY_BACK' +!#endif +! endif +! +! end subroutine + +end module CKellyEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CKellyEnumVariables.f90 b/CSharp/OperationScenarios/UnitySignals/CKellyEnumVariables.f90 new file mode 100644 index 0000000..2391a50 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CKellyEnumVariables.f90 @@ -0,0 +1,79 @@ +module CKellyEnumVariables + use CVoidEventHandlerCollection + implicit none + integer :: Kelly = 0 + integer :: Kelly_S = 0 + + public + + type(VoidEventHandlerCollection) :: OnKellyChange + + enum, bind(c) + enumerator KELLY_NEUTRAL + enumerator KELLY_INSTALL + enumerator KELLY_REMOVE + end enum + + private :: Kelly + + contains + + subroutine Set_Kelly(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(Kelly == v) return +#endif + Kelly = v +#ifdef deb + print*, 'Kelly=', Kelly +#endif + call OnKellyChange%RunAll() + end subroutine + + integer function Get_Kelly() + implicit none + Get_Kelly = Kelly + end function + + + + + subroutine Set_Kelly_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_Kelly_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_Kelly_WN' :: Set_Kelly_WN + implicit none + integer , intent(in) :: v + !call Set_Kelly(v) + Kelly_S = v + end subroutine + + integer function Get_Kelly_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_Kelly_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_Kelly_WN' :: Get_Kelly_WN + implicit none + Get_Kelly_WN = Kelly + end function + + + + + + + + + logical function Get_KellyBack() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_KellyBack + !DEC$ ATTRIBUTES ALIAS: 'Get_KellyBack' :: Get_KellyBack + implicit none + Get_KellyBack = .false. ! Kelly == KELLY_BACK + end function + + logical function Get_InstallKelly() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_InstallKelly + !DEC$ ATTRIBUTES ALIAS: 'Get_InstallKelly' :: Get_InstallKelly + implicit none + Get_InstallKelly = .false. ! Kelly == INSTALL_KELLY + end function + +end module CKellyEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CMouseHoleEnum.f90 b/CSharp/OperationScenarios/UnitySignals/CMouseHoleEnum.f90 new file mode 100644 index 0000000..24d85f5 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CMouseHoleEnum.f90 @@ -0,0 +1,39 @@ +module CMouseHoleEnum + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_MouseHole() + implicit none + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_MouseHole=TopDrive' +!#endif +! endif +! +! +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_MouseHole=Kelly' +!#endif +! endif + + end subroutine + + subroutine Subscribe_MouseHole() + !use CDrillingConsoleVariables + implicit none + !call OnFillMouseHolePress%Add(ButtonPress_MouseHole) + end subroutine + + !subroutine ButtonPress_MouseHole() + ! implicit none + ! print*, 'ButtonPress_MouseHole' + !end subroutine + +end module CMouseHoleEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CMouseHoleEnumVariables.f90 b/CSharp/OperationScenarios/UnitySignals/CMouseHoleEnumVariables.f90 new file mode 100644 index 0000000..8cc5539 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CMouseHoleEnumVariables.f90 @@ -0,0 +1,83 @@ +module CMouseHoleEnumVariables + use CVoidEventHandlerCollection + implicit none + integer :: MouseHole = 0 + integer :: MouseHole_S = 0 + + public + + type(VoidEventHandlerCollection) :: OnMouseHoleChange + + enum, bind(c) + enumerator MOUSE_HOLE_NEUTRAL + enumerator MOUSE_HOLE_FILL + enumerator MOUSE_HOLE_EMPTY + end enum + + private :: MouseHole + + contains + + subroutine Set_MouseHole(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(MouseHole == v) return +#endif + !call sleep(2) + MouseHole = v +#ifdef deb + print*, 'MouseHole=', MouseHole +#endif + call OnMouseHoleChange%RunAll() + end subroutine + + integer function Get_MouseHole() + implicit none + Get_MouseHole = MouseHole + end function + + + subroutine Update_MouseHole_From_Snapshot() + implicit none + call Set_MouseHole(MouseHole_S) + end subroutine + + subroutine Set_MouseHole_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_MouseHole_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_MouseHole_WN' :: Set_MouseHole_WN + implicit none + integer , intent(in) :: v + !call Set_MouseHole(v) + MouseHole_S = v + end subroutine + + integer function Get_MouseHole_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_MouseHole_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_MouseHole_WN' :: Get_MouseHole_WN + implicit none + Get_MouseHole_WN = MouseHole + end function + + + + + + + + + logical function Get_EmptyMouseHole() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_EmptyMouseHole + !DEC$ ATTRIBUTES ALIAS: 'Get_EmptyMouseHole' :: Get_EmptyMouseHole + implicit none + Get_EmptyMouseHole = .false. ! MouseHole == EMPTY_MOUSE_HOLE + end function + + logical function Get_FillMouseHole() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_FillMouseHole + !DEC$ ATTRIBUTES ALIAS: 'Get_FillMouseHole' :: Get_FillMouseHole + implicit none + Get_FillMouseHole = .false. ! MouseHole == FILL_MOUSE_HOLE + end function + +end module CMouseHoleEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/COperationConditionEnum.f90 b/CSharp/OperationScenarios/UnitySignals/COperationConditionEnum.f90 new file mode 100644 index 0000000..0719827 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/COperationConditionEnum.f90 @@ -0,0 +1,147 @@ +module COperationConditionEnum + use CLog4 + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_OperationCondition() + implicit none + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_OperationCondition=TopDrive' +!#endif +! endif +! +! +! +! +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_OperationCondition=Kelly' +!#endif +! endif + + end subroutine + + ! subroutine Subscribe_OperationCondition() + ! use CDrillingConsoleVariables + ! implicit none + ! call OnLatchPipePress%Add(ButtonPress_Latch_OperationCondition) + ! call OnUnlatchPipePress%Add(ButtonPress_Unlatch_OperationCondition) + ! end subroutine + + subroutine ButtonPress_Latch_OperationCondition() + use CHoistingVariables, only: DriveType, Kelly_DriveType + use CManifolds, only: InstallKellyCock + implicit none + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'ButtonPress_Latch_OperationCondition=TopDrive' +#endif + endif + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'ButtonPress_Latch_OperationCondition=Kelly' +#endif + + !OPERATION-CODE=17 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .and.& + Get_KellyConnection() == KELLY_CONNECTION_NOTHING .and.& + Get_Swing() == SWING_RAT_HOLE_END .and.& + Get_LatchLed() .and.& + Get_UnlatchLed() == .false.) then + + call Set_OperationCondition(OPERATION_DRILL) + call Set_LatchLed(.false.) + call Set_UnlatchLed(.true.) + call Set_Kelly(KELLY_INSTALL) + if(DriveType == Kelly_DriveType) then + call InstallKellyCock() !drill mode + endif + return + end if + + endif + + + + + + + + + + end subroutine + + subroutine ButtonPress_Unlatch_OperationCondition() + use CHoistingVariables, only: DriveType, Kelly_DriveType + use CManifolds, only: RemoveKellyCock + implicit none + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'ButtonPress_Unlatch_OperationCondition=TopDrive' +#endif + endif + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'ButtonPress_Unlatch_OperationConditions=Kelly' +#endif + + + !OPERATION-CODE=18 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .and.& + Get_KellyConnection() == KELLY_CONNECTION_NOTHING .and.& + Get_Swing() == SWING_RAT_HOLE_END .and.& + Get_LatchLed() == .false. .and.& + Get_UnlatchLed()) then + + call Set_Kelly(KELLY_REMOVE) + call Set_Swing(SWING_WELL_BEGIN) + call Set_OperationCondition(OPERATION_TRIP) + call Set_LatchLed(.true.) + call Set_UnlatchLed(.false.) + call Set_IrSafetyValveLed(.false.) + if(DriveType == Kelly_DriveType) then ! top drive mode + call RemoveKellyCock() !trip mode + endif + return + end if + + + + endif + + + + + + + end subroutine + +end module COperationConditionEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/COperationConditionEnumVariables.f90 b/CSharp/OperationScenarios/UnitySignals/COperationConditionEnumVariables.f90 new file mode 100644 index 0000000..6090d02 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/COperationConditionEnumVariables.f90 @@ -0,0 +1,84 @@ +module COperationConditionEnumVariables + use CIntegerEventHandlerCollection + use CVoidEventHandlerCollection + implicit none + integer :: OperationCondition = 0 + + public + + type(VoidEventHandlerCollection) :: OnOperationConditionChange + type(IntegerEventHandlerCollection) :: OnOperationConditionChangeInt + + enum, bind(c) + enumerator OPERATION_DRILL + enumerator OPERATION_TRIP + end enum + + private :: OperationCondition + + contains + + subroutine Set_OperationCondition(v) + use CKellyEnumVariables + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(OperationCondition == v) return +#endif + OperationCondition = v +#ifdef deb + print*, 'OperationCondition=', OperationCondition +#endif + call OnOperationConditionChange%RunAll() + call OnOperationConditionChangeInt%RunAll(OperationCondition) + end subroutine + + integer function Get_OperationCondition() + implicit none + Get_OperationCondition = OperationCondition + end function + + + + + + subroutine Set_OperationCondition_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_OperationCondition_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_OperationCondition_WN' :: Set_OperationCondition_WN + implicit none + integer , intent(in) :: v + call Set_OperationCondition(v) + end subroutine + + integer function Get_OperationCondition_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_OperationCondition_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_OperationCondition_WN' :: Get_OperationCondition_WN + implicit none + Get_OperationCondition_WN = OperationCondition + end function + + + + + + + + + + + + logical function Get_DrillCondition() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_DrillCondition + !DEC$ ATTRIBUTES ALIAS: 'Get_DrillCondition' :: Get_DrillCondition + implicit none + Get_DrillCondition = OperationCondition == OPERATION_DRILL + end function + + logical function Get_TripCondition() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_TripCondition + !DEC$ ATTRIBUTES ALIAS: 'Get_TripCondition' :: Get_TripCondition + implicit none + Get_TripCondition = OperationCondition == OPERATION_TRIP + end function + +end module COperationConditionEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CSafetyValveEnum.f90 b/CSharp/OperationScenarios/UnitySignals/CSafetyValveEnum.f90 new file mode 100644 index 0000000..a260d0b --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CSafetyValveEnum.f90 @@ -0,0 +1,32 @@ +module CSafetyValveEnum + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_SafetyValve() + implicit none + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_SafetyValve=TopDrive' +!#endif +! endif +! +! +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_SafetyValve=Kelly' +!#endif +! endif + + end subroutine + + subroutine Subscribe_SafetyValve() + implicit none + end subroutine + +end module CSafetyValveEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CSafetyValveEnumVariables.f90 b/CSharp/OperationScenarios/UnitySignals/CSafetyValveEnumVariables.f90 new file mode 100644 index 0000000..7902e9c --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CSafetyValveEnumVariables.f90 @@ -0,0 +1,101 @@ +module CSafetyValveEnumVariables + use CVoidEventHandlerCollection + implicit none + integer :: SafetyValve = 0 + integer :: operation = 0 + + public + + type(VoidEventHandlerCollection) :: OnSafetyValveChange + + enum, bind(c) + enumerator SAFETY_VALVE_NEUTRAL + enumerator SAFETY_VALVE_REMOVE + enumerator SAFETY_VALVE_INSTALL + end enum + + private :: SafetyValve + + contains + + subroutine Set_Operation(i) + implicit none + integer, intent (in) :: i + operation = i + end subroutine + + subroutine Set_SafetyValve(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(SafetyValve == v) return +#endif + SafetyValve = v +#ifdef deb + if(SafetyValve == SAFETY_VALVE_NEUTRAL) then + print*, 'SafetyValve=SAFETY_VALVE_NEUTRAL' + else if (SafetyValve == SAFETY_VALVE_INSTALL) then + print*, 'SafetyValve=SAFETY_VALVE_INSTALL' + else if (SafetyValve == SAFETY_VALVE_INSTALL) then + print*, 'SafetyValve=SAFETY_VALVE_REMOVE' + endif +#endif + call OnSafetyValveChange%RunAll() + end subroutine + + integer function Get_SafetyValve() + implicit none + Get_SafetyValve = SafetyValve + end function + + + + + subroutine Set_SafetyValve_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_SafetyValve_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_SafetyValve_WN' :: Set_SafetyValve_WN + implicit none + integer , intent(in) :: v + call Set_SafetyValve(v) + end subroutine + + integer function Get_SafetyValve_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_SafetyValve_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_SafetyValve_WN' :: Get_SafetyValve_WN + implicit none + Get_SafetyValve_WN = SafetyValve + end function + + + + + + subroutine Set_SafetyValve_Install() + implicit none + call Set_SafetyValve(SAFETY_VALVE_INSTALL) + end subroutine + + subroutine Set_SafetyValve_Remove() + implicit none + call Set_SafetyValve(SAFETY_VALVE_REMOVE) + end subroutine + + + + + + logical function Get_RemoveSafetyValve() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_RemoveSafetyValve + !DEC$ ATTRIBUTES ALIAS: 'Get_RemoveSafetyValve' :: Get_RemoveSafetyValve + implicit none + Get_RemoveSafetyValve = .false. ! SafetyValve == REMOVE_SAFETY_VALVE + end function + + logical function Get_InstallSafetyValve() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_InstallSafetyValve + !DEC$ ATTRIBUTES ALIAS: 'Get_InstallSafetyValve' :: Get_InstallSafetyValve + implicit none + Get_InstallSafetyValve = .false. ! SafetyValve == INSTALL_SAFETY_VALVE + end function + +end module CSafetyValveEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CSlipsEnum.f90 b/CSharp/OperationScenarios/UnitySignals/CSlipsEnum.f90 new file mode 100644 index 0000000..da01d13 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CSlipsEnum.f90 @@ -0,0 +1,152 @@ +module CSlipsEnum + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_Slips() + implicit none + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_Slips=TopDrive' +!#endif +! endif +! +! +! +! +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_Slips=Kelly' +!#endif +! endif + + end subroutine + + ! subroutine Subscribe_Slips() + ! use CDrillingConsoleVariables + ! implicit none + + ! !call Set_Slips(SLIPS_SET) + + ! call OnSlipsPress%Add(ButtonPress_Slips) + ! end subroutine + + subroutine ButtonPress_Slips() + implicit none + + + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'ButtonPress_Slips=TopDrive' +#endif + + + !TOPDRIVE-CODE=30 + if (Get_Slips() == SLIPS_UNSET_END .and.& + Get_SlipsNotification()) then + + call Set_Slips(SLIPS_SET_BEGIN) + return + end if + + + + + + + !TOPDRIVE-CODE=31 + if (Get_TdsConnectionModes() == TDS_CONNECTION_STRING .and.& + Get_Slips() == SLIPS_SET_END .and.& + Get_SlipsNotification()) then + + call Set_Slips(SLIPS_UNSET_BEGIN) + return + end if + + + + + + + !TOPDRIVE-CODE=32 + if (Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_STRING .and.& + Get_Slips() == SLIPS_SET_END .and.& + Get_SlipsNotification()) then + + call Set_Slips(SLIPS_UNSET_BEGIN) + return + end if + + + + endif + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'ButtonPress_Slips=Kelly' +#endif + + !OPERATION-CODE=19 + if (Get_Slips() == SLIPS_UNSET_END .and.& + Get_SlipsNotification()) then + + call Set_Slips(SLIPS_SET_BEGIN) + return + end if + + !OPERATION-CODE=20 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + Get_KellyConnection() == KELLY_CONNECTION_STRING .and.& + GetRotaryRpm() == 0.0d0 .and.& + Get_SlipsNotification() .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_Slips(SLIPS_UNSET_BEGIN) + return + end if + + + !OPERATION-CODE=21 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_STRING .and.& + GetRotaryRpm() == 0.0d0 .and.& + Get_SlipsNotification() .and.& + Get_Slips() == SLIPS_SET_END) then + + call Set_Slips(SLIPS_UNSET_BEGIN) + return + end if + + + + + + + endif + + + + + + + + + + end subroutine + +end module CSlipsEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CSlipsEnumVariables.f90 b/CSharp/OperationScenarios/UnitySignals/CSlipsEnumVariables.f90 new file mode 100644 index 0000000..2c5fc71 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CSlipsEnumVariables.f90 @@ -0,0 +1,108 @@ +module CSlipsEnumVariables + use CVoidEventHandlerCollection + implicit none + integer :: Slips = 0 + integer :: Slips_S = 0 + + public + + type(VoidEventHandlerCollection) :: OnSlipsChange + + enum, bind(c) + enumerator SLIPS_NEUTRAL + enumerator SLIPS_SET_BEGIN + enumerator SLIPS_SET_END + enumerator SLIPS_UNSET_BEGIN + enumerator SLIPS_UNSET_END + end enum + + private :: Slips + + contains + + subroutine Set_Slips(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(Slips == v) return +#endif + Slips = v +#ifdef deb + print*, 'Slips=', Slips +#endif + call OnSlipsChange%RunAll() + end subroutine + + integer function Get_Slips() + implicit none + Get_Slips = Slips + end function + + + + subroutine Set_Slips_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_Slips_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_Slips_WN' :: Set_Slips_WN + implicit none + integer , intent(in) :: v + !call Set_Slips(v) + Slips_S = v + end subroutine + + integer function Get_Slips_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_Slips_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_Slips_WN' :: Get_Slips_WN + implicit none + Get_Slips_WN = Slips + end function + + + + subroutine SlipsSetEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: SlipsSetEnd + !DEC$ ATTRIBUTES ALIAS: 'SlipsSetEnd' :: SlipsSetEnd + implicit none + !if(Slips /= SLIPS_SET_END) Slips = SLIPS_SET_END + call Set_Slips(SLIPS_SET_END) +#ifdef deb + print*, 'SlipsSetEnd' +#endif + end subroutine + + subroutine SlipsUnsetEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: SlipsUnsetEnd + !DEC$ ATTRIBUTES ALIAS: 'SlipsUnsetEnd' :: SlipsUnsetEnd + implicit none + !if(Slips /= SLIPS_UNSET_END) Slips = SLIPS_UNSET_END + call Set_Slips(SLIPS_UNSET_END) +#ifdef deb + print*, 'SlipsUnsetEnd' +#endif + end subroutine + + + + + + + + + + + + + logical function Get_SlipsUnset() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_SlipsUnset + !DEC$ ATTRIBUTES ALIAS: 'Get_SlipsUnset' :: Get_SlipsUnset + implicit none + Get_SlipsUnset = .false. ! Slips == SLIPS_UNSET + end function + + logical function Get_SlipsSet() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_SlipsSet + !DEC$ ATTRIBUTES ALIAS: 'Get_SlipsSet' :: Get_SlipsSet + implicit none + Get_SlipsSet = .false. ! Slips == SLIPS_SET + end function + +end module CSlipsEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CSwingEnum.f90 b/CSharp/OperationScenarios/UnitySignals/CSwingEnum.f90 new file mode 100644 index 0000000..9bdf9bd --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CSwingEnum.f90 @@ -0,0 +1,233 @@ +module CSwingEnum + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_Swing() + implicit none + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_Swing=TopDrive' +!#endif +! endif +! +! +! +! +! +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_Swing=Kelly' +!#endif +! endif + + end subroutine + + ! subroutine Subscribe_Swing() + ! use CDrillingConsoleVariables + ! implicit none + ! call OnSwingPress%Add(ButtonPress_Swing) + ! end subroutine + + subroutine ButtonPress_Swing() + implicit none + + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'ButtonPress_Swing=TopDrive' +#endif + endif + + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'ButtonPress_Swing=Kelly' +#endif + + + !!OPERATION-CODE=84 + !if (Get_OperationCondition() == OPERATION_DRILL .and.& + ! Get_HookHeight() >= (HKL + Get_NearFloorConnection() + RE) .and.& + ! Get_Swing() == SWING_RAT_HOLE_END) then + ! call Set_Swing(SWING_WELL_BEGIN) + ! return + !endif + + !OPERATION-CODE=26 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + Get_HookHeight() >= (HKL + Get_NearFloorConnection() + PL) .and.& + Get_KellyConnection() == KELLY_CONNECTION_SINGLE .and.& + Get_Swing() == SWING_WELL_END .and.& + Get_SwingLed() .and.& + Get_FillMouseHoleLed() == .false.) then + + call Set_Swing(SWING_MOUSE_HOLE_BEGIN) + return + endif + + + + + !OPERATION-CODE=27 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + Get_HookHeight() >= (HKL + Get_NearFloorConnection() + PL) .and.& + Get_KellyConnection() == KELLY_CONNECTION_SINGLE .and.& + Get_Swing() == SWING_MOUSE_HOLE_END .and.& + Get_SwingLed()) then + + call Set_Swing(SWING_WELL_BEGIN) + return + endif + + + + + !OPERATION-CODE=28 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + Get_HookHeight() >= (HKL + Get_NearFloorConnection()) .and.& + Get_KellyConnection() == KELLY_CONNECTION_NOTHING .and.& + Get_Swing() == SWING_WELL_END .and.& + Get_SwingLed()) then + + call Set_Swing(SWING_MOUSE_HOLE_BEGIN) + return + endif + + + + !OPERATION-CODE=29 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + Get_HookHeight() >= (HKL + SG) .and.& + Get_KellyConnection() == KELLY_CONNECTION_NOTHING .and.& + Get_Swing() == SWING_MOUSE_HOLE_END .and.& + Get_SwingLed()) then + + call Set_Swing(SWING_RAT_HOLE_BEGIN) + return + endif + + + !OPERATION-CODE=30 + if (Get_OperationCondition() == OPERATION_DRILL .and.& + Get_HookHeight() >= (HKL + Get_NearFloorConnection()) .and.& + Get_Swing() == SWING_RAT_HOLE_END .and.& + Get_SwingLed()) then + + call Set_Swing(SWING_WELL_BEGIN) + return + endif + + + + !OPERATION-CODE=31 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() >= (HL + Get_NearFloorConnection()) .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .and.& + Get_Swing() == SWING_WELL_END .and.& + Get_SwingLed()) then + + call Set_Swing(SWING_MOUSE_HOLE_BEGIN) + return + endif + + + + !OPERATION-CODE=32 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() >= 27.41 .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .and.& + !Get_Swing() == SWING_WELL_END .and.& + Get_Swing() == SWING_MOUSE_HOLE_END .and.& + Get_SwingLed()) then + + call Set_Swing(SWING_RAT_HOLE_BEGIN) + return + endif + + + + !OPERATION-CODE=33 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + (Get_HookHeight() >= (HL + Get_NearFloorConnection()) .and. Get_HookHeight() <= 27.41) .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .and.& + Get_Swing() == SWING_MOUSE_HOLE_END .and.&!Get_Swing() == SWING_MOUSE_HOLE_END .and.&!Get_Swing() /= SWING_WELL_END + Get_SwingLed()) then + + call Set_Swing(SWING_WELL_BEGIN) + return + endif + + + + !OPERATION-CODE=34 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() >= (HL + Get_NearFloorConnection() + PL - ECG) .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_SINGLE .and.& + Get_Swing() == SWING_WELL_END .and.& + Get_SwingLed()) then + + call Set_Swing(SWING_MOUSE_HOLE_BEGIN) + return + endif + + + + + + !OPERATION-CODE=35 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() >= (HL + Get_NearFloorConnection() + PL - ECG + RE) .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_SINGLE .and.& + Get_Swing() == SWING_MOUSE_HOLE_END .and.& + Get_SwingLed()) then + + call Set_Swing(SWING_WELL_BEGIN) + return + endif + + !OPERATION-CODE=80 + if (Get_OperationCondition() == OPERATION_TRIP .and.& + Get_HookHeight() >= 27.41 .and. Get_HookHeight() <= (27.41 + 10) .and.& + Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING .and.& + Get_Swing() == SWING_RAT_HOLE_END .and.& + Get_SwingLed()) then + + call Set_Swing(SWING_WELL_BEGIN) + return + end if + + + + + endif + + + + + + + + + + + + + + end subroutine + +end module CSwingEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CSwingEnumVariables.f90 b/CSharp/OperationScenarios/UnitySignals/CSwingEnumVariables.f90 new file mode 100644 index 0000000..27ca75c --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CSwingEnumVariables.f90 @@ -0,0 +1,135 @@ +module CSwingEnumVariables + use CVoidEventHandlerCollection + use CLog4 + implicit none + integer :: Swing = 0 + integer :: Swing_S = 0 + + public + + type(VoidEventHandlerCollection) :: OnSwingChange + + enum, bind(c) + enumerator SWING_NEUTRAL + enumerator SWING_MOUSE_HOLE_BEGIN + enumerator SWING_MOUSE_HOLE_END + enumerator SWING_RAT_HOLE_BEGIN + enumerator SWING_RAT_HOLE_END + enumerator SWING_WELL_BEGIN + enumerator SWING_WELL_END + end enum + + private :: Swing + + contains + + subroutine Set_Swing(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(Swing == v) return +#endif + Swing = v +#ifdef deb + print*, 'Swing=', Swing +#endif + call OnSwingChange%RunAll() + end subroutine + + integer function Get_Swing() + implicit none + Get_Swing = Swing + end function + + + subroutine Set_Swing_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_Swing_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_Swing_WN' :: Set_Swing_WN + implicit none + integer , intent(in) :: v + !call Set_Swing(v) + Swing_S = v + end subroutine + + integer function Get_Swing_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_Swing_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_Swing_WN' :: Get_Swing_WN + implicit none + Get_Swing_WN = Swing + end function + + + + + + + + subroutine SwingMouseHoleEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: SwingMouseHoleEnd + !DEC$ ATTRIBUTES ALIAS: 'SwingMouseHoleEnd' :: SwingMouseHoleEnd + implicit none + !if(Swing /= SWING_MOUSE_HOLE_END) Swing = SWING_MOUSE_HOLE_END + call Set_Swing(SWING_MOUSE_HOLE_END) +#ifdef deb + print*, 'SWING_MOUSE_HOLE_END' +#endif + end subroutine + + + subroutine SwingRatHoleEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: SwingRatHoleEnd + !DEC$ ATTRIBUTES ALIAS: 'SwingRatHoleEnd' :: SwingRatHoleEnd + implicit none + !if(Swing /= SWING_RAT_HOLE_END) Swing = SWING_RAT_HOLE_END + call Set_Swing(SWING_RAT_HOLE_END) +#ifdef deb + print*, 'SWING_RAT_HOLE_END' +#endif + end subroutine + + + subroutine SwingWellEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: SwingWellEnd + !DEC$ ATTRIBUTES ALIAS: 'SwingWellEnd' :: SwingWellEnd + implicit none + !if(Swing /= SWING_WELL_END) Swing = SWING_WELL_END + call Set_Swing(SWING_WELL_END) +#ifdef deb + print*, 'SWING_WELL_END' +#endif + end subroutine + + + + + + + + + + + + + + logical function Get_SwingMouseHole() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_SwingMouseHole + !DEC$ ATTRIBUTES ALIAS: 'Get_SwingMouseHole' :: Get_SwingMouseHole + implicit none + Get_SwingMouseHole = .false. ! Swing == SWING_MOUSE_HOLE + end function + + logical function Get_SwingRatHole() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_SwingRatHole + !DEC$ ATTRIBUTES ALIAS: 'Get_SwingRatHole' :: Get_SwingRatHole + implicit none + Get_SwingRatHole = .false. ! Swing == SWING_RAT_HOLE + end function + + logical function Get_SwingWell() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_SwingWell + !DEC$ ATTRIBUTES ALIAS: 'Get_SwingWell' :: Get_SwingWell + implicit none + Get_SwingWell = .false. ! Swing == SWING_WELL + end function + +end module CSwingEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CTdsBackupClamp.f90 b/CSharp/OperationScenarios/UnitySignals/CTdsBackupClamp.f90 new file mode 100644 index 0000000..62dcb4c --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CTdsBackupClamp.f90 @@ -0,0 +1,57 @@ +module CTdsBackupClamp + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_TdsBackupClamp() + implicit none + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_TdsBackupClamp=TopDrive' +#endif + + !TOPDRIVE-CODE=79 + if(Get_TdsBackupClamp() == BACKUP_CLAMP_OFF_END .and.& + TopDriveTdsPowerState /= TdsPower_OFF .and.& + TopDriveTorqueWrench) then + + call Set_TdsBackupClamp(BACKUP_CLAMP_FW_BEGIN) + + endif + + !TOPDRIVE-CODE=80 + if(Get_TdsBackupClamp() /= BACKUP_CLAMP_OFF_END .and.& + Get_TdsBackupClamp() /= BACKUP_CLAMP_OFF_BEGIN .and.& + TopDriveTdsPowerState /= TdsPower_OFF .and.& + TopDriveTorqueWrench == .false.) then + + call Set_TdsBackupClamp(BACKUP_CLAMP_OFF_BEGIN) + + endif + + + endif + + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_TdsBackupClamp=Kelly' +#endif + endif + + end subroutine + + subroutine Subscribe_TdsBackupClamp() + use CDrillingConsoleVariables + implicit none + end subroutine + +end module CTdsBackupClamp \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CTdsBackupClampVariables.f90 b/CSharp/OperationScenarios/UnitySignals/CTdsBackupClampVariables.f90 new file mode 100644 index 0000000..f8ed662 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CTdsBackupClampVariables.f90 @@ -0,0 +1,83 @@ +module CTdsBackupClampVariables + use CVoidEventHandlerCollection + implicit none + integer :: TdsBackupClamp = 0 + + public + + type(VoidEventHandlerCollection) :: OnTdsBackupClampChange + + enum, bind(c) + enumerator BACKUP_CLAMP_OFF_END + enumerator BACKUP_CLAMP_OFF_BEGIN + enumerator BACKUP_CLAMP_FW_BEGIN + enumerator BACKUP_CLAMP_FW_END + end enum + + private :: TdsBackupClamp + contains + + subroutine Set_TdsBackupClamp(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(TdsBackupClamp == v) return +#endif + TdsBackupClamp = v +#ifdef deb + print*, 'TdsBackupClamp=', TdsBackupClamp +#endif + call OnTdsBackupClampChange%RunAll() + end subroutine + + integer function Get_TdsBackupClamp() + implicit none + Get_TdsBackupClamp = TdsBackupClamp + end function + + + + subroutine Set_TdsBackupClamp_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_TdsBackupClamp_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_TdsBackupClamp_WN' :: Set_TdsBackupClamp_WN + implicit none + integer , intent(in) :: v + call Set_TdsBackupClamp(v) + end subroutine + + integer function Get_TdsBackupClamp_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_TdsBackupClamp_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_TdsBackupClamp_WN' :: Get_TdsBackupClamp_WN + implicit none + Get_TdsBackupClamp_WN = TdsBackupClamp + end function + + + + + + subroutine TdsBackupClampFwEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: TdsBackupClampFwEnd + !DEC$ ATTRIBUTES ALIAS: 'TdsBackupClampFwEnd' :: TdsBackupClampFwEnd + implicit none + call Set_TdsBackupClamp(BACKUP_CLAMP_FW_END) +#ifdef deb + print*, 'BACKUP_CLAMP_FW_END' +#endif + end subroutine + + + subroutine TdsBackupClampOffEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: TdsBackupClampOffEnd + !DEC$ ATTRIBUTES ALIAS: 'TdsBackupClampOffEnd' :: TdsBackupClampOffEnd + implicit none + call Set_TdsBackupClamp(BACKUP_CLAMP_OFF_END) +#ifdef deb + print*, 'BACKUP_CLAMP_OFF_END' +#endif + end subroutine + + + + +end module CTdsBackupClampVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CTdsSpineEnum.f90 b/CSharp/OperationScenarios/UnitySignals/CTdsSpineEnum.f90 new file mode 100644 index 0000000..ded19cc --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CTdsSpineEnum.f90 @@ -0,0 +1,61 @@ +module CTdsSpineEnum + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_TdsSpine() + implicit none + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_TdsSpine=TopDrive' +#endif + + !TOPDRIVE-CODE=83 + if (Get_TdsStemIn() .and.& + Get_TdsConnectionModes() == TDS_CONNECTION_NOTHING .and.& + !Get_TdsConnectionPossible() .and.& + TopDriveTdsPowerState == TdsPower_FWD .and.& + TopDriveDrillTorqueState == TdsMu_SPINE) then + + call Set_TdsSpine(TDS_SPINE_CONNECT_BEGIN) + return + end if + + !TOPDRIVE-CODE=84 + if (Get_TdsStemIn() .and.& + Get_TdsTong() == TDS_TONG_BREAKOUT_END .and.& + Get_TdsConnectionModes() == TDS_CONNECTION_SPINE .and.& + TopDriveTdsPowerState == TdsPower_REV .and.& + TopDriveDrillTorqueState == TdsMu_SPINE) then + + call Set_TdsSpine(TDS_SPINE_DISCONNECT_BEGIN) + return + end if + + + + endif + + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_TdsSpine=Kelly' +#endif + endif + + end subroutine + + subroutine Subscribe_TdsSpine() + use CDrillingConsoleVariables + implicit none + end subroutine + +end module CTdsSpineEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CTdsSpineEnumVariables.f90 b/CSharp/OperationScenarios/UnitySignals/CTdsSpineEnumVariables.f90 new file mode 100644 index 0000000..0d67708 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CTdsSpineEnumVariables.f90 @@ -0,0 +1,84 @@ +module CTdsSpineEnumVariables + use CVoidEventHandlerCollection + use CLog4 + implicit none + integer :: TdsSpine = 0 + + public + + type(VoidEventHandlerCollection) :: OnTdsSpineChange + + enum, bind(c) + enumerator TDS_SPINE_NEUTRAL + enumerator TDS_SPINE_CONNECT_BEGIN + enumerator TDS_SPINE_CONNECT_END + enumerator TDS_SPINE_DISCONNECT_BEGIN + enumerator TDS_SPINE_DISCONNECT_END + end enum + + private :: TdsSpine + contains + + subroutine Set_TdsSpine(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(TdsSpine == v) return +#endif + TdsSpine = v +#ifdef deb + print*, 'TdsSpine=', TdsSpine +#endif + call OnTdsSpineChange%RunAll() + end subroutine + + integer function Get_TdsSpine() + implicit none + Get_TdsSpine = TdsSpine + end function + + + + subroutine Set_TdsSpine_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_TdsSpine_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_TdsSpine_WN' :: Set_TdsSpine_WN + implicit none + integer , intent(in) :: v + call Set_TdsSpine(v) + end subroutine + + integer function Get_TdsSpine_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_TdsSpine_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_TdsSpine_WN' :: Get_TdsSpine_WN + implicit none + Get_TdsSpine_WN = TdsSpine + end function + + + + + subroutine TdsSpineConnectEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: TdsSpineConnectEnd + !DEC$ ATTRIBUTES ALIAS: 'TdsSpineConnectEnd' :: TdsSpineConnectEnd + implicit none + !if(TdsSpine /= TDS_SPINE_CONNECT_END) TdsSpine = TDS_SPINE_CONNECT_END + call Set_TdsSpine(TDS_SPINE_CONNECT_END) +#ifdef deb + print*, 'TDS_SPINE_CONNECT_END' +#endif + end subroutine + + + subroutine TdsSpineDisconnectEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: TdsSpineDisconnectEnd + !DEC$ ATTRIBUTES ALIAS: 'TdsSpineDisconnectEnd' :: TdsSpineDisconnectEnd + implicit none + !if(TdsSpine /= TDS_SPINE_DISCONNECT_END) TdsSpine = TDS_SPINE_DISCONNECT_END + call Set_TdsSpine(TDS_SPINE_DISCONNECT_END) +#ifdef deb + print*, 'TDS_SPINE_DISCONNECT_END' +#endif + end subroutine + + +end module CTdsSpineEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CTdsSwingEnum.f90 b/CSharp/OperationScenarios/UnitySignals/CTdsSwingEnum.f90 new file mode 100644 index 0000000..c8fe34c --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CTdsSwingEnum.f90 @@ -0,0 +1,140 @@ +module CTdsSwingEnum + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_TdsSwing() + implicit none + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_TdsSwing=TopDrive' +#endif + + + !TOPDRIVE-CODE=37 + if (Get_SwingDrillPermission() .and.& + Get_TdsSwing() == TDS_SWING_OFF_END .and.& + Get_FillMouseHoleLed() == .false. .and.& + TopDriveLinkTiltState == TdsLinkTilt_DRILL) then + + call Set_TdsSwing(TDS_SWING_DRILL_BEGIN) + TopDriveLinkTiltLed = LED_ON + return + end if + + + + !TOPDRIVE-CODE=38 + if (Get_SwingTiltPermission() .and.& + Get_TdsSwing() == TDS_SWING_TILT_END .and.& + TopDriveLinkTiltState == TdsLinkTilt_TILT) then + + call Set_TdsSwing(TDS_SWING_TILT_BEGIN) + TopDriveLinkTiltLed = LED_ON + return + end if + + + + !TOPDRIVE-CODE=39 + if (Get_SwingOffPermission() .and.& + Get_TdsConnectionModes() == TDS_CONNECTION_NOTHING .and.& + Get_TdsSwing() == TDS_SWING_OFF_END .and.& + TopDriveLinkTiltState == TdsLinkTilt_OFF) then + + call Set_TdsSwing(TDS_SWING_OFF_BEGIN) + TopDriveLinkTiltLed = LED_ON + return + end if + + + + + + !TOPDRIVE-CODE=40 + if (Get_SwingTiltPermission() .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_NOTHING .and.& + Get_TdsSwing() == TDS_SWING_OFF_END .and.& + TopDriveLinkTiltState == TdsLinkTilt_TILT) then + + call Set_TdsSwing(TDS_SWING_TILT_BEGIN) + TopDriveLinkTiltLed = LED_ON + return + end if + + + + + + !TOPDRIVE-CODE=41 + if (Get_SwingOffPermission() .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_NOTHING .and.& + Get_TdsSwing() == TDS_SWING_TILT_END .and.& + TopDriveLinkTiltState == TdsLinkTilt_OFF) then + + call Set_TdsSwing(TDS_SWING_OFF_BEGIN) + TopDriveLinkTiltLed = LED_ON + return + end if + + + + + + !TOPDRIVE-CODE=42 + if (Get_HookHeight() > (TL() + NFC() + PL - ECG) .and.& + Get_SwingTiltPermission() .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_SINGLE .and.& + Get_TdsSwing() == TDS_SWING_OFF_END .and.& + TopDriveLinkTiltState == TdsLinkTilt_TILT) then + + call Set_TdsSwing(TDS_SWING_TILT_BEGIN) + TopDriveLinkTiltLed = LED_ON + return + end if + + + + + !TOPDRIVE-CODE=43 + if (Get_HookHeight() > (TL() + NFC() + PL - ECG) .and.& + Get_SwingOffPermission() .and.& + Get_TdsElevatorModes() == TDS_ELEVATOR_CONNECTION_SINGLE .and.& + Get_TdsSwing() == TDS_SWING_TILT_END .and.& + TopDriveLinkTiltState == TdsLinkTilt_OFF) then + + call Set_TdsSwing(TDS_SWING_OFF_BEGIN) + TopDriveLinkTiltLed = LED_ON + return + end if + + + + endif + + + + + + + + + + + + +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_TdsSwing=Kelly' +!#endif +! endif + + end subroutine + + subroutine Subscribe_TdsSwing() + use CDrillingConsoleVariables + implicit none + end subroutine + +end module CTdsSwingEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CTdsSwingEnumVariables.f90 b/CSharp/OperationScenarios/UnitySignals/CTdsSwingEnumVariables.f90 new file mode 100644 index 0000000..c931f63 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CTdsSwingEnumVariables.f90 @@ -0,0 +1,97 @@ +module CTdsSwingEnumVariables + use CVoidEventHandlerCollection + use CLog4 + implicit none + integer :: TdsSwing = 0 + + public + + type(VoidEventHandlerCollection) :: OnTdsSwingChange + + enum, bind(c) + enumerator TDS_SWING_NEUTRAL + enumerator TDS_SWING_OFF_BEGIN + enumerator TDS_SWING_OFF_END + enumerator TDS_SWING_DRILL_BEGIN + enumerator TDS_SWING_DRILL_END + enumerator TDS_SWING_TILT_BEGIN + enumerator TDS_SWING_TILT_END + end enum + + private :: TdsSwing + contains + + subroutine Set_TdsSwing(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(TdsSwing == v) return +#endif + TdsSwing = v +#ifdef deb + print*, 'TdsSwing=', TdsSwing +#endif + call OnTdsSwingChange%RunAll() + end subroutine + + integer function Get_TdsSwing() + implicit none + Get_TdsSwing = TdsSwing + end function + + + + + subroutine Set_TdsSwing_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_TdsSwing_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_TdsSwing_WN' :: Set_TdsSwing_WN + implicit none + integer , intent(in) :: v + call Set_TdsSwing(v) + end subroutine + + integer function Get_TdsSwing_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_TdsSwing_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_TdsSwing_WN' :: Get_TdsSwing_WN + implicit none + Get_TdsSwing_WN = TdsSwing + end function + + + + subroutine TdsSwingOffEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: TdsSwingOffEnd + !DEC$ ATTRIBUTES ALIAS: 'TdsSwingOffEnd' :: TdsSwingOffEnd + implicit none + !if(TdsSwing /= TDS_SWING_OFF_END) TdsSwing = TDS_SWING_OFF_END + call Set_TdsSwing(TDS_SWING_OFF_END) +#ifdef deb + print*, 'TDS_SWING_OFF_END' +#endif + end subroutine + + + subroutine TdsSwingDrillEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: TdsSwingDrillEnd + !DEC$ ATTRIBUTES ALIAS: 'TdsSwingDrillEnd' :: TdsSwingDrillEnd + implicit none + !if(TdsSwing /= TDS_SWING_DRILL_END) TdsSwing = TDS_SWING_DRILL_END + call Set_TdsSwing(TDS_SWING_DRILL_END) +#ifdef deb + print*, 'TDS_SWING_DRILL_END' +#endif + end subroutine + + + subroutine TdsSwingTiltEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: TdsSwingTiltEnd + !DEC$ ATTRIBUTES ALIAS: 'TdsSwingTiltEnd' :: TdsSwingTiltEnd + implicit none + !if(TdsSwing /= TDS_SWING_TILT_END) TdsSwing = TDS_SWING_TILT_END + call Set_TdsSwing(TDS_SWING_TILT_END) +#ifdef deb + print*, 'TDS_SWING_TILT_END' +#endif + end subroutine + +end module CTdsSwingEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CTdsTongEnum.f90 b/CSharp/OperationScenarios/UnitySignals/CTdsTongEnum.f90 new file mode 100644 index 0000000..9fc4dae --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CTdsTongEnum.f90 @@ -0,0 +1,64 @@ +module CTdsTongEnum + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_TdsTong() + implicit none + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'Evaluate_TdsTong=TopDrive' +#endif + + + + !TOPDRIVE-CODE=1 + if (Get_TdsConnectionModes() == TDS_CONNECTION_SPINE .and.& + Get_TdsBackupClamp() == BACKUP_CLAMP_FW_END .and.& + TopDriveTdsPowerState == TdsPower_FWD .and.& + TopDriveDrillTorqueState == TdsMu_TORQ) then + + call Set_TdsTong(TDS_TONG_MAKEUP_BEGIN) + !TopDriveTorqueWrenchLed = LED_ON + return + end if + + + + !TOPDRIVE-CODE=2 + if (Get_TdsConnectionModes() == TDS_CONNECTION_STRING .and.& + Get_TdsBackupClamp() == BACKUP_CLAMP_FW_END .and.& + TopDriveTdsPowerState == TdsPower_REV .and.& + TopDriveDrillTorqueState == TdsMu_TORQ) then + + call Set_TdsTong(TDS_TONG_BREAKOUT_BEGIN) + !TopDriveTorqueWrenchLed = LED_ON + return + end if + + + endif + + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'Evaluate_TdsTong=Kelly' +#endif + endif + + end subroutine + + subroutine Subscribe_TdsTong() + use CDrillingConsoleVariables + implicit none + end subroutine + +end module CTdsTongEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CTdsTongEnumVariables.f90 b/CSharp/OperationScenarios/UnitySignals/CTdsTongEnumVariables.f90 new file mode 100644 index 0000000..b814a21 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CTdsTongEnumVariables.f90 @@ -0,0 +1,86 @@ +module CTdsTongEnumVariables + use CVoidEventHandlerCollection + implicit none + integer :: TdsTong = 0 + + public + + type(VoidEventHandlerCollection) :: OnTdsTongChange + + enum, bind(c) + enumerator TDS_TONG_BREAKOUT_END + enumerator TDS_TONG_BREAKOUT_BEGIN + enumerator TDS_TONG_MAKEUP_BEGIN + enumerator TDS_TONG_MAKEUP_END + end enum + + private :: TdsTong + contains + + subroutine Set_TdsTong(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(TdsTong == v) return +#endif + TdsTong = v +#ifdef deb + print*, 'TdsTong=', TdsTong +#endif + call OnTdsTongChange%RunAll() + end subroutine + + integer function Get_TdsTong() + implicit none + Get_TdsTong = TdsTong + end function + + + + + subroutine Set_TdsTong_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_TdsTong_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_TdsTong_WN' :: Set_TdsTong_WN + implicit none + integer , intent(in) :: v + call Set_TdsTong(v) + end subroutine + + integer function Get_TdsTong_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_TdsTong_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_TdsTong_WN' :: Get_TdsTong_WN + implicit none + Get_TdsTong_WN = TdsTong + end function + + + + + + subroutine TdsTongBreakoutEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: TdsTongBreakoutEnd + !DEC$ ATTRIBUTES ALIAS: 'TdsTongBreakoutEnd' :: TdsTongBreakoutEnd + implicit none + !if(TdsTong /= TDS_TONG_BREAKOUT_END) TdsTong = TDS_TONG_BREAKOUT_END + call Set_TdsTong(TDS_TONG_BREAKOUT_END) +#ifdef deb + print*, 'TDS_TONG_BREAKOUT_END' +#endif + end subroutine + + + subroutine TdsTongMakeupEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: TdsTongMakeupEnd + !DEC$ ATTRIBUTES ALIAS: 'TdsTongMakeupEnd' :: TdsTongMakeupEnd + implicit none + !if(TdsTong /= TDS_TONG_MAKEUP_END) TdsTong = TDS_TONG_MAKEUP_END + call Set_TdsTong(TDS_TONG_MAKEUP_END) +#ifdef deb + print*, 'TDS_TONG_MAKEUP_END' +#endif + end subroutine + + + + +end module CTdsTongEnumVariables \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CTongEnum.f90 b/CSharp/OperationScenarios/UnitySignals/CTongEnum.f90 new file mode 100644 index 0000000..edfb28d --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CTongEnum.f90 @@ -0,0 +1,189 @@ +module CTongEnum + use COperationScenariosVariables + implicit none + contains + + subroutine Evaluate_Tong() + implicit none + +! if (DriveType == TopDrive_DriveType) then +!#ifdef OST +! print*, 'Evaluate_Tong=TopDrive' +!#endif +! endif +! +! +! +! +! +! +! +! +! if (DriveType == Kelly_DriveType) then +!#ifdef OST +! print*, 'Evaluate_Tong=Kelly' +!#endif +! endif + + end subroutine + + ! subroutine Subscribe_Tong() + ! use CDrillingConsoleVariables + ! implicit none + + ! call OnBreakoutLeverPress%Add(ButtonPress_Breakout_TongNotification) + ! call OnMakeupLeverPress%Add(ButtonPress_Makeup_TongNotification) + ! call OnTongNeutralPress%Add(ButtonPress_Neutral_TongNotification) + + ! end subroutine + + + + subroutine ButtonPress_Breakout_TongNotification() + implicit none + + + + + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'ButtonPress_Breakout_TongNotification=TopDrive' +#endif + + !TOPDRIVE-CODE=70 + if (Get_TongNotification()) then + + call Set_Tong(TONG_BREAKOUT_BEGIN) + return + end if + + + endif + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'ButtonPress_Breakout_TongNotification=Kelly' +#endif + + + !OPERATION-CODE=74 + if (Get_TongNotification()) then + call Set_Tong(TONG_BREAKOUT_BEGIN) + endif + + + + + + endif + + + + + + + + + + + + end subroutine + + + + + + + + subroutine ButtonPress_Makeup_TongNotification() + use CTongNotificationVariables + implicit none + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'ButtonPress_Makeup_TongNotification=TopDrive' +#endif + + + !TOPDRIVE-CODE=69 + if (Get_TongNotification()) then + + call Set_Tong(TONG_MAKEUP_BEGIN) + return + end if + + endif + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'ButtonPress_Makeup_TongNotification=Kelly' +#endif + + + !OPERATION-CODE=73 + if (Get_TongNotification()) then + call Set_Tong(TONG_MAKEUP_BEGIN) + endif + + endif + + + + + + + + + end subroutine + + subroutine ButtonPress_Neutral_TongNotification() + implicit none + + + + if (DriveType == TopDrive_DriveType) then +#ifdef OST + print*, 'ButtonPress_Neutral_TongNotification=TopDrive' +#endif + endif + + + + + + + + + if (DriveType == Kelly_DriveType) then +#ifdef OST + print*, 'ButtonPress_Neutral_TongNotification=Kelly' +#endif + + call Set_Tong(TONG_NEUTRAL) + + + endif + + + end subroutine + +end module CTongEnum \ No newline at end of file diff --git a/CSharp/OperationScenarios/UnitySignals/CTongEnumVariables.f90 b/CSharp/OperationScenarios/UnitySignals/CTongEnumVariables.f90 new file mode 100644 index 0000000..a3ec977 --- /dev/null +++ b/CSharp/OperationScenarios/UnitySignals/CTongEnumVariables.f90 @@ -0,0 +1,129 @@ +module CTongEnumVariables + use CVoidEventHandlerCollection + use CLog4 + implicit none + integer :: Tong = 0 + integer :: Tong_S = 0 + + public + + type(VoidEventHandlerCollection) :: OnTongChange + + enum, bind(c) + enumerator TONG_NEUTRAL + enumerator TONG_BREAKOUT_BEGIN + enumerator TONG_BREAKOUT_END + enumerator TONG_MAKEUP_BEGIN + enumerator TONG_MAKEUP_END + end enum + + private :: Tong + + contains + + subroutine Set_Tong(v) + implicit none + integer , intent(in) :: v +#ifdef ExcludeExtraChanges + if(Tong == v) return +#endif + Tong = v +#ifdef deb + !if(Tong==TONG_NEUTRAL) then + ! print*, 'Tong=TONG_NEUTRAL' + !else if(Tong==TONG_BREAKOUT) then + ! print*, 'Tong=TONG_BREAKOUT' + !else if(Tong==TONG_MAKEUP) then + ! print*, 'Tong=TONG_MAKEUP' + !endif + print*, 'Tong=', Tong +#endif + call OnTongChange%RunAll() + end subroutine + + integer function Get_Tong() + implicit none + Get_Tong = Tong + end function + + + + subroutine Set_Tong_WN(v) + !DEC$ ATTRIBUTES DLLEXPORT :: Set_Tong_WN + !DEC$ ATTRIBUTES ALIAS: 'Set_Tong_WN' :: Set_Tong_WN + implicit none + integer , intent(in) :: v + !call Set_Tong(v) + Tong_S = v + end subroutine + + integer function Get_Tong_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_Tong_WN + !DEC$ ATTRIBUTES ALIAS: 'Get_Tong_WN' :: Get_Tong_WN + implicit none + Get_Tong_WN = Tong + end function + + + + + + + + + + subroutine TongBreakoutEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: TongBreakoutEnd + !DEC$ ATTRIBUTES ALIAS: 'TongBreakoutEnd' :: TongBreakoutEnd + implicit none + !if(Tong /= TONG_BREAKOUT_END) then + ! Tong = TONG_BREAKOUT_END + !endif + call Set_Tong(TONG_BREAKOUT_END) +#ifdef deb + print*, 'TONG_BREAKOUT_END' +#endif + end subroutine + + + subroutine TongMakeupEnd() + !DEC$ ATTRIBUTES DLLEXPORT :: TongMakeupEnd + !DEC$ ATTRIBUTES ALIAS: 'TongMakeupEnd' :: TongMakeupEnd + implicit none + !if(Tong /= TONG_MAKEUP_END) then + ! Tong = TONG_MAKEUP_END + ! + !endif + call Set_Tong(TONG_MAKEUP_END) +#ifdef deb + print*, 'TONG_MAKEUP_END' +#endif + end subroutine + + + + + + + + + + + + + + logical function Get_TongBreakout() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_TongBreakout + !DEC$ ATTRIBUTES ALIAS: 'Get_TongBreakout' :: Get_TongBreakout + implicit none + Get_TongBreakout = .false. ! Tong == TONG_BREAKOUT + end function + + logical function Get_TongMakeup() + !DEC$ ATTRIBUTES DLLEXPORT :: Get_TongMakeup + !DEC$ ATTRIBUTES ALIAS: 'Get_TongMakeup' :: Get_TongMakeup + implicit none + Get_TongMakeup = .false. ! Tong == TONG_MAKEUP + end function + +end module CTongEnumVariables \ No newline at end of file diff --git a/CSharp/Problems/CBitProblems.f90 b/CSharp/Problems/CBitProblems.f90 new file mode 100644 index 0000000..8b38696 --- /dev/null +++ b/CSharp/Problems/CBitProblems.f90 @@ -0,0 +1,65 @@ +module CBitProblems + use CBitProblemsVariables + implicit none + public + contains + + ! Input routines + subroutine SetPlugJets(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetPlugJets + !DEC$ ATTRIBUTES ALIAS: 'SetPlugJets' :: SetPlugJets + implicit none + type(CProblem), intent(in) :: v + PlugJets = SetDue(v, ChangePlugJets) +#ifdef deb + !print*, 'PlugJets%ProblemType=', PlugJets%ProblemType + !print*, 'PlugJets%StatusType=', PlugJets%StatusType + !print*, 'PlugJets%Value=', PlugJets%Value + !print*, 'PlugJets%DueValue=', PlugJets%DueValue + + call Log_3("==============================") + call Log_3("PlugJets%ProblemType=", PlugJets%ProblemType) + call Log_3("PlugJets%StatusType=", PlugJets%StatusType) + call Log_3("PlugJets%Value=", PlugJets%Value) + call Log_3("PlugJets%DueValue=", PlugJets%DueValue) + call Log_3("==============================") +#endif + end subroutine + + subroutine SetJetWashout(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetJetWashout + !DEC$ ATTRIBUTES ALIAS: 'SetJetWashout' :: SetJetWashout + implicit none + type(CProblem), intent(in) :: v + JetWashout = SetDue(v, ChangeJetWashout) +#ifdef deb + print*, 'JetWashout%ProblemType=', JetWashout%ProblemType + print*, 'JetWashout%StatusType=', JetWashout%StatusType + print*, 'JetWashout%Value=', JetWashout%Value + print*, 'JetWashout%DueValue=', JetWashout%DueValue +#endif + end subroutine + + subroutine SetPlugJetsCount(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetPlugJetsCount + !DEC$ ATTRIBUTES ALIAS: 'SetPlugJetsCount' :: SetPlugJetsCount + implicit none + integer, intent(in) :: v + PlugJetsCount = v +#ifdef deb + print*, 'PlugJetsCount=', PlugJetsCount +#endif + end subroutine + + subroutine SetJetWashoutCount(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetJetWashoutCount + !DEC$ ATTRIBUTES ALIAS: 'SetJetWashoutCount' :: SetJetWashoutCount + implicit none + integer, intent(in) :: v + JetWashoutCount = v +#ifdef deb + print*, 'JetWashoutCount=', JetWashoutCount +#endif + end subroutine + +end module CBitProblems \ No newline at end of file diff --git a/CSharp/Problems/CBitProblemsVariables.f90 b/CSharp/Problems/CBitProblemsVariables.f90 new file mode 100644 index 0000000..512a901 --- /dev/null +++ b/CSharp/Problems/CBitProblemsVariables.f90 @@ -0,0 +1,95 @@ +module CBitProblemsVariables + use CProblemDifinition + use CLog3 + implicit none + public + + ! Input vars + type(CProblem) :: PlugJets + type(CProblem) :: JetWashout + integer :: PlugJetsCount + integer :: JetWashoutCount + + procedure (ActionInteger), pointer :: PlugJetsPtr + procedure (ActionInteger), pointer :: JetWashoutPtr + + contains + subroutine ProcessBitProblemsDueTime(time) + implicit none + integer :: time + if(PlugJets%ProblemType == Time_ProblemType) call ProcessDueTime(PlugJets, ChangePlugJets, time) + if(JetWashout%ProblemType == Time_ProblemType) call ProcessDueTime(JetWashout, ChangeJetWashout, time) + + end subroutine + + subroutine ProcessBitProblemsDuePumpStrokes(strokes) + implicit none + integer :: strokes + + if(PlugJets%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(PlugJets, ChangePlugJets, strokes) + if(JetWashout%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(JetWashout, ChangeJetWashout, strokes) + + end subroutine + + subroutine ProcessBitProblemsDueVolumePumped(volume) + implicit none + real(8) :: volume + + if(PlugJets%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(PlugJets, ChangePlugJets, volume) + if(JetWashout%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(JetWashout, ChangeJetWashout, volume) + + end subroutine + + subroutine ProcessBitProblemsDueDistanceDrilled(distance) + implicit none + real(8) :: distance + + if(PlugJets%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(PlugJets, ChangePlugJets, distance) + if(JetWashout%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(JetWashout, ChangeJetWashout, distance) + + end subroutine + + subroutine ChangePlugJets(status) + USE FricPressDropVars + implicit none + integer, intent (in) :: status + if(associated(PlugJetsPtr)) call PlugJetsPtr(status) + if(status == Clear_StatusType) BitJetsPlugged = 0 + if(status == Executed_StatusType) BitJetsPlugged = 1 + endsubroutine + + subroutine ChangeJetWashout(status) + USE FricPressDropVars + implicit none + integer, intent (in) :: status + if(associated(JetWashoutPtr)) call JetWashoutPtr(status) + if(status == Clear_StatusType) BitJetsWashedOut = 0 + if(status == Executed_StatusType) BitJetsWashedOut = 1 + endsubroutine + + + + + + + + + + + subroutine SubscribePlugJets(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePlugJets + !DEC$ ATTRIBUTES ALIAS: 'SubscribePlugJets' :: SubscribePlugJets + implicit none + procedure (ActionInteger) :: v + PlugJetsPtr => v + end subroutine + + subroutine SubscribeJetWashout(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeJetWashout + !DEC$ ATTRIBUTES ALIAS: 'SubscribeJetWashout' :: SubscribeJetWashout + implicit none + procedure (ActionInteger) :: v + JetWashoutPtr => v + end subroutine + +end module CBitProblemsVariables \ No newline at end of file diff --git a/CSharp/Problems/CBopProblems.f90 b/CSharp/Problems/CBopProblems.f90 new file mode 100644 index 0000000..5fc1b12 --- /dev/null +++ b/CSharp/Problems/CBopProblems.f90 @@ -0,0 +1,217 @@ +module CBopProblems + use CBopProblemsVariables + implicit none + public + contains + + ! Input routines + + subroutine SetAnnularWash(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAnnularWash + !DEC$ ATTRIBUTES ALIAS: 'SetAnnularWash' :: SetAnnularWash + implicit none + type(CProblem), intent(in) :: v + AnnularWash = SetDue(v, ChangeAnnularWash) +#ifdef deb + print*, 'AnnularWash%ProblemType=', AnnularWash%ProblemType + print*, 'AnnularWash%StatusType=', AnnularWash%StatusType + print*, 'AnnularWash%Value=', AnnularWash%Value +#endif + end subroutine + + subroutine SetAnnularFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAnnularFail + !DEC$ ATTRIBUTES ALIAS: 'SetAnnularFail' :: SetAnnularFail + implicit none + type(CProblem), intent(in) :: v + AnnularFail = SetDue(v, ChangeAnnularFail) +#ifdef deb + print*, 'AnnularFail%ProblemType=', AnnularFail%ProblemType + print*, 'AnnularFail%StatusType=', AnnularFail%StatusType + print*, 'AnnularFail%Value=', AnnularFail%Value +#endif + end subroutine + + subroutine SetAnnularLeak(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAnnularLeak + !DEC$ ATTRIBUTES ALIAS: 'SetAnnularLeak' :: SetAnnularLeak + implicit none + type(CProblem), intent(in) :: v + AnnularLeak = SetDue(v, ChangeAnnularLeak) +#ifdef deb + print*, 'AnnularLeak%ProblemType=', AnnularLeak%ProblemType + print*, 'AnnularLeak%StatusType=', AnnularLeak%StatusType + print*, 'AnnularLeak%Value=', AnnularLeak%Value +#endif + end subroutine + + subroutine SetUpperRamWash(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetUpperRamWash + !DEC$ ATTRIBUTES ALIAS: 'SetUpperRamWash' :: SetUpperRamWash + implicit none + type(CProblem), intent(in) :: v + UpperRamWash = SetDue(v, ChangeUpperRamWash) +#ifdef deb + print*, 'UpperRamWash%ProblemType=', UpperRamWash%ProblemType + print*, 'UpperRamWash%StatusType=', UpperRamWash%StatusType + print*, 'UpperRamWash%Value=', UpperRamWash%Value +#endif + end subroutine + + subroutine SetUpperRamFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetUpperRamFail + !DEC$ ATTRIBUTES ALIAS: 'SetUpperRamFail' :: SetUpperRamFail + implicit none + type(CProblem), intent(in) :: v + UpperRamFail = SetDue(v, ChangeUpperRamFail) +#ifdef deb + print*, 'UpperRamFail%ProblemType=', UpperRamFail%ProblemType + print*, 'UpperRamFail%StatusType=', UpperRamFail%StatusType + print*, 'UpperRamFail%Value=', UpperRamFail%Value +#endif + end subroutine + + subroutine SetUpperRamLeak(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetUpperRamLeak + !DEC$ ATTRIBUTES ALIAS: 'SetUpperRamLeak' :: SetUpperRamLeak + implicit none + type(CProblem), intent(in) :: v + UpperRamLeak = SetDue(v, ChangeUpperRamLeak) +#ifdef deb + print*, 'UpperRamLeak%ProblemType=', UpperRamLeak%ProblemType + print*, 'UpperRamLeak%StatusType=', UpperRamLeak%StatusType + print*, 'UpperRamLeak%Value=', UpperRamLeak%Value +#endif + end subroutine + + subroutine SetMiddleRamWash(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMiddleRamWash + !DEC$ ATTRIBUTES ALIAS: 'SetMiddleRamWash' :: SetMiddleRamWash + implicit none + type(CProblem), intent(in) :: v + MiddleRamWash = SetDue(v, ChangeMiddleRamWash) +#ifdef deb + print*, 'MiddleRamWash%ProblemType=', MiddleRamWash%ProblemType + print*, 'MiddleRamWash%StatusType=', MiddleRamWash%StatusType + print*, 'MiddleRamWash%Value=', MiddleRamWash%Value +#endif + end subroutine + + subroutine SetMiddleRamFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMiddleRamFail + !DEC$ ATTRIBUTES ALIAS: 'SetMiddleRamFail' :: SetMiddleRamFail + implicit none + type(CProblem), intent(in) :: v + MiddleRamFail = SetDue(v, ChangeMiddleRamFail) +#ifdef deb + print*, 'MiddleRamFail%ProblemType=', MiddleRamFail%ProblemType + print*, 'MiddleRamFail%StatusType=', MiddleRamFail%StatusType + print*, 'MiddleRamFail%Value=', MiddleRamFail%Value +#endif + end subroutine + + subroutine SetMiddleRamLeak(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMiddleRamLeak + !DEC$ ATTRIBUTES ALIAS: 'SetMiddleRamLeak' :: SetMiddleRamLeak + implicit none + type(CProblem), intent(in) :: v + MiddleRamLeak = SetDue(v, ChangeMiddleRamLeak) +#ifdef deb + print*, 'MiddleRamLeak%ProblemType=', MiddleRamLeak%ProblemType + print*, 'MiddleRamLeak%StatusType=', MiddleRamLeak%StatusType + print*, 'MiddleRamLeak%Value=', MiddleRamLeak%Value +#endif + end subroutine + + subroutine SetLowerRamWash(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLowerRamWash + !DEC$ ATTRIBUTES ALIAS: 'SetLowerRamWash' :: SetLowerRamWash + implicit none + type(CProblem), intent(in) :: v + LowerRamWash = SetDue(v, ChangeLowerRamWash) +#ifdef deb + print*, 'LowerRamWash%ProblemType=', LowerRamWash%ProblemType + print*, 'LowerRamWash%StatusType=', LowerRamWash%StatusType + print*, 'LowerRamWash%Value=', LowerRamWash%Value +#endif + end subroutine + + subroutine SetLowerRamFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLowerRamFail + !DEC$ ATTRIBUTES ALIAS: 'SetLowerRamFail' :: SetLowerRamFail + implicit none + type(CProblem), intent(in) :: v + LowerRamFail = SetDue(v, ChangeLowerRamFail) +#ifdef deb + print*, 'LowerRamFail%ProblemType=', LowerRamFail%ProblemType + print*, 'LowerRamFail%StatusType=', LowerRamFail%StatusType + print*, 'LowerRamFail%Value=', LowerRamFail%Value +#endif + end subroutine + + subroutine SetLowerRamLeak(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLowerRamLeak + !DEC$ ATTRIBUTES ALIAS: 'SetLowerRamLeak' :: SetLowerRamLeak + implicit none + type(CProblem), intent(in) :: v + LowerRamLeak = SetDue(v, ChangeLowerRamLeak) +#ifdef deb + print*, 'LowerRamLeak%ProblemType=', LowerRamLeak%ProblemType + print*, 'LowerRamLeak%StatusType=', LowerRamLeak%StatusType + print*, 'LowerRamLeak%Value=', LowerRamLeak%Value +#endif + end subroutine + + subroutine SetAccumulatorPumpFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAccumulatorPumpFail + !DEC$ ATTRIBUTES ALIAS: 'SetAccumulatorPumpFail' :: SetAccumulatorPumpFail + implicit none + type(CProblem), intent(in) :: v + AccumulatorPumpFail = SetDue(v, ChangeAccumulatorPumpFail) +#ifdef deb + print*, 'AccumulatorPumpFail%ProblemType=', AccumulatorPumpFail%ProblemType + print*, 'AccumulatorPumpFail%StatusType=', AccumulatorPumpFail%StatusType + print*, 'AccumulatorPumpFail%Value=', AccumulatorPumpFail%Value +#endif + end subroutine + + subroutine SetAccumulatorPumpLeak(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAccumulatorPumpLeak + !DEC$ ATTRIBUTES ALIAS: 'SetAccumulatorPumpLeak' :: SetAccumulatorPumpLeak + implicit none + type(CProblem), intent(in) :: v + AccumulatorPumpLeak = SetDue(v, ChangeAccumulatorPumpLeak) +#ifdef deb + print*, 'AccumulatorPumpLeak%ProblemType=', AccumulatorPumpLeak%ProblemType + print*, 'AccumulatorPumpLeak%StatusType=', AccumulatorPumpLeak%StatusType + print*, 'AccumulatorPumpLeak%Value=', AccumulatorPumpLeak%Value +#endif + end subroutine + + subroutine SetAccumulatorSystemFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAccumulatorSystemFail + !DEC$ ATTRIBUTES ALIAS: 'SetAccumulatorSystemFail' :: SetAccumulatorSystemFail + implicit none + type(CProblem), intent(in) :: v + AccumulatorSystemFail = SetDue(v, ChangeAccumulatorSystemFail) +#ifdef deb + print*, 'AccumulatorSystemFail%ProblemType=', AccumulatorSystemFail%ProblemType + print*, 'AccumulatorSystemFail%StatusType=', AccumulatorSystemFail%StatusType + print*, 'AccumulatorSystemFail%Value=', AccumulatorSystemFail%Value +#endif + end subroutine + + subroutine SetAccumulatorSystemLeak(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAccumulatorSystemLeak + !DEC$ ATTRIBUTES ALIAS: 'SetAccumulatorSystemLeak' :: SetAccumulatorSystemLeak + implicit none + type(CProblem), intent(in) :: v + AccumulatorSystemLeak = SetDue(v, ChangeAccumulatorSystemLeak) +#ifdef deb + print*, 'AccumulatorSystemLeak%ProblemType=', AccumulatorSystemLeak%ProblemType + print*, 'AccumulatorSystemLeak%StatusType=', AccumulatorSystemLeak%StatusType + print*, 'AccumulatorSystemLeak%Value=', AccumulatorSystemLeak%Value +#endif + end subroutine + +end module CBopProblems \ No newline at end of file diff --git a/CSharp/Problems/CBopProblemsVariables.f90 b/CSharp/Problems/CBopProblemsVariables.f90 new file mode 100644 index 0000000..3af9260 --- /dev/null +++ b/CSharp/Problems/CBopProblemsVariables.f90 @@ -0,0 +1,417 @@ +module CBopProblemsVariables + use CProblemDifinition + implicit none + public + + ! Input vars + type(CProblem) :: AnnularWash + type(CProblem) :: AnnularFail + type(CProblem) :: AnnularLeak + type(CProblem) :: UpperRamWash + type(CProblem) :: UpperRamFail + type(CProblem) :: UpperRamLeak + type(CProblem) :: MiddleRamWash + type(CProblem) :: MiddleRamFail + type(CProblem) :: MiddleRamLeak + type(CProblem) :: LowerRamWash + type(CProblem) :: LowerRamFail + type(CProblem) :: LowerRamLeak + type(CProblem) :: AccumulatorPumpFail + type(CProblem) :: AccumulatorPumpLeak + type(CProblem) :: AccumulatorSystemFail + type(CProblem) :: AccumulatorSystemLeak + + + procedure (ActionInteger), pointer :: AnnularWashPtr + procedure (ActionInteger), pointer :: AnnularFailPtr + procedure (ActionInteger), pointer :: AnnularLeakPtr + procedure (ActionInteger), pointer :: UpperRamWashPtr + procedure (ActionInteger), pointer :: UpperRamFailPtr + procedure (ActionInteger), pointer :: UpperRamLeakPtr + procedure (ActionInteger), pointer :: MiddleRamWashPtr + procedure (ActionInteger), pointer :: MiddleRamFailPtr + procedure (ActionInteger), pointer :: MiddleRamLeakPtr + procedure (ActionInteger), pointer :: LowerRamWashPtr + procedure (ActionInteger), pointer :: LowerRamFailPtr + procedure (ActionInteger), pointer :: LowerRamLeakPtr + procedure (ActionInteger), pointer :: AccumulatorPumpFailPtr + procedure (ActionInteger), pointer :: AccumulatorPumpLeakPtr + procedure (ActionInteger), pointer :: AccumulatorSystemFailPtr + procedure (ActionInteger), pointer :: AccumulatorSystemLeakPtr + + contains + + subroutine ProcessBopProblemsDueTime(time) + implicit none + integer :: time + if(AnnularWash%ProblemType == Time_ProblemType) call ProcessDueTime(AnnularWash, ChangeAnnularWash, time) + if(AnnularFail%ProblemType == Time_ProblemType) call ProcessDueTime(AnnularFail, ChangeAnnularFail, time) + if(AnnularLeak%ProblemType == Time_ProblemType) call ProcessDueTime(AnnularLeak, ChangeAnnularLeak, time) + if(UpperRamWash%ProblemType == Time_ProblemType) call ProcessDueTime(UpperRamWash, ChangeUpperRamWash, time) + if(UpperRamFail%ProblemType == Time_ProblemType) call ProcessDueTime(UpperRamFail, ChangeUpperRamFail, time) + if(UpperRamLeak%ProblemType == Time_ProblemType) call ProcessDueTime(UpperRamLeak, ChangeUpperRamLeak, time) + if(MiddleRamWash%ProblemType == Time_ProblemType) call ProcessDueTime(MiddleRamWash, ChangeMiddleRamWash, time) + if(MiddleRamFail%ProblemType == Time_ProblemType) call ProcessDueTime(MiddleRamFail, ChangeMiddleRamFail, time) + if(MiddleRamLeak%ProblemType == Time_ProblemType) call ProcessDueTime(MiddleRamLeak, ChangeMiddleRamLeak, time) + if(LowerRamWash%ProblemType == Time_ProblemType) call ProcessDueTime(LowerRamWash, ChangeLowerRamWash, time) + if(LowerRamFail%ProblemType == Time_ProblemType) call ProcessDueTime(LowerRamFail, ChangeLowerRamFail, time) + if(LowerRamLeak%ProblemType == Time_ProblemType) call ProcessDueTime(LowerRamLeak, ChangeLowerRamLeak, time) + if(AccumulatorPumpFail%ProblemType == Time_ProblemType) call ProcessDueTime(AccumulatorPumpFail, ChangeAccumulatorPumpFail, time) + if(AccumulatorPumpLeak%ProblemType == Time_ProblemType) call ProcessDueTime(AccumulatorPumpLeak, ChangeAccumulatorPumpLeak, time) + if(AccumulatorSystemFail%ProblemType == Time_ProblemType) call ProcessDueTime(AccumulatorSystemFail, ChangeAccumulatorSystemFail, time) + if(AccumulatorSystemLeak%ProblemType == Time_ProblemType) call ProcessDueTime(AccumulatorSystemLeak, ChangeAccumulatorSystemLeak, time) + end subroutine + + subroutine ProcessBopProblemsDuePumpStrokes(strokes) + implicit none + integer :: strokes + if(AnnularWash%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(AnnularWash, ChangeAnnularWash, strokes) + if(AnnularFail%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(AnnularFail, ChangeAnnularFail, strokes) + if(AnnularLeak%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(AnnularLeak, ChangeAnnularLeak, strokes) + if(UpperRamWash%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(UpperRamWash, ChangeUpperRamWash, strokes) + if(UpperRamFail%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(UpperRamFail, ChangeUpperRamFail, strokes) + if(UpperRamLeak%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(UpperRamLeak, ChangeUpperRamLeak, strokes) + if(MiddleRamWash%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(MiddleRamWash, ChangeMiddleRamWash, strokes) + if(MiddleRamFail%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(MiddleRamFail, ChangeMiddleRamFail, strokes) + if(MiddleRamLeak%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(MiddleRamLeak, ChangeMiddleRamLeak, strokes) + if(LowerRamWash%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(LowerRamWash, ChangeLowerRamWash, strokes) + if(LowerRamFail%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(LowerRamFail, ChangeLowerRamFail, strokes) + if(LowerRamLeak%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(LowerRamLeak, ChangeLowerRamLeak, strokes) + if(AccumulatorPumpFail%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(AccumulatorPumpFail, ChangeAccumulatorPumpFail, strokes) + if(AccumulatorPumpLeak%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(AccumulatorPumpLeak, ChangeAccumulatorPumpLeak, strokes) + if(AccumulatorSystemFail%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(AccumulatorSystemFail, ChangeAccumulatorSystemFail, strokes) + if(AccumulatorSystemLeak%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(AccumulatorSystemLeak, ChangeAccumulatorSystemLeak, strokes) + end subroutine + + subroutine ProcessBopProblemsDueVolumePumped(volume) + implicit none + real(8) :: volume + if(AnnularWash%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(AnnularWash, ChangeAnnularWash, volume) + if(AnnularFail%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(AnnularFail, ChangeAnnularFail, volume) + if(AnnularLeak%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(AnnularLeak, ChangeAnnularLeak, volume) + if(UpperRamWash%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(UpperRamWash, ChangeUpperRamWash, volume) + if(UpperRamFail%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(UpperRamFail, ChangeUpperRamFail, volume) + if(UpperRamLeak%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(UpperRamLeak, ChangeUpperRamLeak, volume) + if(MiddleRamWash%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(MiddleRamWash, ChangeMiddleRamWash, volume) + if(MiddleRamFail%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(MiddleRamFail, ChangeMiddleRamFail, volume) + if(MiddleRamLeak%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(MiddleRamLeak, ChangeMiddleRamLeak, volume) + if(LowerRamWash%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(LowerRamWash, ChangeLowerRamWash, volume) + if(LowerRamFail%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(LowerRamFail, ChangeLowerRamFail, volume) + if(LowerRamLeak%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(LowerRamLeak, ChangeLowerRamLeak, volume) + if(AccumulatorPumpFail%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(AccumulatorPumpFail, ChangeAccumulatorPumpFail, volume) + if(AccumulatorPumpLeak%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(AccumulatorPumpLeak, ChangeAccumulatorPumpLeak, volume) + if(AccumulatorSystemFail%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(AccumulatorSystemFail, ChangeAccumulatorSystemFail,volume) + if(AccumulatorSystemLeak%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(AccumulatorSystemLeak, ChangeAccumulatorSystemLeak, volume) + end subroutine + + subroutine ProcessBopProblemsDueDistanceDrilled(distance) + implicit none + real(8) :: distance + if(AnnularWash%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(AnnularWash, ChangeAnnularWash, distance) + if(AnnularFail%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(AnnularFail, ChangeAnnularFail, distance) + if(AnnularLeak%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(AnnularLeak, ChangeAnnularLeak, distance) + if(UpperRamWash%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(UpperRamWash, ChangeUpperRamWash, distance) + if(UpperRamFail%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(UpperRamFail, ChangeUpperRamFail, distance) + if(UpperRamLeak%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(UpperRamLeak, ChangeUpperRamLeak, distance) + if(MiddleRamWash%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(MiddleRamWash, ChangeMiddleRamWash, distance) + if(MiddleRamFail%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(MiddleRamFail, ChangeMiddleRamFail, distance) + if(MiddleRamLeak%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(MiddleRamLeak, ChangeMiddleRamLeak, distance) + if(LowerRamWash%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(LowerRamWash, ChangeLowerRamWash, distance) + if(LowerRamFail%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(LowerRamFail, ChangeLowerRamFail, distance) + if(LowerRamLeak%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(LowerRamLeak, ChangeLowerRamLeak, distance) + if(AccumulatorPumpFail%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(AccumulatorPumpFail, ChangeAccumulatorPumpFail, distance) + if(AccumulatorPumpLeak%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(AccumulatorPumpLeak, ChangeAccumulatorPumpLeak, distance) + if(AccumulatorSystemFail%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(AccumulatorSystemFail, ChangeAccumulatorSystemFail, distance) + if(AccumulatorSystemLeak%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(AccumulatorSystemLeak, ChangeAccumulatorSystemLeak, distance) + end subroutine + + + subroutine ChangeAnnularWash(status) + implicit none + integer, intent (in) :: status + if(associated(AnnularWashPtr)) call AnnularWashPtr(status) + !if(status == Clear_StatusType) print*,'On_AnnularWash_Clear' + !if(status == Executed_StatusType) print*,'On_AnnularWash_Execute' + endsubroutine + + subroutine ChangeAnnularFail(status) + USE VARIABLES + implicit none + integer, intent (in) :: status + if(associated(AnnularFailPtr)) call AnnularFailPtr(status) + if(status == Clear_StatusType) AnnularFailureMalf = 0 + if(status == Executed_StatusType) AnnularFailureMalf = 1 + endsubroutine + + subroutine ChangeAnnularLeak(status) + USE VARIABLES + implicit none + integer, intent (in) :: status + if(associated(AnnularLeakPtr)) call AnnularLeakPtr(status) + if(status == Clear_StatusType) AnnularLeakMalf = 0 + if(status == Executed_StatusType) AnnularLeakMalf = 1 + endsubroutine + + + + subroutine ChangeUpperRamWash(status) + implicit none + integer, intent (in) :: status + if(associated(UpperRamWashPtr)) call UpperRamWashPtr(status) + !if(status == Clear_StatusType) print*,'On_UpperRamWash_Clear' + !if(status == Executed_StatusType) print*,'On_UpperRamWash_Execute' + endsubroutine + + subroutine ChangeUpperRamFail(status) + USE VARIABLES + implicit none + integer, intent (in) :: status + if(associated(UpperRamFailPtr)) call UpperRamFailPtr(status) + if(status == Clear_StatusType) UpperRamsFailureMalf = 0 + if(status == Executed_StatusType) UpperRamsFailureMalf = 1 + endsubroutine + + subroutine ChangeUpperRamLeak(status) + USE VARIABLES + implicit none + integer, intent (in) :: status + if(associated(UpperRamLeakPtr)) call UpperRamLeakPtr(status) + if(status == Clear_StatusType) UpperRamsLeakMalf = 0 + if(status == Executed_StatusType) UpperRamsLeakMalf = 1 + endsubroutine + + + subroutine ChangeMiddleRamWash(status) + implicit none + integer, intent (in) :: status + if(associated(MiddleRamWashPtr)) call MiddleRamWashPtr(status) + !if(status == Clear_StatusType) print*,'On_MiddleRamWash_Clear' + !if(status == Executed_StatusType) print*,'On_MiddleRamWash_Execute' + endsubroutine + + subroutine ChangeMiddleRamFail(status) + USE VARIABLES + implicit none + integer, intent (in) :: status + if(associated(MiddleRamFailPtr)) call MiddleRamFailPtr(status) + if(status == Clear_StatusType) MiddleRamsFailureMalf = 0 + if(status == Executed_StatusType) MiddleRamsFailureMalf = 1 + endsubroutine + + subroutine ChangeMiddleRamLeak(status) + USE VARIABLES + implicit none + integer, intent (in) :: status + if(associated(MiddleRamLeakPtr)) call MiddleRamLeakPtr(status) + if(status == Clear_StatusType) MiddleRamsLeakMalf = 0 + if(status == Executed_StatusType) MiddleRamsLeakMalf = 1 + endsubroutine + + + + subroutine ChangeLowerRamWash(status) + implicit none + integer, intent (in) :: status + if(associated(LowerRamWashPtr)) call LowerRamWashPtr(status) + !if(status == Clear_StatusType) print*,'On_LowerRamWash_Clear' + !if(status == Executed_StatusType) print*,'On_LowerRamWash_Execute' + endsubroutine + + subroutine ChangeLowerRamFail(status) + USE VARIABLES + implicit none + integer, intent (in) :: status + if(associated(LowerRamFailPtr)) call LowerRamFailPtr(status) + if(status == Clear_StatusType) LowerRamsFailureMalf = 0 + if(status == Executed_StatusType) LowerRamsFailureMalf = 1 + endsubroutine + + subroutine ChangeLowerRamLeak(status) + USE VARIABLES + implicit none + integer, intent (in) :: status + if(associated(LowerRamLeakPtr)) call LowerRamLeakPtr(status) + if(status == Clear_StatusType) LowerRamsLeakMalf = 0 + if(status == Executed_StatusType) LowerRamsLeakMalf = 1 + endsubroutine + + subroutine ChangeAccumulatorPumpFail(status) + USE VARIABLES + implicit none + integer, intent (in) :: status + if(associated(AccumulatorPumpFailPtr)) call AccumulatorPumpFailPtr(status) + if(status == Clear_StatusType) AccPupmsFailMalf = 0 + if(status == Executed_StatusType) AccPupmsFailMalf = 1 + endsubroutine + + subroutine ChangeAccumulatorPumpLeak(status) + implicit none + integer, intent (in) :: status + if(associated(AccumulatorPumpLeakPtr)) call AccumulatorPumpLeakPtr(status) + !if(status == Clear_StatusType) print*,'On_AccumulatorPumpLeak_Clear' + !if(status == Executed_StatusType) print*,'On_AccumulatorPumpLeak_Execute' + endsubroutine + + subroutine ChangeAccumulatorSystemFail(status) + implicit none + integer, intent (in) :: status + if(associated(AccumulatorSystemFailPtr)) call AccumulatorSystemFailPtr(status) + !if(status == Clear_StatusType) print*,'On_AccumulatorSystemFail_Clear' + !if(status == Executed_StatusType) print*,'On_AccumulatorSystemFail_Execute' + endsubroutine + + subroutine ChangeAccumulatorSystemLeak(status) + implicit none + integer, intent (in) :: status + if(associated(AccumulatorSystemLeakPtr)) call AccumulatorSystemLeakPtr(status) + !if(status == Clear_StatusType) print*,'On_AccumulatorSystemLeak_Clear' + !if(status == Executed_StatusType) print*,'On_AccumulatorSystemLeak_Execute' + endsubroutine + + + + + + + + + + + + + subroutine SubscribeAnnularWash(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeAnnularWash + !DEC$ ATTRIBUTES ALIAS: 'SubscribeAnnularWash' :: SubscribeAnnularWash + implicit none + procedure (ActionInteger) :: v + AnnularWashPtr => v + end subroutine + + subroutine SubscribeAnnularFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeAnnularFail + !DEC$ ATTRIBUTES ALIAS: 'SubscribeAnnularFail' :: SubscribeAnnularFail + implicit none + procedure (ActionInteger) :: v + AnnularFailPtr => v + end subroutine + + subroutine SubscribeAnnularLeak(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeAnnularLeak + !DEC$ ATTRIBUTES ALIAS: 'SubscribeAnnularLeak' :: SubscribeAnnularLeak + implicit none + procedure (ActionInteger) :: v + AnnularLeakPtr => v + end subroutine + + + subroutine SubscribeUpperRamWash(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeUpperRamWash + !DEC$ ATTRIBUTES ALIAS: 'SubscribeUpperRamWash' :: SubscribeUpperRamWash + implicit none + procedure (ActionInteger) :: v + UpperRamWashPtr => v + end subroutine + + subroutine SubscribeUpperRamFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeUpperRamFail + !DEC$ ATTRIBUTES ALIAS: 'SubscribeUpperRamFail' :: SubscribeUpperRamFail + implicit none + procedure (ActionInteger) :: v + UpperRamFailPtr => v + end subroutine + + subroutine SubscribeUpperRamLeak(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeUpperRamLeak + !DEC$ ATTRIBUTES ALIAS: 'SubscribeUpperRamLeak' :: SubscribeUpperRamLeak + implicit none + procedure (ActionInteger) :: v + UpperRamLeakPtr => v + end subroutine + + + subroutine SubscribeMiddleRamWash(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeMiddleRamWash + !DEC$ ATTRIBUTES ALIAS: 'SubscribeMiddleRamWash' :: SubscribeMiddleRamWash + implicit none + procedure (ActionInteger) :: v + MiddleRamWashPtr => v + end subroutine + + subroutine SubscribeMiddleRamFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeMiddleRamFail + !DEC$ ATTRIBUTES ALIAS: 'SubscribeMiddleRamFail' :: SubscribeMiddleRamFail + implicit none + procedure (ActionInteger) :: v + MiddleRamFailPtr => v + end subroutine + + subroutine SubscribeMiddleRamLeak(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeMiddleRamLeak + !DEC$ ATTRIBUTES ALIAS: 'SubscribeMiddleRamLeak' :: SubscribeMiddleRamLeak + implicit none + procedure (ActionInteger) :: v + MiddleRamLeakPtr => v + end subroutine + + + subroutine SubscribeLowerRamWash(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLowerRamWash + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLowerRamWash' :: SubscribeLowerRamWash + implicit none + procedure (ActionInteger) :: v + LowerRamWashPtr => v + end subroutine + + subroutine SubscribeLowerRamFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLowerRamFail + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLowerRamFail' :: SubscribeLowerRamFail + implicit none + procedure (ActionInteger) :: v + LowerRamFailPtr => v + end subroutine + + subroutine SubscribeLowerRamLeak(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLowerRamLeak + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLowerRamLeak' :: SubscribeLowerRamLeak + implicit none + procedure (ActionInteger) :: v + LowerRamLeakPtr => v + end subroutine + + subroutine SubscribeAccumulatorPumpFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeAccumulatorPumpFail + !DEC$ ATTRIBUTES ALIAS: 'SubscribeAccumulatorPumpFail' :: SubscribeAccumulatorPumpFail + implicit none + procedure (ActionInteger) :: v + AccumulatorPumpFailPtr => v + end subroutine + + subroutine SubscribeAccumulatorPumpLeak(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeAccumulatorPumpLeak + !DEC$ ATTRIBUTES ALIAS: 'SubscribeAccumulatorPumpLeak' :: SubscribeAccumulatorPumpLeak + implicit none + procedure (ActionInteger) :: v + AccumulatorPumpLeakPtr => v + end subroutine + + subroutine SubscribeAccumulatorSystemFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeAccumulatorSystemFail + !DEC$ ATTRIBUTES ALIAS: 'SubscribeAccumulatorSystemFail' :: SubscribeAccumulatorSystemFail + implicit none + procedure (ActionInteger) :: v + AccumulatorSystemFailPtr => v + end subroutine + + subroutine SubscribeAccumulatorSystemLeak(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeAccumulatorSystemLeak + !DEC$ ATTRIBUTES ALIAS: 'SubscribeAccumulatorSystemLeak' :: SubscribeAccumulatorSystemLeak + implicit none + procedure (ActionInteger) :: v + AccumulatorSystemLeakPtr => v + end subroutine + + + + + +end module CBopProblemsVariables \ No newline at end of file diff --git a/CSharp/Problems/CChokeProblems.f90 b/CSharp/Problems/CChokeProblems.f90 new file mode 100644 index 0000000..a70aaad --- /dev/null +++ b/CSharp/Problems/CChokeProblems.f90 @@ -0,0 +1,221 @@ +module CChokeProblems + use CChokeProblemsVariables + implicit none + public + contains + + ! Input routines + subroutine SetHydraulicChoke1Plugged(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetHydraulicChoke1Plugged + !DEC$ ATTRIBUTES ALIAS: 'SetHydraulicChoke1Plugged' :: SetHydraulicChoke1Plugged + implicit none + type(CProblem), intent(in) :: v + HydraulicChoke1Plugged = SetDue(v, ChangeHydraulicChoke1Plugged) +#ifdef deb + print*, 'HydraulicChoke1Plugged%ProblemType=', HydraulicChoke1Plugged%ProblemType + print*, 'HydraulicChoke1Plugged%StatusType=', HydraulicChoke1Plugged%StatusType + print*, 'HydraulicChoke1Plugged%Value=', HydraulicChoke1Plugged%Value +#endif + end subroutine + + subroutine SetHydraulicChoke1Fail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetHydraulicChoke1Fail + !DEC$ ATTRIBUTES ALIAS: 'SetHydraulicChoke1Fail' :: SetHydraulicChoke1Fail + implicit none + type(CProblem), intent(in) :: v + HydraulicChoke1Fail = SetDue(v, ChangeHydraulicChoke1Fail) +#ifdef deb + print*, 'HydraulicChoke1Fail%ProblemType=', HydraulicChoke1Fail%ProblemType + print*, 'HydraulicChoke1Fail%StatusType=', HydraulicChoke1Fail%StatusType + print*, 'HydraulicChoke1Fail%Value=', HydraulicChoke1Fail%Value +#endif + end subroutine + + subroutine SetHydraulicChoke1Washout(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetHydraulicChoke1Washout + !DEC$ ATTRIBUTES ALIAS: 'SetHydraulicChoke1Washout' :: SetHydraulicChoke1Washout + implicit none + type(CProblem), intent(in) :: v + HydraulicChoke1Washout = SetDue(v, ChangeHydraulicChoke1Washout) +#ifdef deb + print*, 'HydraulicChoke1Washout%ProblemType=', HydraulicChoke1Washout%ProblemType + print*, 'HydraulicChoke1Washout%StatusType=', HydraulicChoke1Washout%StatusType + print*, 'HydraulicChoke1Washout%Value=', HydraulicChoke1Washout%Value +#endif + end subroutine + + subroutine SetHydraulicChoke1PluggedPercent(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetHydraulicChoke1PluggedPercent + !DEC$ ATTRIBUTES ALIAS: 'SetHydraulicChoke1PluggedPercent' :: SetHydraulicChoke1PluggedPercent + implicit none + integer, intent(in) :: v + HydraulicChoke1PluggedPercent = v +#ifdef deb + print*, 'HydraulicChoke1PluggedPercent=', HydraulicChoke1PluggedPercent +#endif + end subroutine + + subroutine SetHydraulicChoke2Plugged(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetHydraulicChoke2Plugged + !DEC$ ATTRIBUTES ALIAS: 'SetHydraulicChoke2Plugged' :: SetHydraulicChoke2Plugged + implicit none + type(CProblem), intent(in) :: v + HydraulicChoke2Plugged = SetDue(v, ChangeHydraulicChoke2Plugged) +#ifdef deb + print*, 'HydraulicChoke2Plugged%ProblemType=', HydraulicChoke2Plugged%ProblemType + print*, 'HydraulicChoke2Plugged%StatusType=', HydraulicChoke2Plugged%StatusType + print*, 'HydraulicChoke2Plugged%Value=', HydraulicChoke2Plugged%Value +#endif + end subroutine + + subroutine SetHydraulicChoke2Fail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetHydraulicChoke2Fail + !DEC$ ATTRIBUTES ALIAS: 'SetHydraulicChoke2Fail' :: SetHydraulicChoke2Fail + implicit none + type(CProblem), intent(in) :: v + HydraulicChoke2Fail = SetDue(v, ChangeHydraulicChoke2Fail) +#ifdef deb + print*, 'HydraulicChoke2Fail%ProblemType=', HydraulicChoke2Fail%ProblemType + print*, 'HydraulicChoke2Fail%StatusType=', HydraulicChoke2Fail%StatusType + print*, 'HydraulicChoke2Fail%Value=', HydraulicChoke2Fail%Value +#endif + end subroutine + + subroutine SetHydraulicChoke2Washout(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetHydraulicChoke2Washout + !DEC$ ATTRIBUTES ALIAS: 'SetHydraulicChoke2Washout' :: SetHydraulicChoke2Washout + implicit none + type(CProblem), intent(in) :: v + HydraulicChoke2Washout = SetDue(v, ChangeHydraulicChoke2Washout) +#ifdef deb + print*, 'HydraulicChoke2Washout%ProblemType=', HydraulicChoke2Washout%ProblemType + print*, 'HydraulicChoke2Washout%StatusType=', HydraulicChoke2Washout%StatusType + print*, 'HydraulicChoke2Washout%Value=', HydraulicChoke2Washout%Value +#endif + end subroutine + + subroutine SetHydraulicChoke2PluggedPercent(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetHydraulicChoke2PluggedPercent + !DEC$ ATTRIBUTES ALIAS: 'SetHydraulicChoke2PluggedPercent' :: SetHydraulicChoke2PluggedPercent + implicit none + integer, intent(in) :: v + HydraulicChoke2PluggedPercent = v +#ifdef deb + print*, 'HydraulicChoke2PluggedPercent=', HydraulicChoke2PluggedPercent +#endif + end subroutine + + subroutine SetManualChoke1Plugged(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetManualChoke1Plugged + !DEC$ ATTRIBUTES ALIAS: 'SetManualChoke1Plugged' :: SetManualChoke1Plugged + implicit none + type(CProblem), intent(in) :: v + ManualChoke1Plugged = SetDue(v, ChangeManualChoke1Plugged) +#ifdef deb + print*, 'ManualChoke1Plugged%ProblemType=', ManualChoke1Plugged%ProblemType + print*, 'ManualChoke1Plugged%StatusType=', ManualChoke1Plugged%StatusType + print*, 'ManualChoke1Plugged%Value=', ManualChoke1Plugged%Value +#endif + end subroutine + + subroutine SetManualChoke1Fail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetManualChoke1Fail + !DEC$ ATTRIBUTES ALIAS: 'SetManualChoke1Fail' :: SetManualChoke1Fail + implicit none + type(CProblem), intent(in) :: v + ManualChoke1Fail = SetDue(v, ChangeManualChoke1Fail) +#ifdef deb + print*, 'ManualChoke1Fail%ProblemType=', ManualChoke1Fail%ProblemType + print*, 'ManualChoke1Fail%StatusType=', ManualChoke1Fail%StatusType + print*, 'ManualChoke1Fail%Value=', ManualChoke1Fail%Value +#endif + end subroutine + + subroutine SetManualChoke1Washout(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetManualChoke1Washout + !DEC$ ATTRIBUTES ALIAS: 'SetManualChoke1Washout' :: SetManualChoke1Washout + implicit none + type(CProblem), intent(in) :: v + ManualChoke1Washout = SetDue(v, ChangeManualChoke1Washout) +#ifdef deb + print*, 'ManualChoke1Washout%ProblemType=', ManualChoke1Washout%ProblemType + print*, 'ManualChoke1Washout%StatusType=', ManualChoke1Washout%StatusType + print*, 'ManualChoke1Washout%Value=', ManualChoke1Washout%Value +#endif + end subroutine + + subroutine SetManualChoke1PluggedPercent(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetManualChoke1PluggedPercent + !DEC$ ATTRIBUTES ALIAS: 'SetManualChoke1PluggedPercent' :: SetManualChoke1PluggedPercent + implicit none + integer, intent(in) :: v + ManualChoke1PluggedPercent = v +#ifdef deb + print*, 'ManualChoke1PluggedPercent=', ManualChoke1PluggedPercent +#endif + end subroutine + + subroutine SetManualChoke2Plugged(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetManualChoke2Plugged + !DEC$ ATTRIBUTES ALIAS: 'SetManualChoke2Plugged' :: SetManualChoke2Plugged + implicit none + type(CProblem), intent(in) :: v + ManualChoke2Plugged = SetDue(v, ChangeManualChoke2Plugged) +#ifdef deb + print*, 'ManualChoke2Plugged%ProblemType=', ManualChoke2Plugged%ProblemType + print*, 'ManualChoke2Plugged%StatusType=', ManualChoke2Plugged%StatusType + print*, 'ManualChoke2Plugged%Value=', ManualChoke2Plugged%Value +#endif + end subroutine + + subroutine SetManualChoke2Fail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetManualChoke2Fail + !DEC$ ATTRIBUTES ALIAS: 'SetManualChoke2Fail' :: SetManualChoke2Fail + implicit none + type(CProblem), intent(in) :: v + ManualChoke2Fail = SetDue(v, ChangeManualChoke2Fail) +#ifdef deb + print*, 'ManualChoke2Fail%ProblemType=', ManualChoke2Fail%ProblemType + print*, 'ManualChoke2Fail%StatusType=', ManualChoke2Fail%StatusType + print*, 'ManualChoke2Fail%Value=', ManualChoke2Fail%Value +#endif + end subroutine + + subroutine SetManualChoke2Washout(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetManualChoke2Washout + !DEC$ ATTRIBUTES ALIAS: 'SetManualChoke2Washout' :: SetManualChoke2Washout + implicit none + type(CProblem), intent(in) :: v + ManualChoke2Washout = SetDue(v, ChangeManualChoke2Washout) +#ifdef deb + print*, 'ManualChoke2Washout%ProblemType=', ManualChoke2Washout%ProblemType + print*, 'ManualChoke2Washout%StatusType=', ManualChoke2Washout%StatusType + print*, 'ManualChoke2Washout%Value=', ManualChoke2Washout%Value +#endif + end subroutine + + subroutine SetManualChoke2PluggedPercent(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetManu alChoke2PluggedPercent + !DEC$ ATTRIBUTES ALIAS: 'SetManualChoke2PluggedPercent' :: SetManualChoke2PluggedPercent + implicit none + integer, intent(in) :: v + ManualChoke2PluggedPercent = v +#ifdef deb + print*, 'ManualChoke2PluggedPercent=', ManualChoke2PluggedPercent +#endif + end subroutine + + subroutine SetChokePanelAirFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokePanelAirFail + !DEC$ ATTRIBUTES ALIAS: 'SetChokePanelAirFail' :: SetChokePanelAirFail + implicit none + type(CProblem), intent(in) :: v + ChokePanelAirFail = SetDue(v, ChangeChokePanelAirFail) +#ifdef deb + print*, 'ChokePanelAirFail%ProblemType=', ChokePanelAirFail%ProblemType + print*, 'ChokePanelAirFail%StatusType=', ChokePanelAirFail%StatusType + print*, 'ChokePanelAirFail%Value=', ChokePanelAirFail%Value +#endif + end subroutine + +end module CChokeProblems \ No newline at end of file diff --git a/CSharp/Problems/CChokeProblemsVariables.f90 b/CSharp/Problems/CChokeProblemsVariables.f90 new file mode 100644 index 0000000..72ae275 --- /dev/null +++ b/CSharp/Problems/CChokeProblemsVariables.f90 @@ -0,0 +1,367 @@ +module CChokeProblemsVariables + use CProblemDifinition + + implicit none + public + + ! Input vars + type(CProblem) :: HydraulicChoke1Plugged + type(CProblem) :: HydraulicChoke1Fail + type(CProblem) :: HydraulicChoke1Washout + integer :: HydraulicChoke1PluggedPercent + type(CProblem) :: HydraulicChoke2Plugged + type(CProblem) :: HydraulicChoke2Fail + type(CProblem) :: HydraulicChoke2Washout + integer :: HydraulicChoke2PluggedPercent + type(CProblem) :: ManualChoke1Plugged + type(CProblem) :: ManualChoke1Fail + type(CProblem) :: ManualChoke1Washout + integer :: ManualChoke1PluggedPercent + type(CProblem) :: ManualChoke2Plugged + type(CProblem) :: ManualChoke2Fail + type(CProblem) :: ManualChoke2Washout + integer :: ManualChoke2PluggedPercent + type(CProblem) :: ChokePanelAirFail + + procedure (ActionInteger), pointer :: HydraulicChoke1PluggedPtr + procedure (ActionInteger), pointer :: HydraulicChoke1FailPtr + procedure (ActionInteger), pointer :: HydraulicChoke1WashoutPtr + procedure (ActionInteger), pointer :: HydraulicChoke2PluggedPtr + procedure (ActionInteger), pointer :: HydraulicChoke2FailPtr + procedure (ActionInteger), pointer :: HydraulicChoke2WashoutPtr + procedure (ActionInteger), pointer :: ManualChoke1PluggedPtr + procedure (ActionInteger), pointer :: ManualChoke1FailPtr + procedure (ActionInteger), pointer :: ManualChoke1WashoutPtr + procedure (ActionInteger), pointer :: ManualChoke2PluggedPtr + procedure (ActionInteger), pointer :: ManualChoke2FailPtr + procedure (ActionInteger), pointer :: ManualChoke2WashoutPtr + procedure (ActionInteger), pointer :: ChokePanelAirFailPtr + + contains + + subroutine ProcessChokeProblemsDueTime(time) + implicit none + integer :: time + if(HydraulicChoke1Plugged%ProblemType == Time_ProblemType) call ProcessDueTime(HydraulicChoke1Plugged, ChangeHydraulicChoke1Plugged, time) + if(HydraulicChoke1Fail%ProblemType == Time_ProblemType) call ProcessDueTime(HydraulicChoke1Fail, ChangeHydraulicChoke1Fail, time) + if(HydraulicChoke1Washout%ProblemType == Time_ProblemType) call ProcessDueTime(HydraulicChoke1Washout, ChangeHydraulicChoke1Washout, time) + if(HydraulicChoke2Plugged%ProblemType == Time_ProblemType) call ProcessDueTime(HydraulicChoke2Plugged, ChangeHydraulicChoke2Plugged, time) + if(HydraulicChoke2Fail%ProblemType == Time_ProblemType) call ProcessDueTime(HydraulicChoke2Fail, ChangeHydraulicChoke2Fail, time) + if(HydraulicChoke2Washout%ProblemType == Time_ProblemType) call ProcessDueTime(HydraulicChoke2Washout, ChangeHydraulicChoke2Washout, time) + if(ManualChoke1Plugged%ProblemType == Time_ProblemType) call ProcessDueTime(ManualChoke1Plugged, ChangeManualChoke1Plugged, time) + if(ManualChoke1Fail%ProblemType == Time_ProblemType) call ProcessDueTime(ManualChoke1Fail, ChangeManualChoke1Fail, time) + if(ManualChoke1Washout%ProblemType == Time_ProblemType) call ProcessDueTime(ManualChoke1Washout, ChangeManualChoke1Washout, time) + if(ManualChoke2Plugged%ProblemType == Time_ProblemType) call ProcessDueTime(ManualChoke2Plugged, ChangeManualChoke2Plugged, time) + if(ManualChoke2Fail%ProblemType == Time_ProblemType) call ProcessDueTime(ManualChoke2Fail, ChangeManualChoke2Fail, time) + if(ManualChoke2Washout%ProblemType == Time_ProblemType) call ProcessDueTime(ManualChoke2Washout, ChangeManualChoke2Washout, time) + if(ChokePanelAirFail%ProblemType == Time_ProblemType) call ProcessDueTime(ChokePanelAirFail, ChangeChokePanelAirFail, time) + end subroutine + + subroutine ProcessChokeProblemsDuePumpStrokes(strokes) + implicit none + integer :: strokes + if(HydraulicChoke1Plugged%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(HydraulicChoke1Plugged, ChangeHydraulicChoke1Plugged, strokes) + if(HydraulicChoke1Fail%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(HydraulicChoke1Fail, ChangeHydraulicChoke1Fail, strokes) + if(HydraulicChoke1Washout%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(HydraulicChoke1Washout, ChangeHydraulicChoke1Washout, strokes) + if(HydraulicChoke2Plugged%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(HydraulicChoke2Plugged, ChangeHydraulicChoke2Plugged, strokes) + if(HydraulicChoke2Fail%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(HydraulicChoke2Fail, ChangeHydraulicChoke2Fail, strokes) + if(HydraulicChoke2Washout%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(HydraulicChoke2Washout, ChangeHydraulicChoke2Washout, strokes) + if(ManualChoke1Plugged%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(ManualChoke1Plugged, ChangeManualChoke1Plugged, strokes) + if(ManualChoke1Fail%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(ManualChoke1Fail, ChangeManualChoke1Fail, strokes) + if(ManualChoke1Washout%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(ManualChoke1Washout, ChangeManualChoke1Washout, strokes) + if(ManualChoke2Plugged%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(ManualChoke2Plugged, ChangeManualChoke2Plugged, strokes) + if(ManualChoke2Fail%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(ManualChoke2Fail, ChangeManualChoke2Fail, strokes) + if(ManualChoke2Washout%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(ManualChoke2Washout, ChangeManualChoke2Washout, strokes) + if(ChokePanelAirFail%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(ChokePanelAirFail, ChangeChokePanelAirFail, strokes) + end subroutine + + subroutine ProcessChokeProblemsDueVolumePumped(volume) + implicit none + real(8) :: volume + if(HydraulicChoke1Plugged%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(HydraulicChoke1Plugged, ChangeHydraulicChoke1Plugged, volume) + if(HydraulicChoke1Fail%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(HydraulicChoke1Fail, ChangeHydraulicChoke1Fail, volume) + if(HydraulicChoke1Washout%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(HydraulicChoke1Washout, ChangeHydraulicChoke1Washout, volume) + if(HydraulicChoke2Plugged%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(HydraulicChoke2Plugged, ChangeHydraulicChoke2Plugged, volume) + if(HydraulicChoke2Fail%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(HydraulicChoke2Fail, ChangeHydraulicChoke2Fail, volume) + if(HydraulicChoke2Washout%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(HydraulicChoke2Washout, ChangeHydraulicChoke2Washout, volume) + if(ManualChoke1Plugged%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(ManualChoke1Plugged, ChangeManualChoke1Plugged, volume) + if(ManualChoke1Fail%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(ManualChoke1Fail, ChangeManualChoke1Fail, volume) + if(ManualChoke1Washout%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(ManualChoke1Washout, ChangeManualChoke1Washout, volume) + if(ManualChoke2Plugged%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(ManualChoke2Plugged, ChangeManualChoke2Plugged, volume) + if(ManualChoke2Fail%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(ManualChoke2Fail, ChangeManualChoke2Fail, volume) + if(ManualChoke2Washout%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(ManualChoke2Washout, ChangeManualChoke2Washout, volume) + if(ChokePanelAirFail%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(ChokePanelAirFail, ChangeChokePanelAirFail, volume) + end subroutine + + subroutine ProcessChokeProblemsDueDistanceDrilled(distance) + implicit none + real(8) :: distance + if(HydraulicChoke1Plugged%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(HydraulicChoke1Plugged, ChangeHydraulicChoke1Plugged, distance) + if(HydraulicChoke1Fail%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(HydraulicChoke1Fail, ChangeHydraulicChoke1Fail, distance) + if(HydraulicChoke1Washout%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(HydraulicChoke1Washout, ChangeHydraulicChoke1Washout, distance) + if(HydraulicChoke2Plugged%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(HydraulicChoke2Plugged, ChangeHydraulicChoke2Plugged, distance) + if(HydraulicChoke2Fail%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(HydraulicChoke2Fail, ChangeHydraulicChoke2Fail, distance) + if(HydraulicChoke2Washout%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(HydraulicChoke2Washout, ChangeHydraulicChoke2Washout, distance) + if(ManualChoke1Plugged%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(ManualChoke1Plugged, ChangeManualChoke1Plugged, distance) + if(ManualChoke1Fail%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(ManualChoke1Fail, ChangeManualChoke1Fail, distance) + if(ManualChoke1Washout%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(ManualChoke1Washout, ChangeManualChoke1Washout, distance) + if(ManualChoke2Plugged%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(ManualChoke2Plugged, ChangeManualChoke2Plugged, distance) + if(ManualChoke2Fail%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(ManualChoke2Fail, ChangeManualChoke2Fail, distance) + if(ManualChoke2Washout%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(ManualChoke2Washout, ChangeManualChoke2Washout, distance) + if(ChokePanelAirFail%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(ChokePanelAirFail, ChangeChokePanelAirFail, distance) + end subroutine + + + + + subroutine ChangeHydraulicChoke1Plugged(status) + USE CHOKEVARIABLES + implicit none + integer, intent (in) :: status + if(associated(HydraulicChoke1PluggedPtr)) call HydraulicChoke1PluggedPtr(status) + if(status == Clear_StatusType) CHOOKE(1)%PlugMalf = 0 + if(status == Executed_StatusType) CHOOKE(1)%PlugMalf = 1 + endsubroutine + + subroutine ChangeHydraulicChoke1Fail(status) + USE CHOKEVARIABLES + implicit none + integer, intent (in) :: status + if(associated(HydraulicChoke1FailPtr)) call HydraulicChoke1FailPtr(status) + if(status == Clear_StatusType) CHOOKE(1)%FailMalf = 0 + if(status == Executed_StatusType) CHOOKE(1)%FailMalf = 1 + endsubroutine + + subroutine ChangeHydraulicChoke1Washout(status) + USE CHOKEVARIABLES + use CChokeManifoldVariables + implicit none + integer, intent (in) :: status + if(associated(HydraulicChoke1WashoutPtr)) call HydraulicChoke1WashoutPtr(status) + if(status == Clear_StatusType) CHOOKE(1)%WashoutMalf = 0 + if(status == Executed_StatusType) CHOOKE(1)%WashoutMalf = 1 + + if(status == Clear_StatusType) HyChock1OnProblem = .false. + if(status == Executed_StatusType) HyChock1OnProblem = .true. + endsubroutine + + subroutine ChangeHydraulicChoke2Plugged(status) + USE CHOKEVARIABLES + implicit none + integer, intent (in) :: status + if(associated(HydraulicChoke2PluggedPtr)) call HydraulicChoke2PluggedPtr(status) + if(status == Clear_StatusType) CHOOKE(2)%PlugMalf = 0 + if(status == Executed_StatusType) CHOOKE(2)%PlugMalf = 1 + endsubroutine + + subroutine ChangeHydraulicChoke2Fail(status) + USE CHOKEVARIABLES + implicit none + integer, intent (in) :: status + if(associated(HydraulicChoke2FailPtr)) call HydraulicChoke2FailPtr(status) + if(status == Clear_StatusType) CHOOKE(2)%FailMalf = 0 + if(status == Executed_StatusType) CHOOKE(2)%FailMalf = 1 + endsubroutine + + subroutine ChangeHydraulicChoke2Washout(status) + USE CHOKEVARIABLES + use CChokeManifoldVariables + implicit none + integer, intent (in) :: status + if(associated(HydraulicChoke2WashoutPtr)) call HydraulicChoke2WashoutPtr(status) + if(status == Clear_StatusType) CHOOKE(2)%WashoutMalf = 0 + if(status == Executed_StatusType) CHOOKE(2)%WashoutMalf = 1 + + if(status == Clear_StatusType) HyChock2OnProblem = .false. + if(status == Executed_StatusType) HyChock2OnProblem = .true. + endsubroutine + + subroutine ChangeManualChoke1Plugged(status) + USE FricPressDropVars + implicit none + integer, intent (in) :: status + if(associated(ManualChoke1PluggedPtr)) call ManualChoke1PluggedPtr(status) + if(status == Clear_StatusType) ManChoke1Plug = 0 + if(status == Executed_StatusType) ManChoke1Plug = 1 + endsubroutine + + subroutine ChangeManualChoke1Fail(status) + implicit none + integer, intent (in) :: status + if(associated(ManualChoke1FailPtr)) call ManualChoke1FailPtr(status) + !if(status == Clear_StatusType) print*,'On_ManualChoke1Fail_Clear' + !if(status == Executed_StatusType) print*,'On_ManualChoke1Fail_Execute' + endsubroutine + + subroutine ChangeManualChoke1Washout(status) + USE FricPressDropVars + use CChokeManifoldVariables + implicit none + integer, intent (in) :: status + if(associated(ManualChoke1WashoutPtr)) call ManualChoke1WashoutPtr(status) + if(status == Clear_StatusType) ManChoke1Washout = 0 + if(status == Executed_StatusType) ManChoke1Washout = 1 + + if(status == Clear_StatusType) LeftManChokeOnProblem = .false. + if(status == Executed_StatusType) LeftManChokeOnProblem = .true. + endsubroutine + + subroutine ChangeManualChoke2Plugged(status) + USE FricPressDropVars + implicit none + integer, intent (in) :: status + if(associated(ManualChoke2PluggedPtr)) call ManualChoke2PluggedPtr(status) + if(status == Clear_StatusType) ManChoke2Plug = 0 + if(status == Executed_StatusType) ManChoke2Plug = 1 + endsubroutine + + subroutine ChangeManualChoke2Fail(status) + implicit none + integer, intent (in) :: status + if(associated(ManualChoke2FailPtr)) call ManualChoke2FailPtr(status) + !if(status == Clear_StatusType) print*,'On_ManualChoke2Fail_Clear' + !if(status == Executed_StatusType) print*,'On_ManualChoke2Fail_Execute' + endsubroutine + + subroutine ChangeManualChoke2Washout(status) + USE FricPressDropVars + use CChokeManifoldVariables + implicit none + integer, intent (in) :: status + if(associated(ManualChoke2WashoutPtr)) call ManualChoke2WashoutPtr(status) + if(status == Clear_StatusType) ManChoke2Washout = 0 + if(status == Executed_StatusType) ManChoke2Washout = 1 + + if(status == Clear_StatusType) RightManChokeOnProblem = .false. + if(status == Executed_StatusType) RightManChokeOnProblem = .true. + endsubroutine + + subroutine ChangeChokePanelAirFail(status) + USE CHOKEVARIABLES + implicit none + integer, intent (in) :: status + if(associated(ChokePanelAirFailPtr)) call ChokePanelAirFailPtr(status) + if(status == Clear_StatusType) ChokeAirFail = 0 + if(status == Executed_StatusType) ChokeAirFail = 1 + endsubroutine + + + + + + + + + + + + + + + + + subroutine SubscribeHydraulicChoke1Plugged(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeHydraulicChoke1Plugged + !DEC$ ATTRIBUTES ALIAS: 'SubscribeHydraulicChoke1Plugged' :: SubscribeHydraulicChoke1Plugged + implicit none + procedure (ActionInteger) :: v + HydraulicChoke1PluggedPtr => v + end subroutine + + subroutine SubscribeHydraulicChoke1Fail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeHydraulicChoke1Fail + !DEC$ ATTRIBUTES ALIAS: 'SubscribeHydraulicChoke1Fail' :: SubscribeHydraulicChoke1Fail + implicit none + procedure (ActionInteger) :: v + HydraulicChoke1FailPtr => v + end subroutine + + subroutine SubscribeHydraulicChoke1Washout(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeHydraulicChoke1Washout + !DEC$ ATTRIBUTES ALIAS: 'SubscribeHydraulicChoke1Washout' :: SubscribeHydraulicChoke1Washout + implicit none + procedure (ActionInteger) :: v + HydraulicChoke1WashoutPtr => v + end subroutine + + subroutine SubscribeHydraulicChoke2Plugged(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeHydraulicChoke2Plugged + !DEC$ ATTRIBUTES ALIAS: 'SubscribeHydraulicChoke2Plugged' :: SubscribeHydraulicChoke2Plugged + implicit none + procedure (ActionInteger) :: v + HydraulicChoke2PluggedPtr => v + end subroutine + + subroutine SubscribeHydraulicChoke2Fail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeHydraulicChoke2Fail + !DEC$ ATTRIBUTES ALIAS: 'SubscribeHydraulicChoke2Fail' :: SubscribeHydraulicChoke2Fail + implicit none + procedure (ActionInteger) :: v + HydraulicChoke2FailPtr => v + end subroutine + + subroutine SubscribeHydraulicChoke2Washout(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeHydraulicChoke2Washout + !DEC$ ATTRIBUTES ALIAS: 'SubscribeHydraulicChoke2Washout' :: SubscribeHydraulicChoke2Washout + implicit none + procedure (ActionInteger) :: v + HydraulicChoke2WashoutPtr => v + end subroutine + + subroutine SubscribeManualChoke1Plugged(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeManualChoke1Plugged + !DEC$ ATTRIBUTES ALIAS: 'SubscribeManualChoke1Plugged' :: SubscribeManualChoke1Plugged + implicit none + procedure (ActionInteger) :: v + ManualChoke1PluggedPtr => v + end subroutine + + subroutine SubscribeManualChoke1Fail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeManualChoke1Fail + !DEC$ ATTRIBUTES ALIAS: 'SubscribeManualChoke1Fail' :: SubscribeManualChoke1Fail + implicit none + procedure (ActionInteger) :: v + ManualChoke1FailPtr => v + end subroutine + + subroutine SubscribeManualChoke1Washout(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeManualChoke1Washout + !DEC$ ATTRIBUTES ALIAS: 'SubscribeManualChoke1Washout' :: SubscribeManualChoke1Washout + implicit none + procedure (ActionInteger) :: v + ManualChoke1WashoutPtr => v + end subroutine + + subroutine SubscribeManualChoke2Plugged(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeManualChoke2Plugged + !DEC$ ATTRIBUTES ALIAS: 'SubscribeManualChoke2Plugged' :: SubscribeManualChoke2Plugged + implicit none + procedure (ActionInteger) :: v + ManualChoke2PluggedPtr => v + end subroutine + + subroutine SubscribeManualChoke2Fail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeManualChoke2Fail + !DEC$ ATTRIBUTES ALIAS: 'SubscribeManualChoke2Fail' :: SubscribeManualChoke2Fail + implicit none + procedure (ActionInteger) :: v + ManualChoke2FailPtr => v + end subroutine + + subroutine SubscribeManualChoke2Washout(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeManualChoke2Washout + !DEC$ ATTRIBUTES ALIAS: 'SubscribeManualChoke2Washout' :: SubscribeManualChoke2Washout + implicit none + procedure (ActionInteger) :: v + ManualChoke2WashoutPtr => v + end subroutine + + subroutine SubscribeChokePanelAirFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeChokePanelAirFail + !DEC$ ATTRIBUTES ALIAS: 'SubscribeChokePanelAirFail' :: SubscribeChokePanelAirFail + implicit none + procedure (ActionInteger) :: v + ChokePanelAirFailPtr => v + end subroutine + +end module CChokeProblemsVariables \ No newline at end of file diff --git a/CSharp/Problems/CDrillStemProblems.f90 b/CSharp/Problems/CDrillStemProblems.f90 new file mode 100644 index 0000000..c6aa4ff --- /dev/null +++ b/CSharp/Problems/CDrillStemProblems.f90 @@ -0,0 +1,69 @@ +module CDrillStemProblems + use CDrillStemProblemsVariables + implicit none + public + contains + + ! Input routines + subroutine SetStringDragIncrease(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStringDragIncrease + !DEC$ ATTRIBUTES ALIAS: 'SetStringDragIncrease' :: SetStringDragIncrease + implicit none + type(CProblem), intent(in) :: v + StringDragIncrease = SetDue(v, ChangeStringDragIncrease) +#ifdef deb + print*, 'StringDragIncrease%ProblemType=', StringDragIncrease%ProblemType + print*, 'StringDragIncrease%StatusType=', StringDragIncrease%StatusType + print*, 'StringDragIncrease%Value=', StringDragIncrease%Value +#endif + end subroutine + + subroutine SetStringTorqueIncrease(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStringTorqueIncrease + !DEC$ ATTRIBUTES ALIAS: 'SetStringTorqueIncrease' :: SetStringTorqueIncrease + implicit none + type(CProblem), intent(in) :: v + StringTorqueIncrease = SetDue(v, ChangeStringTorqueIncrease) +#ifdef deb + print*, 'StringTorqueIncrease%ProblemType=', StringTorqueIncrease%ProblemType + print*, 'StringTorqueIncrease%StatusType=', StringTorqueIncrease%StatusType + print*, 'StringTorqueIncrease%Value=', StringTorqueIncrease%Value +#endif + end subroutine + + subroutine SetStringTorqueFluctuation(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStringTorqueFluctuation + !DEC$ ATTRIBUTES ALIAS: 'SetStringTorqueFluctuation' :: SetStringTorqueFluctuation + implicit none + type(CProblem), intent(in) :: v + StringTorqueFluctuation = SetDue(v, ChangeStringTorqueFluctuation) +#ifdef deb + print*, 'StringTorqueFluctuation%ProblemType=', StringTorqueFluctuation%ProblemType + print*, 'StringTorqueFluctuation%StatusType=', StringTorqueFluctuation%StatusType + print*, 'StringTorqueFluctuation%Value=', StringTorqueFluctuation%Value +#endif + end subroutine + + subroutine SetStringDragIncreaseTime(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStringDragIncreaseTime + !DEC$ ATTRIBUTES ALIAS: 'SetStringDragIncreaseTime' :: SetStringDragIncreaseTime + implicit none + real(8), intent(in) :: v + StringDragIncreaseTime = v +#ifdef deb + print*, 'StringDragIncreaseTime=', StringDragIncreaseTime +#endif + end subroutine + + subroutine SetStringTorqueIncreaseTime(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStringTorqueIncreaseTime + !DEC$ ATTRIBUTES ALIAS: 'SetStringTorqueIncreaseTime' :: SetStringTorqueIncreaseTime + implicit none + real(8), intent(in) :: v + StringTorqueIncreaseTime = v +#ifdef deb + print*, 'StringTorqueIncreaseTime=', StringTorqueIncreaseTime +#endif + end subroutine + +end module CDrillStemProblems \ No newline at end of file diff --git a/CSharp/Problems/CDrillStemProblemsVariables.f90 b/CSharp/Problems/CDrillStemProblemsVariables.f90 new file mode 100644 index 0000000..9c2cb1c --- /dev/null +++ b/CSharp/Problems/CDrillStemProblemsVariables.f90 @@ -0,0 +1,113 @@ +module CDrillStemProblemsVariables + use CProblemDifinition + implicit none + public + + ! Input vars + type(CProblem) :: StringDragIncrease + type(CProblem) :: StringTorqueIncrease + type(CProblem) :: StringTorqueFluctuation + real(8) :: StringDragIncreaseTime + real(8) :: StringTorqueIncreaseTime + + + procedure (ActionInteger), pointer :: StringDragIncreasePtr + procedure (ActionInteger), pointer :: StringTorqueIncreasePtr + procedure (ActionInteger), pointer :: StringTorqueFluctuationPtr + + contains + + subroutine ProcessDrillStemProblemsDueTime(time) + implicit none + integer :: time + if(StringDragIncrease%ProblemType == Time_ProblemType) call ProcessDueTime(StringDragIncrease, ChangeStringDragIncrease, time) + if(StringTorqueIncrease%ProblemType == Time_ProblemType) call ProcessDueTime(StringTorqueIncrease, ChangeStringTorqueIncrease, time) + if(StringTorqueFluctuation%ProblemType == Time_ProblemType) call ProcessDueTime(StringTorqueFluctuation, ChangeStringTorqueFluctuation, time) + end subroutine + + subroutine ProcessDrillStemProblemsDuePumpStrokes(strokes) + implicit none + integer :: strokes + if(StringDragIncrease%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(StringDragIncrease, ChangeStringDragIncrease, strokes) + if(StringTorqueIncrease%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(StringTorqueIncrease, ChangeStringTorqueIncrease, strokes) + if(StringTorqueFluctuation%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(StringTorqueFluctuation, ChangeStringTorqueFluctuation, strokes) + end subroutine + + subroutine ProcessDrillStemProblemsDueVolumePumped(volume) + implicit none + real(8) :: volume + if(StringDragIncrease%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(StringDragIncrease, ChangeStringDragIncrease, volume) + if(StringTorqueIncrease%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(StringTorqueIncrease, ChangeStringTorqueIncrease, volume) + if(StringTorqueFluctuation%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(StringTorqueFluctuation, ChangeStringTorqueFluctuation, volume) + end subroutine + + subroutine ProcessDrillStemProblemsDueDistanceDrilled(distance) + implicit none + real(8) :: distance + if(StringDragIncrease%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(StringDragIncrease, ChangeStringDragIncrease, distance) + if(StringTorqueIncrease%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(StringTorqueIncrease, ChangeStringTorqueIncrease, distance) + if(StringTorqueFluctuation%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(StringTorqueFluctuation, ChangeStringTorqueFluctuation, distance) + end subroutine + + + + subroutine ChangeStringDragIncrease(status) + implicit none + integer, intent (in) :: status + if(associated(StringDragIncreasePtr)) call StringDragIncreasePtr(status) + !if(status == Clear_StatusType) print*,'On_StringDragIncrease_Clear' + !if(status == Executed_StatusType) print*,'On_StringDragIncrease_Execute' + endsubroutine + + subroutine ChangeStringTorqueIncrease(status) + implicit none + integer, intent (in) :: status + if(associated(StringTorqueIncreasePtr)) call StringTorqueIncreasePtr(status) + !if(status == Clear_StatusType) print*,'On_StringTorqueIncrease_Clear' + !if(status == Executed_StatusType) print*,'On_StringTorqueIncrease_Execute' + endsubroutine + + subroutine ChangeStringTorqueFluctuation(status) + implicit none + integer, intent (in) :: status + if(associated(StringTorqueFluctuationPtr)) call StringTorqueFluctuationPtr(status) + !if(status == Clear_StatusType) print*,'On_StringTorqueFluctuation_Clear' + !if(status == Executed_StatusType) print*,'On_StringTorqueFluctuation_Execute' + endsubroutine + + + + + + + + + + subroutine SubscribeStringDragIncrease(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeStringDragIncrease + !DEC$ ATTRIBUTES ALIAS: 'SubscribeStringDragIncrease' :: SubscribeStringDragIncrease + implicit none + procedure (ActionInteger) :: v + StringDragIncreasePtr => v + end subroutine + + subroutine SubscribeStringTorqueIncrease(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeStringTorqueIncrease + !DEC$ ATTRIBUTES ALIAS: 'SubscribeStringTorqueIncrease' :: SubscribeStringTorqueIncrease + implicit none + procedure (ActionInteger) :: v + StringTorqueIncreasePtr => v + end subroutine + + subroutine SubscribeStringTorqueFluctuation(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeStringTorqueFluctuation + !DEC$ ATTRIBUTES ALIAS: 'SubscribeStringTorqueFluctuation' :: SubscribeStringTorqueFluctuation + implicit none + procedure (ActionInteger) :: v + StringTorqueFluctuationPtr => v + end subroutine + + + + +end module CDrillStemProblemsVariables \ No newline at end of file diff --git a/CSharp/Problems/CGaugesProblems.f90 b/CSharp/Problems/CGaugesProblems.f90 new file mode 100644 index 0000000..30bd0d8 --- /dev/null +++ b/CSharp/Problems/CGaugesProblems.f90 @@ -0,0 +1,307 @@ +module CGaugesProblems + use CGaugesProblemsVariables + implicit none + public + contains + + ! Input routines + subroutine SetWeightIndicator(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetWeightIndicator + !DEC$ ATTRIBUTES ALIAS: 'SetWeightIndicator' :: SetWeightIndicator + implicit none + type(CProblem), intent(in) :: v + WeightIndicator = SetDue(v, ChangeWeightIndicator) +#ifdef deb + print*, 'WeightIndicator%ProblemType=', WeightIndicator%ProblemType + print*, 'WeightIndicator%StatusType=', WeightIndicator%StatusType + print*, 'WeightIndicator%Value=', WeightIndicator%Value +#endif + end subroutine + + subroutine SetRotaryRpm(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRotaryRpm + !DEC$ ATTRIBUTES ALIAS: 'SetRotaryRpm' :: SetRotaryRpm + implicit none + type(CProblem), intent(in) :: v + RotaryRpm = SetDue(v, ChangeRotaryRpm) +#ifdef deb + print*, 'RotaryRpm%ProblemType=', RotaryRpm%ProblemType + print*, 'RotaryRpm%StatusType=', RotaryRpm%StatusType + print*, 'RotaryRpm%Value=', RotaryRpm%Value +#endif + end subroutine + + subroutine SetRotaryTorque(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRotaryTorque + !DEC$ ATTRIBUTES ALIAS: 'SetRotaryTorque' :: SetRotaryTorque + implicit none + type(CProblem), intent(in) :: v + RotaryTorque = SetDue(v, ChangeRotaryTorque) +#ifdef deb + print*, 'RotaryTorque%ProblemType=', RotaryTorque%ProblemType + print*, 'RotaryTorque%StatusType=', RotaryTorque%StatusType + print*, 'RotaryTorque%Value=', RotaryTorque%Value +#endif + end subroutine + + subroutine SetStandPipePressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipePressure + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipePressure' :: SetStandPipePressure + implicit none + type(CProblem), intent(in) :: v + StandPipePressure = SetDue(v, ChangeStandPipePressure) +#ifdef deb + print*, 'StandPipePressure%ProblemType=', StandPipePressure%ProblemType + print*, 'StandPipePressure%StatusType=', StandPipePressure%StatusType + print*, 'StandPipePressure%Value=', StandPipePressure%Value +#endif + end subroutine + + subroutine SetCasingPressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCasingPressure + !DEC$ ATTRIBUTES ALIAS: 'SetCasingPressure' :: SetCasingPressure + implicit none + type(CProblem), intent(in) :: v + CasingPressure = SetDue(v, ChangeCasingPressure) +#ifdef deb + print*, 'CasingPressure%ProblemType=', CasingPressure%ProblemType + print*, 'CasingPressure%StatusType=', CasingPressure%StatusType + print*, 'CasingPressure%Value=', CasingPressure%Value +#endif + end subroutine + + subroutine SetPump1Strokes(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetPump1Strokes + !DEC$ ATTRIBUTES ALIAS: 'SetPump1Strokes' :: SetPump1Strokes + implicit none + type(CProblem), intent(in) :: v + Pump1Strokes = SetDue(v, ChangePump1Strokes) +#ifdef deb + print*, 'Pump1Strokes%ProblemType=', Pump1Strokes%ProblemType + print*, 'Pump1Strokes%StatusType=', Pump1Strokes%StatusType + print*, 'Pump1Strokes%Value=', Pump1Strokes%Value +#endif + end subroutine + + subroutine SetPump2Strokes(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetPump2Strokes + !DEC$ ATTRIBUTES ALIAS: 'SetPump2Strokes' :: SetPump2Strokes + implicit none + type(CProblem), intent(in) :: v + Pump2Strokes = SetDue(v, ChangePump2Strokes) +#ifdef deb + print*, 'Pump2Strokes%ProblemType=', Pump2Strokes%ProblemType + print*, 'Pump2Strokes%StatusType=', Pump2Strokes%StatusType + print*, 'Pump2Strokes%Value=', Pump2Strokes%Value +#endif + end subroutine + + subroutine SetReturnLineTemperature(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetReturnLineTemperature + !DEC$ ATTRIBUTES ALIAS: 'SetReturnLineTemperature' :: SetReturnLineTemperature + implicit none + type(CProblem), intent(in) :: v + ReturnLineTemperature = SetDue(v, ChangeReturnLineTemperature) +#ifdef deb + print*, 'ReturnLineTemperature%ProblemType=', ReturnLineTemperature%ProblemType + print*, 'ReturnLineTemperature%StatusType=', ReturnLineTemperature%StatusType + print*, 'ReturnLineTemperature%Value=', ReturnLineTemperature%Value +#endif + end subroutine + + subroutine SetTripTank(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTripTank + !DEC$ ATTRIBUTES ALIAS: 'SetTripTank' :: SetTripTank + implicit none + type(CProblem), intent(in) :: v + TripTank = SetDue(v, ChangeTripTank) +#ifdef deb + print*, 'TripTank%ProblemType=', TripTank%ProblemType + print*, 'TripTank%StatusType=', TripTank%StatusType + print*, 'TripTank%Value=', TripTank%Value +#endif + end subroutine + + subroutine SetPitGainLoss(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetPitGainLoss + !DEC$ ATTRIBUTES ALIAS: 'SetPitGainLoss' :: SetPitGainLoss + implicit none + type(CProblem), intent(in) :: v + PitGainLoss = SetDue(v, ChangePitGainLoss) +#ifdef deb + print*, 'PitGainLoss%ProblemType=', PitGainLoss%ProblemType + print*, 'PitGainLoss%StatusType=', PitGainLoss%StatusType + print*, 'PitGainLoss%Value=', PitGainLoss%Value +#endif + end subroutine + + subroutine SetMudTankVolume(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudTankVolume + !DEC$ ATTRIBUTES ALIAS: 'SetMudTankVolume' :: SetMudTankVolume + implicit none + type(CProblem), intent(in) :: v + MudTankVolume = SetDue(v, ChangeMudTankVolume) +#ifdef deb + print*, 'MudTankVolume%ProblemType=', MudTankVolume%ProblemType + print*, 'MudTankVolume%StatusType=', MudTankVolume%StatusType + print*, 'MudTankVolume%Value=', MudTankVolume%Value +#endif + end subroutine + + subroutine SetReturnMudFlow(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetReturnMudFlow + !DEC$ ATTRIBUTES ALIAS: 'SetReturnMudFlow' :: SetReturnMudFlow + implicit none + type(CProblem), intent(in) :: v + ReturnMudFlow = SetDue(v, ChangeReturnMudFlow) +#ifdef deb + print*, 'ReturnMudFlow%ProblemType=', ReturnMudFlow%ProblemType + print*, 'ReturnMudFlow%StatusType=', ReturnMudFlow%StatusType + print*, 'ReturnMudFlow%Value=', ReturnMudFlow%Value +#endif + end subroutine + + subroutine SetTorqueLimit(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTorqueLimit + !DEC$ ATTRIBUTES ALIAS: 'SetTorqueLimit' :: SetTorqueLimit + implicit none + type(CProblem), intent(in) :: v + TorqueLimit = SetDue(v, ChangeTorqueLimit) +#ifdef deb + print*, 'TorqueLimit%ProblemType=', TorqueLimit%ProblemType + print*, 'TorqueLimit%StatusType=', TorqueLimit%StatusType + print*, 'TorqueLimit%Value=', TorqueLimit%Value +#endif + end subroutine + + subroutine SetPowerLimit(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetPowerLimit + !DEC$ ATTRIBUTES ALIAS: 'SetPowerLimit' :: SetPowerLimit + implicit none + type(CProblem), intent(in) :: v + PowerLimit = SetDue(v, ChangePowerLimit) +#ifdef deb + print*, 'PowerLimit%ProblemType=', PowerLimit%ProblemType + print*, 'PowerLimit%StatusType=', PowerLimit%StatusType + print*, 'PowerLimit%Value=', PowerLimit%Value +#endif + end subroutine + + subroutine SetAccumulatorPressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAccumulatorPressure + !DEC$ ATTRIBUTES ALIAS: 'SetAccumulatorPressure' :: SetAccumulatorPressure + implicit none + type(CProblem), intent(in) :: v + AccumulatorPressure = SetDue(v, ChangeAccumulatorPressure) +#ifdef deb + print*, 'AccumulatorPressure%ProblemType=', AccumulatorPressure%ProblemType + print*, 'AccumulatorPressure%StatusType=', AccumulatorPressure%StatusType + print*, 'AccumulatorPressure%Value=', AccumulatorPressure%Value +#endif + end subroutine + + subroutine SetManifoldPressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetManifoldPressure + !DEC$ ATTRIBUTES ALIAS: 'SetManifoldPressure' :: SetManifoldPressure + implicit none + type(CProblem), intent(in) :: v + ManifoldPressure = SetDue(v, ChangeManifoldPressure) +#ifdef deb + print*, 'ManifoldPressure%ProblemType=', ManifoldPressure%ProblemType + print*, 'ManifoldPressure%StatusType=', ManifoldPressure%StatusType + print*, 'ManifoldPressure%Value=', ManifoldPressure%Value +#endif + end subroutine + + subroutine SetAnnularPressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAnnularPressure + !DEC$ ATTRIBUTES ALIAS: 'SetAnnularPressure' :: SetAnnularPressure + implicit none + type(CProblem), intent(in) :: v + AnnularPressure = SetDue(v, ChangeAnnularPressure) +#ifdef deb + print*, 'AnnularPressure%ProblemType=', AnnularPressure%ProblemType + print*, 'AnnularPressure%StatusType=', AnnularPressure%StatusType + print*, 'AnnularPressure%Value=', AnnularPressure%Value +#endif + end subroutine + + subroutine SetRigAirPressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRigAirPressure + !DEC$ ATTRIBUTES ALIAS: 'SetRigAirPressure' :: SetRigAirPressure + implicit none + type(CProblem), intent(in) :: v + RigAirPressure = SetDue(v, ChangeRigAirPressure) +#ifdef deb + print*, 'RigAirPressure%ProblemType=', RigAirPressure%ProblemType + print*, 'RigAirPressure%StatusType=', RigAirPressure%StatusType + print*, 'RigAirPressure%Value=', RigAirPressure%Value +#endif + end subroutine + + subroutine SetStandPipe1(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipe1 + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipe1' :: SetStandPipe1 + implicit none + type(CProblem), intent(in) :: v + StandPipe1 = SetDue(v, ChangeStandPipe1) +#ifdef deb + print*, 'StandPipe1%ProblemType=', StandPipe1%ProblemType + print*, 'StandPipe1%StatusType=', StandPipe1%StatusType + print*, 'StandPipe1%Value=', StandPipe1%Value +#endif + end subroutine + + subroutine SetStandPipe2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetStandPipe2 + !DEC$ ATTRIBUTES ALIAS: 'SetStandPipe2' :: SetStandPipe2 + implicit none + type(CProblem), intent(in) :: v + StandPipe2 = SetDue(v, ChangeStandPipe2) +#ifdef deb + print*, 'StandPipe2%ProblemType=', StandPipe2%ProblemType + print*, 'StandPipe2%StatusType=', StandPipe2%StatusType + print*, 'StandPipe2%Value=', StandPipe2%Value +#endif + end subroutine + + subroutine SetDrillPipePressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetDrillPipePressure + !DEC$ ATTRIBUTES ALIAS: 'SetDrillPipePressure' :: SetDrillPipePressure + implicit none + type(CProblem), intent(in) :: v + DrillPipePressure = SetDue(v, ChangeDrillPipePressure) +#ifdef deb + print*, 'DrillPipePressure%ProblemType=', DrillPipePressure%ProblemType + print*, 'DrillPipePressure%StatusType=', DrillPipePressure%StatusType + print*, 'DrillPipePressure%Value=', DrillPipePressure%Value +#endif + end subroutine + + subroutine SetChokePosition(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetChokePosition + !DEC$ ATTRIBUTES ALIAS: 'SetChokePosition' :: SetChokePosition + implicit none + type(CProblem), intent(in) :: v + ChokePosition = SetDue(v, ChangeChokePosition) +#ifdef deb + print*, 'ChokePosition%ProblemType=', ChokePosition%ProblemType + print*, 'ChokePosition%StatusType=', ChokePosition%StatusType + print*, 'ChokePosition%Value=', ChokePosition%Value +#endif + end subroutine + + subroutine SetCasingPressure2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCasingPressure2 + !DEC$ ATTRIBUTES ALIAS: 'SetCasingPressure2' :: SetCasingPressure2 + implicit none + type(CProblem), intent(in) :: v + CasingPressure2 = SetDue(v, ChangeCasingPressure2) +#ifdef deb + print*, 'CasingPressure2%ProblemType=', CasingPressure2%ProblemType + print*, 'CasingPressure2%StatusType=', CasingPressure2%StatusType + print*, 'CasingPressure2%Value=', CasingPressure2%Value +#endif + end subroutine + +end module CGaugesProblems \ No newline at end of file diff --git a/CSharp/Problems/CGaugesProblemsVariables.f90 b/CSharp/Problems/CGaugesProblemsVariables.f90 new file mode 100644 index 0000000..43723c6 --- /dev/null +++ b/CSharp/Problems/CGaugesProblemsVariables.f90 @@ -0,0 +1,585 @@ +module CGaugesProblemsVariables + use CProblemDifinition + implicit none + public + + type(CProblem) :: WeightIndicator + type(CProblem) :: RotaryRpm + type(CProblem) :: RotaryTorque + type(CProblem) :: StandPipePressure + type(CProblem) :: CasingPressure + type(CProblem) :: Pump1Strokes + type(CProblem) :: Pump2Strokes + type(CProblem) :: ReturnLineTemperature + type(CProblem) :: TripTank + type(CProblem) :: PitGainLoss + type(CProblem) :: MudTankVolume + type(CProblem) :: ReturnMudFlow + type(CProblem) :: TorqueLimit + type(CProblem) :: PowerLimit + type(CProblem) :: AccumulatorPressure + type(CProblem) :: ManifoldPressure + type(CProblem) :: AnnularPressure + type(CProblem) :: RigAirPressure + type(CProblem) :: StandPipe1 + type(CProblem) :: StandPipe2 + type(CProblem) :: DrillPipePressure + type(CProblem) :: ChokePosition + type(CProblem) :: CasingPressure2 + + + + + procedure (ActionInteger), pointer :: WeightIndicatorPtr + procedure (ActionInteger), pointer :: RotaryRpmPtr + procedure (ActionInteger), pointer :: RotaryTorquePtr + procedure (ActionInteger), pointer :: StandPipePressurePtr + procedure (ActionInteger), pointer :: CasingPressurePtr + procedure (ActionInteger), pointer :: Pump1StrokesPtr + procedure (ActionInteger), pointer :: Pump2StrokesPtr + procedure (ActionInteger), pointer :: ReturnLineTemperaturePtr + procedure (ActionInteger), pointer :: TripTankPtr + procedure (ActionInteger), pointer :: PitGainLossPtr + procedure (ActionInteger), pointer :: MudTankVolumePtr + procedure (ActionInteger), pointer :: ReturnMudFlowPtr + procedure (ActionInteger), pointer :: TorqueLimitPtr + procedure (ActionInteger), pointer :: PowerLimitPtr + procedure (ActionInteger), pointer :: AccumulatorPressurePtr + procedure (ActionInteger), pointer :: ManifoldPressurePtr + procedure (ActionInteger), pointer :: AnnularPressurePtr + procedure (ActionInteger), pointer :: RigAirPressurePtr + procedure (ActionInteger), pointer :: StandPipe1Ptr + procedure (ActionInteger), pointer :: StandPipe2Ptr + procedure (ActionInteger), pointer :: DrillPipePressurePtr + procedure (ActionInteger), pointer :: ChokePositionPtr + procedure (ActionInteger), pointer :: CasingPressure2Ptr + + + contains + + subroutine ProcessGaugesProblemsDueTime(time) + implicit none + integer :: time + if(WeightIndicator%ProblemType == Time_ProblemType) call ProcessDueTime(WeightIndicator, ChangeWeightIndicator, time) + if(RotaryRpm%ProblemType == Time_ProblemType) call ProcessDueTime(RotaryRpm, ChangeRotaryRpm, time) + if(RotaryTorque%ProblemType == Time_ProblemType) call ProcessDueTime(RotaryTorque, ChangeRotaryTorque, time) + if(StandPipePressure%ProblemType == Time_ProblemType) call ProcessDueTime(StandPipePressure, ChangeStandPipePressure, time) + if(CasingPressure%ProblemType == Time_ProblemType) call ProcessDueTime(CasingPressure, ChangeCasingPressure, time) + if(Pump1Strokes%ProblemType == Time_ProblemType) call ProcessDueTime(Pump1Strokes, ChangePump1Strokes, time) + if(Pump2Strokes%ProblemType == Time_ProblemType) call ProcessDueTime(Pump2Strokes, ChangePump2Strokes, time) + if(ReturnLineTemperature%ProblemType == Time_ProblemType) call ProcessDueTime(ReturnLineTemperature, ChangeReturnLineTemperature, time) + if(TripTank%ProblemType == Time_ProblemType) call ProcessDueTime(TripTank, ChangeTripTank, time) + if(PitGainLoss%ProblemType == Time_ProblemType) call ProcessDueTime(PitGainLoss, ChangePitGainLoss, time) + if(MudTankVolume%ProblemType == Time_ProblemType) call ProcessDueTime(MudTankVolume, ChangeMudTankVolume, time) + if(ReturnMudFlow%ProblemType == Time_ProblemType) call ProcessDueTime(ReturnMudFlow, ChangeReturnMudFlow, time) + if(TorqueLimit%ProblemType == Time_ProblemType) call ProcessDueTime(TorqueLimit, ChangeTorqueLimit, time) + if(PowerLimit%ProblemType == Time_ProblemType) call ProcessDueTime(PowerLimit, ChangePowerLimit, time) + if(AccumulatorPressure%ProblemType == Time_ProblemType) call ProcessDueTime(AccumulatorPressure, ChangeAccumulatorPressure, time) + if(ManifoldPressure%ProblemType == Time_ProblemType) call ProcessDueTime(ManifoldPressure, ChangeManifoldPressure, time) + if(AnnularPressure%ProblemType == Time_ProblemType) call ProcessDueTime(AnnularPressure, ChangeAnnularPressure, time) + if(RigAirPressure%ProblemType == Time_ProblemType) call ProcessDueTime(RigAirPressure, ChangeRigAirPressure, time) + if(StandPipe1%ProblemType == Time_ProblemType) call ProcessDueTime(StandPipe1, ChangeStandPipe1, time) + if(StandPipe2%ProblemType == Time_ProblemType) call ProcessDueTime(StandPipe2, ChangeStandPipe2, time) + if(DrillPipePressure%ProblemType == Time_ProblemType) call ProcessDueTime(DrillPipePressure, ChangeDrillPipePressure, time) + if(ChokePosition%ProblemType == Time_ProblemType) call ProcessDueTime(ChokePosition, ChangeChokePosition, time) + if(CasingPressure2%ProblemType == Time_ProblemType) call ProcessDueTime(CasingPressure2, ChangeCasingPressure2, time) + end subroutine + + subroutine ProcessGaugesProblemsDuePumpStrokes(strokes) + implicit none + integer :: strokes + if(WeightIndicator%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(WeightIndicator, ChangeWeightIndicator, strokes) + if(RotaryRpm%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(RotaryRpm, ChangeRotaryRpm, strokes) + if(RotaryTorque%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(RotaryTorque, ChangeRotaryTorque, strokes) + if(StandPipePressure%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(StandPipePressure, ChangeStandPipePressure, strokes) + if(CasingPressure%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(CasingPressure, ChangeCasingPressure, strokes) + if(Pump1Strokes%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Pump1Strokes, ChangePump1Strokes, strokes) + if(Pump2Strokes%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Pump2Strokes, ChangePump2Strokes, strokes) + if(ReturnLineTemperature%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(ReturnLineTemperature, ChangeReturnLineTemperature, strokes) + if(TripTank%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(TripTank, ChangeTripTank, strokes) + if(PitGainLoss%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(PitGainLoss, ChangePitGainLoss, strokes) + if(MudTankVolume%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(MudTankVolume, ChangeMudTankVolume, strokes) + if(ReturnMudFlow%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(ReturnMudFlow, ChangeReturnMudFlow, strokes) + if(TorqueLimit%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(TorqueLimit, ChangeTorqueLimit, strokes) + if(PowerLimit%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(PowerLimit, ChangePowerLimit, strokes) + if(AccumulatorPressure%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(AccumulatorPressure, ChangeAccumulatorPressure, strokes) + if(ManifoldPressure%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(ManifoldPressure, ChangeManifoldPressure, strokes) + if(AnnularPressure%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(AnnularPressure, ChangeAnnularPressure, strokes) + if(RigAirPressure%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(RigAirPressure, ChangeRigAirPressure, strokes) + if(StandPipe1%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(StandPipe1, ChangeStandPipe1, strokes) + if(StandPipe2%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(StandPipe2, ChangeStandPipe2, strokes) + if(DrillPipePressure%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(DrillPipePressure, ChangeDrillPipePressure, strokes) + if(ChokePosition%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(ChokePosition, ChangeChokePosition, strokes) + if(CasingPressure2%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(CasingPressure2, ChangeCasingPressure2, strokes) + end subroutine + + subroutine ProcessGaugesProblemsDueVolumePumped(volume) + implicit none + real(8) :: volume + if(WeightIndicator%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(WeightIndicator, ChangeWeightIndicator, volume) + if(RotaryRpm%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(RotaryRpm, ChangeRotaryRpm, volume) + if(RotaryTorque%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(RotaryTorque, ChangeRotaryTorque, volume) + if(StandPipePressure%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(StandPipePressure, ChangeStandPipePressure, volume) + if(CasingPressure%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(CasingPressure, ChangeCasingPressure, volume) + if(Pump1Strokes%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Pump1Strokes, ChangePump1Strokes, volume) + if(Pump2Strokes%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Pump2Strokes, ChangePump2Strokes, volume) + if(ReturnLineTemperature%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(ReturnLineTemperature, ChangeReturnLineTemperature, volume) + if(TripTank%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(TripTank, ChangeTripTank, volume) + if(PitGainLoss%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(PitGainLoss, ChangePitGainLoss, volume) + if(MudTankVolume%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(MudTankVolume, ChangeMudTankVolume, volume) + if(ReturnMudFlow%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(ReturnMudFlow, ChangeReturnMudFlow, volume) + if(TorqueLimit%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(TorqueLimit, ChangeTorqueLimit, volume) + if(PowerLimit%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(PowerLimit, ChangePowerLimit, volume) + if(AccumulatorPressure%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(AccumulatorPressure, ChangeAccumulatorPressure, volume) + if(ManifoldPressure%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(ManifoldPressure, ChangeManifoldPressure, volume) + if(AnnularPressure%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(AnnularPressure, ChangeAnnularPressure, volume) + if(RigAirPressure%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(RigAirPressure, ChangeRigAirPressure, volume) + if(StandPipe1%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(StandPipe1, ChangeStandPipe1, volume) + if(StandPipe2%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(StandPipe2, ChangeStandPipe2, volume) + if(DrillPipePressure%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(DrillPipePressure, ChangeDrillPipePressure, volume) + if(ChokePosition%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(ChokePosition, ChangeChokePosition, volume) + if(CasingPressure2%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(CasingPressure2, ChangeCasingPressure2, volume) + end subroutine + + subroutine ProcessGaugesProblemsDueDistanceDrilled(distance) + implicit none + real(8) :: distance + if(WeightIndicator%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(WeightIndicator, ChangeWeightIndicator, distance) + if(RotaryRpm%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(RotaryRpm, ChangeRotaryRpm, distance) + if(RotaryTorque%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(RotaryTorque, ChangeRotaryTorque, distance) + if(StandPipePressure%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(StandPipePressure, ChangeStandPipePressure, distance) + if(CasingPressure%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(CasingPressure, ChangeCasingPressure, distance) + if(Pump1Strokes%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Pump1Strokes, ChangePump1Strokes, distance) + if(Pump2Strokes%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Pump2Strokes, ChangePump2Strokes, distance) + if(ReturnLineTemperature%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(ReturnLineTemperature, ChangeReturnLineTemperature, distance) + if(TripTank%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(TripTank, ChangeTripTank, distance) + if(PitGainLoss%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(PitGainLoss, ChangePitGainLoss, distance) + if(MudTankVolume%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(MudTankVolume, ChangeMudTankVolume, distance) + if(ReturnMudFlow%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(ReturnMudFlow, ChangeReturnMudFlow, distance) + if(TorqueLimit%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(TorqueLimit, ChangeTorqueLimit, distance) + if(PowerLimit%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(PowerLimit, ChangePowerLimit, distance) + if(AccumulatorPressure%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(AccumulatorPressure, ChangeAccumulatorPressure, distance) + if(ManifoldPressure%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(ManifoldPressure, ChangeManifoldPressure, distance) + if(AnnularPressure%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(AnnularPressure, ChangeAnnularPressure, distance) + if(RigAirPressure%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(RigAirPressure, ChangeRigAirPressure, distance) + if(StandPipe1%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(StandPipe1, ChangeStandPipe1, distance) + if(StandPipe2%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(StandPipe2, ChangeStandPipe2, distance) + if(DrillPipePressure%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(DrillPipePressure, ChangeDrillPipePressure, distance) + if(ChokePosition%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(ChokePosition, ChangeChokePosition, distance) + if(CasingPressure2%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(CasingPressure2, ChangeCasingPressure2, distance) + end subroutine + + + + + + + + + + subroutine ChangeWeightIndicator(status) + use TD_GeneralData + implicit none + integer, intent (in) :: status + if(associated(WeightIndicatorPtr)) call WeightIndicatorPtr(status) + if(status == Clear_StatusType) TD_WeightIndicatorMalf = 0 + if(status == Executed_StatusType) TD_WeightIndicatorMalf = 1 + endsubroutine + + subroutine ChangeRotaryRpm(status) + use RTable_VARIABLES + implicit none + integer, intent (in) :: status + if(associated(RotaryRpmPtr)) call RotaryRpmPtr(status) + if(status == Clear_StatusType) RTable%RpmGaugeMalf = 0 + if(status == Executed_StatusType) RTable%RpmGaugeMalf = 1 + endsubroutine + + subroutine ChangeRotaryTorque(status) + use RTable_VARIABLES + implicit none + integer, intent (in) :: status + if(associated(RotaryTorquePtr)) call RotaryTorquePtr(status) + if(status == Clear_StatusType) RTable%TorqueGaugeMalf = 0 + if(status == Executed_StatusType) RTable%TorqueGaugeMalf = 1 + endsubroutine + + subroutine ChangeStandPipePressure(status) + use MudSystemVARIABLES + implicit none + integer, intent (in) :: status + if(associated(StandPipePressurePtr)) call StandPipePressurePtr(status) + if(status == Clear_StatusType) StandPipePressure_DataDisplayMalf = 0 + if(status == Executed_StatusType) StandPipePressure_DataDisplayMalf = 1 + endsubroutine + + subroutine ChangeCasingPressure(status) + USE FricPressDropVars + implicit none + integer, intent (in) :: status + if(associated(CasingPressurePtr)) call CasingPressurePtr(status) + if(status == Clear_StatusType) CasingPressure_DataDisplayMalF = 0 + if(status == Executed_StatusType) CasingPressure_DataDisplayMalF = 1 + endsubroutine + + subroutine ChangePump1Strokes(status) + use Pump_VARIABLES + implicit none + integer, intent (in) :: status + if(associated(Pump1StrokesPtr)) call Pump1StrokesPtr(status) + if(status == Clear_StatusType) PUMP(1)%SPMGaugeMalf = 0 + if(status == Executed_StatusType) PUMP(1)%SPMGaugeMalf = 1 + endsubroutine + + subroutine ChangePump2Strokes(status) + use Pump_VARIABLES + implicit none + integer, intent (in) :: status + if(associated(Pump2StrokesPtr)) call Pump2StrokesPtr(status) + if(status == Clear_StatusType) PUMP(2)%SPMGaugeMalf = 0 + if(status == Executed_StatusType) PUMP(2)%SPMGaugeMalf = 1 + endsubroutine + + subroutine ChangeReturnLineTemperature(status) + implicit none + integer, intent (in) :: status + if(associated(ReturnLineTemperaturePtr)) call ReturnLineTemperaturePtr(status) + !if(status == Clear_StatusType) print*,'On_ReturnLineTemperature_Clear' + !if(status == Executed_StatusType) print*,'On_ReturnLineTemperature_Execute' + endsubroutine + + subroutine ChangeTripTank(status) + USE MudSystemVARIABLES + implicit none + integer, intent (in) :: status + if(associated(TripTankPtr)) call TripTankPtr(status) + if(status == Clear_StatusType) TripTankPressure_DataDisplayMalf = 0 + if(status == Executed_StatusType) TripTankPressure_DataDisplayMalf = 1 + endsubroutine + + subroutine ChangePitGainLoss(status) + USE MudSystemVARIABLES + implicit none + integer, intent (in) :: status + if(associated(PitGainLossPtr)) call PitGainLossPtr(status) + if(status == Clear_StatusType) PitGainLossGaugeMalf = 0 + if(status == Executed_StatusType) PitGainLossGaugeMalf = 1 + endsubroutine + + subroutine ChangeMudTankVolume(status) + implicit none + integer, intent (in) :: status + if(associated(MudTankVolumePtr)) call MudTankVolumePtr(status) + !if(status == Clear_StatusType) print*,'On_MudTankVolume_Clear' + !if(status == Executed_StatusType) print*,'On_MudTankVolume_Execute' + endsubroutine + + subroutine ChangeReturnMudFlow(status) + implicit none + integer, intent (in) :: status + if(associated(ReturnMudFlowPtr)) call ReturnMudFlowPtr(status) + !if(status == Clear_StatusType) print*,'On_ReturnMudFlow_Clear' + !if(status == Executed_StatusType) print*,'On_ReturnMudFlow_Execute' + endsubroutine + + subroutine ChangeTorqueLimit(status) + use RTable_VARIABLES + implicit none + integer, intent (in) :: status + if(associated(TorqueLimitPtr)) call TorqueLimitPtr(status) + if(status == Clear_StatusType) RTable%TorqueLimitGaugeMalf = 0 + if(status == Executed_StatusType) RTable%TorqueLimitGaugeMalf = 1 + endsubroutine + + subroutine ChangePowerLimit(status) + implicit none + integer, intent (in) :: status + if(associated(PowerLimitPtr)) call PowerLimitPtr(status) + !if(status == Clear_StatusType) print*,'On_PowerLimit_Clear' + !if(status == Executed_StatusType) print*,'On_PowerLimit_Execute' + endsubroutine + + subroutine ChangeAccumulatorPressure(status) + USE VARIABLES + implicit none + integer, intent (in) :: status + if(associated(AccumulatorPressurePtr)) call AccumulatorPressurePtr(status) + if(status == Clear_StatusType) AccumulatorPressureGaugeMalf = 0 + if(status == Executed_StatusType) AccumulatorPressureGaugeMalf = 1 + endsubroutine + + subroutine ChangeManifoldPressure(status) + USE VARIABLES + implicit none + integer, intent (in) :: status + if(associated(ManifoldPressurePtr)) call ManifoldPressurePtr(status) + if(status == Clear_StatusType) ManifoldPressureGaugeMalf = 0 + if(status == Executed_StatusType) ManifoldPressureGaugeMalf = 1 + endsubroutine + + subroutine ChangeAnnularPressure(status) + USE VARIABLES + implicit none + integer, intent (in) :: status + if(associated(AnnularPressurePtr)) call AnnularPressurePtr(status) + if(status == Clear_StatusType) AnnularPressureGaugeMalf = 0 + if(status == Executed_StatusType) AnnularPressureGaugeMalf = 1 + endsubroutine + + subroutine ChangeRigAirPressure(status) + USE VARIABLES + implicit none + integer, intent (in) :: status + if(associated(RigAirPressurePtr)) call RigAirPressurePtr(status) + if(status == Clear_StatusType) AirSupplyPressureGaugeMalf = 0 + if(status == Executed_StatusType) AirSupplyPressureGaugeMalf = 1 + endsubroutine + + subroutine ChangeStandPipe1(status) + use MudSystemVARIABLES + implicit none + integer, intent (in) :: status + if(associated(StandPipe1Ptr)) call StandPipe1Ptr(status) + if(status == Clear_StatusType) StandPipeGauge1Malf = 0 + if(status == Executed_StatusType) StandPipeGauge1Malf = 1 + endsubroutine + + subroutine ChangeStandPipe2(status) + use MudSystemVARIABLES + implicit none + integer, intent (in) :: status + if(associated(StandPipe2Ptr)) call StandPipe2Ptr(status) + if(status == Clear_StatusType) StandPipeGauge2Malf = 0 + if(status == Executed_StatusType) StandPipeGauge2Malf = 1 + endsubroutine + + subroutine ChangeDrillPipePressure(status) + use MudSystemVARIABLES + implicit none + integer, intent (in) :: status + if(associated(DrillPipePressurePtr)) call DrillPipePressurePtr(status) + if(status == Clear_StatusType) DrillPipePressureMalf = 0 + if(status == Executed_StatusType) DrillPipePressureMalf = 1 + endsubroutine + + subroutine ChangeChokePosition(status) + USE CHOKEVARIABLES + implicit none + integer, intent (in) :: status + if(associated(ChokePositionPtr)) call ChokePositionPtr(status) + if(status == Clear_StatusType) GaugeChokePositionMailf = 0 + if(status == Executed_StatusType) GaugeChokePositionMailf = 1 + endsubroutine + + subroutine ChangeCasingPressure2(status) + use FricPressDropVars + implicit none + integer, intent (in) :: status + if(associated(CasingPressure2Ptr)) call CasingPressure2Ptr(status) + if(status == Clear_StatusType) CasingPressure_ChokeMalF = 0 + if(status == Executed_StatusType) CasingPressure_ChokeMalF = 1 + endsubroutine + + + + + + + + + + + + + + + + + subroutine SubscribeWeightIndicator(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeWeightIndicator + !DEC$ ATTRIBUTES ALIAS: 'SubscribeWeightIndicator' :: SubscribeWeightIndicator + implicit none + procedure (ActionInteger) :: v + WeightIndicatorPtr => v + end subroutine + + subroutine SubscribeRotaryRpm(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeRotaryRpm + !DEC$ ATTRIBUTES ALIAS: 'SubscribeRotaryRpm' :: SubscribeRotaryRpm + implicit none + procedure (ActionInteger) :: v + RotaryRpmPtr => v + end subroutine + + subroutine SubscribeRotaryTorque(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeRotaryTorque + !DEC$ ATTRIBUTES ALIAS: 'SubscribeRotaryTorque' :: SubscribeRotaryTorque + implicit none + procedure (ActionInteger) :: v + RotaryTorquePtr => v + end subroutine + + subroutine SubscribeStandPipePressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeStandPipePressure + !DEC$ ATTRIBUTES ALIAS: 'SubscribeStandPipePressure' :: SubscribeStandPipePressure + implicit none + procedure (ActionInteger) :: v + StandPipePressurePtr => v + end subroutine + + subroutine SubscribeCasingPressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeCasingPressure + !DEC$ ATTRIBUTES ALIAS: 'SubscribeCasingPressure' :: SubscribeCasingPressure + implicit none + procedure (ActionInteger) :: v + CasingPressurePtr => v + end subroutine + + subroutine SubscribePump1Strokes(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePump1Strokes + !DEC$ ATTRIBUTES ALIAS: 'SubscribePump1Strokes' :: SubscribePump1Strokes + implicit none + procedure (ActionInteger) :: v + Pump1StrokesPtr => v + end subroutine + + subroutine SubscribePump2Strokes(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePump2Strokes + !DEC$ ATTRIBUTES ALIAS: 'SubscribePump2Strokes' :: SubscribePump2Strokes + implicit none + procedure (ActionInteger) :: v + Pump2StrokesPtr => v + end subroutine + + subroutine SubscribeReturnLineTemperature(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeReturnLineTemperature + !DEC$ ATTRIBUTES ALIAS: 'SubscribeReturnLineTemperature' :: SubscribeReturnLineTemperature + implicit none + procedure (ActionInteger) :: v + ReturnLineTemperaturePtr => v + end subroutine + + subroutine SubscribeTripTank(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeTripTank + !DEC$ ATTRIBUTES ALIAS: 'SubscribeTripTank' :: SubscribeTripTank + implicit none + procedure (ActionInteger) :: v + TripTankPtr => v + end subroutine + + subroutine SubscribePitGainLoss(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePitGainLoss + !DEC$ ATTRIBUTES ALIAS: 'SubscribePitGainLoss' :: SubscribePitGainLoss + implicit none + procedure (ActionInteger) :: v + PitGainLossPtr => v + end subroutine + + subroutine SubscribeMudTankVolume(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeMudTankVolume + !DEC$ ATTRIBUTES ALIAS: 'SubscribeMudTankVolume' :: SubscribeMudTankVolume + implicit none + procedure (ActionInteger) :: v + MudTankVolumePtr => v + end subroutine + + subroutine SubscribeReturnMudFlow(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeReturnMudFlow + !DEC$ ATTRIBUTES ALIAS: 'SubscribeReturnMudFlow' :: SubscribeReturnMudFlow + implicit none + procedure (ActionInteger) :: v + ReturnMudFlowPtr => v + end subroutine + + subroutine SubscribeTorqueLimit(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeTorqueLimit + !DEC$ ATTRIBUTES ALIAS: 'SubscribeTorqueLimit' :: SubscribeTorqueLimit + implicit none + procedure (ActionInteger) :: v + TorqueLimitPtr => v + end subroutine + + subroutine SubscribePowerLimit(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePowerLimit + !DEC$ ATTRIBUTES ALIAS: 'SubscribePowerLimit' :: SubscribePowerLimit + implicit none + procedure (ActionInteger) :: v + PowerLimitPtr => v + end subroutine + + subroutine SubscribeAccumulatorPressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeAccumulatorPressure + !DEC$ ATTRIBUTES ALIAS: 'SubscribeAccumulatorPressure' :: SubscribeAccumulatorPressure + implicit none + procedure (ActionInteger) :: v + AccumulatorPressurePtr => v + end subroutine + + subroutine SubscribeManifoldPressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeManifoldPressure + !DEC$ ATTRIBUTES ALIAS: 'SubscribeManifoldPressure' :: SubscribeManifoldPressure + implicit none + procedure (ActionInteger) :: v + ManifoldPressurePtr => v + end subroutine + + subroutine SubscribeAnnularPressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeAnnularPressure + !DEC$ ATTRIBUTES ALIAS: 'SubscribeAnnularPressure' :: SubscribeAnnularPressure + implicit none + procedure (ActionInteger) :: v + AnnularPressurePtr => v + end subroutine + + subroutine SubscribeRigAirPressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeRigAirPressure + !DEC$ ATTRIBUTES ALIAS: 'SubscribeRigAirPressure' :: SubscribeRigAirPressure + implicit none + procedure (ActionInteger) :: v + RigAirPressurePtr => v + end subroutine + + subroutine SubscribeStandPipe1(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeStandPipe1 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeStandPipe1' :: SubscribeStandPipe1 + implicit none + procedure (ActionInteger) :: v + StandPipe1Ptr => v + end subroutine + + subroutine SubscribeStandPipe2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeStandPipe2 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeStandPipe2' :: SubscribeStandPipe2 + implicit none + procedure (ActionInteger) :: v + StandPipe2Ptr => v + end subroutine + + subroutine SubscribeDrillPipePressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeDrillPipePressure + !DEC$ ATTRIBUTES ALIAS: 'SubscribeDrillPipePressure' :: SubscribeDrillPipePressure + implicit none + procedure (ActionInteger) :: v + DrillPipePressurePtr => v + end subroutine + + subroutine SubscribeChokePosition(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeChokePosition + !DEC$ ATTRIBUTES ALIAS: 'SubscribeChokePosition' :: SubscribeChokePosition + implicit none + procedure (ActionInteger) :: v + ChokePositionPtr => v + end subroutine + + subroutine SubscribeCasingPressure2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeCasingPressure2 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeCasingPressure2' :: SubscribeCasingPressure2 + implicit none + procedure (ActionInteger) :: v + CasingPressure2Ptr => v + end subroutine + + + + +end module CGaugesProblemsVariables \ No newline at end of file diff --git a/CSharp/Problems/CHoistingProblems.f90 b/CSharp/Problems/CHoistingProblems.f90 new file mode 100644 index 0000000..295d536 --- /dev/null +++ b/CSharp/Problems/CHoistingProblems.f90 @@ -0,0 +1,47 @@ +module CHoistingProblems + use CHoistingProblemsVariables + implicit none + public + contains + + ! Input routines + subroutine SetMotorFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMotorFail + !DEC$ ATTRIBUTES ALIAS: 'SetMotorFail' :: SetMotorFail + implicit none + type(CProblem), intent(in) :: v + MotorFail = SetDue(v, ChangeMotorFail) +#ifdef deb + print*, 'MotorFail%ProblemType=', MotorFail%ProblemType + print*, 'MotorFail%StatusType=', MotorFail%StatusType + print*, 'MotorFail%Value=', MotorFail%Value +#endif + end subroutine + + subroutine SetClutchEngage(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetClutchEngage + !DEC$ ATTRIBUTES ALIAS: 'SetClutchEngage' :: SetClutchEngage + implicit none + type(CProblem), intent(in) :: v + ClutchEngage = SetDue(v, ChangeClutchEngage) +#ifdef deb + print*, 'ClutchEngage%ProblemType=', ClutchEngage%ProblemType + print*, 'ClutchEngage%StatusType=', ClutchEngage%StatusType + print*, 'ClutchEngage%Value=', ClutchEngage%Value +#endif + end subroutine + + subroutine SetClutchDisengage(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetClutchDisengage + !DEC$ ATTRIBUTES ALIAS: 'SetClutchDisengage' :: SetClutchDisengage + implicit none + type(CProblem), intent(in) :: v + ClutchDisengage = SetDue(v, ChangeClutchDisengage) +#ifdef deb + print*, 'ClutchDisengage%ProblemType=', ClutchDisengage%ProblemType + print*, 'ClutchDisengage%StatusType=', ClutchDisengage%StatusType + print*, 'ClutchDisengage%Value=', ClutchDisengage%Value +#endif + end subroutine + +end module CHoistingProblems \ No newline at end of file diff --git a/CSharp/Problems/CHoistingProblemsVariables.f90 b/CSharp/Problems/CHoistingProblemsVariables.f90 new file mode 100644 index 0000000..fa98360 --- /dev/null +++ b/CSharp/Problems/CHoistingProblemsVariables.f90 @@ -0,0 +1,116 @@ +module CHoistingProblemsVariables + use CProblemDifinition + implicit none + public + + ! Input vars + type(CProblem) :: MotorFail + type(CProblem) :: ClutchEngage + type(CProblem) :: ClutchDisengage + + procedure (ActionInteger), pointer :: MotorFailPtr + procedure (ActionInteger), pointer :: ClutchEngagePtr + procedure (ActionInteger), pointer :: ClutchDisengagePtr + + + contains + + subroutine ProcessHoistingProblemsDueTime(time) + implicit none + integer :: time + if(MotorFail%ProblemType == Time_ProblemType) call ProcessDueTime(MotorFail, ChangeMotorFail, time) + if(ClutchEngage%ProblemType == Time_ProblemType) call ProcessDueTime(ClutchEngage, ChangeClutchEngage, time) + if(ClutchDisengage%ProblemType == Time_ProblemType) call ProcessDueTime(ClutchDisengage, ChangeClutchDisengage, time) + end subroutine + + subroutine ProcessHoistingProblemsDuePumpStrokes(strokes) + implicit none + integer :: strokes + if(MotorFail%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(MotorFail, ChangeMotorFail, strokes) + if(ClutchEngage%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(ClutchEngage, ChangeClutchEngage, strokes) + if(ClutchDisengage%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(ClutchDisengage, ChangeClutchDisengage, strokes) + end subroutine + + subroutine ProcessHoistingProblemsDueVolumePumped(volume) + implicit none + real(8) :: volume + if(MotorFail%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(MotorFail, ChangeMotorFail, volume) + if(ClutchEngage%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(ClutchEngage, ChangeClutchEngage, volume) + if(ClutchDisengage%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(ClutchDisengage, ChangeClutchDisengage, volume) + end subroutine + + subroutine ProcessHoistingProblemsDueDistanceDrilled(distance) + implicit none + real(8) :: distance + if(MotorFail%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(MotorFail, ChangeMotorFail, distance) + if(ClutchEngage%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(ClutchEngage, ChangeClutchEngage, distance) + if(ClutchDisengage%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(ClutchDisengage, ChangeClutchDisengage, distance) + end subroutine + + + + + + + subroutine ChangeMotorFail(status) + use Drawworks_VARIABLES + implicit none + integer, intent (in) :: status + if(associated(MotorFailPtr)) call MotorFailPtr(status) + if(status == Clear_StatusType) Drawworks%MotorFaileMalf=0 + if(status == Executed_StatusType) Drawworks%MotorFaileMalf=1 + endsubroutine + + subroutine ChangeClutchEngage(status) + use Drawworks_VARIABLES + implicit none + integer, intent (in) :: status + if(associated(ClutchEngagePtr)) call ClutchEngagePtr(status) + if(status == Clear_StatusType) Drawworks%ClutchEngageMalf=0 + if(status == Executed_StatusType) Drawworks%ClutchEngageMalf=1 + endsubroutine + + subroutine ChangeClutchDisengage(status) + use Drawworks_VARIABLES + implicit none + integer, intent (in) :: status + if(associated(ClutchDisengagePtr)) call ClutchDisengagePtr(status) + if(status == Clear_StatusType) Drawworks%ClutchDisengageMalf=0 + if(status == Executed_StatusType) Drawworks%ClutchDisengageMalf=1 + endsubroutine + + + + + + + + + + + subroutine SubscribeMotorFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeMotorFail + !DEC$ ATTRIBUTES ALIAS: 'SubscribeMotorFail' :: SubscribeMotorFail + implicit none + procedure (ActionInteger) :: v + MotorFailPtr => v + end subroutine + + subroutine SubscribeClutchEngage(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeClutchEngage + !DEC$ ATTRIBUTES ALIAS: 'SubscribeClutchEngage' :: SubscribeClutchEngage + implicit none + procedure (ActionInteger) :: v + ClutchEngagePtr => v + end subroutine + + subroutine SubscribeClutchDisengage(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeClutchDisengage + !DEC$ ATTRIBUTES ALIAS: 'SubscribeClutchDisengage' :: SubscribeClutchDisengage + implicit none + procedure (ActionInteger) :: v + ClutchDisengagePtr => v + end subroutine + + +end module CHoistingProblemsVariables \ No newline at end of file diff --git a/CSharp/Problems/CKickProblems.f90 b/CSharp/Problems/CKickProblems.f90 new file mode 100644 index 0000000..e4b913b --- /dev/null +++ b/CSharp/Problems/CKickProblems.f90 @@ -0,0 +1,76 @@ +module CKickProblems + use CKickProblemsVariables + implicit none + public + contains + + ! Input routines + subroutine SetKick(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetKick + !DEC$ ATTRIBUTES ALIAS: 'SetKick' :: SetKick + implicit none + type(CProblem), intent(in) :: v + Kick = SetDue(v, ChangeKick) +#ifdef deb + print*, 'Kick%ProblemType=', Kick%ProblemType + print*, 'Kick%StatusType=', Kick%StatusType + print*, 'Kick%Value=', Kick%Value +#endif + end subroutine + + subroutine SetFluidTypeP(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetFluidTypeP + !DEC$ ATTRIBUTES ALIAS: 'SetFluidTypeP' :: SetFluidTypeP + implicit none + integer, intent(in) :: v + FluidType = v +#ifdef deb + print*, 'FluidType=', FluidType +#endif + end subroutine + + subroutine SetFlowRateP(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetFlowRateP + !DEC$ ATTRIBUTES ALIAS: 'SetFlowRateP' :: SetFlowRateP + implicit none + real*8, intent(in) :: v + FlowRate = v +#ifdef deb + print*, 'FlowRate=', FlowRate +#endif + end subroutine + + subroutine SetOverBalancePressure(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetOverBalancePressure + !DEC$ ATTRIBUTES ALIAS: 'SetOverBalancePressure' :: SetOverBalancePressure + implicit none + real*8, intent(in) :: v + OverBalancePressure = v +#ifdef deb + print*, 'OverBalancePressure=', OverBalancePressure +#endif + end subroutine + + subroutine SetIsAutoMigrationRateSelectedP(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetIsAutoMigrationRateSelectedP + !DEC$ ATTRIBUTES ALIAS: 'SetIsAutoMigrationRateSelectedP' :: SetIsAutoMigrationRateSelectedP + implicit none + logical, intent(in) :: v + IsAutoMigrationRateSelected = v +#ifdef deb + print*, 'IsAutoMigrationRateSelected=', IsAutoMigrationRateSelected +#endif + end subroutine + + subroutine SetAutoMigrationRateP(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetAutoMigrationRateP + !DEC$ ATTRIBUTES ALIAS: 'SetAutoMigrationRateP' :: SetAutoMigrationRateP + implicit none + real*8, intent(in) :: v + AutoMigrationRate = v +#ifdef deb + print*, 'AutoMigrationRate=', AutoMigrationRate +#endif + end subroutine + +end module CKickProblems \ No newline at end of file diff --git a/CSharp/Problems/CKickProblemsVariables.f90 b/CSharp/Problems/CKickProblemsVariables.f90 new file mode 100644 index 0000000..3eae2d9 --- /dev/null +++ b/CSharp/Problems/CKickProblemsVariables.f90 @@ -0,0 +1,86 @@ +module CKickProblemsVariables + use CProblemDifinition + implicit none + public + + !constants + integer :: Gas_FluidType = 0 + integer :: Oil_FluidType = 1 + integer :: Water_FluidType = 2 + + + ! Input vars + type(CProblem) :: Kick + integer :: FluidType + integer :: FlowRate + integer :: OverBalancePressure + logical :: IsAutoMigrationRateSelected + real(8) :: AutoMigrationRate + + procedure (ActionInteger), pointer :: KickPtr + + contains + + + subroutine ProcessKickProblemsDueTime(time) + implicit none + integer :: time + + if(Kick%ProblemType == Time_ProblemType) call ProcessDueTime(Kick, ChangeKick, time) + + end subroutine + + subroutine ProcessKickProblemsDuePumpStrokes(strokes) + implicit none + integer :: strokes + + if(Kick%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Kick, ChangeKick, strokes) + + end subroutine + + subroutine ProcessKickProblemsDueVolumePumped(volume) + implicit none + real(8) :: volume + + if(Kick%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Kick, ChangeKick, volume) + + end subroutine + + subroutine ProcessKickProblemsDueDistanceDrilled(distance) + implicit none + real(8) :: distance + + if(Kick%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Kick, ChangeKick, distance) + + end subroutine + + subroutine ChangeKick(status) + implicit none + integer, intent (in) :: status + if(associated(KickPtr)) call KickPtr(status) + !if(status == Clear_StatusType) print*,'On_Kick_Clear' + !if(status == Executed_StatusType) print*,'On_Kick_Execute' + endsubroutine + + + + + + + + + + + + + subroutine SubscribeKick(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeKick + !DEC$ ATTRIBUTES ALIAS: 'SubscribeKick' :: SubscribeKick + implicit none + procedure (ActionInteger) :: v + KickPtr => v + end subroutine + + + +end module CKickProblemsVariables \ No newline at end of file diff --git a/CSharp/Problems/CLostProblems.f90 b/CSharp/Problems/CLostProblems.f90 new file mode 100644 index 0000000..fd28a11 --- /dev/null +++ b/CSharp/Problems/CLostProblems.f90 @@ -0,0 +1,32 @@ +module CLostProblems + use CLostProblemsVariables + implicit none + public + contains + + ! Input routines + subroutine SetLostCirculation(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetLostCirculation + !DEC$ ATTRIBUTES ALIAS: 'SetLostCirculation' :: SetLostCirculation + implicit none + type(CProblem), intent(in) :: v + LostCirculation = SetDue(v, ChangeLostCirculation) +#ifdef deb + print*, 'LostCirculation%ProblemType=', LostCirculation%ProblemType + print*, 'LostCirculation%StatusType=', LostCirculation%StatusType + print*, 'LostCirculation%Value=', LostCirculation%Value +#endif + end subroutine + + subroutine SetFlowRate(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetFlowRate + !DEC$ ATTRIBUTES ALIAS: 'SetFlowRate' :: SetFlowRate + implicit none + real*8, intent(in) :: v + FlowRate = v +#ifdef deb + print*, 'FlowRate=', FlowRate +#endif + end subroutine + +end module CLostProblems \ No newline at end of file diff --git a/CSharp/Problems/CLostProblemsVariables.f90 b/CSharp/Problems/CLostProblemsVariables.f90 new file mode 100644 index 0000000..aae9ca9 --- /dev/null +++ b/CSharp/Problems/CLostProblemsVariables.f90 @@ -0,0 +1,73 @@ +module CLostProblemsVariables + use CProblemDifinition + implicit none + public + + ! Input vars + type(CProblem) :: LostCirculation + real(8) :: FlowRate + + procedure (ActionInteger), pointer :: LostCirculationPtr + + contains + + subroutine ProcessLostProblemsDueTime(time) + implicit none + integer :: time + + if(LostCirculation%ProblemType == Time_ProblemType) call ProcessDueTime(LostCirculation, ChangeLostCirculation, time) + + end subroutine + + subroutine ProcessLostProblemsDuePumpStrokes(strokes) + implicit none + integer :: strokes + + if(LostCirculation%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(LostCirculation, ChangeLostCirculation, strokes) + + end subroutine + + subroutine ProcessLostProblemsDueVolumePumped(volume) + implicit none + real(8) :: volume + + if(LostCirculation%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(LostCirculation, ChangeLostCirculation, volume) + + end subroutine + + subroutine ProcessLostProblemsDueDistanceDrilled(distance) + implicit none + real(8) :: distance + + if(LostCirculation%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(LostCirculation, ChangeLostCirculation, distance) + + end subroutine + + + + + subroutine ChangeLostCirculation(status) + implicit none + integer, intent (in) :: status + if(associated(LostCirculationPtr)) call LostCirculationPtr(status) + !if(status == Clear_StatusType) print*,'On_LostCirculation_Clear' + !if(status == Executed_StatusType) print*,'On_LostCirculation_Execute' + endsubroutine + + + + + + + + + + subroutine SubscribeLostCirculation(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeLostCirculation + !DEC$ ATTRIBUTES ALIAS: 'SubscribeLostCirculation' :: SubscribeLostCirculation + implicit none + procedure (ActionInteger) :: v + LostCirculationPtr => v + end subroutine + +end module CLostProblemsVariables \ No newline at end of file diff --git a/CSharp/Problems/CMudTreatmentProblems.f90 b/CSharp/Problems/CMudTreatmentProblems.f90 new file mode 100644 index 0000000..2b1f5bd --- /dev/null +++ b/CSharp/Problems/CMudTreatmentProblems.f90 @@ -0,0 +1,60 @@ +module CMudTreatmentProblems + use CMudTreatmentProblemsVariables + implicit none + public + contains + + ! Input routines + subroutine SetDegasser(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetDegasser + !DEC$ ATTRIBUTES ALIAS: 'SetDegasser' :: SetDegasser + implicit none + type(CProblem), intent(in) :: v + Degasser = SetDue(v, ChangeDegasser) +#ifdef deb + print*, 'Degasser%ProblemType=', V%ProblemType + print*, 'Degasser%StatusType=', V%StatusType + print*, 'Degasser%Value=', V%Value +#endif + end subroutine + + subroutine SetShaleShaker(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetShaleShaker + !DEC$ ATTRIBUTES ALIAS: 'SetShaleShaker' :: SetShaleShaker + implicit none + type(CProblem), intent(in) :: v + ShaleShaker = SetDue(v, ChangeShaleShaker) +#ifdef deb + print*, 'ShaleShaker%ProblemType=', V%ProblemType + print*, 'ShaleShaker%StatusType=', V%StatusType + print*, 'ShaleShaker%Value=', V%Value +#endif + end subroutine + + subroutine SetDesander(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetDesander + !DEC$ ATTRIBUTES ALIAS: 'SetDesander' :: SetDesander + implicit none + type(CProblem), intent(in) :: v + Desander = SetDue(v, ChangeDesander) +#ifdef deb + print*, 'Desander%ProblemType=', V%ProblemType + print*, 'Desander%StatusType=', V%StatusType + print*, 'Desander%Value=', V%Value +#endif + end subroutine + + subroutine SetDesilter(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetDesilter + !DEC$ ATTRIBUTES ALIAS: 'SetDesilter' :: SetDesilter + implicit none + type(CProblem), intent(in) :: v + Desilter = SetDue(v, ChangeDesilter) +#ifdef deb + print*, 'Desilter%ProblemType=', V%ProblemType + print*, 'Desilter%StatusType=', V%StatusType + print*, 'Desilter%Value=', V%Value +#endif + end subroutine + +end module CMudTreatmentProblems \ No newline at end of file diff --git a/CSharp/Problems/CMudTreatmentProblemsVariables.f90 b/CSharp/Problems/CMudTreatmentProblemsVariables.f90 new file mode 100644 index 0000000..9be98eb --- /dev/null +++ b/CSharp/Problems/CMudTreatmentProblemsVariables.f90 @@ -0,0 +1,154 @@ +module CMudTreatmentProblemsVariables + use CProblemDifinition + implicit none + public + + ! Input vars + type(CProblem) :: Degasser + type(CProblem) :: ShaleShaker + type(CProblem) :: Desander + type(CProblem) :: Desilter + + + procedure (ActionInteger), pointer :: DegasserPtr + procedure (ActionInteger), pointer :: ShaleShakerPtr + procedure (ActionInteger), pointer :: DesanderPtr + procedure (ActionInteger), pointer :: DesilterPtr + + contains + + subroutine ProcessMudTreatmentProblemsDueTime(time) + implicit none + integer :: time + + if(Degasser%ProblemType == Time_ProblemType) call ProcessDueTime(Degasser, ChangeDegasser, time) + if(ShaleShaker%ProblemType == Time_ProblemType) call ProcessDueTime(ShaleShaker, ChangeShaleShaker, time) + if(Desander%ProblemType == Time_ProblemType) call ProcessDueTime(Desander, ChangeDesander, time) + if(Desilter%ProblemType == Time_ProblemType) call ProcessDueTime(Desilter, ChangeDesilter, time) + + end subroutine + + + subroutine ProcessMudTreatmentProblemsDuePumpStrokes(strokes) + implicit none + integer :: strokes + + if(Degasser%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Degasser, ChangeDegasser, strokes) + if(ShaleShaker%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(ShaleShaker, ChangeShaleShaker, strokes) + if(Desander%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Desander, ChangeDesander, strokes) + if(Desilter%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Desilter, ChangeDesilter, strokes) + + end subroutine + + + subroutine ProcessMudTreatmentProblemsDueVolumePumped(volume) + implicit none + real(8) :: volume + + if(Degasser%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Degasser, ChangeDegasser, volume) + if(ShaleShaker%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(ShaleShaker, ChangeShaleShaker, volume) + if(Desander%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Desander, ChangeDesander, volume) + if(Desilter%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Desilter, ChangeDesilter, volume) + + end subroutine + + subroutine ProcessMudTreatmentProblemsDueDistanceDrilled(distance) + implicit none + real(8) :: distance + + if(Degasser%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Degasser, ChangeDegasser, distance) + if(ShaleShaker%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(ShaleShaker, ChangeShaleShaker, distance) + if(Desander%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Desander, ChangeDesander, distance) + if(Desilter%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Desilter, ChangeDesilter, distance) + + end subroutine + + + + + + + + subroutine ChangeDegasser(status) + implicit none + integer, intent (in) :: status + if(associated(DegasserPtr)) call DegasserPtr(status) + !if(status == Clear_StatusType) print*,'On_Degasser_Clear' + !if(status == Executed_StatusType) print*,'On_Degasser_Execute' + endsubroutine + + subroutine ChangeShaleShaker(status) + implicit none + integer, intent (in) :: status + if(associated(ShaleShakerPtr)) call ShaleShakerPtr(status) + !if(status == Clear_StatusType) print*,'On_ShaleShaker_Clear' + !if(status == Executed_StatusType) print*,'On_ShaleShaker_Execute' + endsubroutine + + subroutine ChangeDesander(status) + implicit none + integer, intent (in) :: status + if(associated(DesanderPtr)) call DesanderPtr(status) + !if(status == Clear_StatusType) print*,'On_Desander_Clear' + !if(status == Executed_StatusType) print*,'On_Desander_Execute' + endsubroutine + + subroutine ChangeDesilter(status) + implicit none + integer, intent (in) :: status + if(associated(DesilterPtr)) call DesilterPtr(status) + !if(status == Clear_StatusType) print*,'On_Desilter_Clear' + !if(status == Executed_StatusType) print*,'On_Desilter_Execute' + endsubroutine + + + + + + + + + + + + + + + + + subroutine SubscribeDegasser(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeDegasser + !DEC$ ATTRIBUTES ALIAS: 'SubscribeDegasser' :: SubscribeDegasser + implicit none + procedure (ActionInteger) :: v + DegasserPtr => v + end subroutine + + subroutine SubscribeShaleShaker(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeShaleShaker + !DEC$ ATTRIBUTES ALIAS: 'SubscribeShaleShaker' :: SubscribeShaleShaker + implicit none + procedure (ActionInteger) :: v + ShaleShakerPtr => v + end subroutine + + subroutine SubscribeDesander(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeDesander + !DEC$ ATTRIBUTES ALIAS: 'SubscribeDesander' :: SubscribeDesander + implicit none + procedure (ActionInteger) :: v + DesanderPtr => v + end subroutine + + subroutine SubscribeDesilter(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeDesilter + !DEC$ ATTRIBUTES ALIAS: 'SubscribeDesilter' :: SubscribeDesilter + implicit none + procedure (ActionInteger) :: v + DesilterPtr => v + end subroutine + + + + +end module CMudTreatmentProblemsVariables \ No newline at end of file diff --git a/CSharp/Problems/COtherProblems.f90 b/CSharp/Problems/COtherProblems.f90 new file mode 100644 index 0000000..4dd4a5b --- /dev/null +++ b/CSharp/Problems/COtherProblems.f90 @@ -0,0 +1,151 @@ +module COtherProblems + use COtherProblemsVariables + implicit none + public + contains + + ! Input routines + subroutine SetRigAlarm(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRigAlarm + !DEC$ ATTRIBUTES ALIAS: 'SetRigAlarm' :: SetRigAlarm + implicit none + type(CProblem), intent(in) :: v + RigAlarm = SetDue(v, ChangeRigAlarm) +#ifdef deb + print*, 'RigAlarm%ProblemType=', V%ProblemType + print*, 'RigAlarm%StatusType=', V%StatusType + print*, 'RigAlarm%Value=', V%Value +#endif + end subroutine + + subroutine SetRigWaterSupply(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRigWaterSupply + !DEC$ ATTRIBUTES ALIAS: 'SetRigWaterSupply' :: SetRigWaterSupply + implicit none + type(CProblem), intent(in) :: v + RigWaterSupply = SetDue(v, ChangeRigWaterSupply) +#ifdef deb + print*, 'RigWaterSupply%ProblemType=', V%ProblemType + print*, 'RigWaterSupply%StatusType=', V%StatusType + print*, 'RigWaterSupply%Value=', V%Value +#endif + end subroutine + + subroutine SetRigAir(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetRigAir + !DEC$ ATTRIBUTES ALIAS: 'SetRigAir' :: SetRigAir + implicit none + type(CProblem), intent(in) :: v + RigAir = SetDue(v, ChangeRigAir) +#ifdef deb + print*, 'RigAir%ProblemType=', V%ProblemType + print*, 'RigAir%StatusType=', V%StatusType + print*, 'RigAir%Value=', V%Value +#endif + end subroutine + + subroutine SetGen1(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetGen1 + !DEC$ ATTRIBUTES ALIAS: 'SetGen1' :: SetGen1 + implicit none + type(CProblem), intent(in) :: v + Gen1 = SetDue(v, ChangeGen1) +#ifdef deb + print*, 'Gen1%ProblemType=', V%ProblemType + print*, 'Gen1%StatusType=', V%StatusType + print*, 'Gen1%Value=', V%Value +#endif + end subroutine + + subroutine SetGen2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetGen2 + !DEC$ ATTRIBUTES ALIAS: 'SetGen2' :: SetGen2 + implicit none + type(CProblem), intent(in) :: v + Gen2 = SetDue(v, ChangeGen2) +#ifdef deb + print*, 'Gen2%ProblemType=', V%ProblemType + print*, 'Gen2%StatusType=', V%StatusType + print*, 'Gen2%Value=', V%Value +#endif + end subroutine + + subroutine SetGen3(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetGen3 + !DEC$ ATTRIBUTES ALIAS: 'SetGen3' :: SetGen3 + implicit none + type(CProblem), intent(in) :: v + Gen3 = SetDue(v, ChangeGen3) +#ifdef deb + print*, 'Gen3%ProblemType=', V%ProblemType + print*, 'Gen3%StatusType=', V%StatusType + print*, 'Gen3%Value=', V%Value +#endif + end subroutine + + subroutine SetGen4(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetGen4 + !DEC$ ATTRIBUTES ALIAS: 'SetGen4' :: SetGen4 + implicit none + type(CProblem), intent(in) :: v + Gen4 = SetDue(v, ChangeGen4) +#ifdef deb + print*, 'Gen4%ProblemType=', V%ProblemType + print*, 'Gen4%StatusType=', V%StatusType + print*, 'Gen4%Value=', V%Value +#endif + end subroutine + + subroutine SetScr1(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetScr1 + !DEC$ ATTRIBUTES ALIAS: 'SetScr1' :: SetScr1 + implicit none + type(CProblem), intent(in) :: v + Scr1 = SetDue(v, ChangeScr1) +#ifdef deb + print*, 'Scr1%ProblemType=', V%ProblemType + print*, 'Scr1%StatusType=', V%StatusType + print*, 'Scr1%Value=', V%Value +#endif + end subroutine + + subroutine SetScr2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetScr2 + !DEC$ ATTRIBUTES ALIAS: 'SetScr2' :: SetScr2 + implicit none + type(CProblem), intent(in) :: v + Scr2 = SetDue(v, ChangeScr2) +#ifdef deb + print*, 'Scr2%ProblemType=', V%ProblemType + print*, 'Scr2%StatusType=', V%StatusType + print*, 'Scr2%Value=', V%Value +#endif + end subroutine + + subroutine SetScr3(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetScr3 + !DEC$ ATTRIBUTES ALIAS: 'SetScr3' :: SetScr3 + implicit none + type(CProblem), intent(in) :: v + Scr3 = SetDue(v, ChangeScr3) +#ifdef deb + print*, 'Scr3%ProblemType=', V%ProblemType + print*, 'Scr3%StatusType=', V%StatusType + print*, 'Scr3%Value=', V%Value +#endif + end subroutine + + subroutine SetScr4(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetScr4 + !DEC$ ATTRIBUTES ALIAS: 'SetScr4' :: SetScr4 + implicit none + type(CProblem), intent(in) :: v + Scr4 = SetDue(v, ChangeScr4) +#ifdef deb + print*, 'Scr4%ProblemType=', V%ProblemType + print*, 'Scr4%StatusType=', V%StatusType + print*, 'Scr4%Value=', V%Value +#endif + end subroutine + +end module COtherProblems \ No newline at end of file diff --git a/CSharp/Problems/COtherProblemsVariables.f90 b/CSharp/Problems/COtherProblemsVariables.f90 new file mode 100644 index 0000000..f3a158d --- /dev/null +++ b/CSharp/Problems/COtherProblemsVariables.f90 @@ -0,0 +1,300 @@ +module COtherProblemsVariables + use CProblemDifinition + implicit none + public + + ! Input vars + type(CProblem) :: RigAlarm + type(CProblem) :: RigWaterSupply + type(CProblem) :: RigAir + type(CProblem) :: Gen1 + type(CProblem) :: Gen2 + type(CProblem) :: Gen3 + type(CProblem) :: Gen4 + type(CProblem) :: Scr1 + type(CProblem) :: Scr2 + type(CProblem) :: Scr3 + type(CProblem) :: Scr4 + + procedure (ActionInteger), pointer :: RigAlarmPtr + procedure (ActionInteger), pointer :: RigWaterSupplyPtr + procedure (ActionInteger), pointer :: RigAirPtr + procedure (ActionInteger), pointer :: Gen1Ptr + procedure (ActionInteger), pointer :: Gen2Ptr + procedure (ActionInteger), pointer :: Gen3Ptr + procedure (ActionInteger), pointer :: Gen4Ptr + procedure (ActionInteger), pointer :: Scr1Ptr + procedure (ActionInteger), pointer :: Scr2Ptr + procedure (ActionInteger), pointer :: Scr3Ptr + procedure (ActionInteger), pointer :: Scr4Ptr + + contains + + subroutine ProcessOtherProblemsDueTime(time) + implicit none + integer :: time + + if(RigAlarm%ProblemType == Time_ProblemType) call ProcessDueTime(RigAlarm, ChangeRigAlarm, time) + if(RigWaterSupply%ProblemType == Time_ProblemType) call ProcessDueTime(RigWaterSupply, ChangeRigWaterSupply, time) + if(RigAir%ProblemType == Time_ProblemType) call ProcessDueTime(RigAir, ChangeRigAir, time) + if(Gen1%ProblemType == Time_ProblemType) call ProcessDueTime(Gen1, ChangeGen1, time) + if(Gen2%ProblemType == Time_ProblemType) call ProcessDueTime(Gen2, ChangeGen2, time) + if(Gen3%ProblemType == Time_ProblemType) call ProcessDueTime(Gen3, ChangeGen3, time) + if(Gen4%ProblemType == Time_ProblemType) call ProcessDueTime(Gen4, ChangeGen4, time) + if(Scr1%ProblemType == Time_ProblemType) call ProcessDueTime(Scr1, ChangeScr1, time) + if(Scr2%ProblemType == Time_ProblemType) call ProcessDueTime(Scr2, ChangeScr2, time) + if(Scr3%ProblemType == Time_ProblemType) call ProcessDueTime(Scr3, ChangeScr3, time) + if(Scr4%ProblemType == Time_ProblemType) call ProcessDueTime(Scr4, ChangeScr4, time) + + end subroutine + + subroutine ProcessOtherProblemsDuePumpStrokes(strokes) + implicit none + integer :: strokes + + if(RigAlarm%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(RigAlarm, ChangeRigAlarm, strokes) + if(RigWaterSupply%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(RigWaterSupply, ChangeRigWaterSupply, strokes) + if(RigAir%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(RigAir, ChangeRigAir, strokes) + if(Gen1%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Gen1, ChangeGen1, strokes) + if(Gen2%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Gen2, ChangeGen2, strokes) + if(Gen3%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Gen3, ChangeGen3, strokes) + if(Gen4%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Gen4, ChangeGen4, strokes) + if(Scr1%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Scr1, ChangeScr1, strokes) + if(Scr2%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Scr2, ChangeScr2, strokes) + if(Scr3%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Scr3, ChangeScr3, strokes) + if(Scr4%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Scr4, ChangeScr4, strokes) + + end subroutine + + subroutine ProcessOtherProblemsDueVolumePumped(volume) + implicit none + real(8) :: volume + + if(RigAlarm%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(RigAlarm, ChangeRigAlarm, volume) + if(RigWaterSupply%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(RigWaterSupply, ChangeRigWaterSupply, volume) + if(RigAir%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(RigAir, ChangeRigAir, volume) + if(Gen1%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Gen1, ChangeGen1, volume) + if(Gen2%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Gen2, ChangeGen2, volume) + if(Gen3%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Gen3, ChangeGen3, volume) + if(Gen4%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Gen4, ChangeGen4, volume) + if(Scr1%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Scr1, ChangeScr1, volume) + if(Scr2%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Scr2, ChangeScr2, volume) + if(Scr3%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Scr3, ChangeScr3, volume) + if(Scr4%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Scr4, ChangeScr4, volume) + + end subroutine + + subroutine ProcessOtherProblemsDueDistanceDrilled(distance) + implicit none + real(8) :: distance + + if(RigAlarm%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(RigAlarm, ChangeRigAlarm, distance) + if(RigWaterSupply%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(RigWaterSupply, ChangeRigWaterSupply, distance) + if(RigAir%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(RigAir, ChangeRigAir, distance) + if(Gen1%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Gen1, ChangeGen1, distance) + if(Gen2%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Gen2, ChangeGen2, distance) + if(Gen3%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Gen3, ChangeGen3, distance) + if(Gen4%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Gen4, ChangeGen4, distance) + if(Scr1%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Scr1, ChangeScr1, distance) + if(Scr2%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Scr2, ChangeScr2, distance) + if(Scr3%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Scr3, ChangeScr3, distance) + if(Scr4%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Scr4, ChangeScr4, distance) + + end subroutine + + + subroutine ChangeRigAlarm(status) + implicit none + integer, intent (in) :: status + if(associated(RigAlarmPtr)) call RigAlarmPtr(status) + !if(status == Clear_StatusType) print*,'On_RigAlarm_Clear' + !if(status == Executed_StatusType) print*,'On_RigAlarm_Execute' + endsubroutine + + subroutine ChangeRigWaterSupply(status) + implicit none + integer, intent (in) :: status + if(associated(RigWaterSupplyPtr)) call RigWaterSupplyPtr(status) + !if(status == Clear_StatusType) print*,'On_RigWaterSupply_Clear' + !if(status == Executed_StatusType) print*,'On_RigWaterSupply_Execute' + endsubroutine + + subroutine ChangeRigAir(status) + use VARIABLES + implicit none + integer, intent (in) :: status + if(associated(RigAirPtr)) call RigAirPtr(status) + if(status == Clear_StatusType) RigAirMalf = 0 + if(status == Executed_StatusType) RigAirMalf = 1 + endsubroutine + + subroutine ChangeGen1(status) + implicit none + integer, intent (in) :: status + if(associated(Gen1Ptr)) call Gen1Ptr(status) + !if(status == Clear_StatusType) print*,'On_Gen1_Clear' + !if(status == Executed_StatusType) print*,'On_Gen1_Execute' + endsubroutine + + subroutine ChangeGen2(status) + implicit none + integer, intent (in) :: status + if(associated(Gen2Ptr)) call Gen2Ptr(status) + !if(status == Clear_StatusType) print*,'On_Gen2_Clear' + !if(status == Executed_StatusType) print*,'On_Gen2_Execute' + endsubroutine + + subroutine ChangeGen3(status) + implicit none + integer, intent (in) :: status + if(associated(Gen3Ptr)) call Gen3Ptr(status) + !if(status == Clear_StatusType) print*,'On_Gen3_Clear' + !if(status == Executed_StatusType) print*,'On_Gen3_Execute' + endsubroutine + + subroutine ChangeGen4(status) + implicit none + integer, intent (in) :: status + if(associated(Gen4Ptr)) call Gen4Ptr(status) + !if(status == Clear_StatusType) print*,'On_Gen4_Clear' + !if(status == Executed_StatusType) print*,'On_Gen4_Execute' + endsubroutine + + subroutine ChangeScr1(status) + implicit none + integer, intent (in) :: status + if(associated(Scr1Ptr)) call Scr1Ptr(status) + !if(status == Clear_StatusType) print*,'On_Scr1_Clear' + !if(status == Executed_StatusType) print*,'On_Scr1_Execute' + endsubroutine + + subroutine ChangeScr2(status) + implicit none + integer, intent (in) :: status + if(associated(Scr2Ptr)) call Scr2Ptr(status) + !if(status == Clear_StatusType) print*,'On_Scr2_Clear' + !if(status == Executed_StatusType) print*,'On_Scr2_Execute' + endsubroutine + + subroutine ChangeScr3(status) + implicit none + integer, intent (in) :: status + if(associated(Scr3Ptr)) call Scr3Ptr(status) + !if(status == Clear_StatusType) print*,'On_Scr3_Clear' + !if(status == Executed_StatusType) print*,'On_Scr3_Execute' + endsubroutine + + subroutine ChangeScr4(status) + implicit none + integer, intent (in) :: status + if(associated(Scr4Ptr)) call Scr4Ptr(status) + !if(status == Clear_StatusType) print*,'On_Scr4_Clear' + !if(status == Executed_StatusType) print*,'On_Scr4_Execute' + endsubroutine + + + + + + + + + + + + + subroutine SubscribeRigAlarm(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeRigAlarm + !DEC$ ATTRIBUTES ALIAS: 'SubscribeRigAlarm' :: SubscribeRigAlarm + implicit none + procedure (ActionInteger) :: v + RigAlarmPtr => v + end subroutine + + subroutine SubscribeRigWaterSupply(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeRigWaterSupply + !DEC$ ATTRIBUTES ALIAS: 'SubscribeRigWaterSupply' :: SubscribeRigWaterSupply + implicit none + procedure (ActionInteger) :: v + RigWaterSupplyPtr => v + end subroutine + + subroutine SubscribeRigAir(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeRigAir + !DEC$ ATTRIBUTES ALIAS: 'SubscribeRigAir' :: SubscribeRigAir + implicit none + procedure (ActionInteger) :: v + RigAirPtr => v + end subroutine + + subroutine SubscribeGen1(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeGen1 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeGen1' :: SubscribeGen1 + implicit none + procedure (ActionInteger) :: v + Gen1Ptr => v + end subroutine + + subroutine SubscribeGen2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeGen2 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeGen2' :: SubscribeGen2 + implicit none + procedure (ActionInteger) :: v + Gen2Ptr => v + end subroutine + + subroutine SubscribeGen3(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeGen3 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeGen3' :: SubscribeGen3 + implicit none + procedure (ActionInteger) :: v + Gen3Ptr => v + end subroutine + + subroutine SubscribeGen4(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeGen4 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeGen4' :: SubscribeGen4 + implicit none + procedure (ActionInteger) :: v + Gen4Ptr => v + end subroutine + + subroutine SubscribeScr1(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeScr1 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeScr1' :: SubscribeScr1 + implicit none + procedure (ActionInteger) :: v + Scr1Ptr => v + end subroutine + + subroutine SubscribeScr2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeScr2 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeScr2' :: SubscribeScr2 + implicit none + procedure (ActionInteger) :: v + Scr2Ptr => v + end subroutine + + subroutine SubscribeScr3(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeScr3 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeScr3' :: SubscribeScr3 + implicit none + procedure (ActionInteger) :: v + Scr3Ptr => v + end subroutine + + subroutine SubscribeScr4(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeScr4 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeScr4' :: SubscribeScr4 + implicit none + procedure (ActionInteger) :: v + Scr4Ptr => v + end subroutine + + + + + + + +end module COtherProblemsVariables \ No newline at end of file diff --git a/CSharp/Problems/CProblemDifinition.f90 b/CSharp/Problems/CProblemDifinition.f90 new file mode 100644 index 0000000..ea23d40 --- /dev/null +++ b/CSharp/Problems/CProblemDifinition.f90 @@ -0,0 +1,154 @@ +module CProblemDifinition + use CIActionReference + implicit none + public + + procedure (ActionInteger), pointer :: Nil => null() + + 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 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 + + type(CProblem) function SetDue(problem, action) + use CSimulationVariables + + implicit none + type(CProblem), intent(in) :: problem + procedure (ActionInteger), pointer, intent(in) :: action + real(8) :: CurrentTime + real(8) :: CurrentPumpStrokes + real(8) :: CurrentVolumePumped + real(8) :: CurrentDistanceDrilled + real(8) :: Due + + CurrentTime = 0 + CurrentPumpStrokes = 0 + CurrentVolumePumped = 0 + CurrentDistanceDrilled = 0 + + SetDue = problem + + if(problem%StatusType == Clear_StatusType .and. associated(action)) then + call action(Clear_StatusType) + SetDue%DueValue = 0 + return + endif + + select case (problem%ProblemType) + case(Time_ProblemType) + select case (SimulationState) + case(SimulationState_Stopped) + CurrentTime = 0 + case(SimulationState_Started) + CurrentTime = dble(SimulationTime) + case(SimulationState_Paused) + CurrentTime = dble(SimulationTime) + end select + Due = problem%Value + CurrentTime + case(PumpStrokes_ProblemType) + select case (SimulationState) + case(SimulationState_Stopped) + CurrentPumpStrokes = 0 + case(SimulationState_Started) + CurrentPumpStrokes = TotalPumpStrokes + case(SimulationState_Paused) + CurrentPumpStrokes = TotalPumpStrokes + end select + Due = problem%Value + CurrentPumpStrokes + case(VolumePumped_ProblemType) + select case (SimulationState) + case(SimulationState_Stopped) + CurrentVolumePumped = 0 + case(SimulationState_Started) + CurrentVolumePumped = TotalVolumePumped + case(SimulationState_Paused) + CurrentVolumePumped = TotalVolumePumped + end select + Due = problem%Value + CurrentVolumePumped + case(DistanceDrilled_ProblemType) + select case (SimulationState) + case(SimulationState_Stopped) + CurrentDistanceDrilled = 0 + case(SimulationState_Started) + CurrentDistanceDrilled = DistanceDrilled + case(SimulationState_Paused) + CurrentDistanceDrilled = DistanceDrilled + end select + Due = problem%Value + CurrentDistanceDrilled + end select + + SetDue%DueValue = Due + + + end function SetDue + + + subroutine ProcessDueTime(problem, action, time) + use CSimulationVariables + 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) + use CSimulationVariables + 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) + use CSimulationVariables + 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) + use CSimulationVariables + 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 \ No newline at end of file diff --git a/CSharp/Problems/CPumpProblems.f90 b/CSharp/Problems/CPumpProblems.f90 new file mode 100644 index 0000000..e79c161 --- /dev/null +++ b/CSharp/Problems/CPumpProblems.f90 @@ -0,0 +1,86 @@ +module CPumpProblems + use CPumpProblemsVariables + implicit none + public + contains + + ! Input routines + subroutine SetPump1PowerFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetPump1PowerFail + !DEC$ ATTRIBUTES ALIAS: 'SetPump1PowerFail' :: SetPump1PowerFail + implicit none + type(CProblem), intent(in) :: v + Pump1PowerFail = SetDue(v, ChangePump1PowerFail) +#ifdef deb + print*, 'Pump1PowerFail%ProblemType=', V%ProblemType + print*, 'Pump1PowerFail%StatusType=', V%StatusType + print*, 'Pump1PowerFail%Value=', V%Value +#endif + end subroutine + + subroutine SetPump1BlowPopOffValve(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetPump1BlowPopOffValve + !DEC$ ATTRIBUTES ALIAS: 'SetPump1BlowPopOffValve' :: SetPump1BlowPopOffValve + implicit none + type(CProblem), intent(in) :: v + Pump1BlowPopOffValve = SetDue(v, ChangePump1BlowPopOffValve) +#ifdef deb + print*, 'Pump1BlowPopOffValve%ProblemType=', V%ProblemType + print*, 'Pump1BlowPopOffValve%StatusType=', V%StatusType + print*, 'Pump1BlowPopOffValve%Value=', V%Value +#endif + end subroutine + + subroutine SetPump2PowerFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetPump2PowerFail + !DEC$ ATTRIBUTES ALIAS: 'SetPump2PowerFail' :: SetPump2PowerFail + implicit none + type(CProblem), intent(in) :: v + Pump2PowerFail = SetDue(v, ChangePump2PowerFail) +#ifdef deb + print*, 'Pump2PowerFail%ProblemType=', V%ProblemType + print*, 'Pump2PowerFail%StatusType=', V%StatusType + print*, 'Pump2PowerFail%Value=', V%Value +#endif + end subroutine + + subroutine SetPump2BlowPopOffValve(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetPump2BlowPopOffValve + !DEC$ ATTRIBUTES ALIAS: 'SetPump2BlowPopOffValve' :: SetPump2BlowPopOffValve + implicit none + type(CProblem), intent(in) :: v + Pump2BlowPopOffValve = SetDue(v, ChangePump2BlowPopOffValve) +#ifdef deb + print*, 'Pump2BlowPopOffValve%ProblemType=', V%ProblemType + print*, 'Pump2BlowPopOffValve%StatusType=', V%StatusType + print*, 'Pump2BlowPopOffValve%Value=', V%Value +#endif + end subroutine + + subroutine SetCementPumpPowerFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCementPumpPowerFail + !DEC$ ATTRIBUTES ALIAS: 'SetCementPumpPowerFail' :: SetCementPumpPowerFail + implicit none + type(CProblem), intent(in) :: v + CementPumpPowerFail = SetDue(v, ChangeCementPumpPowerFail) +#ifdef deb + print*, 'CementPumpPowerFail%ProblemType=', V%ProblemType + print*, 'CementPumpPowerFail%StatusType=', V%StatusType + print*, 'CementPumpPowerFail%Value=', V%Value +#endif + end subroutine + + subroutine SetCementPumpBlowPopOffValve(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetCementPumpBlowPopOffValve + !DEC$ ATTRIBUTES ALIAS: 'SetCementPumpBlowPopOffValve' :: SetCementPumpBlowPopOffValve + implicit none + type(CProblem), intent(in) :: v + CementPumpBlowPopOffValve = SetDue(v, ChangeCementPumpBlowPopOffValve) +#ifdef deb + print*, 'CementPumpBlowPopOffValve%ProblemType=', V%ProblemType + print*, 'CementPumpBlowPopOffValve%StatusType=', V%StatusType + print*, 'CementPumpBlowPopOffValve%Value=', V%Value +#endif + end subroutine + +end module CPumpProblems \ No newline at end of file diff --git a/CSharp/Problems/CPumpProblemsVariables.f90 b/CSharp/Problems/CPumpProblemsVariables.f90 new file mode 100644 index 0000000..fc82247 --- /dev/null +++ b/CSharp/Problems/CPumpProblemsVariables.f90 @@ -0,0 +1,208 @@ +module CPumpProblemsVariables + use CProblemDifinition + implicit none + public + + ! Input vars + type(CProblem) :: Pump1PowerFail + type(CProblem) :: Pump1BlowPopOffValve + type(CProblem) :: Pump2PowerFail + type(CProblem) :: Pump2BlowPopOffValve + type(CProblem) :: CementPumpPowerFail + type(CProblem) :: CementPumpBlowPopOffValve + + procedure (ActionInteger), pointer :: Pump1PowerFailPtr + procedure (ActionInteger), pointer :: Pump1BlowPopOffValvePtr + procedure (ActionInteger), pointer :: Pump2PowerFailPtr + procedure (ActionInteger), pointer :: Pump2BlowPopOffValvePtr + procedure (ActionInteger), pointer :: CementPumpPowerFailPtr + procedure (ActionInteger), pointer :: CementPumpBlowPopOffValvePtr + + + contains + + subroutine ProcessPumpProblemsDueTime(time) + implicit none + integer :: time + + if(Pump1PowerFail%ProblemType == Time_ProblemType) call ProcessDueTime(Pump1PowerFail, ChangePump1PowerFail, time) + if(Pump1BlowPopOffValve%ProblemType == Time_ProblemType) call ProcessDueTime(Pump1BlowPopOffValve, ChangePump1BlowPopOffValve, time) + if(Pump2PowerFail%ProblemType == Time_ProblemType) call ProcessDueTime(Pump2PowerFail, ChangePump2PowerFail, time) + if(Pump2BlowPopOffValve%ProblemType == Time_ProblemType) call ProcessDueTime(Pump2BlowPopOffValve, ChangePump2BlowPopOffValve, time) + if(CementPumpPowerFail%ProblemType == Time_ProblemType) call ProcessDueTime(CementPumpPowerFail, ChangeCementPumpPowerFail, time) + if(CementPumpBlowPopOffValve%ProblemType == Time_ProblemType) call ProcessDueTime(CementPumpBlowPopOffValve, ChangeCementPumpBlowPopOffValve, time) + + end subroutine + + subroutine ProcessPumpProblemsDuePumpStrokes(strokes) + implicit none + integer :: strokes + + if(Pump1PowerFail%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Pump1PowerFail, ChangePump1PowerFail, strokes) + if(Pump1BlowPopOffValve%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Pump1BlowPopOffValve, ChangePump1BlowPopOffValve, strokes) + if(Pump2PowerFail%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Pump2PowerFail, ChangePump2PowerFail, strokes) + if(Pump2BlowPopOffValve%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(Pump2BlowPopOffValve, ChangePump2BlowPopOffValve, strokes) + if(CementPumpPowerFail%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(CementPumpPowerFail, ChangeCementPumpPowerFail, strokes) + if(CementPumpBlowPopOffValve%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(CementPumpBlowPopOffValve, ChangeCementPumpBlowPopOffValve, strokes) + + end subroutine + + subroutine ProcessPumpProblemsDueVolumePumped(volume) + implicit none + real(8) :: volume + + if(Pump1PowerFail%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Pump1PowerFail, ChangePump1PowerFail, volume) + if(Pump1BlowPopOffValve%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Pump1BlowPopOffValve, ChangePump1BlowPopOffValve, volume) + if(Pump2PowerFail%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Pump2PowerFail, ChangePump2PowerFail, volume) + if(Pump2BlowPopOffValve%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(Pump2BlowPopOffValve, ChangePump2BlowPopOffValve, volume) + if(CementPumpPowerFail%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(CementPumpPowerFail, ChangeCementPumpPowerFail, volume) + if(CementPumpBlowPopOffValve%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(CementPumpBlowPopOffValve, ChangeCementPumpBlowPopOffValve, volume) + + end subroutine + + subroutine ProcessPumpProblemsDueDistanceDrilled(distance) + implicit none + real(8) :: distance + + if(Pump1PowerFail%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Pump1PowerFail, ChangePump1PowerFail, distance) + if(Pump1BlowPopOffValve%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Pump1BlowPopOffValve, ChangePump1BlowPopOffValve, distance) + if(Pump2PowerFail%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Pump2PowerFail, ChangePump2PowerFail, distance) + if(Pump2BlowPopOffValve%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(Pump2BlowPopOffValve, ChangePump2BlowPopOffValve, distance) + if(CementPumpPowerFail%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(CementPumpPowerFail, ChangeCementPumpPowerFail, distance) + if(CementPumpBlowPopOffValve%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(CementPumpBlowPopOffValve, ChangeCementPumpBlowPopOffValve, distance) + + end subroutine + + + + + + + + + + + + subroutine ChangePump1PowerFail(status) + Use Pump_VARIABLES + implicit none + integer, intent (in) :: status + if(associated(Pump1PowerFailPtr)) call Pump1PowerFailPtr(status) + if(status == Clear_StatusType) PUMP(1)%PowerFailMalf=0 + if(status == Executed_StatusType) PUMP(1)%PowerFailMalf=1 + endsubroutine + + subroutine ChangePump1BlowPopOffValve(status) + Use Pump_VARIABLES + implicit none + integer, intent (in) :: status + if(associated(Pump1BlowPopOffValvePtr)) call Pump1BlowPopOffValvePtr(status) + if(status == Clear_StatusType) PUMP(1)%BlowPopOffMalf=0 + if(status == Executed_StatusType) PUMP(1)%BlowPopOffMalf=1 + endsubroutine + + subroutine ChangePump2PowerFail(status) + Use Pump_VARIABLES + implicit none + integer, intent (in) :: status + if(associated(Pump2PowerFailPtr)) call Pump2PowerFailPtr(status) + if(status == Clear_StatusType) PUMP(2)%PowerFailMalf=0 + if(status == Executed_StatusType) PUMP(2)%PowerFailMalf=1 + endsubroutine + + subroutine ChangePump2BlowPopOffValve(status) + Use Pump_VARIABLES + implicit none + integer, intent (in) :: status + if(associated(Pump2BlowPopOffValvePtr)) call Pump2BlowPopOffValvePtr(status) + if(status == Clear_StatusType) PUMP(2)%BlowPopOffMalf=0 + if(status == Executed_StatusType) PUMP(2)%BlowPopOffMalf=1 + endsubroutine + + subroutine ChangeCementPumpPowerFail(status) + Use Pump_VARIABLES + implicit none + integer, intent (in) :: status + if(associated(CementPumpPowerFailPtr)) call CementPumpPowerFailPtr(status) + if(status == Clear_StatusType) PUMP(3)%PowerFailMalf=0 + if(status == Executed_StatusType) PUMP(3)%PowerFailMalf=1 + endsubroutine + + subroutine ChangeCementPumpBlowPopOffValve(status) + Use Pump_VARIABLES + implicit none + integer, intent (in) :: status + if(associated(CementPumpBlowPopOffValvePtr)) call CementPumpBlowPopOffValvePtr(status) + if(status == Clear_StatusType) PUMP(3)%BlowPopOffMalf=0 + if(status == Executed_StatusType) PUMP(3)%BlowPopOffMalf=1 + endsubroutine + + + + + + + + + + + + + + + + subroutine SubscribePump1PowerFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePump1PowerFail + !DEC$ ATTRIBUTES ALIAS: 'SubscribePump1PowerFail' :: SubscribePump1PowerFail + implicit none + procedure (ActionInteger) :: v + Pump1PowerFailPtr => v + end subroutine + + subroutine SubscribePump1BlowPopOffValve(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePump1BlowPopOffValve + !DEC$ ATTRIBUTES ALIAS: 'SubscribePump1BlowPopOffValve' :: SubscribePump1BlowPopOffValve + implicit none + procedure (ActionInteger) :: v + Pump1BlowPopOffValvePtr => v + end subroutine + + subroutine SubscribePump2PowerFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePump2PowerFail + !DEC$ ATTRIBUTES ALIAS: 'SubscribePump2PowerFail' :: SubscribePump2PowerFail + implicit none + procedure (ActionInteger) :: v + Pump2PowerFailPtr => v + end subroutine + + subroutine SubscribePump2BlowPopOffValve(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePump2BlowPopOffValve + !DEC$ ATTRIBUTES ALIAS: 'SubscribePump2BlowPopOffValve' :: SubscribePump2BlowPopOffValve + implicit none + procedure (ActionInteger) :: v + Pump2BlowPopOffValvePtr => v + end subroutine + + subroutine SubscribeCementPumpPowerFail(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeCementPumpPowerFail + !DEC$ ATTRIBUTES ALIAS: 'SubscribeCementPumpPowerFail' :: SubscribeCementPumpPowerFail + implicit none + procedure (ActionInteger) :: v + CementPumpPowerFailPtr => v + end subroutine + + subroutine SubscribeCementPumpBlowPopOffValve(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeCementPumpBlowPopOffValve + !DEC$ ATTRIBUTES ALIAS: 'SubscribeCementPumpBlowPopOffValve' :: SubscribeCementPumpBlowPopOffValve + implicit none + procedure (ActionInteger) :: v + CementPumpBlowPopOffValvePtr => v + end subroutine + + + + + + + +end module CPumpProblemsVariables \ No newline at end of file diff --git a/CSharp/Problems/CRotaryProblems.f90 b/CSharp/Problems/CRotaryProblems.f90 new file mode 100644 index 0000000..1b83828 --- /dev/null +++ b/CSharp/Problems/CRotaryProblems.f90 @@ -0,0 +1,34 @@ +module CRotaryProblems + use CRotaryProblemsVariables + implicit none + public + contains + + ! Input routines + subroutine SetMotorFail2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMotorFail2 + !DEC$ ATTRIBUTES ALIAS: 'SetMotorFail2' :: SetMotorFail2 + implicit none + type(CProblem), intent(in) :: v + MotorFail = SetDue(v, ChangeMotorFail) +#ifdef deb + print*, 'MotorFail%ProblemType=', V%ProblemType + print*, 'MotorFail%StatusType=', V%StatusType + print*, 'MotorFail%Value=', V%Value +#endif + end subroutine + + subroutine SetOverideTorqueLimit2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetOverideTorqueLimit2 + !DEC$ ATTRIBUTES ALIAS: 'SetOverideTorqueLimit2' :: SetOverideTorqueLimit2 + implicit none + type(CProblem), intent(in) :: v + OverideTorqueLimit = SetDue(v, ChangeOverideTorqueLimit) +#ifdef deb + print*, 'OverideTorqueLimit%ProblemType=', V%ProblemType + print*, 'OverideTorqueLimit%StatusType=', V%StatusType + print*, 'OverideTorqueLimit%Value=', V%Value +#endif + end subroutine + +end module CRotaryProblems \ No newline at end of file diff --git a/CSharp/Problems/CRotaryProblemsVariables.f90 b/CSharp/Problems/CRotaryProblemsVariables.f90 new file mode 100644 index 0000000..1564942 --- /dev/null +++ b/CSharp/Problems/CRotaryProblemsVariables.f90 @@ -0,0 +1,106 @@ +module CRotaryProblemsVariables + use CProblemDifinition + implicit none + public + + ! Input vars + type(CProblem) :: MotorFail + type(CProblem) :: OverideTorqueLimit + + procedure (ActionInteger), pointer :: MotorFailPtr + procedure (ActionInteger), pointer :: OverideTorqueLimitPtr + + contains + + subroutine ProcessRotaryProblemsDueTime(time) + implicit none + integer :: time + + if(MotorFail%ProblemType == Time_ProblemType) call ProcessDueTime(MotorFail, ChangeMotorFail, time) + if(OverideTorqueLimit%ProblemType == Time_ProblemType) call ProcessDueTime(OverideTorqueLimit, ChangeOverideTorqueLimit, time) + + end subroutine + + subroutine ProcessRotaryProblemsDuePumpStrokes(strokes) + implicit none + integer :: strokes + + if(MotorFail%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(MotorFail, ChangeMotorFail, strokes) + if(OverideTorqueLimit%ProblemType == PumpStrokes_ProblemType) call ProcessDuePumpStrokes(OverideTorqueLimit, ChangeOverideTorqueLimit, strokes) + + end subroutine + + subroutine ProcessRotaryProblemsDueVolumePumped(volume) + implicit none + real(8) :: volume + + if(MotorFail%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(MotorFail, ChangeMotorFail, volume) + if(OverideTorqueLimit%ProblemType == VolumePumped_ProblemType) call ProcessDueVolumePumped(OverideTorqueLimit, ChangeOverideTorqueLimit, volume) + + end subroutine + + subroutine ProcessRotaryProblemsDueDistanceDrilled(distance) + implicit none + real(8) :: distance + + if(MotorFail%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(MotorFail, ChangeMotorFail, distance) + if(OverideTorqueLimit%ProblemType == DistanceDrilled_ProblemType) call ProcessDueDistanceDrilled(OverideTorqueLimit, ChangeOverideTorqueLimit, distance) + + end subroutine + + + + + + + + subroutine ChangeMotorFail(status) + use RTable_VARIABLES + implicit none + integer, intent (in) :: status + if(associated(MotorFailPtr)) call MotorFailPtr(status) + if(status == Clear_StatusType) RTable%MotorFaileMalf=0 + if(status == Executed_StatusType) RTable%MotorFaileMalf=1 + endsubroutine + + subroutine ChangeOverideTorqueLimit(status) + use RTable_VARIABLES + implicit none + integer, intent (in) :: status + if(associated(OverideTorqueLimitPtr)) call OverideTorqueLimitPtr(status) + if(status == Clear_StatusType) RTable%OverideTorqueLimitMalf=0 + if(status == Executed_StatusType) RTable%OverideTorqueLimitMalf=1 + endsubroutine + + + + + + + + + + + + + + + subroutine SubscribeMotorFail2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeMotorFail2 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeMotorFail2' :: SubscribeMotorFail2 + implicit none + procedure (ActionInteger) :: v + MotorFailPtr => v + end subroutine + + subroutine SubscribeOverideTorqueLimit(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeOverideTorqueLimit + !DEC$ ATTRIBUTES ALIAS: 'SubscribeOverideTorqueLimit' :: SubscribeOverideTorqueLimit + implicit none + procedure (ActionInteger) :: v + OverideTorqueLimitPtr => v + end subroutine + + + +end module CRotaryProblemsVariables \ No newline at end of file diff --git a/CSharp/Simulation/CSimulation.f90 b/CSharp/Simulation/CSimulation.f90 new file mode 100644 index 0000000..101aaa2 --- /dev/null +++ b/CSharp/Simulation/CSimulation.f90 @@ -0,0 +1,1080 @@ +module CSimulation + use CSimulationVariables + use CSimulationThreads + use ifcore + use ifmt + implicit none + public + + + contains + + subroutine InitThreads + implicit none + +#ifdef EnableSimulation + !BopStack + BopStackThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + BopStackThread, & + loc(BopStackThreadParam), & + CREATE_SUSPENDED, & + BopStackThreadId ) + + !Pumps + Pump1ThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + Pump1Thread, & + loc(Pump1ThreadParam), & + CREATE_SUSPENDED, & + Pump1ThreadId ) + Pump2ThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + Pump2Thread, & + loc(Pump2ThreadParam), & + CREATE_SUSPENDED, & + Pump2ThreadId ) + Pump3ThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + Pump3Thread, & + loc(Pump3ThreadParam), & + CREATE_SUSPENDED, & + Pump3ThreadId ) + + + !ChokeControl + ChokeControlThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + ChokeControlThread, & + loc(ChokeControlThreadParam), & + CREATE_SUSPENDED, & + ChokeControlThreadId ) + + !ROP + RopThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + RopThread, & + loc(RopThreadParam), & + CREATE_SUSPENDED, & + RopThreadId ) + + !Geo + GeoThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + GeoThread, & + loc(GeoThreadParam), & + CREATE_SUSPENDED, & + GeoThreadId ) + + !RotaryTable + RotaryTableThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + RotaryTableThread, & + loc(RotaryTableThreadParam), & + CREATE_SUSPENDED, & + RotaryTableThreadId ) + + + !Drawworks + DrawworksThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + DrawworksThread, & + loc(DrawworksThreadParam), & + CREATE_SUSPENDED, & + DrawworksThreadId ) + + !FluidFlow + FluidFlowThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + FluidFlowThread, & + loc(FluidFlowThreadParam), & + CREATE_SUSPENDED, & + FluidFlowThreadId ) + + + !TorqueDrag + TorqueDragThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + TorqueDragThread, & + loc(TorqueDragThreadParam), & + CREATE_SUSPENDED, & + TorqueDragThreadId ) + + !TopDrive + TopDriveThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + TopDriveThread, & + loc(TopDriveThreadParam), & + CREATE_SUSPENDED, & + TopDriveThreadId ) + + !MudSystem + MudSystemThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + MudSystemThread, & + loc(MudSystemThreadParam), & + CREATE_SUSPENDED, & + MudSystemThreadId ) + + !PipeRams1 + PipeRams1ThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + PipeRams1Thread, & + loc(PipeRams1ThreadParam), & + CREATE_SUSPENDED, & + PipeRams1ThreadId ) + + !PipeRams2 + PipeRams2ThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + PipeRams2Thread, & + loc(PipeRams2ThreadParam), & + CREATE_SUSPENDED, & + PipeRams2ThreadId ) + + !KillLine + KillLineThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + KillLineThread, & + loc(KillLineThreadParam), & + CREATE_SUSPENDED, & + KillLineThreadId ) + + !ChokeLine + ChokeLineThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + ChokeLineThread, & + loc(ChokeLineThreadParam), & + CREATE_SUSPENDED, & + ChokeLineThreadId ) + + !BlindRams + BlindRamsThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + BlindRamsThread, & + loc(BlindRamsThreadParam), & + CREATE_SUSPENDED, & + BlindRamsThreadId ) + + !Annular + AnnularThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + AnnularThread, & + loc(AnnularThreadParam), & + CREATE_SUSPENDED, & + AnnularThreadId ) + + + !OperationScenarios + OperationScenariosThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + OperationScenariosThread, & + loc(OperationScenariosThreadParam), & + CREATE_SUSPENDED, & + OperationScenariosThreadId ) + + !PathFinding + PathFindingThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + PathFindingThread, & + loc(PathFindingThreadParam), & + CREATE_SUSPENDED, & + PathFindingThreadId ) + + + !Sample + SampleThreadHandle = CreateThread( & + ThreadSecurity, & + ThreadStackSize, & + SampleThread, & + loc(SampleThreadParam), & + CREATE_SUSPENDED, & + SampleThreadId ) + +#endif + + end subroutine InitThreads + + subroutine StopThreads + implicit none + +#ifdef EnableSimulation + !BopStack +#ifdef HardStop + ApiResult = TerminateThread(BopStackThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(BopStackThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(BopStackThreadHandle) + + + + + !Pump 1 +#ifdef HardStop + ApiResult = TerminateThread(Pump1ThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(Pump1ThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(Pump1ThreadHandle) + + !Pump 2 +#ifdef HardStop + ApiResult = TerminateThread(Pump2ThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(Pump2ThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(Pump2ThreadHandle) + + !Pump 3 +#ifdef HardStop + ApiResult = TerminateThread(Pump3ThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(Pump3ThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(Pump3ThreadHandle) + + + !ChokeControl +#ifdef HardStop + ApiResult = TerminateThread(ChokeControlThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(ChokeControlThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(ChokeControlThreadHandle) + + !ROP +#ifdef HardStop + ApiResult = TerminateThread(RopThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(RopThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(RopThreadHandle) + + !Geo +#ifdef HardStop + ApiResult = TerminateThread(GeoThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(GeoThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(GeoThreadHandle) + + !RotaryTable +#ifdef HardStop + ApiResult = TerminateThread(RotaryTableThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(RotaryTableThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(RotaryTableThreadHandle) + + + !Drawworks +#ifdef HardStop + ApiResult = TerminateThread(DrawworksThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(DrawworksThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(DrawworksThreadHandle) + + !FluidFlow +#ifdef HardStop + ApiResult = TerminateThread(FluidFlowThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(FluidFlowThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(FluidFlowThreadHandle) + + + !TorqueDrag +#ifdef HardStop + ApiResult = TerminateThread(TorqueDragThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(TorqueDragThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(TorqueDragThreadHandle) + + + !TopDrive +#ifdef HardStop + ApiResult = TerminateThread(TopDriveThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(TopDriveThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(TopDriveThreadHandle) + + + + !MudSystem +#ifdef HardStop + ApiResult = TerminateThread(MudSystemThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(MudSystemThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(MudSystemThreadHandle) + + !PipeRams1 +#ifdef HardStop + ApiResult = TerminateThread(PipeRams1ThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(PipeRams1ThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(PipeRams1ThreadHandle) + + !PipeRams2 +#ifdef HardStop + ApiResult = TerminateThread(PipeRams2ThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(PipeRams2ThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(PipeRams2ThreadHandle) + + !KillLine +#ifdef HardStop + ApiResult = TerminateThread(KillLineThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(KillLineThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(KillLineThreadHandle) + + !ChokeLine +#ifdef HardStop + ApiResult = TerminateThread(ChokeLineThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(ChokeLineThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(ChokeLineThreadHandle) + + !BlindRams +#ifdef HardStop + ApiResult = TerminateThread(BlindRamsThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(BlindRamsThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(BlindRamsThreadHandle) + + !Annular +#ifdef HardStop + ApiResult = TerminateThread(AnnularThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(AnnularThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(AnnularThreadHandle) + + + !OperationScenarios +#ifdef HardStop + ApiResult = TerminateThread(OperationScenariosThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(OperationScenariosThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(OperationScenariosThreadHandle) + + !PathFinding +#ifdef HardStop + ApiResult = TerminateThread(PathFindingThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(PathFindingThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(PathFindingThreadHandle) + + + + + + + !Sample +#ifdef HardStop + ApiResult = TerminateThread(SampleThreadHandle, 0) +#else + !ApiResult = WaitForSingleObject(SampleThreadHandle, WaitForStopMs) +#endif + ApiResult = CloseHandle(SampleThreadHandle) + +#endif + + + + + + + + + + + + + end subroutine StopThreads + + subroutine Initialization(portable) + !DEC$ ATTRIBUTES DLLEXPORT::Initialization + !DEC$ ATTRIBUTES ALIAS: 'Initialization' :: Initialization + use BopStackMain + use PumpsMain + use ChokeControlMain + 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 GeoMain + + use COperationScenariosMain + use CManifolds + implicit none + logical, intent(in) :: portable + IsPortable = portable + if(portable) then + IsPortableInt = 1 + !print*, 'IsPortableInt=', IsPortableInt + else + IsPortableInt = 0 + !print*, 'IsPortableInt=', IsPortableInt + endif + + call BopStack_Setup() + call Pump1_Setup() + call Pump2_Setup() + call Pump3_Setup() + call ChokeControl_Setup() + call Rop_Setup() + call RotaryTable_Setup() + call Drawworks_Setup() + call FluidFlow_Setup() + call TorqueDrag_Setup() + call MudSystem_Setup() + call PipeRams1_Setup() + call PipeRams2_Setup() + call KillLine_Setup() + call ChokeLine_Setup() + call BlindRams_Setup() + call Annular_Setup() + call TopDrive_Setup() + call Geo_Setup() + + call OperationScenarios_Setup() + call PathFinding_Setup() + + call Sample_Setup() + + call OnSimulationInitialization%RunAll() + + call InitThreads() + + + call OnBopStackPause%Add(BopStack_Thread) + call OnPump1Pause%Add(Pump1_Thread) + call OnPump2Pause%Add(Pump2_Thread) + call OnPump3Pause%Add(Pump3_Thread) + call OnChokeControlPause%Add(ChokeControl_Thread) + call OnRopPause%Add(Rop_Thread) + call OnRotaryTablePause%Add(RotaryTable_Thread) + call OnDrawworksPause%Add(Drawworks_Thread) + call OnFluidFlowPause%Add(FluidFlow_Thread) + call OnTorqueDragPause%Add(TorqueDrag_Thread) + call OnMudSystemPause%Add(MudSystem_Thread) + call OnPipeRams1Pause%Add(PipeRams1_Thread) + call OnPipeRams2Pause%Add(PipeRams2_Thread) + call OnKillLinePause%Add(KillLine_Thread) + call OnChokeLinePause%Add(ChokeLine_Thread) + call OnBlindRamsPause%Add(BlindRams_Thread) + call OnAnnularPause%Add(Annular_Thread) + call OnGeoPause%Add(Geo_Thread) + + call OnSamplePause%Add(Sample_Thread) + + TotalStrokesPtr => TotalStrokesDue + TotalVolumePumpedPtr => TotalVolumePumpedDue + DistanceDrilledPtr => DistanceDrilledDue + + !TODO: CHANGE LATER + call DrillMode_ON() + + end subroutine Initialization + + subroutine StartSimulation + !DEC$ ATTRIBUTES DLLEXPORT::StartSimulation + !DEC$ ATTRIBUTES ALIAS: 'StartSimulation' :: StartSimulation + implicit none + + if(SimulationState_old == SimulationState_Stopped) call OnSimulationStart%RunAll() + IsStopped = .false. + SimulationState = SimulationState_Started + SimulationState_old = SimulationState_Started + + BopStackStarted = .false. + Pump1Started = .false. + Pump2Started = .false. + Pump3Started = .false. + ChokeControlStarted = .false. + RopStarted = .false. + RotaryTableStarted = .false. + DrawworksStarted = .false. + FluidFlowStarted = .false. + TorqueDragStarted = .false. + MudSystemStarted = .false. + PipeRams1Started = .false. + PipeRams2Started = .false. + KillLineStarted = .false. + ChokeLineStarted = .false. + BlindRamsStarted = .false. + AnnularStarted = .false. + GeoStarted = .false. + + SampleStarted = .false. + + +#ifdef EnableSimulation + +#ifdef M_BopStack + ApiResult = ResumeThread(BopStackThreadHandle) +#endif + +#ifdef M_Pump1 + ApiResult = ResumeThread(Pump1ThreadHandle) +#endif +#ifdef M_Pump2 + ApiResult = ResumeThread(Pump2ThreadHandle) +#endif +#ifdef M_Pump3 + ApiResult = ResumeThread(Pump3ThreadHandle) +#endif + + +#ifdef M_ChokeControl + ApiResult = ResumeThread(ChokeControlThreadHandle) +#endif +#ifdef M_Rop + ApiResult = ResumeThread(RopThreadHandle) +#endif +#ifdef M_Geo + ApiResult = ResumeThread(GeoThreadHandle) +#endif +#ifdef M_RotaryTable + ApiResult = ResumeThread(RotaryTableThreadHandle) +#endif + +#ifdef M_Drawworks + ApiResult = ResumeThread(DrawworksThreadHandle) +#endif +#ifdef M_FluidFlow + ApiResult = ResumeThread(FluidFlowThreadHandle) +#endif + +#ifdef M_TorqueDrag + ApiResult = ResumeThread(TorqueDragThreadHandle) +#endif + +#ifdef M_TopDrive + ApiResult = ResumeThread(TopDriveThreadHandle) +#endif + +#ifdef M_MudSystem + ApiResult = ResumeThread(MudSystemThreadHandle) +#endif +#ifdef M_PipeRams1 + ApiResult = ResumeThread(PipeRams1ThreadHandle) +#endif +#ifdef M_PipeRams2 + ApiResult = ResumeThread(PipeRams2ThreadHandle) +#endif +#ifdef M_KillLine + ApiResult = ResumeThread(KillLineThreadHandle) +#endif +#ifdef M_ChokeLine + ApiResult = ResumeThread(ChokeLineThreadHandle) +#endif +#ifdef M_BlindRams + ApiResult = ResumeThread(BlindRamsThreadHandle) +#endif +#ifdef M_Annular + ApiResult = ResumeThread(AnnularThreadHandle) +#endif + + !OperationScenarios + ApiResult = ResumeThread(OperationScenariosThreadHandle) + + !PathFinding + ApiResult = ResumeThread(PathFindingThreadHandle) + +#ifdef M_Sample + ApiResult = ResumeThread(SampleThreadHandle) +#endif + +#endif + end subroutine StartSimulation + + subroutine StopSimulation + !DEC$ ATTRIBUTES DLLEXPORT::StopSimulation + !DEC$ ATTRIBUTES ALIAS: 'StopSimulation' :: StopSimulation + use CDrillingConsoleVariables, only: MP1CPSwitchI, MP2SwitchI, MP1CPSwitch, MP2Switch, MP1Throttle, MP2Throttle, MP1ThrottleUpdate, MP2ThrottleUpdate + implicit none + MP1CPSwitchI = 0 + MP1CPSwitch = 0 + MP2SwitchI = 0 + MP2Switch = .false. + MP1ThrottleUpdate = .false. + MP2ThrottleUpdate = .false. + MP1Throttle = -1.0 + MP2Throttle = -1.0 + !MP1Throttle = 0.0 + !MP2Throttle = 0.0 + + IsSnapshot = .false. + IsStopped = .true. + TotalPumpStrokes = 0 + TotalVolumePumped = 0 + DistanceDrilled = 0 + SimulationState = SimulationState_Stopped + SimulationState_old = SimulationState_Stopped + call OnSimulationStop%RunAll() + call StopThreads() + call InitThreads() + end subroutine StopSimulation + + subroutine PauseSimulation + implicit none + if(SimulationState_old == SimulationState_Stopped) then + SimulationState_old = SimulationState_Started + return + endif + SimulationState_old = SimulationState_Paused +#ifdef EnableSimulation + !BopStack + ApiResult = SuspendThread(BopStackThreadHandle) + + !Pumps + ApiResult = SuspendThread(Pump1ThreadHandle) + ApiResult = SuspendThread(Pump2ThreadHandle) + ApiResult = SuspendThread(Pump3ThreadHandle) + + + !ChokeControl + ApiResult = SuspendThread(ChokeControlThreadHandle) + + !ROP + ApiResult = SuspendThread(RopThreadHandle) + + !Geo + ApiResult = SuspendThread(GeoThreadHandle) + + !RotaryTable + ApiResult = SuspendThread(RotaryTableThreadHandle) + + + !Drawworks + ApiResult = SuspendThread(DrawworksThreadHandle) + + !FluidFlow + ApiResult = SuspendThread(FluidFlowThreadHandle) + + + !TorqueDrag + ApiResult = SuspendThread(TorqueDragThreadHandle) + + + !TopDrive + ApiResult = SuspendThread(TopDriveThreadHandle) + + !MudSystem + ApiResult = SuspendThread(MudSystemThreadHandle) + + !PipeRams1 + ApiResult = SuspendThread(PipeRams1ThreadHandle) + + !PipeRams2 + ApiResult = SuspendThread(PipeRams2ThreadHandle) + + !KillLine + ApiResult = SuspendThread(KillLineThreadHandle) + + !ChokeLine + ApiResult = SuspendThread(ChokeLineThreadHandle) + + !BlindRams + ApiResult = SuspendThread(BlindRamsThreadHandle) + + !Annular + ApiResult = SuspendThread(AnnularThreadHandle) + + + !OperationScenarios + ApiResult = SuspendThread(OperationScenariosThreadHandle) + + !PathFinding + ApiResult = SuspendThread(PathFindingThreadHandle) + + + + !Sample + ApiResult = SuspendThread(SampleThreadHandle) +#endif + call OnSimulationPause%RunAll() + end subroutine PauseSimulation + + logical function IsRunning() + !DEC$ ATTRIBUTES DLLEXPORT :: IsRunning + !DEC$ ATTRIBUTES ALIAS: 'IsRunning' :: IsRunning + implicit none + IsRunning = .not. IsStopped + end function + + subroutine OnTimerTick(time, state) + !DEC$ ATTRIBUTES DLLEXPORT :: OnTimerTick + !DEC$ ATTRIBUTES ALIAS: 'OnTimerTick' :: OnTimerTick + implicit none + integer, intent(in) :: time + integer, intent(in) :: state + SimulationState = state + SimulationTime = time + end subroutine + + subroutine TimerTick(s) + !DEC$ ATTRIBUTES DLLEXPORT :: TimerTick + !DEC$ ATTRIBUTES ALIAS: 'TimerTick' :: TimerTick + use CBitProblemsVariables + use CBopProblemsVariables + use CChokeProblemsVariables + use CDrillStemProblemsVariables + use CGaugesProblemsVariables + use CHoistingProblemsVariables + use CLostProblemsVariables + use CMudTreatmentProblemsVariables + use COtherProblemsVariables + use CPumpProblemsVariables + use CRotaryProblemsVariables + use CKickProblemsVariables + use GeoMain + implicit none + integer, intent(in) :: s + SimulationTime = s + call ProcessBitProblemsDueTime(s) + call ProcessBopProblemsDueTime(s) + call ProcessChokeProblemsDueTime(s) + call ProcessDrillStemProblemsDueTime(s) + call ProcessGaugesProblemsDueTime(s) + call ProcessHoistingProblemsDueTime(s) + call ProcessLostProblemsDueTime(s) + call ProcessMudTreatmentProblemsDueTime(s) + call ProcessOtherProblemsDueTime(s) + call ProcessPumpProblemsDueTime(s) + call ProcessRotaryProblemsDueTime(s) + call ProcessKickProblemsDueTime(s) + +#ifdef S_BopStack + ApiResult = ResumeThread(BopStackThreadHandle) +#endif +#ifdef S_Pump1 + ApiResult = ResumeThread(Pump1ThreadHandle) +#endif +#ifdef S_Pump2 + ApiResult = ResumeThread(Pump2ThreadHandle) +#endif +#ifdef S_Pump3 + ApiResult = ResumeThread(Pump3ThreadHandle) +#endif +#ifdef S_ChokeControl + ApiResult = ResumeThread(ChokeControlThreadHandle) +#endif +#ifdef S_Rop + ApiResult = ResumeThread(RopThreadHandle) +#endif +#ifdef S_RotaryTable + ApiResult = ResumeThread(RotaryTableThreadHandle) +#endif +#ifdef S_Drawworks + ApiResult = ResumeThread(DrawworksThreadHandle) +#endif +#ifdef S_FluidFlow + ApiResult = ResumeThread(FluidFlowThreadHandle) +#endif +#ifdef S_TorqueDrag + ApiResult = ResumeThread(TorqueDragThreadHandle) +#endif +#ifdef S_TopDrive + ApiResult = ResumeThread(TopDriveThreadHandle) +#endif +#ifdef S_MudSystem + ApiResult = ResumeThread(MudSystemThreadHandle) +#endif +#ifdef S_PipeRams1 + ApiResult = ResumeThread(PipeRams1ThreadHandle) +#endif +#ifdef S_PipeRams2 + ApiResult = ResumeThread(PipeRams2ThreadHandle) +#endif +#ifdef S_KillLine + ApiResult = ResumeThread(KillLineThreadHandle) +#endif +#ifdef S_ChokeLine + ApiResult = ResumeThread(ChokeLineThreadHandle) +#endif +#ifdef S_BlindRams + ApiResult = ResumeThread(BlindRamsThreadHandle) +#endif +#ifdef S_Annular ت + ApiResult = ResumeThread(AnnularThreadHandle) +#endif +#ifdef S_Geo + ApiResult = ResumeThread(GeoThreadHandle) +#endif + + + +#ifdef S_Sample + ApiResult = ResumeThread(SampleThreadHandle) +#endif + + end subroutine + + subroutine StateChanged(state) + !DEC$ ATTRIBUTES DLLEXPORT :: StateChanged + !DEC$ ATTRIBUTES ALIAS: 'StateChanged' :: StateChanged + implicit none + integer, intent(in) :: state + SimulationState = state + if(SimulationState == SimulationState_Paused) call PauseSimulation() + end subroutine + + subroutine SetSimulationSpeed(speed) + !DEC$ ATTRIBUTES DLLEXPORT :: SetSimulationSpeed + !DEC$ ATTRIBUTES ALIAS: 'SetSimulationSpeed' :: SetSimulationSpeed + implicit none + integer, intent(in) :: speed + SimulationSpeed = speed + end subroutine + + + subroutine SetSnapshot(s) + !DEC$ ATTRIBUTES DLLEXPORT::SetSnapshot + !DEC$ ATTRIBUTES ALIAS: 'SetSnapshot' :: SetSnapshot + implicit none + logical, intent(in) :: s + IsSnapshot = s + !if(IsSnapshot) SimulationState_old = SimulationState_Started + end subroutine SetSnapshot + + + subroutine TotalStrokesDue(strokes) + use CBitProblemsVariables + use CBopProblemsVariables + use CChokeProblemsVariables + use CDrillStemProblemsVariables + use CGaugesProblemsVariables + use CHoistingProblemsVariables + use CLostProblemsVariables + use CMudTreatmentProblemsVariables + use COtherProblemsVariables + use CPumpProblemsVariables + use CRotaryProblemsVariables + use CKickProblemsVariables + implicit none + integer, intent(in) :: strokes + call ProcessBitProblemsDuePumpStrokes(strokes) + call ProcessBopProblemsDuePumpStrokes(strokes) + call ProcessChokeProblemsDuePumpStrokes(strokes) + call ProcessDrillStemProblemsDuePumpStrokes(strokes) + call ProcessGaugesProblemsDuePumpStrokes(strokes) + call ProcessHoistingProblemsDuePumpStrokes(strokes) + call ProcessLostProblemsDuePumpStrokes(strokes) + call ProcessMudTreatmentProblemsDuePumpStrokes(strokes) + call ProcessOtherProblemsDuePumpStrokes(strokes) + call ProcessPumpProblemsDuePumpStrokes(strokes) + call ProcessRotaryProblemsDuePumpStrokes(strokes) + call ProcessKickProblemsDuePumpStrokes(strokes) + + end subroutine + + subroutine TotalVolumePumpedDue(volume) + use CBitProblemsVariables + use CBopProblemsVariables + use CChokeProblemsVariables + use CDrillStemProblemsVariables + use CGaugesProblemsVariables + use CHoistingProblemsVariables + use CLostProblemsVariables + use CMudTreatmentProblemsVariables + use COtherProblemsVariables + use CPumpProblemsVariables + use CRotaryProblemsVariables + use CKickProblemsVariables + implicit none + real(8), intent(in) :: volume + call ProcessBitProblemsDueVolumePumped(volume) + call ProcessBopProblemsDueVolumePumped(volume) + call ProcessChokeProblemsDueVolumePumped(volume) + call ProcessDrillStemProblemsDueVolumePumped(volume) + call ProcessGaugesProblemsDueVolumePumped(volume) + call ProcessHoistingProblemsDueVolumePumped(volume) + call ProcessLostProblemsDueVolumePumped(volume) + call ProcessMudTreatmentProblemsDueVolumePumped(volume) + call ProcessOtherProblemsDueVolumePumped(volume) + call ProcessPumpProblemsDueVolumePumped(volume) + call ProcessRotaryProblemsDueVolumePumped(volume) + call ProcessKickProblemsDueVolumePumped(volume) + + end subroutine + + subroutine DistanceDrilledDue(distance) + use CBitProblemsVariables + use CBopProblemsVariables + use CChokeProblemsVariables + use CDrillStemProblemsVariables + use CGaugesProblemsVariables + use CHoistingProblemsVariables + use CLostProblemsVariables + use CMudTreatmentProblemsVariables + use COtherProblemsVariables + use CPumpProblemsVariables + use CRotaryProblemsVariables + use CKickProblemsVariables + implicit none + real(8), intent(in) :: distance + call ProcessBitProblemsDueDistanceDrilled(distance) + call ProcessBopProblemsDueDistanceDrilled(distance) + call ProcessChokeProblemsDueDistanceDrilled(distance) + call ProcessDrillStemProblemsDueDistanceDrilled(distance) + call ProcessGaugesProblemsDueDistanceDrilled(distance) + call ProcessHoistingProblemsDueDistanceDrilled(distance) + call ProcessLostProblemsDueDistanceDrilled(distance) + call ProcessMudTreatmentProblemsDueDistanceDrilled(distance) + call ProcessOtherProblemsDueDistanceDrilled(distance) + call ProcessPumpProblemsDueDistanceDrilled(distance) + call ProcessRotaryProblemsDueDistanceDrilled(distance) + call ProcessKickProblemsDueDistanceDrilled(distance) + end subroutine + + + + + subroutine BopStack_Thread + implicit none + ApiResult = SuspendThread(BopStackThreadHandle) + end subroutine BopStack_Thread + + subroutine Pump1_Thread + implicit none + ApiResult = SuspendThread(Pump1ThreadHandle) + end subroutine Pump1_Thread + + subroutine Pump2_Thread + implicit none + ApiResult = SuspendThread(Pump2ThreadHandle) + end subroutine Pump2_Thread + + subroutine Pump3_Thread + implicit none + ApiResult = SuspendThread(Pump3ThreadHandle) + end subroutine Pump3_Thread + + subroutine ChokeControl_Thread + implicit none + ApiResult = SuspendThread(ChokeControlThreadHandle) + end subroutine ChokeControl_Thread + + subroutine Rop_Thread + implicit none + ApiResult = SuspendThread(RopThreadHandle) + end subroutine Rop_Thread + + subroutine RotaryTable_Thread + implicit none + ApiResult = SuspendThread(RotaryTableThreadHandle) + end subroutine RotaryTable_Thread + + subroutine Drawworks_Thread + implicit none + ApiResult = SuspendThread(DrawworksThreadHandle) + end subroutine Drawworks_Thread + + subroutine FluidFlow_Thread + implicit none + ApiResult = SuspendThread(FluidFlowThreadHandle) + end subroutine FluidFlow_Thread + + subroutine TorqueDrag_Thread + implicit none + ApiResult = SuspendThread(TorqueDragThreadHandle) + end subroutine TorqueDrag_Thread + + subroutine TopDrive_Thread + implicit none + ApiResult = SuspendThread(TopDriveThreadHandle) + end subroutine TopDrive_Thread + + subroutine MudSystem_Thread + implicit none + ApiResult = SuspendThread(MudSystemThreadHandle) + end subroutine MudSystem_Thread + + subroutine PipeRams1_Thread + implicit none + ApiResult = SuspendThread(PipeRams1ThreadHandle) + end subroutine PipeRams1_Thread + + subroutine PipeRams2_Thread + implicit none + ApiResult = SuspendThread(PipeRams2ThreadHandle) + end subroutine PipeRams2_Thread + + subroutine KillLine_Thread + implicit none + ApiResult = SuspendThread(KillLineThreadHandle) + end subroutine KillLine_Thread + + subroutine ChokeLine_Thread + implicit none + ApiResult = SuspendThread(ChokeLineThreadHandle) + end subroutine ChokeLine_Thread + + subroutine BlindRams_Thread + implicit none + ApiResult = SuspendThread(BlindRamsThreadHandle) + end subroutine BlindRams_Thread + + subroutine Annular_Thread + implicit none + ApiResult = SuspendThread(AnnularThreadHandle) + end subroutine Annular_Thread + + subroutine Geo_Thread + implicit none + ApiResult = SuspendThread(GeoThreadHandle) + end subroutine Geo_Thread + + + + subroutine Sample_Thread + implicit none + ApiResult = SuspendThread(SampleThreadHandle) + end subroutine Sample_Thread + +end module CSimulation \ No newline at end of file diff --git a/CSharp/Simulation/CSimulationThreads.f90 b/CSharp/Simulation/CSimulationThreads.f90 new file mode 100644 index 0000000..257114d --- /dev/null +++ b/CSharp/Simulation/CSimulationThreads.f90 @@ -0,0 +1,146 @@ +module CSimulationThreads + use iso_c_binding + implicit none + public + ! Thread Related Variables + integer(INT_PTR_KIND()), parameter :: ThreadSecurity = 0 + integer(INT_PTR_KIND()), parameter :: ThreadStackSize = 0 + integer(4) :: ApiResult + integer(4) :: WaitForStopMs = 500 + + !BopStack + integer(INT_PTR_KIND()) :: BopStackThreadHandle + integer(INT_PTR_KIND()) :: BopStackThreadId + integer(4) :: BopStackThreadParam = 0 + + !Pumps + integer(INT_PTR_KIND()) :: Pump1ThreadHandle + integer(INT_PTR_KIND()) :: Pump2ThreadHandle + integer(INT_PTR_KIND()) :: Pump3ThreadHandle + integer(INT_PTR_KIND()) :: Pump1ThreadId + integer(INT_PTR_KIND()) :: Pump2ThreadId + integer(INT_PTR_KIND()) :: Pump3ThreadId + integer(4) :: Pump1ThreadParam = 0 + integer(4) :: Pump2ThreadParam = 0 + integer(4) :: Pump3ThreadParam = 0 + + !ChokeControl + integer(INT_PTR_KIND()) :: ChokeControlThreadHandle + integer(INT_PTR_KIND()) :: ChokeControlThreadId + integer(4) :: ChokeControlThreadParam = 0 + + !Rop + integer(INT_PTR_KIND()) :: RopThreadHandle + integer(INT_PTR_KIND()) :: RopThreadId + integer(4) :: RopThreadParam = 0 + + + !RotaryTable + integer(INT_PTR_KIND()) :: RotaryTableThreadHandle + integer(INT_PTR_KIND()) :: RotaryTableThreadId + integer(4) :: RotaryTableThreadParam = 0 + + + !FluidFlow + integer(INT_PTR_KIND()) :: FluidFlowThreadHandle + integer(INT_PTR_KIND()) :: FluidFlowThreadId + integer(4) :: FluidFlowThreadParam = 0 + + !TorqueDrag + integer(INT_PTR_KIND()) :: TorqueDragThreadHandle + integer(INT_PTR_KIND()) :: TorqueDragThreadId + integer(4) :: TorqueDragThreadParam = 0 + + + !TopDrive + integer(INT_PTR_KIND()) :: TopDriveThreadHandle + integer(INT_PTR_KIND()) :: TopDriveThreadId + integer(4) :: TopDriveThreadParam = 0 + + + !Drawworks + integer(INT_PTR_KIND()) :: DrawworksThreadHandle + integer(INT_PTR_KIND()) :: DrawworksThreadId + integer(4) :: DrawworksThreadParam = 0 + + !Geo + integer(INT_PTR_KIND()) :: GeoThreadHandle + integer(INT_PTR_KIND()) :: GeoThreadId + integer(4) :: GeoThreadParam = 0 + + !MudFlowFillIndicator + integer(INT_PTR_KIND()) :: MudFlowFillIndicatorThreadHandle + integer(INT_PTR_KIND()) :: MudFlowFillIndicatorThreadId + integer(4) :: MudFlowFillIndicatorThreadParam = 0 + + !MudSystem + integer(INT_PTR_KIND()) :: MudSystemThreadHandle + integer(INT_PTR_KIND()) :: MudSystemThreadId + integer(4) :: MudSystemThreadParam = 0 + + + + + + + !PipeRams1 + integer(INT_PTR_KIND()) :: PipeRams1ThreadHandle + integer(INT_PTR_KIND()) :: PipeRams1ThreadId + integer(4) :: PipeRams1ThreadParam = 0 + + !PipeRams2 + integer(INT_PTR_KIND()) :: PipeRams2ThreadHandle + integer(INT_PTR_KIND()) :: PipeRams2ThreadId + integer(4) :: PipeRams2ThreadParam = 0 + + !KillLine + integer(INT_PTR_KIND()) :: KillLineThreadHandle + integer(INT_PTR_KIND()) :: KillLineThreadId + integer(4) :: KillLineThreadParam = 0 + + !ChokeLine + integer(INT_PTR_KIND()) :: ChokeLineThreadHandle + integer(INT_PTR_KIND()) :: ChokeLineThreadId + integer(4) :: ChokeLineThreadParam = 0 + + !BlindRams + integer(INT_PTR_KIND()) :: BlindRamsThreadHandle + integer(INT_PTR_KIND()) :: BlindRamsThreadId + integer(4) :: BlindRamsThreadParam = 0 + + !Annular + integer(INT_PTR_KIND()) :: AnnularThreadHandle + integer(INT_PTR_KIND()) :: AnnularThreadId + integer(4) :: AnnularThreadParam = 0 + + + + !OperationScenarios + integer(INT_PTR_KIND()) :: OperationScenariosThreadHandle + integer(INT_PTR_KIND()) :: OperationScenariosThreadId + integer(4) :: OperationScenariosThreadParam = 0 + + + !PathFinding + integer(INT_PTR_KIND()) :: PathFindingThreadHandle + integer(INT_PTR_KIND()) :: PathFindingThreadId + integer(4) :: PathFindingThreadParam = 0 + + + ! just for now + !Sample + integer(INT_PTR_KIND()) :: SampleThreadHandle + integer(INT_PTR_KIND()) :: SampleThreadId + integer(4) :: SampleThreadParam = 0 + + +#ifdef disEnableSimulation + + + !Test + integer(INT_PTR_KIND()) :: TestThreadHandle + integer(INT_PTR_KIND()) :: TestThreadId + integer(4) :: TestThreadParam = 0 +#endif + contains +end module CSimulationThreads \ No newline at end of file diff --git a/CSharp/Simulation/CSimulationVariables.f90 b/CSharp/Simulation/CSimulationVariables.f90 new file mode 100644 index 0000000..482b495 --- /dev/null +++ b/CSharp/Simulation/CSimulationVariables.f90 @@ -0,0 +1,1211 @@ +module CSimulationVariables + use CVoidEventHandlerCollection + ! use CSimulationThreads + use CIActionReference + ! use ifcore + use ifmt + ! use CTimer + use CError + use CLog3 + implicit none + public + + integer, parameter :: SimulationState_Stopped = 0; + integer, parameter :: SimulationState_Started = 1; + integer, parameter :: SimulationState_Paused = 2; + + logical :: IsStopped = .false. + logical :: IsSnapshot = .false. + logical :: IsPortable = .false. + integer :: IsPortableInt = 0 + + integer :: SimulationState_old + integer :: SimulationState + integer :: SimulationTime + integer :: SimulationSpeed ! 1, 2, 5, 10 + + integer :: SleepLimit = 0 + + integer :: TotalPumpStrokes + real(8) :: TotalVolumePumped + real(8) :: DistanceDrilled + + type(VoidEventHandlerCollection) :: OnSimulationInitialization + type(VoidEventHandlerCollection) :: OnSimulationStart + type(VoidEventHandlerCollection) :: OnSimulationStop + type(VoidEventHandlerCollection) :: OnSimulationPause + !type(VoidEventHandlerCollection) :: OnSimulationGetOutput + + procedure (ActionVoid), pointer :: ForceRealTimeSpeedPtr + procedure (ActionBool), pointer :: SpeedChangePossibilityPtr + logical :: SpeedChangePossibilityValue + + procedure (ActionInteger), pointer :: TotalStrokesChangedPtr + procedure (ActionInteger), pointer :: TotalStrokesPtr + procedure (ActionDouble), pointer :: TotalVolumePumpedPtr + procedure (ActionDouble), pointer :: DistanceDrilledPtr + + ! modules... + !BopStack + type(VoidEventHandlerCollection) :: OnBopStackStep + type(VoidEventHandlerCollection) :: OnBopStackStart + type(VoidEventHandlerCollection) :: OnBopStackOutput + type(VoidEventHandlerCollection) :: OnBopStackPause + type(VoidEventHandlerCollection) :: OnBopStackMain + logical :: BopStackStarted + + !Pumps + type(VoidEventHandlerCollection) :: OnPump1Step + type(VoidEventHandlerCollection) :: OnPump1Start + type(VoidEventHandlerCollection) :: OnPump1Output + type(VoidEventHandlerCollection) :: OnPump1Pause + type(VoidEventHandlerCollection) :: OnPump1Main + logical :: Pump1Started + + type(VoidEventHandlerCollection) :: OnPump2Step + type(VoidEventHandlerCollection) :: OnPump2Start + type(VoidEventHandlerCollection) :: OnPump2Output + type(VoidEventHandlerCollection) :: OnPump2Pause + type(VoidEventHandlerCollection) :: OnPump2Main + logical :: Pump2Started + + type(VoidEventHandlerCollection) :: OnPump3Step + type(VoidEventHandlerCollection) :: OnPump3Start + type(VoidEventHandlerCollection) :: OnPump3Output + type(VoidEventHandlerCollection) :: OnPump3Pause + type(VoidEventHandlerCollection) :: OnPump3Main + logical :: Pump3Started + + !ChokeControl + type(VoidEventHandlerCollection) :: OnChokeControlStep + type(VoidEventHandlerCollection) :: OnChokeControlStart + type(VoidEventHandlerCollection) :: OnChokeControlOutput + type(VoidEventHandlerCollection) :: OnChokeControlPause + type(VoidEventHandlerCollection) :: OnChokeControlMain + logical :: ChokeControlStarted + + !ROP + type(VoidEventHandlerCollection) :: OnRopStep + type(VoidEventHandlerCollection) :: OnRopStart + type(VoidEventHandlerCollection) :: OnRopOutput + type(VoidEventHandlerCollection) :: OnRopPause + type(VoidEventHandlerCollection) :: OnRopMain + logical :: RopStarted + + !RotaryTable + type(VoidEventHandlerCollection) :: OnRotaryTableStep + type(VoidEventHandlerCollection) :: OnRotaryTableStart + type(VoidEventHandlerCollection) :: OnRotaryTableOutput + type(VoidEventHandlerCollection) :: OnRotaryTablePause + type(VoidEventHandlerCollection) :: OnRotaryTableMain + logical :: RotaryTableStarted + + !Drawworks + type(VoidEventHandlerCollection) :: OnDrawworksStep + type(VoidEventHandlerCollection) :: OnDrawworksStart + type(VoidEventHandlerCollection) :: OnDrawworksOutput + type(VoidEventHandlerCollection) :: OnDrawworksPause + type(VoidEventHandlerCollection) :: OnDrawworksMain + logical :: DrawworksStarted + + !FluidFlow + type(VoidEventHandlerCollection) :: OnFluidFlowStep + type(VoidEventHandlerCollection) :: OnFluidFlowStart + type(VoidEventHandlerCollection) :: OnFluidFlowOutput + type(VoidEventHandlerCollection) :: OnFluidFlowPause + type(VoidEventHandlerCollection) :: OnFluidFlowMain + logical :: FluidFlowStarted + + !TorqueDrag + type(VoidEventHandlerCollection) :: OnTorqueDragStep + type(VoidEventHandlerCollection) :: OnTorqueDragStart + type(VoidEventHandlerCollection) :: OnTorqueDragOutput + type(VoidEventHandlerCollection) :: OnTorqueDragPause + type(VoidEventHandlerCollection) :: OnTorqueDragMain + logical :: TorqueDragStarted + + + !TopDrive + type(VoidEventHandlerCollection) :: OnTopDriveStep + type(VoidEventHandlerCollection) :: OnTopDriveStart + type(VoidEventHandlerCollection) :: OnTopDriveOutput + type(VoidEventHandlerCollection) :: OnTopDrivePause + type(VoidEventHandlerCollection) :: OnTopDriveMain + logical :: TopDriveStarted + + + !MudSystem + type(VoidEventHandlerCollection) :: OnMudSystemStep + type(VoidEventHandlerCollection) :: OnMudSystemStart + type(VoidEventHandlerCollection) :: OnMudSystemOutput + type(VoidEventHandlerCollection) :: OnMudSystemPause + type(VoidEventHandlerCollection) :: OnMudSystemMain + logical :: MudSystemStarted + + !PipeRams1 + type(VoidEventHandlerCollection) :: OnPipeRams1Step + type(VoidEventHandlerCollection) :: OnPipeRams1Start + type(VoidEventHandlerCollection) :: OnPipeRams1Output + type(VoidEventHandlerCollection) :: OnPipeRams1Pause + type(VoidEventHandlerCollection) :: OnPipeRams1Main + logical :: PipeRams1Started + + !PipeRams2 + type(VoidEventHandlerCollection) :: OnPipeRams2Step + type(VoidEventHandlerCollection) :: OnPipeRams2Start + type(VoidEventHandlerCollection) :: OnPipeRams2Output + type(VoidEventHandlerCollection) :: OnPipeRams2Pause + type(VoidEventHandlerCollection) :: OnPipeRams2Main + logical :: PipeRams2Started + + !KillLine + type(VoidEventHandlerCollection) :: OnKillLineStep + type(VoidEventHandlerCollection) :: OnKillLineStart + type(VoidEventHandlerCollection) :: OnKillLineOutput + type(VoidEventHandlerCollection) :: OnKillLinePause + type(VoidEventHandlerCollection) :: OnKillLineMain + logical :: KillLineStarted + + !ChokeLine + type(VoidEventHandlerCollection) :: OnChokeLineStep + type(VoidEventHandlerCollection) :: OnChokeLineStart + type(VoidEventHandlerCollection) :: OnChokeLineOutput + type(VoidEventHandlerCollection) :: OnChokeLinePause + type(VoidEventHandlerCollection) :: OnChokeLineMain + logical :: ChokeLineStarted + + !BlindRams + type(VoidEventHandlerCollection) :: OnBlindRamsStep + type(VoidEventHandlerCollection) :: OnBlindRamsStart + type(VoidEventHandlerCollection) :: OnBlindRamsOutput + type(VoidEventHandlerCollection) :: OnBlindRamsPause + type(VoidEventHandlerCollection) :: OnBlindRamsMain + logical :: BlindRamsStarted + + !Annular + type(VoidEventHandlerCollection) :: OnAnnularStep + type(VoidEventHandlerCollection) :: OnAnnularStart + type(VoidEventHandlerCollection) :: OnAnnularOutput + type(VoidEventHandlerCollection) :: OnAnnularPause + type(VoidEventHandlerCollection) :: OnAnnularMain + logical :: AnnularStarted + + !Geo + type(VoidEventHandlerCollection) :: OnGeoStep + type(VoidEventHandlerCollection) :: OnGeoStart + type(VoidEventHandlerCollection) :: OnGeoOutput + type(VoidEventHandlerCollection) :: OnGeoPause + type(VoidEventHandlerCollection) :: OnGeoMain + logical :: GeoStarted + + + + + + !OperationScenarios + type(VoidEventHandlerCollection) :: OnOperationScenariosStep + type(VoidEventHandlerCollection) :: OnOperationScenariosOutput + type(VoidEventHandlerCollection) :: OnOperationScenariosPause + type(VoidEventHandlerCollection) :: OnOperationScenariosMain + + !PathFinding + type(VoidEventHandlerCollection) :: OnPathFindingStep + type(VoidEventHandlerCollection) :: OnPathFindingOutput + type(VoidEventHandlerCollection) :: OnPathFindingPause + type(VoidEventHandlerCollection) :: OnPathFindingMain + + ! sample + type(VoidEventHandlerCollection) :: OnSampleStep + type(VoidEventHandlerCollection) :: OnSampleStart + type(VoidEventHandlerCollection) :: OnSampleOutput + type(VoidEventHandlerCollection) :: OnSamplePause + type(VoidEventHandlerCollection) :: OnSampleMain + logical :: SampleStarted + + !!MudFlowFillIndicator + !type(VoidEventHandlerCollection) :: OnMudFlowFillIndicatorStep + !type(VoidEventHandlerCollection) :: OnMudFlowFillIndicatorOutput + !type(VoidEventHandlerCollection) :: OnMudFlowFillIndicatorMain + + + + + + + + + + + + + + contains + + subroutine Quit() + use ifmt + call ExitThread(0) + end subroutine + + real function GetSimulationSpeedSecond() + implicit none + GetSimulationSpeedSecond = 1.0 / SimulationSpeed + end function GetSimulationSpeedSecond + + integer function GetSimulationSpeedMilisecond() + implicit none + GetSimulationSpeedMilisecond = int(GetSimulationSpeedSecond()* 1000.0) + end function GetSimulationSpeedMilisecond + + subroutine DrillMode_ON() + implicit none + call SpeedChangePossibility(.true.) + end subroutine + + subroutine DrillMode_OFF() + implicit none + call ForceRealTimeSpeed() + call SpeedChangePossibility(.false.) + end subroutine + + subroutine ForceRealTimeSpeed() + implicit none + if(associated(ForceRealTimeSpeedPtr)) call ForceRealTimeSpeedPtr() + end subroutine + + subroutine SpeedChangePossibility(v) + implicit none + logical, intent(in) :: v + SpeedChangePossibilityValue = v + if(associated(SpeedChangePossibilityPtr)) call SpeedChangePossibilityPtr(SpeedChangePossibilityValue) + end subroutine + + subroutine SubscribeSpeedChangePossibility(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSpeedChangePossibility + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSpeedChangePossibility' :: SubscribeSpeedChangePossibility + implicit none + procedure (ActionBool) :: a + SpeedChangePossibilityPtr => a + end subroutine + + subroutine SubscribeForceRealTimeSpeed(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeForceRealTimeSpeed + !DEC$ ATTRIBUTES ALIAS: 'SubscribeForceRealTimeSpeed' :: SubscribeForceRealTimeSpeed + implicit none + procedure (ActionVoid) :: a + ForceRealTimeSpeedPtr => a + end subroutine + + subroutine SubscribeTotalStrokesChanged(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeTotalStrokesChanged + !DEC$ ATTRIBUTES ALIAS: 'SubscribeTotalStrokesChanged' :: SubscribeTotalStrokesChanged + implicit none + procedure (ActionInteger) :: a + TotalStrokesChangedPtr => a + end subroutine + + subroutine SetTotalStrokes(strokes) + implicit none + integer, intent(in) :: strokes + if (TotalPumpStrokes == strokes) return + TotalPumpStrokes = strokes + if(associated(TotalStrokesChangedPtr)) call TotalStrokesChangedPtr(TotalPumpStrokes) + if(associated(TotalStrokesPtr)) call TotalStrokesPtr(TotalPumpStrokes) + end subroutine + + subroutine SetTotalVolumePumped(volume) + implicit none + real(8), intent(in) :: volume + if (TotalVolumePumped == volume) return + TotalVolumePumped = volume + if(associated(TotalVolumePumpedPtr)) call TotalVolumePumpedPtr(TotalVolumePumped) + end subroutine + + subroutine SetDistanceDrilled(distance) + implicit none + real(8), intent(in) :: distance + if (DistanceDrilled == distance) return + DistanceDrilled = distance + if(associated(DistanceDrilledPtr)) call DistanceDrilledPtr(DistanceDrilled) + end subroutine + +! integer(4) function BopStackThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_bopstackthread" :: BopStackThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_BopStack +! call OnBopStackMain%RunAll() +! #endif +! #ifdef S_BopStack +! if(.not.BopStackStarted) then +! call OnBopStackStart%RunAll() +! BopStackStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnBopStackStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('BOP Stack Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnBopStackOutput%RunAll() +! end do +! call OnBopStackPause%RunAll() +! end do loop +! #endif +! BopStackThread = 0; +! call ExitThread(0) +! end function BopStackThread + +! integer(4) function Pump1Thread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_pump1thread" :: Pump1Thread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_Pump1 +! call OnPump1Main%RunAll() +! #endif +! #ifdef S_Pump1 +! if(.not.Pump1Started) then +! call OnPump1Start%RunAll() +! Pump1Started = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnPump1Step%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Pump 1 Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnPump1Output%RunAll() +! end do +! call OnPump1Pause%RunAll() +! end do loop +! #endif +! Pump1Thread = 0; +! call ExitThread(0) +! end function Pump1Thread + +! integer(4) function Pump2Thread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_pump2thread" :: Pump2Thread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_Pump2 +! call OnPump2Main%RunAll() +! #endif +! #ifdef S_Pump2 +! if(.not.Pump2Started) then +! call OnPump2Start%RunAll() +! Pump2Started = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnPump2Step%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Pump 2 Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnPump2Output%RunAll() +! end do +! call OnPump2Pause%RunAll() +! end do loop +! #endif +! Pump2Thread = 0; +! call ExitThread(0) +! end function Pump2Thread + +! integer(4) function Pump3Thread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_pump3thread" :: Pump3Thread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_Pump3 +! call OnPump3Main%RunAll() +! #endif +! #ifdef S_Pump3 +! if(.not.Pump3Started) then +! call OnPump3Start%RunAll() +! Pump3Started = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnPump3Step%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Pump 3 Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnPump3Output%RunAll() +! end do +! call OnPump3Pause%RunAll() +! end do loop +! #endif +! Pump3Thread = 0; +! call ExitThread(0) +! end function Pump3Thread + +! integer(4) function ChokeControlThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_chokecontrolthread" :: ChokeControlThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_ChokeControl +! call OnChokeControlMain%RunAll() +! #endif +! #ifdef S_ChokeControl +! if(.not.ChokeControlStarted) then +! call OnChokeControlStart%RunAll() +! ChokeControlStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnChokeControlStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Choke Control Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnChokeControlOutput%RunAll() +! end do +! call OnChokeControlPause%RunAll() +! end do loop +! #endif +! ChokeControlThread = 0; +! call ExitThread(0) +! end function ChokeControlThread + +! integer(4) function RopThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_ropthread" :: RopThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_Rop +! call OnRopMain%RunAll() +! #endif +! #ifdef S_Rop +! if(.not.RopStarted) then +! call OnRopStart%RunAll() +! RopStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnRopStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('ROP Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnRopOutput%RunAll() +! end do +! call OnRopPause%RunAll() +! end do loop +! #endif +! RopThread = 0; +! call ExitThread(0) +! end function RopThread + +! integer(4) function RotaryTableThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_rotarytablethread" :: RotaryTableThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_RotaryTable +! call OnRotaryTableMain%RunAll() +! #endif +! #ifdef S_RotaryTable +! if(.not.RotaryTableStarted) then +! call OnRotaryTableStart%RunAll() +! RotaryTableStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnRotaryTableStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Rotary Table Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnRotaryTableOutput%RunAll() +! end do +! call OnRotaryTablePause%RunAll() +! end do loop +! #endif +! RotaryTableThread = 0; +! call ExitThread(0) +! end function RotaryTableThread + +! integer(4) function DrawworksThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_drawworksthread" :: DrawworksThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_Drawworks +! call OnDrawworksMain%RunAll() +! #endif +! #ifdef S_Drawworks +! if(.not.DrawworksStarted) then +! call OnDrawworksStart%RunAll() +! DrawworksStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnDrawworksStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Drawworks Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnDrawworksOutput%RunAll() +! end do +! call OnDrawworksPause%RunAll() +! end do loop +! #endif +! DrawworksThread = 0; +! call ExitThread(0) +! end function DrawworksThread + +! integer(4) function FluidFlowThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_fluidflowthread" :: FluidFlowThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_FluidFlow +! call OnFluidFlowMain%RunAll() +! #endif +! #ifdef S_FluidFlow +! if(.not.FluidFlowStarted) then +! call OnFluidFlowStart%RunAll() +! FluidFlowStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnFluidFlowStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Fluid Flow Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnFluidFlowOutput%RunAll() +! end do +! call OnFluidFlowPause%RunAll() +! end do loop +! #endif +! FluidFlowThread = 0; +! call ExitThread(0) +! end function FluidFlowThread + +! integer(4) function TorqueDragThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_torquedragthread" :: TorqueDragThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_TorqueDrag +! call OnTorqueDragMain%RunAll() +! #endif +! #ifdef S_TorqueDrag +! if(.not.TorqueDragStarted) then +! call OnTorqueDragStart%RunAll() +! TorqueDragStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnTorqueDragStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Torque Drag Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnTorqueDragOutput%RunAll() +! end do +! call OnTorqueDragPause%RunAll() +! end do loop +! #endif +! TorqueDragThread = 0; +! call ExitThread(0) +! end function TorqueDragThread + + +! integer(4) function TopDriveThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_topdrivethread" :: TopDriveThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_TopDrive +! call OnTopDriveMain%RunAll() +! #endif +! #ifdef S_TopDrive +! if(.not.TopDriveStarted) then +! call OnTopDriveStart%RunAll() +! TopDriveStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnTopDriveStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('TopDrive Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnTopDriveOutput%RunAll() +! end do +! call OnTopDrivePause%RunAll() +! end do loop +! #endif +! TopDriveThread = 0; +! call ExitThread(0) +! end function TopDriveThread + + +! integer(4) function MudSystemThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_MudSystemthread" :: MudSystemThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_MudSystem +! call OnMudSystemMain%RunAll() +! #endif +! #ifdef S_MudSystem +! if(.not.MudSystemStarted) then +! call OnMudSystemStart%RunAll() +! MudSystemStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnMudSystemStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Mud System Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnMudSystemOutput%RunAll() +! end do +! call OnMudSystemPause%RunAll() +! end do loop +! #endif +! MudSystemThread = 0; +! call ExitThread(0) +! end function MudSystemThread + +! integer(4) function PipeRams1Thread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_piperams1thread" :: PipeRams1Thread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_PipeRams1 +! call OnPipeRams1Main%RunAll() +! #endif +! #ifdef S_PipeRams1 +! if(.not.PipeRams1Started) then +! call OnPipeRams1Start%RunAll() +! PipeRams1Started = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnPipeRams1Step%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Pipe Rams 1 Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnPipeRams1Output%RunAll() +! end do +! call OnPipeRams1Pause%RunAll() +! end do loop +! #endif +! PipeRams1Thread = 0; +! call ExitThread(0) +! end function PipeRams1Thread + +! integer(4) function PipeRams2Thread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_piperams2thread" :: PipeRams2Thread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_PipeRams2 +! call OnPipeRams2Main%RunAll() +! #endif +! #ifdef S_PipeRams2 +! if(.not.PipeRams2Started) then +! call OnPipeRams2Start%RunAll() +! PipeRams2Started = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnPipeRams2Step%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Pipe Rams 2 Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnPipeRams2Output%RunAll() +! end do +! call OnPipeRams2Pause%RunAll() +! end do loop +! #endif +! PipeRams2Thread = 0; +! call ExitThread(0) +! end function PipeRams2Thread + +! integer(4) function KillLineThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_killlinethread" :: KillLineThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_KillLine +! call OnKillLineMain%RunAll() +! #endif +! #ifdef S_KillLine +! if(.not.KillLineStarted) then +! call OnKillLineStart%RunAll() +! KillLineStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnKillLineStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Kill Line Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnKillLineOutput%RunAll() +! end do +! call OnKillLinePause%RunAll() +! end do loop +! #endif +! KillLineThread = 0; +! call ExitThread(0) +! end function KillLineThread + +! integer(4) function ChokeLineThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_chokelinethread" :: ChokeLineThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_ChokeLine +! call OnChokeLineMain%RunAll() +! #endif +! #ifdef S_ChokeLine +! if(.not.ChokeLineStarted) then +! call OnChokeLineStart%RunAll() +! ChokeLineStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnChokeLineStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Choke Line Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnChokeLineOutput%RunAll() +! end do +! call OnChokeLinePause%RunAll() +! end do loop +! #endif +! ChokeLineThread = 0; +! call ExitThread(0) +! end function ChokeLineThread + +! integer(4) function BlindRamsThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_blindramsthread" :: BlindRamsThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_BlindRams +! call OnBlindRamsMain%RunAll() +! #endif +! #ifdef S_BlindRams +! if(.not.BlindRamsStarted) then +! call OnBlindRamsStart%RunAll() +! BlindRamsStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnBlindRamsStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Blind Rams Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnBlindRamsOutput%RunAll() +! end do +! call OnBlindRamsPause%RunAll() +! end do loop +! #endif +! BlindRamsThread = 0; +! call ExitThread(0) +! end function BlindRamsThread + +! integer(4) function AnnularThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_annularthread" :: AnnularThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_Annular +! call OnAnnularMain%RunAll() +! #endif +! #ifdef S_Annular +! if(.not.AnnularStarted) then +! call OnAnnularStart%RunAll() +! AnnularStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnAnnularStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Annular Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnAnnularOutput%RunAll() +! end do +! call OnAnnularPause%RunAll() +! end do loop +! #endif +! AnnularThread = 0; +! call ExitThread(0) +! end function AnnularThread + +! integer(4) function GeoThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_geothread" :: GeoThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_Geo +! call OnGeoMain%RunAll() +! #endif +! #ifdef S_Geo +! if(.not.GeoStarted) then +! call OnGeoStart%RunAll() +! GeoStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnGeoStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Geo Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnGeoOutput%RunAll() +! end do +! call OnGeoPause%RunAll() +! end do loop +! #endif +! GeoThread = 0; +! call ExitThread(0) +! end function GeoThread + + + +! integer(4) function OperationScenariosThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_operationscenariosthread" :: OperationScenariosThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! call OnOperationScenariosMain%RunAll() +! OperationScenariosThread = 0; +! call ExitThread(0) +! end function OperationScenariosThread + +! integer(4) function PathFindingThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_pathfindingthread" :: PathFindingThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! call OnPathFindingMain%RunAll() +! PathFindingThread = 0; +! call ExitThread(0) +! end function PathFindingThread + + + + + + + + + + + + + + +! integer(4) function SampleThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_samplethread" :: SampleThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_Sample +! call OnSampleMain%RunAll() +! #endif +! #ifdef S_Sample +! if(.not.SampleStarted) then +! call OnSampleStart%RunAll() +! SampleStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnSampleStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Sample Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnSampleOutput%RunAll() +! end do +! call OnSamplePause%RunAll() +! end do loop + +! #endif +! SampleThread = 0; +! call ExitThread(0) +! end function SampleThread + +end module CSimulationVariables \ No newline at end of file diff --git a/CSharp/Simulation/CSounds.f90 b/CSharp/Simulation/CSounds.f90 new file mode 100644 index 0000000..0bb7826 --- /dev/null +++ b/CSharp/Simulation/CSounds.f90 @@ -0,0 +1,683 @@ +module CSounds + use CIActionReference + implicit none + public + + ! Input vars + + ! Output vars + integer :: SoundMP1s + integer :: SoundMP2s + integer :: SoundMP3s + integer :: SoundRTs + integer :: SoundDwFws + integer :: SoundDwRevs + integer :: SoundDwBrakes + integer :: SoundChokePumps + integer :: SoundGasThroughChokes + integer :: SoundKoomeyAirPumps + integer :: SoundKoomeyElectricPumps + logical :: SoundRtGearCrashs + logical :: SoundDwGearCrashs + logical :: SoundFloorCollisions + logical :: SoundCrownCollisions + logical :: SoundDwClutchs + logical :: SoundBlowers + logical :: SoundBlowerMp1s + logical :: SoundBlowerMp2s + logical :: SoundBlowerMp3s + logical :: SoundBlowerRts + logical :: SoundBlowerDws + logical :: SoundBlowerStarts + logical :: SoundBlowerShutdowns + logical :: SoundElectricPumps + + + procedure (ActionInteger), pointer :: SoundMP1Ptr + procedure (ActionInteger), pointer :: SoundMP2Ptr + procedure (ActionInteger), pointer :: SoundMP3Ptr + procedure (ActionInteger), pointer :: SoundRTPtr + procedure (ActionInteger), pointer :: SoundDwFwPtr + procedure (ActionInteger), pointer :: SoundDwRevPtr + procedure (ActionInteger), pointer :: SoundDwBrakePtr + procedure (ActionInteger), pointer :: SoundChokePumpPtr + procedure (ActionInteger), pointer :: SoundGasThroughChokePtr + procedure (ActionInteger), pointer :: SoundKoomeyAirPumpPtr + procedure (ActionInteger), pointer :: SoundKoomeyElectricPumpPtr + procedure (ActionBool), pointer :: SoundRtGearCrashPtr + procedure (ActionBool), pointer :: SoundDwGearCrashPtr + procedure (ActionBool), pointer :: SoundFloorCollisionPtr + procedure (ActionBool), pointer :: SoundCrownCollisionPtr + procedure (ActionBool), pointer :: SoundDwClutchPtr + procedure (ActionBool), pointer :: SoundBlowerPtr + procedure (ActionBool), pointer :: SoundBlowerMp1Ptr + procedure (ActionBool), pointer :: SoundBlowerMp2Ptr + procedure (ActionBool), pointer :: SoundBlowerMp3Ptr + procedure (ActionBool), pointer :: SoundBlowerRtPtr + procedure (ActionBool), pointer :: SoundBlowerDwPtr + procedure (ActionBool), pointer :: SoundBlowerStartPtr + procedure (ActionBool), pointer :: SoundBlowerShutdownPtr + procedure (ActionBool), pointer :: SoundElectricPumpPtr + + private :: SoundMP1Ptr, SoundMP2Ptr, SoundMP3Ptr, SoundRTPtr, SoundDwFwPtr, SoundDwRevPtr,SoundDwBrakePtr,SoundChokePumpPtr,SoundGasThroughChokePtr,SoundKoomeyAirPumpPtr, & + SoundKoomeyElectricPumpPtr, SoundRtGearCrashPtr,SoundDwGearCrashPtr,SoundFloorCollisionPtr,SoundCrownCollisionPtr,SoundDwClutchPtr,SoundBlowerPtr, & + SoundBlowerMp1Ptr, SoundBlowerMp2Ptr,SoundBlowerMp3Ptr,SoundBlowerRtPtr,SoundBlowerDwPtr,SoundBlowerStartPtr,SoundBlowerShutdownPtr,SoundElectricPumpPtr + + contains + + + + + + subroutine SetSoundMP1(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundMP1Ptr)) call SoundMP1Ptr(v) + SoundMP1s = v + end subroutine + + subroutine SetSoundMP2(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundMP2Ptr)) call SoundMP2Ptr(v) + SoundMP2s = v + end subroutine + + subroutine SetSoundMP3(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundMP3Ptr)) call SoundMP3Ptr(v) + SoundMP3s = v + end subroutine + + subroutine SetSoundRT(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundRTPtr)) call SoundRTPtr(v) + SoundRTs = v + end subroutine + + subroutine SetSoundDwFw(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundDwFwPtr)) call SoundDwFwPtr(v) + SoundDwFws = v + end subroutine + + subroutine SetSoundDwRev(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundDwRevPtr)) call SoundDwRevPtr(v) + SoundDwRevs = v + end subroutine + + subroutine SetSoundDwBrake(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundDwBrakePtr)) call SoundDwBrakePtr(v) + SoundDwBrakes = v + end subroutine + + subroutine SetSoundChokePump(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundChokePumpPtr)) call SoundChokePumpPtr(v) + SoundChokePumps = v + end subroutine + + subroutine SetSoundGasThroughChoke(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundGasThroughChokePtr)) call SoundGasThroughChokePtr(v) + SoundGasThroughChokes = v + end subroutine + + subroutine SetSoundKoomeyAirPump(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundKoomeyAirPumpPtr)) call SoundKoomeyAirPumpPtr(v) + SoundKoomeyAirPumps = v + end subroutine + + subroutine SetSoundKoomeyElectricPump(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundKoomeyElectricPumpPtr)) call SoundKoomeyElectricPumpPtr(v) + SoundKoomeyElectricPumps = v + end subroutine + + subroutine SetSoundRtGearCrash(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundRtGearCrashPtr)) call SoundRtGearCrashPtr(v) + SoundRtGearCrashs = v + end subroutine + + subroutine SetSoundDwGearCrash(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundDwGearCrashPtr)) call SoundDwGearCrashPtr(v) + SoundDwGearCrashs = v + end subroutine + + subroutine SetSoundFloorCollision(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundFloorCollisionPtr)) call SoundFloorCollisionPtr(v) + SoundFloorCollisions = v + end subroutine + + subroutine SetSoundCrownCollision(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundCrownCollisionPtr)) call SoundCrownCollisionPtr(v) + SoundCrownCollisions = v + end subroutine + + subroutine SetSoundDwClutch(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundDwClutchPtr)) call SoundDwClutchPtr(v) + SoundDwClutchs = v + end subroutine + + subroutine SetSoundBlower(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundBlowerPtr)) call SoundBlowerPtr(v) + SoundBlowers = v + end subroutine + + subroutine SetSoundBlowerMP1(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundBlowerMp1Ptr)) call SoundBlowerMp1Ptr(v) + SoundBlowerMp1s = v + end subroutine + + subroutine SetSoundBlowerMP2(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundBlowerMp2Ptr)) call SoundBlowerMp2Ptr(v) + SoundBlowerMp2s = v + end subroutine + + subroutine SetSoundBlowerMP3(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundBlowerMp3Ptr)) call SoundBlowerMp3Ptr(v) + SoundBlowerMp3s = v + end subroutine + + subroutine SetSoundBlowerRT(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundBlowerRtPtr)) call SoundBlowerRtPtr(v) + SoundBlowerRts = v + end subroutine + + subroutine SetSoundBlowerDW(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundBlowerDwPtr)) call SoundBlowerDwPtr(v) + SoundBlowerDws = v + end subroutine + + + subroutine SetSoundBlowerStart(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundBlowerStartPtr)) call SoundBlowerStartPtr(v) + SoundBlowerStarts = v + end subroutine + + subroutine SetSoundBlowerShutdown(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundBlowerShutdownPtr)) call SoundBlowerShutdownPtr(v) + SoundBlowerShutdowns = v + end subroutine + + + subroutine SetSoundElectricPump(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundElectricPumpPtr)) call SoundElectricPumpPtr(v) + SoundElectricPumps = v + end subroutine + + + + + + + + + + + + + + + + + + + subroutine SubscribeSoundMP1(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundMP1 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundMP1' :: SubscribeSoundMP1 + implicit none + procedure (ActionInteger) :: v + SoundMP1Ptr => v + end subroutine + + subroutine SubscribeSoundMP2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundMP2 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundMP2' :: SubscribeSoundMP2 + implicit none + procedure (ActionInteger) :: v + SoundMP2Ptr => v + end subroutine + + subroutine SubscribeSoundMP3(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundMP3 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundMP3' :: SubscribeSoundMP3 + implicit none + procedure (ActionInteger) :: v + SoundMP3Ptr => v + end subroutine + + subroutine SubscribeSoundRT(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundRT + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundRT' :: SubscribeSoundRT + implicit none + procedure (ActionInteger) :: v + SoundRTPtr => v + end subroutine + + subroutine SubscribeSoundDwFw(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundDwFw + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundDwFw' :: SubscribeSoundDwFw + implicit none + procedure (ActionInteger) :: v + SoundDwFwPtr => v + end subroutine + + subroutine SubscribeSoundDwRev(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundDwRev + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundDwRev' :: SubscribeSoundDwRev + implicit none + procedure (ActionInteger) :: v + SoundDwRevPtr => v + end subroutine + + subroutine SubscribeSoundDwBrake(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundDwBrake + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundDwBrake' :: SubscribeSoundDwBrake + implicit none + procedure (ActionInteger) :: v + SoundDwBrakePtr => v + end subroutine + + subroutine SubscribeSoundChokePump(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundChokePump + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundChokePump' :: SubscribeSoundChokePump + implicit none + procedure (ActionInteger) :: v + SoundChokePumpPtr => v + end subroutine + + subroutine SubscribeSoundGasThroughChoke(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundGasThroughChoke + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundGasThroughChoke' :: SubscribeSoundGasThroughChoke + implicit none + procedure (ActionInteger) :: v + SoundGasThroughChokePtr => v + end subroutine + + subroutine SubscribeSoundKoomeyAirPump(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundKoomeyAirPump + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundKoomeyAirPump' :: SubscribeSoundKoomeyAirPump + implicit none + procedure (ActionInteger) :: v + SoundKoomeyAirPumpPtr => v + end subroutine + + subroutine SubscribeSoundKoomeyElectricPump(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundKoomeyElectricPump + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundKoomeyElectricPump' :: SubscribeSoundKoomeyElectricPump + implicit none + procedure (ActionInteger) :: v + SoundKoomeyElectricPumpPtr => v + end subroutine + + subroutine SubscribeSoundRtGearCrash(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundRtGearCrash + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundRtGearCrash' :: SubscribeSoundRtGearCrash + implicit none + procedure (ActionBool) :: v + SoundRtGearCrashPtr => v + end subroutine + + subroutine SubscribeSoundDwGearCrash(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundDwGearCrash + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundDwGearCrash' :: SubscribeSoundDwGearCrash + implicit none + procedure (ActionBool) :: v + SoundDwGearCrashPtr => v + end subroutine + + subroutine SubscribeSoundFloorCollision(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundFloorCollision + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundFloorCollision' :: SubscribeSoundFloorCollision + implicit none + procedure (ActionBool) :: v + SoundFloorCollisionPtr => v + end subroutine + + subroutine SubscribeSoundCrownCollision(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundCrownCollision + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundCrownCollision' :: SubscribeSoundCrownCollision + implicit none + procedure (ActionBool) :: v + SoundCrownCollisionPtr => v + end subroutine + + subroutine SubscribeSoundDwClutch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundDwClutch + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundDwClutch' :: SubscribeSoundDwClutch + implicit none + procedure (ActionBool) :: v + SoundDwClutchPtr => v + end subroutine + + subroutine SubscribeSoundBlower(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundBlower + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundBlower' :: SubscribeSoundBlower + implicit none + procedure (ActionBool) :: v + SoundBlowerPtr => v + end subroutine + + subroutine SubscribeSoundBlowerMp1(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundBlowerMp1 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundBlowerMp1' :: SubscribeSoundBlowerMp1 + implicit none + procedure (ActionBool) :: v + SoundBlowerMp1Ptr => v + end subroutine + + subroutine SubscribeSoundBlowerMp2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundBlowerMp2 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundBlowerMp2' :: SubscribeSoundBlowerMp2 + implicit none + procedure (ActionBool) :: v + SoundBlowerMp2Ptr => v + end subroutine + + subroutine SubscribeSoundBlowerMp3(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundBlowerMp3 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundBlowerMp3' :: SubscribeSoundBlowerMp3 + implicit none + procedure (ActionBool) :: v + SoundBlowerMp3Ptr => v + end subroutine + + subroutine SubscribeSoundBlowerRt(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundBlowerRt + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundBlowerRt' :: SubscribeSoundBlowerRt + implicit none + procedure (ActionBool) :: v + SoundBlowerRtPtr => v + end subroutine + + subroutine SubscribeSoundBlowerDw(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundBlowerDw + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundBlowerDw' :: SubscribeSoundBlowerDw + implicit none + procedure (ActionBool) :: v + SoundBlowerDwPtr => v + end subroutine + + subroutine SubscribeSoundBlowerStart(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundBlowerStart + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundBlowerStart' :: SubscribeSoundBlowerStart + implicit none + procedure (ActionBool) :: v + SoundBlowerStartPtr => v + end subroutine + + subroutine SubscribeSoundBlowerShutdown(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundBlowerShutdown + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundBlowerShutdown' :: SubscribeSoundBlowerShutdown + implicit none + procedure (ActionBool) :: v + SoundBlowerShutdownPtr => v + end subroutine + + subroutine SubscribeSoundElectricPump(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundElectricPump + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundElectricPump' :: SubscribeSoundElectricPump + implicit none + procedure (ActionBool) :: v + SoundElectricPumpPtr => v + end subroutine + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + ! Input routines + + ! Output routines + integer function GetSoundMP1() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundMP1 + !DEC$ ATTRIBUTES ALIAS: 'GetSoundMP1' :: GetSoundMP1 + implicit none + GetSoundMP1 = SoundMP1s + end function + + integer function GetSoundMP2() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundMP2 + !DEC$ ATTRIBUTES ALIAS: 'GetSoundMP2' :: GetSoundMP2 + implicit none + GetSoundMP2 = SoundMP2s + end function + + integer function GetSoundMP3() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundMP3 + !DEC$ ATTRIBUTES ALIAS: 'GetSoundMP3' :: GetSoundMP3 + implicit none + GetSoundMP3 = SoundMP3s + end function + + integer function GetSoundRT() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundRT + !DEC$ ATTRIBUTES ALIAS: 'GetSoundRT' :: GetSoundRT + implicit none + GetSoundRT = SoundRTs + end function + + integer function GetSoundDwFw() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundDwFw + !DEC$ ATTRIBUTES ALIAS: 'GetSoundDwFw' :: GetSoundDwFw + implicit none + GetSoundDwFw = SoundDwFws + end function + + integer function GetSoundDwRev() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundDwRev + !DEC$ ATTRIBUTES ALIAS: 'GetSoundDwRev' :: GetSoundDwRev + implicit none + GetSoundDwRev = SoundDwRevs + end function + + integer function GetSoundDwBrake() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundDwBrake + !DEC$ ATTRIBUTES ALIAS: 'GetSoundDwBrake' :: GetSoundDwBrake + implicit none + GetSoundDwBrake = SoundDwBrakes + end function + + integer function GetSoundChokePump() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundChokePump + !DEC$ ATTRIBUTES ALIAS: 'GetSoundChokePump' :: GetSoundChokePump + implicit none + GetSoundChokePump = SoundChokePumps + end function + + integer function GetSoundGasThroughChoke() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundGasThroughChoke + !DEC$ ATTRIBUTES ALIAS: 'GetSoundGasThroughChoke' :: GetSoundGasThroughChoke + implicit none + GetSoundGasThroughChoke = SoundGasThroughChokes + end function + + integer function GetSoundKoomeyAirPump() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundKoomeyAirPump + !DEC$ ATTRIBUTES ALIAS: 'GetSoundKoomeyAirPump' :: GetSoundKoomeyAirPump + implicit none + GetSoundKoomeyAirPump = SoundKoomeyAirPumps + end function + + integer function GetSoundKoomeyElectricPump() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundKoomeyElectricPump + !DEC$ ATTRIBUTES ALIAS: 'GetSoundKoomeyElectricPump' :: GetSoundKoomeyElectricPump + implicit none + GetSoundKoomeyElectricPump = SoundKoomeyElectricPumps + end function + + logical function GetSoundRtGearCrash() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundRtGearCrash + !DEC$ ATTRIBUTES ALIAS: 'GetSoundRtGearCrash' :: GetSoundRtGearCrash + implicit none + GetSoundRtGearCrash = SoundRtGearCrashs + end function + + logical function GetSoundDwGearCrash() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundDwGearCrash + !DEC$ ATTRIBUTES ALIAS: 'GetSoundDwGearCrash' :: GetSoundDwGearCrash + implicit none + GetSoundDwGearCrash = SoundDwGearCrashs + end function + + logical function GetSoundFloorCollision() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundFloorCollision + !DEC$ ATTRIBUTES ALIAS: 'GetSoundFloorCollision' :: GetSoundFloorCollision + implicit none + GetSoundFloorCollision = SoundFloorCollisions + end function + + logical function GetSoundCrownCollision() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundCrownCollision + !DEC$ ATTRIBUTES ALIAS: 'GetSoundCrownCollision' :: GetSoundCrownCollision + implicit none + GetSoundCrownCollision = SoundCrownCollisions + end function + + logical function GetSoundDwClutch() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundDwClutch + !DEC$ ATTRIBUTES ALIAS: 'GetSoundDwClutch' :: GetSoundDwClutch + implicit none + GetSoundDwClutch = SoundDwClutchs + end function + + logical function GetSoundBlower() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundBlower + !DEC$ ATTRIBUTES ALIAS: 'GetSoundBlower' :: GetSoundBlower + implicit none + GetSoundBlower = SoundBlowers + end function + + logical function GetSoundBlowerMp1() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundBlowerMp1 + !DEC$ ATTRIBUTES ALIAS: 'GetSoundBlowerMp1' :: GetSoundBlowerMp1 + implicit none + GetSoundBlowerMp1 = SoundBlowerMp1s + end function + + logical function GetSoundBlowerMp2() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundBlowerMp2 + !DEC$ ATTRIBUTES ALIAS: 'GetSoundBlowerMp2' :: GetSoundBlowerMp2 + implicit none + GetSoundBlowerMp2 = SoundBlowerMp2s + end function + + logical function GetSoundBlowerMp3() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundBlowerMp3 + !DEC$ ATTRIBUTES ALIAS: 'GetSoundBlowerMp3' :: GetSoundBlowerMp3 + implicit none + GetSoundBlowerMp3 = SoundBlowerMp3s + end function + + logical function GetSoundBlowerRt() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundBlowerRt + !DEC$ ATTRIBUTES ALIAS: 'GetSoundBlowerRt' :: GetSoundBlowerRt + implicit none + GetSoundBlowerRt = SoundBlowerRts + end function + + logical function GetSoundBlowerDw() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundBlowerDw + !DEC$ ATTRIBUTES ALIAS: 'GetSoundBlowerDw' :: GetSoundBlowerDw + implicit none + GetSoundBlowerDw = SoundBlowerDws + end function + + logical function GetSoundBlowerStart() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundBlowerStart + !DEC$ ATTRIBUTES ALIAS: 'GetSoundBlowerStart' :: GetSoundBlowerStart + implicit none + GetSoundBlowerStart = SoundBlowerStarts + end function + + logical function GetSoundBlowerShutdown() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundBlowerShutdown + !DEC$ ATTRIBUTES ALIAS: 'GetSoundBlowerShutdown' :: GetSoundBlowerShutdown + implicit none + GetSoundBlowerShutdown = SoundBlowerShutdowns + end function + + logical function GetSoundElectricPump() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundElectricPump + !DEC$ ATTRIBUTES ALIAS: 'GetSoundElectricPump' :: GetSoundElectricPump + implicit none + GetSoundElectricPump = SoundElectricPumps + end function + + + + + + + + + + + +end module CSounds \ No newline at end of file diff --git a/CSharp/StudentStation/CStudentStation.f90 b/CSharp/StudentStation/CStudentStation.f90 new file mode 100644 index 0000000..729f367 --- /dev/null +++ b/CSharp/StudentStation/CStudentStation.f90 @@ -0,0 +1,98 @@ +module CStudentStation + use CStudentStationVariables + use CManifolds + implicit none + public + contains + + ! Input routines + subroutine SetFillupHeadInstallation(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetFillupHeadInstallation + !DEC$ ATTRIBUTES ALIAS: 'SetFillupHeadInstallation' :: SetFillupHeadInstallation + implicit none + logical, intent(in) :: v + FillupHeadInstallation = v + if(v)then + call OnFillupHeadInstallationPress%RunAll() + else + call OnFillupHeadRemovePress%RunAll() + endif +#ifdef deb + print*, 'FillupHeadInstallation=', FillupHeadInstallation +#endif + end subroutine + + subroutine SetMudBoxInstallation(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetMudBoxInstallation + !DEC$ ATTRIBUTES ALIAS: 'SetMudBoxInstallation' :: SetMudBoxInstallation + implicit none + logical, intent(in) :: v + MudBoxInstallation = v + if(v)then + call OnMudBoxInstallationPress%RunAll() + else + call OnMudBoxRemovePress%RunAll() + endif +#ifdef deb + print*, 'MudBoxInstallation=', MudBoxInstallation +#endif + end subroutine + + + subroutine SetTapSelector(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetTapSelector + !DEC$ ATTRIBUTES ALIAS: 'SetTapSelector' :: SetTapSelector + implicit none + logical, intent(in) :: v + TapSelector = v +#ifdef deb + print*, 'TapSelector=', TapSelector +#endif + end subroutine + + + subroutine SetPitGainLossZero(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SetPitGainLossZero + !DEC$ ATTRIBUTES ALIAS: 'SetPitGainLossZero' :: SetPitGainLossZero + implicit none + logical, intent(in) :: v + PitGainLossZero = v +#ifdef deb + print*, 'PitGainLossZero=', PitGainLossZero +#endif + end subroutine + + + + + + + + + + ! Output routines + logical function GetFillupHeadInstallation() + !DEC$ ATTRIBUTES DLLEXPORT :: GetFillupHeadInstallation + !DEC$ ATTRIBUTES ALIAS: 'GetFillupHeadInstallation' :: GetFillupHeadInstallation + implicit none + GetFillupHeadInstallation = FillupHeadInstallation + !GetFillupHeadInstallation = .true. + end function + + logical function GetMudBoxInstallation() + !DEC$ ATTRIBUTES DLLEXPORT :: GetMudBoxInstallation + !DEC$ ATTRIBUTES ALIAS: 'GetMudBoxInstallation' :: GetMudBoxInstallation + implicit none + GetMudBoxInstallation = MudBoxInstallation + !GetMudBoxInstallation = .true. + end function + + !logical function GetTapSelector() + !!DEC$ ATTRIBUTES DLLEXPORT :: GetTapSelector + !!DEC$ ATTRIBUTES ALIAS: 'GetTapSelector' :: GetTapSelector + ! implicit none + ! GetTapSelector = TapSelector + !end function + + +end module CStudentStation \ No newline at end of file diff --git a/CSharp/StudentStation/CStudentStationVariables.f90 b/CSharp/StudentStation/CStudentStationVariables.f90 new file mode 100644 index 0000000..37f354f --- /dev/null +++ b/CSharp/StudentStation/CStudentStationVariables.f90 @@ -0,0 +1,21 @@ +module CStudentStationVariables + use CVoidEventHandlerCollection + implicit none + public + + ! Input vars + logical :: FillupHeadInstallation + type(VoidEventHandlerCollection) :: OnFillupHeadInstallationPress + type(VoidEventHandlerCollection) :: OnFillupHeadRemovePress + + + logical :: MudBoxInstallation + type(VoidEventHandlerCollection) :: OnMudBoxInstallationPress + type(VoidEventHandlerCollection) :: OnMudBoxRemovePress + + logical :: TapSelector + logical :: PitGainLossZero + ! Output vars + + contains +end module CStudentStationVariables \ No newline at end of file diff --git a/CSharp/Warnings/CWarnings.f90 b/CSharp/Warnings/CWarnings.f90 new file mode 100644 index 0000000..ab83947 --- /dev/null +++ b/CSharp/Warnings/CWarnings.f90 @@ -0,0 +1,6 @@ +module CWarnings + use CWarningsVariables + implicit none + public + contains +end module CWarnings \ No newline at end of file diff --git a/CSharp/Warnings/CWarningsActions.f90 b/CSharp/Warnings/CWarningsActions.f90 new file mode 100644 index 0000000..3d1b926 --- /dev/null +++ b/CSharp/Warnings/CWarningsActions.f90 @@ -0,0 +1,224 @@ +module CWarningsActions + use CIActionReference + implicit none + public + + procedure (ActionBool), pointer :: PumpWithKellyDisconnectedPtr + procedure (ActionBool), pointer :: PumpWithTopdriveDisconnectedPtr + procedure (ActionBool), pointer :: Pump1PopOffValveBlownPtr + procedure (ActionBool), pointer :: Pump1FailurePtr + procedure (ActionBool), pointer :: Pump2PopOffValveBlownPtr + procedure (ActionBool), pointer :: Pump2FailurePtr + procedure (ActionBool), pointer :: Pump3PopOffValveBlownPtr + procedure (ActionBool), pointer :: Pump3FailurePtr + procedure (ActionBool), pointer :: DrawworksGearsAbusePtr + procedure (ActionBool), pointer :: RotaryGearsAbusePtr + procedure (ActionBool), pointer :: HoistLineBreakPtr + procedure (ActionBool), pointer :: PartedDrillStringPtr + procedure (ActionBool), pointer :: ActiveTankOverflowPtr + procedure (ActionBool), pointer :: ActiveTankUnderVolumePtr + procedure (ActionBool), pointer :: TripTankOverflowPtr + procedure (ActionBool), pointer :: DrillPipeTwistOffPtr + procedure (ActionBool), pointer :: DrillPipePartedPtr + procedure (ActionBool), pointer :: TripWithSlipsSetPtr + procedure (ActionBool), pointer :: BlowoutPtr + procedure (ActionBool), pointer :: UndergroundBlowoutPtr + procedure (ActionBool), pointer :: MaximumWellDepthExceededPtr + procedure (ActionBool), pointer :: CrownCollisionPtr + procedure (ActionBool), pointer :: FloorCollisionPtr + procedure (ActionBool), pointer :: TopdriveRotaryTableConfilictPtr + + contains + subroutine SubscribePumpWithKellyDisconnected(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePumpWithKellyDisconnected + !DEC$ ATTRIBUTES ALIAS: 'SubscribePumpWithKellyDisconnected' :: SubscribePumpWithKellyDisconnected + implicit none + procedure (ActionBool) :: a + PumpWithKellyDisconnectedPtr => a + end subroutine + + subroutine SubscribePumpWithTopdriveDisconnected(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePumpWithTopdriveDisconnected + !DEC$ ATTRIBUTES ALIAS: 'SubscribePumpWithTopdriveDisconnected' :: SubscribePumpWithTopdriveDisconnected + implicit none + procedure (ActionBool) :: a + PumpWithTopdriveDisconnectedPtr => a + end subroutine + + subroutine SubscribePump1PopOffValveBlown(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePump1PopOffValveBlown + !DEC$ ATTRIBUTES ALIAS: 'SubscribePump1PopOffValveBlown' :: SubscribePump1PopOffValveBlown + implicit none + procedure (ActionBool) :: a + Pump1PopOffValveBlownPtr => a + end subroutine + + subroutine SubscribePump1Failure(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePump1Failure + !DEC$ ATTRIBUTES ALIAS: 'SubscribePump1Failure' :: SubscribePump1Failure + implicit none + procedure (ActionBool) :: a + Pump1FailurePtr => a + end subroutine + + subroutine SubscribePump2PopOffValveBlown(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePump2PopOffValveBlown + !DEC$ ATTRIBUTES ALIAS: 'SubscribePump2PopOffValveBlown' :: SubscribePump2PopOffValveBlown + implicit none + procedure (ActionBool) :: a + Pump2PopOffValveBlownPtr => a + end subroutine + + subroutine SubscribePump2Failure(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePump2Failure + !DEC$ ATTRIBUTES ALIAS: 'SubscribePump2Failure' :: SubscribePump2Failure + implicit none + procedure (ActionBool) :: a + Pump2FailurePtr => a + end subroutine + + subroutine SubscribePump3PopOffValveBlown(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePump3PopOffValveBlown + !DEC$ ATTRIBUTES ALIAS: 'SubscribePump3PopOffValveBlown' :: SubscribePump3PopOffValveBlown + implicit none + procedure (ActionBool) :: a + Pump3PopOffValveBlownPtr => a + end subroutine + + subroutine SubscribePump3Failure(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePump3Failure + !DEC$ ATTRIBUTES ALIAS: 'SubscribePump3Failure' :: SubscribePump3Failure + implicit none + procedure (ActionBool) :: a + Pump3FailurePtr => a + end subroutine + + subroutine SubscribeDrawworksGearsAbuse(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeDrawworksGearsAbuse + !DEC$ ATTRIBUTES ALIAS: 'SubscribeDrawworksGearsAbuse' :: SubscribeDrawworksGearsAbuse + implicit none + procedure (ActionBool) :: a + DrawworksGearsAbusePtr => a + end subroutine + + subroutine SubscribeRotaryGearsAbuse(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeRotaryGearsAbuse + !DEC$ ATTRIBUTES ALIAS: 'SubscribeRotaryGearsAbuse' :: SubscribeRotaryGearsAbuse + implicit none + procedure (ActionBool) :: a + RotaryGearsAbusePtr => a + end subroutine + + subroutine SubscribeHoistLineBreak(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeHoistLineBreak + !DEC$ ATTRIBUTES ALIAS: 'SubscribeHoistLineBreak' :: SubscribeHoistLineBreak + implicit none + procedure (ActionBool) :: a + HoistLineBreakPtr => a + end subroutine + + subroutine SubscribePartedDrillString(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribePartedDrillString + !DEC$ ATTRIBUTES ALIAS: 'SubscribePartedDrillString' :: SubscribePartedDrillString + implicit none + procedure (ActionBool) :: a + PartedDrillStringPtr => a + end subroutine + + subroutine SubscribeActiveTankOverflow(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeActiveTankOverflow + !DEC$ ATTRIBUTES ALIAS: 'SubscribeActiveTankOverflow' :: SubscribeActiveTankOverflow + implicit none + procedure (ActionBool) :: a + ActiveTankOverflowPtr => a + end subroutine + + subroutine SubscribeActiveTankUnderVolume(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeActiveTankUnderVolume + !DEC$ ATTRIBUTES ALIAS: 'SubscribeActiveTankUnderVolume' :: SubscribeActiveTankUnderVolume + implicit none + procedure (ActionBool) :: a + ActiveTankUnderVolumePtr => a + end subroutine + + subroutine SubscribeTripTankOverflow(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeTripTankOverflow + !DEC$ ATTRIBUTES ALIAS: 'SubscribeTripTankOverflow' :: SubscribeTripTankOverflow + implicit none + procedure (ActionBool) :: a + TripTankOverflowPtr => a + end subroutine + + subroutine SubscribeDrillPipeTwistOff(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeDrillPipeTwistOff + !DEC$ ATTRIBUTES ALIAS: 'SubscribeDrillPipeTwistOff' :: SubscribeDrillPipeTwistOff + implicit none + procedure (ActionBool) :: a + DrillPipeTwistOffPtr => a + end subroutine + + subroutine SubscribeDrillPipeParted(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeDrillPipeParted + !DEC$ ATTRIBUTES ALIAS: 'SubscribeDrillPipeParted' :: SubscribeDrillPipeParted + implicit none + procedure (ActionBool) :: a + DrillPipePartedPtr => a + end subroutine + + subroutine SubscribeTripWithSlipsSet(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeTripWithSlipsSet + !DEC$ ATTRIBUTES ALIAS: 'SubscribeTripWithSlipsSet' :: SubscribeTripWithSlipsSet + implicit none + procedure (ActionBool) :: a + TripWithSlipsSetPtr => a + end subroutine + + subroutine SubscribeBlowout(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeBlowout + !DEC$ ATTRIBUTES ALIAS: 'SubscribeBlowout' :: SubscribeBlowout + implicit none + procedure (ActionBool) :: a + BlowoutPtr => a + end subroutine + + subroutine SubscribeUndergroundBlowout(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeUndergroundBlowout + !DEC$ ATTRIBUTES ALIAS: 'SubscribeUndergroundBlowout' :: SubscribeUndergroundBlowout + implicit none + procedure (ActionBool) :: a + UndergroundBlowoutPtr => a + end subroutine + + subroutine SubscribeMaximumWellDepthExceeded(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeMaximumWellDepthExceeded + !DEC$ ATTRIBUTES ALIAS: 'SubscribeMaximumWellDepthExceeded' :: SubscribeMaximumWellDepthExceeded + implicit none + procedure (ActionBool) :: a + MaximumWellDepthExceededPtr => a + end subroutine + + subroutine SubscribeCrownCollision(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeCrownCollision + !DEC$ ATTRIBUTES ALIAS: 'SubscribeCrownCollision' :: SubscribeCrownCollision + implicit none + procedure (ActionBool) :: a + CrownCollisionPtr => a + end subroutine + + subroutine SubscribeFloorCollision(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeFloorCollision + !DEC$ ATTRIBUTES ALIAS: 'SubscribeFloorCollision' :: SubscribeFloorCollision + implicit none + procedure (ActionBool) :: a + FloorCollisionPtr => a + end subroutine + + subroutine SubscribeTopdriveRotaryTableConfilict(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeTopdriveRotaryTableConfilict + !DEC$ ATTRIBUTES ALIAS: 'SubscribeTopdriveRotaryTableConfilict' :: SubscribeTopdriveRotaryTableConfilict + implicit none + procedure (ActionBool) :: a + TopdriveRotaryTableConfilictPtr => a + end subroutine + +end module CWarningsActions \ No newline at end of file diff --git a/CSharp/Warnings/CWarningsVariables.f90 b/CSharp/Warnings/CWarningsVariables.f90 new file mode 100644 index 0000000..4b2fc93 --- /dev/null +++ b/CSharp/Warnings/CWarningsVariables.f90 @@ -0,0 +1,1031 @@ +module CWarningsVariables + use CWarningsActions + implicit none + public + + logical :: PumpWithKellyDisconnected + logical :: PumpWithTopdriveDisconnected + logical :: Pump1PopOffValveBlown + logical :: Pump1Failure + logical :: Pump2PopOffValveBlown + logical :: Pump2Failure + logical :: Pump3PopOffValveBlown + logical :: Pump3Failure + logical :: DrawworksGearsAbuse + logical :: RotaryGearsAbuse + logical :: HoistLineBreak + logical :: PartedDrillString + logical :: ActiveTankOverflow + logical :: ActiveTankUnderVolume + logical :: TripTankOverflow + logical :: DrillPipeTwistOff + logical :: DrillPipeParted + logical :: TripWithSlipsSet + logical :: Blowout + logical :: UndergroundBlowout + logical :: MaximumWellDepthExceeded + logical :: CrownCollision + logical :: FloorCollision + logical :: TopdriveRotaryTableConfilict + + contains + + subroutine Activate_PumpWithKellyDisconnected() + implicit none + if(PumpWithKellyDisconnected) return + PumpWithKellyDisconnected = .true. + call RunPumpWithKellyDisconnected() + end subroutine + + subroutine Activate_PumpWithTopdriveDisconnected() + implicit none + if(PumpWithTopdriveDisconnected) return + PumpWithTopdriveDisconnected = .true. + call RunPumpWithTopdriveDisconnected() + end subroutine + + subroutine Activate_Pump1PopOffValveBlown() + implicit none + if(Pump1PopOffValveBlown) return + Pump1PopOffValveBlown = .true. + call RunPump1PopOffValveBlown() + end subroutine + + subroutine Activate_Pump1Failure() + implicit none + if(Pump1Failure) return + Pump1Failure = .true. + call RunPump1Failure() + end subroutine + + subroutine Activate_Pump2PopOffValveBlown() + implicit none + if(Pump2PopOffValveBlown) return + Pump2PopOffValveBlown = .true. + call RunPump2PopOffValveBlown() + end subroutine + + subroutine Activate_Pump2Failure() + implicit none + if(Pump2Failure) return + Pump2Failure = .true. + call RunPump2Failure() + end subroutine + + subroutine Activate_Pump3PopOffValveBlown() + implicit none + if(Pump3PopOffValveBlown) return + Pump3PopOffValveBlown = .true. + call RunPump3PopOffValveBlown() + end subroutine + + subroutine Activate_Pump3Failure() + implicit none + if(Pump3Failure) return + Pump3Failure = .true. + call RunPump3Failure() + end subroutine + + subroutine Activate_DrawworksGearsAbuse() + implicit none + if(DrawworksGearsAbuse) return + DrawworksGearsAbuse = .true. + call RunDrawworksGearsAbuse() + end subroutine + + subroutine Activate_RotaryGearsAbuse() + implicit none + if(RotaryGearsAbuse) return + RotaryGearsAbuse = .true. + call RunRotaryGearsAbuse() + end subroutine + + subroutine Activate_HoistLineBreak() + implicit none + if(HoistLineBreak) return + HoistLineBreak = .true. + call RunHoistLineBreak() + end subroutine + + subroutine Activate_PartedDrillString() + implicit none + if(PartedDrillString) return + PartedDrillString = .true. + call RunPartedDrillString() + end subroutine + + subroutine Activate_ActiveTankOverflow() + implicit none + if(ActiveTankOverflow) return + ActiveTankOverflow = .true. + call RunActiveTankOverflow() + end subroutine + + subroutine Activate_ActiveTankUnderVolume() + implicit none + if(ActiveTankUnderVolume) return + ActiveTankUnderVolume = .true. + call RunActiveTankUnderVolume() + end subroutine + + subroutine Activate_TripTankOverflow() + implicit none + if(TripTankOverflow) return + TripTankOverflow = .true. + call RunTripTankOverflow() + end subroutine + + subroutine Activate_DrillPipeTwistOff() + implicit none + if(DrillPipeTwistOff) return + DrillPipeTwistOff = .true. + call RunDrillPipeTwistOff() + end subroutine + + subroutine Activate_DrillPipeParted() + implicit none + if(DrillPipeParted) return + DrillPipeParted = .true. + call RunDrillPipeParted() + end subroutine + + subroutine Activate_TripWithSlipsSet() + implicit none + if(TripWithSlipsSet) return + TripWithSlipsSet = .true. + call RunTripWithSlipsSet() + end subroutine + + subroutine Activate_Blowout() + implicit none + if(Blowout) return + Blowout = .true. + call RunBlowout() + end subroutine + + subroutine Activate_UndergroundBlowout() + implicit none + if(UndergroundBlowout) return + UndergroundBlowout = .true. + call RunUndergroundBlowout() + end subroutine + + subroutine Activate_MaximumWellDepthExceeded() + implicit none + if(MaximumWellDepthExceeded) return + MaximumWellDepthExceeded = .true. + call RunMaximumWellDepthExceeded() + end subroutine + + subroutine Activate_CrownCollision() + implicit none + if(CrownCollision) return + CrownCollision = .true. + call RunCrownCollision() + end subroutine + + subroutine Activate_FloorCollision() + implicit none + if(FloorCollision) return + FloorCollision = .true. + call RunFloorCollision() + end subroutine + + subroutine Activate_TopdriveRotaryTableConfilict() + implicit none + if(TopdriveRotaryTableConfilict) return + TopdriveRotaryTableConfilict = .true. + call RunTopdriveRotaryTableConfilict() + end subroutine + + + + + + + + + + + + + + + + + + + + + + + + + + + subroutine Deactivate_PumpWithKellyDisconnected() + implicit none + if(.not.PumpWithKellyDisconnected) return + PumpWithKellyDisconnected = .false. + call RunPumpWithKellyDisconnected() + end subroutine + + subroutine Deactivate_PumpWithTopdriveDisconnected() + implicit none + if(.not.PumpWithTopdriveDisconnected) return + PumpWithTopdriveDisconnected = .false. + call RunPumpWithTopdriveDisconnected() + end subroutine + + subroutine Deactivate_Pump1PopOffValveBlown() + use CManifolds + implicit none + if(.not.Pump1PopOffValveBlown) return + Pump1PopOffValveBlown = .false. + call ChangeValve(65, .false.) + call RunPump1PopOffValveBlown() + end subroutine + + subroutine Deactivate_Pump1Failure() + use CManifolds + implicit none + if(.not.Pump1Failure) return + Pump1Failure = .false. + call RunPump1Failure() + end subroutine + + subroutine Deactivate_Pump2PopOffValveBlown() + use CManifolds + implicit none + if(.not.Pump2PopOffValveBlown) return + Pump2PopOffValveBlown = .false. + call ChangeValve(66, .false.) + call RunPump2PopOffValveBlown() + end subroutine + + subroutine Deactivate_Pump2Failure() + use CManifolds + implicit none + if(.not.Pump2Failure) return + Pump2Failure = .false. + call RunPump2Failure() + end subroutine + + subroutine Deactivate_Pump3PopOffValveBlown() + use CManifolds + implicit none + if(.not.Pump3PopOffValveBlown) return + Pump3PopOffValveBlown = .false. + call RunPump3PopOffValveBlown() + end subroutine + + subroutine Deactivate_Pump3Failure() + use CManifolds + implicit none + if(.not.Pump3Failure) return + Pump3Failure = .false. + call RunPump3Failure() + end subroutine + + subroutine Deactivate_DrawworksGearsAbuse() + implicit none + if(.not.DrawworksGearsAbuse) return + DrawworksGearsAbuse = .false. + call RunDrawworksGearsAbuse() + end subroutine + + subroutine Deactivate_RotaryGearsAbuse() + implicit none + if(.not.RotaryGearsAbuse) return + RotaryGearsAbuse = .false. + call RunRotaryGearsAbuse() + end subroutine + + subroutine Deactivate_HoistLineBreak() + implicit none + if(.not.HoistLineBreak) return + HoistLineBreak = .false. + call RunHoistLineBreak() + end subroutine + + subroutine Deactivate_PartedDrillString() + implicit none + if(.not.PartedDrillString) return + PartedDrillString = .false. + call RunPartedDrillString() + end subroutine + + subroutine Deactivate_ActiveTankOverflow() + implicit none + if(.not.ActiveTankOverflow) return + ActiveTankOverflow = .false. + call RunActiveTankOverflow() + end subroutine + + subroutine Deactivate_ActiveTankUnderVolume() + implicit none + if(.not.ActiveTankUnderVolume) return + ActiveTankUnderVolume = .false. + call RunActiveTankUnderVolume() + end subroutine + + subroutine Deactivate_TripTankOverflow() + implicit none + if(.not.TripTankOverflow) return + TripTankOverflow = .false. + call RunTripTankOverflow() + end subroutine + + subroutine Deactivate_DrillPipeTwistOff() + implicit none + if(.not.DrillPipeTwistOff) return + DrillPipeTwistOff = .false. + call RunDrillPipeTwistOff() + end subroutine + + subroutine Deactivate_DrillPipeParted() + implicit none + if(.not.DrillPipeParted) return + DrillPipeParted = .false. + call RunDrillPipeParted() + end subroutine + + subroutine Deactivate_TripWithSlipsSet() + implicit none + if(.not.TripWithSlipsSet) return + TripWithSlipsSet = .false. + call RunTripWithSlipsSet() + end subroutine + + subroutine Deactivate_Blowout() + implicit none + if(.not.Blowout) return + Blowout = .false. + call RunBlowout() + end subroutine + + subroutine Deactivate_UndergroundBlowout() + implicit none + if(.not.UndergroundBlowout) return + UndergroundBlowout = .false. + call RunUndergroundBlowout() + end subroutine + + subroutine Deactivate_MaximumWellDepthExceeded() + implicit none + if(.not.MaximumWellDepthExceeded) return + MaximumWellDepthExceeded = .false. + call RunMaximumWellDepthExceeded() + end subroutine + + subroutine Deactivate_CrownCollision() + implicit none + if(.not.CrownCollision) return + CrownCollision = .false. + call RunCrownCollision() + end subroutine + + subroutine Deactivate_FloorCollision() + implicit none + if(.not.FloorCollision) return + FloorCollision = .false. + call RunFloorCollision() + end subroutine + + subroutine Deactivate_TopdriveRotaryTableConfilict() + implicit none + if(.not.TopdriveRotaryTableConfilict) return + TopdriveRotaryTableConfilict = .false. + call RunTopdriveRotaryTableConfilict() + end subroutine + + + + + + + + + + + + + + + + + + + + + + + + + + subroutine RunPumpWithKellyDisconnected() + implicit none + if(associated(PumpWithKellyDisconnectedPtr)) then + call PumpWithKellyDisconnectedPtr(PumpWithKellyDisconnected) + end if + end subroutine + + subroutine RunPumpWithTopdriveDisconnected() + implicit none + if(associated(PumpWithTopdriveDisconnectedPtr)) then + call PumpWithTopdriveDisconnectedPtr(PumpWithTopdriveDisconnected) + end if + end subroutine + + subroutine RunPump1PopOffValveBlown() + implicit none + if(associated(Pump1PopOffValveBlownPtr)) then + call Pump1PopOffValveBlownPtr(Pump1PopOffValveBlown) + end if + end subroutine + + subroutine RunPump1Failure() + implicit none + if(associated(Pump1FailurePtr)) then + call Pump1FailurePtr(Pump1Failure) + end if + end subroutine + + subroutine RunPump2PopOffValveBlown() + implicit none + if(associated(Pump2PopOffValveBlownPtr)) then + call Pump2PopOffValveBlownPtr(Pump2PopOffValveBlown) + end if + end subroutine + + subroutine RunPump2Failure() + implicit none + if(associated(Pump2FailurePtr)) then + call Pump2FailurePtr(Pump2Failure) + end if + end subroutine + + subroutine RunPump3PopOffValveBlown() + implicit none + if(associated(Pump3PopOffValveBlownPtr)) then + call Pump3PopOffValveBlownPtr(Pump3PopOffValveBlown) + end if + end subroutine + + subroutine RunPump3Failure() + implicit none + if(associated(Pump3FailurePtr)) then + call Pump3FailurePtr(Pump3Failure) + end if + end subroutine + + subroutine RunDrawworksGearsAbuse() + implicit none + if(associated(DrawworksGearsAbusePtr)) then + call DrawworksGearsAbusePtr(DrawworksGearsAbuse) + end if + end subroutine + + subroutine RunRotaryGearsAbuse() + implicit none + if(associated(RotaryGearsAbusePtr)) then + call RotaryGearsAbusePtr(RotaryGearsAbuse) + end if + end subroutine + + subroutine RunHoistLineBreak() + implicit none + if(associated(HoistLineBreakPtr)) then + call HoistLineBreakPtr(HoistLineBreak) + end if + end subroutine + + subroutine RunPartedDrillString() + implicit none + if(associated(PartedDrillStringPtr)) then + call PartedDrillStringPtr(PartedDrillString) + end if + end subroutine + + subroutine RunActiveTankOverflow() + implicit none + if(associated(ActiveTankOverflowPtr)) then + call ActiveTankOverflowPtr(ActiveTankOverflow) + end if + end subroutine + + subroutine RunActiveTankUnderVolume() + implicit none + if(associated(ActiveTankUnderVolumePtr)) then + call ActiveTankUnderVolumePtr(ActiveTankUnderVolume) + end if + end subroutine + + subroutine RunTripTankOverflow() + implicit none + if(associated(TripTankOverflowPtr)) then + call TripTankOverflowPtr(TripTankOverflow) + end if + end subroutine + + subroutine RunDrillPipeTwistOff() + implicit none + if(associated(DrillPipeTwistOffPtr)) then + call DrillPipeTwistOffPtr(DrillPipeTwistOff) + end if + end subroutine + + subroutine RunDrillPipeParted() + implicit none + if(associated(DrillPipePartedPtr)) then + call DrillPipePartedPtr(DrillPipeParted) + end if + end subroutine + + subroutine RunTripWithSlipsSet() + implicit none + if(associated(TripWithSlipsSetPtr)) then + call TripWithSlipsSetPtr(TripWithSlipsSet) + end if + end subroutine + + subroutine RunBlowout() + implicit none + if(associated(BlowoutPtr)) then + call BlowoutPtr(Blowout) + end if + end subroutine + + subroutine RunUndergroundBlowout() + implicit none + if(associated(UndergroundBlowoutPtr)) then + call UndergroundBlowoutPtr(UndergroundBlowout) + end if + end subroutine + + subroutine RunMaximumWellDepthExceeded() + implicit none + if(associated(MaximumWellDepthExceededPtr)) then + call MaximumWellDepthExceededPtr(MaximumWellDepthExceeded) + end if + end subroutine + + subroutine RunCrownCollision() + implicit none + if(associated(CrownCollisionPtr)) then + call CrownCollisionPtr(CrownCollision) + end if + end subroutine + + subroutine RunFloorCollision() + implicit none + if(associated(FloorCollisionPtr)) then + call FloorCollisionPtr(FloorCollision) + end if + end subroutine + + subroutine RunTopdriveRotaryTableConfilict() + implicit none + if(associated(TopdriveRotaryTableConfilictPtr)) then + call TopdriveRotaryTableConfilictPtr(TopdriveRotaryTableConfilict) + end if + end subroutine + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + subroutine Activate_PumpWithKellyDisconnected_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_PumpWithKellyDisconnected_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_PumpWithKellyDisconnected_WN' :: Activate_PumpWithKellyDisconnected_WN + implicit none + call Activate_PumpWithKellyDisconnected() + end subroutine + + subroutine Activate_PumpWithTopdriveDisconnected_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_PumpWithTopdriveDisconnected_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_PumpWithTopdriveDisconnected_WN' :: Activate_PumpWithTopdriveDisconnected_WN + implicit none + call Activate_PumpWithTopdriveDisconnected() + end subroutine + + subroutine Activate_Pump1PopOffValveBlown_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_Pump1PopOffValveBlown_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_Pump1PopOffValveBlown_WN' :: Activate_Pump1PopOffValveBlown_WN + implicit none + call Activate_Pump1PopOffValveBlown() + end subroutine + + subroutine Activate_Pump1Failure_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_Pump1Failure_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_Pump1Failure_WN' :: Activate_Pump1Failure_WN + implicit none + call Activate_Pump1Failure() + end subroutine + + subroutine Activate_Pump2PopOffValveBlown_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_Pump2PopOffValveBlown_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_Pump2PopOffValveBlown_WN' :: Activate_Pump2PopOffValveBlown_WN + implicit none + call Activate_Pump2PopOffValveBlown() + end subroutine + + subroutine Activate_Pump2Failure_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_Pump2Failure_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_Pump2Failure_WN' :: Activate_Pump2Failure_WN + implicit none + call Activate_Pump2Failure() + end subroutine + + subroutine Activate_Pump3PopOffValveBlown_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_Pump3PopOffValveBlown_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_Pump3PopOffValveBlown_WN' :: Activate_Pump3PopOffValveBlown_WN + implicit none + call Activate_Pump3PopOffValveBlown() + end subroutine + + subroutine Activate_Pump3Failure_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_Pump3Failure_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_Pump3Failure_WN' :: Activate_Pump3Failure_WN + implicit none + call Activate_Pump3Failure() + end subroutine + + subroutine Activate_DrawworksGearsAbuse_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_DrawworksGearsAbuse_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_DrawworksGearsAbuse_WN' :: Activate_DrawworksGearsAbuse_WN + implicit none + call Activate_DrawworksGearsAbuse() + end subroutine + + subroutine Activate_RotaryGearsAbuse_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_RotaryGearsAbuse_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_RotaryGearsAbuse_WN' :: Activate_RotaryGearsAbuse_WN + implicit none + call Activate_RotaryGearsAbuse() + end subroutine + + subroutine Activate_HoistLineBreak_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_HoistLineBreak_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_HoistLineBreak_WN' :: Activate_HoistLineBreak_WN + implicit none + call Activate_HoistLineBreak() + end subroutine + + subroutine Activate_PartedDrillString_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_PartedDrillString_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_PartedDrillString_WN' :: Activate_PartedDrillString_WN + implicit none + call Activate_PartedDrillString() + end subroutine + + subroutine Activate_ActiveTankOverflow_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_ActiveTankOverflow_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_ActiveTankOverflow_WN' :: Activate_ActiveTankOverflow_WN + implicit none + call Activate_ActiveTankOverflow() + end subroutine + + subroutine Activate_ActiveTankUnderVolume_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_ActiveTankUnderVolume_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_ActiveTankUnderVolume_WN' :: Activate_ActiveTankUnderVolume_WN + implicit none + call Activate_ActiveTankUnderVolume() + end subroutine + + subroutine Activate_TripTankOverflow_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_TripTankOverflow_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_TripTankOverflow_WN' :: Activate_TripTankOverflow_WN + implicit none + call Activate_TripTankOverflow() + end subroutine + + subroutine Activate_DrillPipeTwistOff_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_DrillPipeTwistOff_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_DrillPipeTwistOff_WN' :: Activate_DrillPipeTwistOff_WN + implicit none + call Activate_DrillPipeTwistOff() + end subroutine + + subroutine Activate_DrillPipeParted_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_DrillPipeParted_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_DrillPipeParted_WN' :: Activate_DrillPipeParted_WN + implicit none + call Activate_DrillPipeParted() + end subroutine + + subroutine Activate_TripWithSlipsSet_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_TripWithSlipsSet_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_TripWithSlipsSet_WN' :: Activate_TripWithSlipsSet_WN + implicit none + call Activate_TripWithSlipsSet() + end subroutine + + subroutine Activate_Blowout_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_Blowout_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_Blowout_WN' :: Activate_Blowout_WN + implicit none + call Activate_Blowout() + end subroutine + + subroutine Activate_UndergroundBlowout_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_UndergroundBlowout_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_UndergroundBlowout_WN' :: Activate_UndergroundBlowout_WN + implicit none + call Activate_UndergroundBlowout() + end subroutine + + subroutine Activate_MaximumWellDepthExceeded_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_MaximumWellDepthExceeded_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_MaximumWellDepthExceeded_WN' :: Activate_MaximumWellDepthExceeded_WN + implicit none + call Activate_MaximumWellDepthExceeded() + end subroutine + + subroutine Activate_CrownCollision_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_CrownCollision_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_CrownCollision_WN' :: Activate_CrownCollision_WN + implicit none + call Activate_CrownCollision() + end subroutine + + subroutine Activate_FloorCollision_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_FloorCollision_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_FloorCollision_WN' :: Activate_FloorCollision_WN + implicit none + call Activate_FloorCollision() + end subroutine + + subroutine Activate_TopdriveRotaryTableConfilict_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Activate_TopdriveRotaryTableConfilict_WN + !DEC$ ATTRIBUTES ALIAS: 'Activate_TopdriveRotaryTableConfilict_WN' :: Activate_TopdriveRotaryTableConfilict_WN + implicit none + call Activate_TopdriveRotaryTableConfilict() + end subroutine + + + + + + + + + + + + + + + + + + + + + + + + + + + subroutine Deactivate_PumpWithKellyDisconnected_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_PumpWithKellyDisconnected_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_PumpWithKellyDisconnected_WN' :: Deactivate_PumpWithKellyDisconnected_WN + implicit none + call Deactivate_PumpWithKellyDisconnected() + end subroutine + + subroutine Deactivate_PumpWithTopdriveDisconnected_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_PumpWithTopdriveDisconnected_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_PumpWithTopdriveDisconnected_WN' :: Deactivate_PumpWithTopdriveDisconnected_WN + implicit none + call Deactivate_PumpWithTopdriveDisconnected() + end subroutine + + subroutine Deactivate_Pump1PopOffValveBlown_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_Pump1PopOffValveBlown_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_Pump1PopOffValveBlown_WN' :: Deactivate_Pump1PopOffValveBlown_WN + implicit none + call Deactivate_Pump1PopOffValveBlown() + end subroutine + + subroutine Deactivate_Pump1Failure_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_Pump1Failure_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_Pump1Failure_WN' :: Deactivate_Pump1Failure_WN + implicit none + call Deactivate_Pump1Failure() + end subroutine + + subroutine Deactivate_Pump2PopOffValveBlown_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_Pump2PopOffValveBlown_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_Pump2PopOffValveBlown_WN' :: Deactivate_Pump2PopOffValveBlown_WN + implicit none + call Deactivate_Pump2PopOffValveBlown() + end subroutine + + subroutine Deactivate_Pump2Failure_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_Pump2Failure_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_Pump2Failure_WN' :: Deactivate_Pump2Failure_WN + implicit none + call Deactivate_Pump2Failure() + end subroutine + + subroutine Deactivate_Pump3PopOffValveBlown_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_Pump3PopOffValveBlown_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_Pump3PopOffValveBlown_WN' :: Deactivate_Pump3PopOffValveBlown_WN + implicit none + call Deactivate_Pump3PopOffValveBlown() + end subroutine + + subroutine Deactivate_Pump3Failure_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_Pump3Failure_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_Pump3Failure_WN' :: Deactivate_Pump3Failure_WN + implicit none + call Deactivate_Pump3Failure() + end subroutine + + subroutine Deactivate_DrawworksGearsAbuse_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_DrawworksGearsAbuse_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_DrawworksGearsAbuse_WN' :: Deactivate_DrawworksGearsAbuse_WN + implicit none + call Deactivate_DrawworksGearsAbuse() + end subroutine + + subroutine Deactivate_RotaryGearsAbuse_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_RotaryGearsAbuse_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_RotaryGearsAbuse_WN' :: Deactivate_RotaryGearsAbuse_WN + implicit none + call Deactivate_RotaryGearsAbuse() + end subroutine + + subroutine Deactivate_HoistLineBreak_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_HoistLineBreak_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_HoistLineBreak_WN' :: Deactivate_HoistLineBreak_WN + implicit none + call Deactivate_HoistLineBreak() + end subroutine + + subroutine Deactivate_PartedDrillString_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_PartedDrillString_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_PartedDrillString_WN' :: Deactivate_PartedDrillString_WN + implicit none + call Deactivate_PartedDrillString() + end subroutine + + subroutine Deactivate_ActiveTankOverflow_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_ActiveTankOverflow_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_ActiveTankOverflow_WN' :: Deactivate_ActiveTankOverflow_WN + implicit none + call Deactivate_ActiveTankOverflow() + end subroutine + + subroutine Deactivate_ActiveTankUnderVolume_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_ActiveTankUnderVolume_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_ActiveTankUnderVolume_WN' :: Deactivate_ActiveTankUnderVolume_WN + implicit none + call Deactivate_ActiveTankUnderVolume() + end subroutine + + subroutine Deactivate_TripTankOverflow_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_TripTankOverflow_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_TripTankOverflow_WN' :: Deactivate_TripTankOverflow_WN + implicit none + call Deactivate_TripTankOverflow() + end subroutine + + subroutine Deactivate_DrillPipeTwistOff_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_DrillPipeTwistOff_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_DrillPipeTwistOff_WN' :: Deactivate_DrillPipeTwistOff_WN + implicit none + call Deactivate_DrillPipeTwistOff() + end subroutine + + subroutine Deactivate_DrillPipeParted_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_DrillPipeParted_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_DrillPipeParted_WN' :: Deactivate_DrillPipeParted_WN + implicit none + call Deactivate_DrillPipeParted() + end subroutine + + subroutine Deactivate_TripWithSlipsSet_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_TripWithSlipsSet_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_TripWithSlipsSet_WN' :: Deactivate_TripWithSlipsSet_WN + implicit none + call Deactivate_TripWithSlipsSet() + end subroutine + + subroutine Deactivate_Blowout_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_Blowout_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_Blowout_WN' :: Deactivate_Blowout_WN + implicit none + call Deactivate_Blowout() + end subroutine + + subroutine Deactivate_UndergroundBlowout_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_UndergroundBlowout_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_UndergroundBlowout_WN' :: Deactivate_UndergroundBlowout_WN + implicit none + call Deactivate_UndergroundBlowout() + end subroutine + + subroutine Deactivate_MaximumWellDepthExceeded_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_MaximumWellDepthExceeded_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_MaximumWellDepthExceeded_WN' :: Deactivate_MaximumWellDepthExceeded_WN + implicit none + call Deactivate_MaximumWellDepthExceeded() + end subroutine + + subroutine Deactivate_CrownCollision_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_CrownCollision_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_CrownCollision_WN' :: Deactivate_CrownCollision_WN + implicit none + call Deactivate_CrownCollision() + end subroutine + + subroutine Deactivate_FloorCollision_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_FloorCollision_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_FloorCollision_WN' :: Deactivate_FloorCollision_WN + implicit none + call Deactivate_FloorCollision() + end subroutine + + subroutine Deactivate_TopdriveRotaryTableConfilict_WN() + !DEC$ ATTRIBUTES DLLEXPORT :: Deactivate_TopdriveRotaryTableConfilict_WN + !DEC$ ATTRIBUTES ALIAS: 'Deactivate_TopdriveRotaryTableConfilict_WN' :: Deactivate_TopdriveRotaryTableConfilict_WN + implicit none + call Deactivate_TopdriveRotaryTableConfilict() + end subroutine + + + + + + +end module CWarningsVariables \ No newline at end of file diff --git a/CSimulationVariables.f90 b/CSimulationVariables.f90 new file mode 100644 index 0000000..a97c8c1 --- /dev/null +++ b/CSimulationVariables.f90 @@ -0,0 +1,1211 @@ +module CSimulationVariables + use CVoidEventHandlerCollection + ! use CSimulationThreads + use CIActionReference + ! use ifcore + ! use ifmt + ! use CTimer + use CError + use CLog3 + implicit none + public + + integer, parameter :: SimulationState_Stopped = 0; + integer, parameter :: SimulationState_Started = 1; + integer, parameter :: SimulationState_Paused = 2; + + logical :: IsStopped = .false. + logical :: IsSnapshot = .false. + logical :: IsPortable = .false. + integer :: IsPortableInt = 0 + + integer :: SimulationState_old + integer :: SimulationState + integer :: SimulationTime + integer :: SimulationSpeed ! 1, 2, 5, 10 + + integer :: SleepLimit = 0 + + integer :: TotalPumpStrokes + real(8) :: TotalVolumePumped + real(8) :: DistanceDrilled + + type(VoidEventHandlerCollection) :: OnSimulationInitialization + type(VoidEventHandlerCollection) :: OnSimulationStart + type(VoidEventHandlerCollection) :: OnSimulationStop + type(VoidEventHandlerCollection) :: OnSimulationPause + !type(VoidEventHandlerCollection) :: OnSimulationGetOutput + + procedure (ActionVoid), pointer :: ForceRealTimeSpeedPtr + procedure (ActionBool), pointer :: SpeedChangePossibilityPtr + logical :: SpeedChangePossibilityValue + + procedure (ActionInteger), pointer :: TotalStrokesChangedPtr + procedure (ActionInteger), pointer :: TotalStrokesPtr + procedure (ActionDouble), pointer :: TotalVolumePumpedPtr + procedure (ActionDouble), pointer :: DistanceDrilledPtr + + ! modules... + !BopStack + type(VoidEventHandlerCollection) :: OnBopStackStep + type(VoidEventHandlerCollection) :: OnBopStackStart + type(VoidEventHandlerCollection) :: OnBopStackOutput + type(VoidEventHandlerCollection) :: OnBopStackPause + type(VoidEventHandlerCollection) :: OnBopStackMain + logical :: BopStackStarted + + !Pumps + type(VoidEventHandlerCollection) :: OnPump1Step + type(VoidEventHandlerCollection) :: OnPump1Start + type(VoidEventHandlerCollection) :: OnPump1Output + type(VoidEventHandlerCollection) :: OnPump1Pause + type(VoidEventHandlerCollection) :: OnPump1Main + logical :: Pump1Started + + type(VoidEventHandlerCollection) :: OnPump2Step + type(VoidEventHandlerCollection) :: OnPump2Start + type(VoidEventHandlerCollection) :: OnPump2Output + type(VoidEventHandlerCollection) :: OnPump2Pause + type(VoidEventHandlerCollection) :: OnPump2Main + logical :: Pump2Started + + type(VoidEventHandlerCollection) :: OnPump3Step + type(VoidEventHandlerCollection) :: OnPump3Start + type(VoidEventHandlerCollection) :: OnPump3Output + type(VoidEventHandlerCollection) :: OnPump3Pause + type(VoidEventHandlerCollection) :: OnPump3Main + logical :: Pump3Started + + !ChokeControl + type(VoidEventHandlerCollection) :: OnChokeControlStep + type(VoidEventHandlerCollection) :: OnChokeControlStart + type(VoidEventHandlerCollection) :: OnChokeControlOutput + type(VoidEventHandlerCollection) :: OnChokeControlPause + type(VoidEventHandlerCollection) :: OnChokeControlMain + logical :: ChokeControlStarted + + !ROP + type(VoidEventHandlerCollection) :: OnRopStep + type(VoidEventHandlerCollection) :: OnRopStart + type(VoidEventHandlerCollection) :: OnRopOutput + type(VoidEventHandlerCollection) :: OnRopPause + type(VoidEventHandlerCollection) :: OnRopMain + logical :: RopStarted + + !RotaryTable + type(VoidEventHandlerCollection) :: OnRotaryTableStep + type(VoidEventHandlerCollection) :: OnRotaryTableStart + type(VoidEventHandlerCollection) :: OnRotaryTableOutput + type(VoidEventHandlerCollection) :: OnRotaryTablePause + type(VoidEventHandlerCollection) :: OnRotaryTableMain + logical :: RotaryTableStarted + + !Drawworks + type(VoidEventHandlerCollection) :: OnDrawworksStep + type(VoidEventHandlerCollection) :: OnDrawworksStart + type(VoidEventHandlerCollection) :: OnDrawworksOutput + type(VoidEventHandlerCollection) :: OnDrawworksPause + type(VoidEventHandlerCollection) :: OnDrawworksMain + logical :: DrawworksStarted + + !FluidFlow + type(VoidEventHandlerCollection) :: OnFluidFlowStep + type(VoidEventHandlerCollection) :: OnFluidFlowStart + type(VoidEventHandlerCollection) :: OnFluidFlowOutput + type(VoidEventHandlerCollection) :: OnFluidFlowPause + type(VoidEventHandlerCollection) :: OnFluidFlowMain + logical :: FluidFlowStarted + + !TorqueDrag + type(VoidEventHandlerCollection) :: OnTorqueDragStep + type(VoidEventHandlerCollection) :: OnTorqueDragStart + type(VoidEventHandlerCollection) :: OnTorqueDragOutput + type(VoidEventHandlerCollection) :: OnTorqueDragPause + type(VoidEventHandlerCollection) :: OnTorqueDragMain + logical :: TorqueDragStarted + + + !TopDrive + type(VoidEventHandlerCollection) :: OnTopDriveStep + type(VoidEventHandlerCollection) :: OnTopDriveStart + type(VoidEventHandlerCollection) :: OnTopDriveOutput + type(VoidEventHandlerCollection) :: OnTopDrivePause + type(VoidEventHandlerCollection) :: OnTopDriveMain + logical :: TopDriveStarted + + + !MudSystem + type(VoidEventHandlerCollection) :: OnMudSystemStep + type(VoidEventHandlerCollection) :: OnMudSystemStart + type(VoidEventHandlerCollection) :: OnMudSystemOutput + type(VoidEventHandlerCollection) :: OnMudSystemPause + type(VoidEventHandlerCollection) :: OnMudSystemMain + logical :: MudSystemStarted + + !PipeRams1 + type(VoidEventHandlerCollection) :: OnPipeRams1Step + type(VoidEventHandlerCollection) :: OnPipeRams1Start + type(VoidEventHandlerCollection) :: OnPipeRams1Output + type(VoidEventHandlerCollection) :: OnPipeRams1Pause + type(VoidEventHandlerCollection) :: OnPipeRams1Main + logical :: PipeRams1Started + + !PipeRams2 + type(VoidEventHandlerCollection) :: OnPipeRams2Step + type(VoidEventHandlerCollection) :: OnPipeRams2Start + type(VoidEventHandlerCollection) :: OnPipeRams2Output + type(VoidEventHandlerCollection) :: OnPipeRams2Pause + type(VoidEventHandlerCollection) :: OnPipeRams2Main + logical :: PipeRams2Started + + !KillLine + type(VoidEventHandlerCollection) :: OnKillLineStep + type(VoidEventHandlerCollection) :: OnKillLineStart + type(VoidEventHandlerCollection) :: OnKillLineOutput + type(VoidEventHandlerCollection) :: OnKillLinePause + type(VoidEventHandlerCollection) :: OnKillLineMain + logical :: KillLineStarted + + !ChokeLine + type(VoidEventHandlerCollection) :: OnChokeLineStep + type(VoidEventHandlerCollection) :: OnChokeLineStart + type(VoidEventHandlerCollection) :: OnChokeLineOutput + type(VoidEventHandlerCollection) :: OnChokeLinePause + type(VoidEventHandlerCollection) :: OnChokeLineMain + logical :: ChokeLineStarted + + !BlindRams + type(VoidEventHandlerCollection) :: OnBlindRamsStep + type(VoidEventHandlerCollection) :: OnBlindRamsStart + type(VoidEventHandlerCollection) :: OnBlindRamsOutput + type(VoidEventHandlerCollection) :: OnBlindRamsPause + type(VoidEventHandlerCollection) :: OnBlindRamsMain + logical :: BlindRamsStarted + + !Annular + type(VoidEventHandlerCollection) :: OnAnnularStep + type(VoidEventHandlerCollection) :: OnAnnularStart + type(VoidEventHandlerCollection) :: OnAnnularOutput + type(VoidEventHandlerCollection) :: OnAnnularPause + type(VoidEventHandlerCollection) :: OnAnnularMain + logical :: AnnularStarted + + !Geo + type(VoidEventHandlerCollection) :: OnGeoStep + type(VoidEventHandlerCollection) :: OnGeoStart + type(VoidEventHandlerCollection) :: OnGeoOutput + type(VoidEventHandlerCollection) :: OnGeoPause + type(VoidEventHandlerCollection) :: OnGeoMain + logical :: GeoStarted + + + + + + !OperationScenarios + type(VoidEventHandlerCollection) :: OnOperationScenariosStep + type(VoidEventHandlerCollection) :: OnOperationScenariosOutput + type(VoidEventHandlerCollection) :: OnOperationScenariosPause + type(VoidEventHandlerCollection) :: OnOperationScenariosMain + + !PathFinding + type(VoidEventHandlerCollection) :: OnPathFindingStep + type(VoidEventHandlerCollection) :: OnPathFindingOutput + type(VoidEventHandlerCollection) :: OnPathFindingPause + type(VoidEventHandlerCollection) :: OnPathFindingMain + + ! sample + type(VoidEventHandlerCollection) :: OnSampleStep + type(VoidEventHandlerCollection) :: OnSampleStart + type(VoidEventHandlerCollection) :: OnSampleOutput + type(VoidEventHandlerCollection) :: OnSamplePause + type(VoidEventHandlerCollection) :: OnSampleMain + logical :: SampleStarted + + !!MudFlowFillIndicator + !type(VoidEventHandlerCollection) :: OnMudFlowFillIndicatorStep + !type(VoidEventHandlerCollection) :: OnMudFlowFillIndicatorOutput + !type(VoidEventHandlerCollection) :: OnMudFlowFillIndicatorMain + + + + + + + + + + + + + + contains + + ! subroutine Quit() + ! use ifmt + ! call ExitThread(0) + ! end subroutine + + real function GetSimulationSpeedSecond() + implicit none + GetSimulationSpeedSecond = 1.0 / SimulationSpeed + end function GetSimulationSpeedSecond + + integer function GetSimulationSpeedMilisecond() + implicit none + GetSimulationSpeedMilisecond = int(GetSimulationSpeedSecond()* 1000.0) + end function GetSimulationSpeedMilisecond + + subroutine DrillMode_ON() + implicit none + call SpeedChangePossibility(.true.) + end subroutine + + subroutine DrillMode_OFF() + implicit none + call ForceRealTimeSpeed() + call SpeedChangePossibility(.false.) + end subroutine + + subroutine ForceRealTimeSpeed() + implicit none + if(associated(ForceRealTimeSpeedPtr)) call ForceRealTimeSpeedPtr() + end subroutine + + subroutine SpeedChangePossibility(v) + implicit none + logical, intent(in) :: v + SpeedChangePossibilityValue = v + if(associated(SpeedChangePossibilityPtr)) call SpeedChangePossibilityPtr(SpeedChangePossibilityValue) + end subroutine + + subroutine SubscribeSpeedChangePossibility(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSpeedChangePossibility + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSpeedChangePossibility' :: SubscribeSpeedChangePossibility + implicit none + procedure (ActionBool) :: a + SpeedChangePossibilityPtr => a + end subroutine + + subroutine SubscribeForceRealTimeSpeed(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeForceRealTimeSpeed + !DEC$ ATTRIBUTES ALIAS: 'SubscribeForceRealTimeSpeed' :: SubscribeForceRealTimeSpeed + implicit none + procedure (ActionVoid) :: a + ForceRealTimeSpeedPtr => a + end subroutine + + subroutine SubscribeTotalStrokesChanged(a) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeTotalStrokesChanged + !DEC$ ATTRIBUTES ALIAS: 'SubscribeTotalStrokesChanged' :: SubscribeTotalStrokesChanged + implicit none + procedure (ActionInteger) :: a + TotalStrokesChangedPtr => a + end subroutine + + subroutine SetTotalStrokes(strokes) + implicit none + integer, intent(in) :: strokes + if (TotalPumpStrokes == strokes) return + TotalPumpStrokes = strokes + if(associated(TotalStrokesChangedPtr)) call TotalStrokesChangedPtr(TotalPumpStrokes) + if(associated(TotalStrokesPtr)) call TotalStrokesPtr(TotalPumpStrokes) + end subroutine + + subroutine SetTotalVolumePumped(volume) + implicit none + real(8), intent(in) :: volume + if (TotalVolumePumped == volume) return + TotalVolumePumped = volume + if(associated(TotalVolumePumpedPtr)) call TotalVolumePumpedPtr(TotalVolumePumped) + end subroutine + + subroutine SetDistanceDrilled(distance) + implicit none + real(8), intent(in) :: distance + if (DistanceDrilled == distance) return + DistanceDrilled = distance + if(associated(DistanceDrilledPtr)) call DistanceDrilledPtr(DistanceDrilled) + end subroutine + +! integer(4) function BopStackThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_bopstackthread" :: BopStackThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_BopStack +! call OnBopStackMain%RunAll() +! #endif +! #ifdef S_BopStack +! if(.not.BopStackStarted) then +! call OnBopStackStart%RunAll() +! BopStackStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnBopStackStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('BOP Stack Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnBopStackOutput%RunAll() +! end do +! call OnBopStackPause%RunAll() +! end do loop +! #endif +! BopStackThread = 0; +! call ExitThread(0) +! end function BopStackThread + +! integer(4) function Pump1Thread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_pump1thread" :: Pump1Thread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_Pump1 +! call OnPump1Main%RunAll() +! #endif +! #ifdef S_Pump1 +! if(.not.Pump1Started) then +! call OnPump1Start%RunAll() +! Pump1Started = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnPump1Step%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Pump 1 Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnPump1Output%RunAll() +! end do +! call OnPump1Pause%RunAll() +! end do loop +! #endif +! Pump1Thread = 0; +! call ExitThread(0) +! end function Pump1Thread + +! integer(4) function Pump2Thread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_pump2thread" :: Pump2Thread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_Pump2 +! call OnPump2Main%RunAll() +! #endif +! #ifdef S_Pump2 +! if(.not.Pump2Started) then +! call OnPump2Start%RunAll() +! Pump2Started = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnPump2Step%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Pump 2 Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnPump2Output%RunAll() +! end do +! call OnPump2Pause%RunAll() +! end do loop +! #endif +! Pump2Thread = 0; +! call ExitThread(0) +! end function Pump2Thread + +! integer(4) function Pump3Thread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_pump3thread" :: Pump3Thread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_Pump3 +! call OnPump3Main%RunAll() +! #endif +! #ifdef S_Pump3 +! if(.not.Pump3Started) then +! call OnPump3Start%RunAll() +! Pump3Started = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnPump3Step%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Pump 3 Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnPump3Output%RunAll() +! end do +! call OnPump3Pause%RunAll() +! end do loop +! #endif +! Pump3Thread = 0; +! call ExitThread(0) +! end function Pump3Thread + +! integer(4) function ChokeControlThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_chokecontrolthread" :: ChokeControlThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_ChokeControl +! call OnChokeControlMain%RunAll() +! #endif +! #ifdef S_ChokeControl +! if(.not.ChokeControlStarted) then +! call OnChokeControlStart%RunAll() +! ChokeControlStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnChokeControlStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Choke Control Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnChokeControlOutput%RunAll() +! end do +! call OnChokeControlPause%RunAll() +! end do loop +! #endif +! ChokeControlThread = 0; +! call ExitThread(0) +! end function ChokeControlThread + +! integer(4) function RopThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_ropthread" :: RopThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_Rop +! call OnRopMain%RunAll() +! #endif +! #ifdef S_Rop +! if(.not.RopStarted) then +! call OnRopStart%RunAll() +! RopStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnRopStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('ROP Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnRopOutput%RunAll() +! end do +! call OnRopPause%RunAll() +! end do loop +! #endif +! RopThread = 0; +! call ExitThread(0) +! end function RopThread + +! integer(4) function RotaryTableThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_rotarytablethread" :: RotaryTableThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_RotaryTable +! call OnRotaryTableMain%RunAll() +! #endif +! #ifdef S_RotaryTable +! if(.not.RotaryTableStarted) then +! call OnRotaryTableStart%RunAll() +! RotaryTableStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnRotaryTableStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Rotary Table Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnRotaryTableOutput%RunAll() +! end do +! call OnRotaryTablePause%RunAll() +! end do loop +! #endif +! RotaryTableThread = 0; +! call ExitThread(0) +! end function RotaryTableThread + +! integer(4) function DrawworksThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_drawworksthread" :: DrawworksThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_Drawworks +! call OnDrawworksMain%RunAll() +! #endif +! #ifdef S_Drawworks +! if(.not.DrawworksStarted) then +! call OnDrawworksStart%RunAll() +! DrawworksStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnDrawworksStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Drawworks Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnDrawworksOutput%RunAll() +! end do +! call OnDrawworksPause%RunAll() +! end do loop +! #endif +! DrawworksThread = 0; +! call ExitThread(0) +! end function DrawworksThread + +! integer(4) function FluidFlowThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_fluidflowthread" :: FluidFlowThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_FluidFlow +! call OnFluidFlowMain%RunAll() +! #endif +! #ifdef S_FluidFlow +! if(.not.FluidFlowStarted) then +! call OnFluidFlowStart%RunAll() +! FluidFlowStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnFluidFlowStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Fluid Flow Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnFluidFlowOutput%RunAll() +! end do +! call OnFluidFlowPause%RunAll() +! end do loop +! #endif +! FluidFlowThread = 0; +! call ExitThread(0) +! end function FluidFlowThread + +! integer(4) function TorqueDragThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_torquedragthread" :: TorqueDragThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_TorqueDrag +! call OnTorqueDragMain%RunAll() +! #endif +! #ifdef S_TorqueDrag +! if(.not.TorqueDragStarted) then +! call OnTorqueDragStart%RunAll() +! TorqueDragStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnTorqueDragStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Torque Drag Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnTorqueDragOutput%RunAll() +! end do +! call OnTorqueDragPause%RunAll() +! end do loop +! #endif +! TorqueDragThread = 0; +! call ExitThread(0) +! end function TorqueDragThread + + +! integer(4) function TopDriveThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_topdrivethread" :: TopDriveThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_TopDrive +! call OnTopDriveMain%RunAll() +! #endif +! #ifdef S_TopDrive +! if(.not.TopDriveStarted) then +! call OnTopDriveStart%RunAll() +! TopDriveStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnTopDriveStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('TopDrive Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnTopDriveOutput%RunAll() +! end do +! call OnTopDrivePause%RunAll() +! end do loop +! #endif +! TopDriveThread = 0; +! call ExitThread(0) +! end function TopDriveThread + + +! integer(4) function MudSystemThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_MudSystemthread" :: MudSystemThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_MudSystem +! call OnMudSystemMain%RunAll() +! #endif +! #ifdef S_MudSystem +! if(.not.MudSystemStarted) then +! call OnMudSystemStart%RunAll() +! MudSystemStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnMudSystemStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Mud System Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnMudSystemOutput%RunAll() +! end do +! call OnMudSystemPause%RunAll() +! end do loop +! #endif +! MudSystemThread = 0; +! call ExitThread(0) +! end function MudSystemThread + +! integer(4) function PipeRams1Thread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_piperams1thread" :: PipeRams1Thread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_PipeRams1 +! call OnPipeRams1Main%RunAll() +! #endif +! #ifdef S_PipeRams1 +! if(.not.PipeRams1Started) then +! call OnPipeRams1Start%RunAll() +! PipeRams1Started = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnPipeRams1Step%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Pipe Rams 1 Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnPipeRams1Output%RunAll() +! end do +! call OnPipeRams1Pause%RunAll() +! end do loop +! #endif +! PipeRams1Thread = 0; +! call ExitThread(0) +! end function PipeRams1Thread + +! integer(4) function PipeRams2Thread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_piperams2thread" :: PipeRams2Thread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_PipeRams2 +! call OnPipeRams2Main%RunAll() +! #endif +! #ifdef S_PipeRams2 +! if(.not.PipeRams2Started) then +! call OnPipeRams2Start%RunAll() +! PipeRams2Started = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnPipeRams2Step%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Pipe Rams 2 Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnPipeRams2Output%RunAll() +! end do +! call OnPipeRams2Pause%RunAll() +! end do loop +! #endif +! PipeRams2Thread = 0; +! call ExitThread(0) +! end function PipeRams2Thread + +! integer(4) function KillLineThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_killlinethread" :: KillLineThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_KillLine +! call OnKillLineMain%RunAll() +! #endif +! #ifdef S_KillLine +! if(.not.KillLineStarted) then +! call OnKillLineStart%RunAll() +! KillLineStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnKillLineStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Kill Line Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnKillLineOutput%RunAll() +! end do +! call OnKillLinePause%RunAll() +! end do loop +! #endif +! KillLineThread = 0; +! call ExitThread(0) +! end function KillLineThread + +! integer(4) function ChokeLineThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_chokelinethread" :: ChokeLineThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_ChokeLine +! call OnChokeLineMain%RunAll() +! #endif +! #ifdef S_ChokeLine +! if(.not.ChokeLineStarted) then +! call OnChokeLineStart%RunAll() +! ChokeLineStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnChokeLineStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Choke Line Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnChokeLineOutput%RunAll() +! end do +! call OnChokeLinePause%RunAll() +! end do loop +! #endif +! ChokeLineThread = 0; +! call ExitThread(0) +! end function ChokeLineThread + +! integer(4) function BlindRamsThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_blindramsthread" :: BlindRamsThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_BlindRams +! call OnBlindRamsMain%RunAll() +! #endif +! #ifdef S_BlindRams +! if(.not.BlindRamsStarted) then +! call OnBlindRamsStart%RunAll() +! BlindRamsStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnBlindRamsStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Blind Rams Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnBlindRamsOutput%RunAll() +! end do +! call OnBlindRamsPause%RunAll() +! end do loop +! #endif +! BlindRamsThread = 0; +! call ExitThread(0) +! end function BlindRamsThread + +! integer(4) function AnnularThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_annularthread" :: AnnularThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_Annular +! call OnAnnularMain%RunAll() +! #endif +! #ifdef S_Annular +! if(.not.AnnularStarted) then +! call OnAnnularStart%RunAll() +! AnnularStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnAnnularStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Annular Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnAnnularOutput%RunAll() +! end do +! call OnAnnularPause%RunAll() +! end do loop +! #endif +! AnnularThread = 0; +! call ExitThread(0) +! end function AnnularThread + +! integer(4) function GeoThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_geothread" :: GeoThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_Geo +! call OnGeoMain%RunAll() +! #endif +! #ifdef S_Geo +! if(.not.GeoStarted) then +! call OnGeoStart%RunAll() +! GeoStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnGeoStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Geo Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnGeoOutput%RunAll() +! end do +! call OnGeoPause%RunAll() +! end do loop +! #endif +! GeoThread = 0; +! call ExitThread(0) +! end function GeoThread + + + +! integer(4) function OperationScenariosThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_operationscenariosthread" :: OperationScenariosThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! call OnOperationScenariosMain%RunAll() +! OperationScenariosThread = 0; +! call ExitThread(0) +! end function OperationScenariosThread + +! integer(4) function PathFindingThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_pathfindingthread" :: PathFindingThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! call OnPathFindingMain%RunAll() +! PathFindingThread = 0; +! call ExitThread(0) +! end function PathFindingThread + + + + + + + + + + + + + + +! integer(4) function SampleThread(arg) +! !DEC$ ATTRIBUTES STDCALL, ALIAS:"_samplethread" :: SampleThread +! use ifport +! use ifmt +! implicit none +! integer(4), pointer :: arg +! integer i, j +! integer elapsed, speed, remaining +! type(Timer) t +! #ifdef M_Sample +! call OnSampleMain%RunAll() +! #endif +! #ifdef S_Sample +! if(.not.SampleStarted) then +! call OnSampleStart%RunAll() +! SampleStarted = .true. +! end if +! loop: do +! if(IsStopped) call ExitThread(0) +! do i=1, 10 +! if(IsStopped) call ExitThread(0) +! call t%Start() +! do j=1, SimulationSpeed +! if(IsStopped) call ExitThread(0) +! call OnSampleStep%RunAll() +! end do +! call t%Finish() +! elapsed = t%ElapsedTimeMs() +! remaining = 100 - elapsed +! #ifdef E_SpeedWatchdog +! if(elapsed > 100) call Error('Sample Module: exceeding more than 100ms interval, the time was ', elapsed) +! #endif +! if(remaining > 0 .and. i < 10) call sleepqq(remaining - SleepLimit) +! call OnSampleOutput%RunAll() +! end do +! call OnSamplePause%RunAll() +! end do loop + +! #endif +! SampleThread = 0; +! call ExitThread(0) +! end function SampleThread + +end module CSimulationVariables \ No newline at end of file diff --git a/CSounds.f90 b/CSounds.f90 new file mode 100644 index 0000000..0bb7826 --- /dev/null +++ b/CSounds.f90 @@ -0,0 +1,683 @@ +module CSounds + use CIActionReference + implicit none + public + + ! Input vars + + ! Output vars + integer :: SoundMP1s + integer :: SoundMP2s + integer :: SoundMP3s + integer :: SoundRTs + integer :: SoundDwFws + integer :: SoundDwRevs + integer :: SoundDwBrakes + integer :: SoundChokePumps + integer :: SoundGasThroughChokes + integer :: SoundKoomeyAirPumps + integer :: SoundKoomeyElectricPumps + logical :: SoundRtGearCrashs + logical :: SoundDwGearCrashs + logical :: SoundFloorCollisions + logical :: SoundCrownCollisions + logical :: SoundDwClutchs + logical :: SoundBlowers + logical :: SoundBlowerMp1s + logical :: SoundBlowerMp2s + logical :: SoundBlowerMp3s + logical :: SoundBlowerRts + logical :: SoundBlowerDws + logical :: SoundBlowerStarts + logical :: SoundBlowerShutdowns + logical :: SoundElectricPumps + + + procedure (ActionInteger), pointer :: SoundMP1Ptr + procedure (ActionInteger), pointer :: SoundMP2Ptr + procedure (ActionInteger), pointer :: SoundMP3Ptr + procedure (ActionInteger), pointer :: SoundRTPtr + procedure (ActionInteger), pointer :: SoundDwFwPtr + procedure (ActionInteger), pointer :: SoundDwRevPtr + procedure (ActionInteger), pointer :: SoundDwBrakePtr + procedure (ActionInteger), pointer :: SoundChokePumpPtr + procedure (ActionInteger), pointer :: SoundGasThroughChokePtr + procedure (ActionInteger), pointer :: SoundKoomeyAirPumpPtr + procedure (ActionInteger), pointer :: SoundKoomeyElectricPumpPtr + procedure (ActionBool), pointer :: SoundRtGearCrashPtr + procedure (ActionBool), pointer :: SoundDwGearCrashPtr + procedure (ActionBool), pointer :: SoundFloorCollisionPtr + procedure (ActionBool), pointer :: SoundCrownCollisionPtr + procedure (ActionBool), pointer :: SoundDwClutchPtr + procedure (ActionBool), pointer :: SoundBlowerPtr + procedure (ActionBool), pointer :: SoundBlowerMp1Ptr + procedure (ActionBool), pointer :: SoundBlowerMp2Ptr + procedure (ActionBool), pointer :: SoundBlowerMp3Ptr + procedure (ActionBool), pointer :: SoundBlowerRtPtr + procedure (ActionBool), pointer :: SoundBlowerDwPtr + procedure (ActionBool), pointer :: SoundBlowerStartPtr + procedure (ActionBool), pointer :: SoundBlowerShutdownPtr + procedure (ActionBool), pointer :: SoundElectricPumpPtr + + private :: SoundMP1Ptr, SoundMP2Ptr, SoundMP3Ptr, SoundRTPtr, SoundDwFwPtr, SoundDwRevPtr,SoundDwBrakePtr,SoundChokePumpPtr,SoundGasThroughChokePtr,SoundKoomeyAirPumpPtr, & + SoundKoomeyElectricPumpPtr, SoundRtGearCrashPtr,SoundDwGearCrashPtr,SoundFloorCollisionPtr,SoundCrownCollisionPtr,SoundDwClutchPtr,SoundBlowerPtr, & + SoundBlowerMp1Ptr, SoundBlowerMp2Ptr,SoundBlowerMp3Ptr,SoundBlowerRtPtr,SoundBlowerDwPtr,SoundBlowerStartPtr,SoundBlowerShutdownPtr,SoundElectricPumpPtr + + contains + + + + + + subroutine SetSoundMP1(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundMP1Ptr)) call SoundMP1Ptr(v) + SoundMP1s = v + end subroutine + + subroutine SetSoundMP2(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundMP2Ptr)) call SoundMP2Ptr(v) + SoundMP2s = v + end subroutine + + subroutine SetSoundMP3(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundMP3Ptr)) call SoundMP3Ptr(v) + SoundMP3s = v + end subroutine + + subroutine SetSoundRT(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundRTPtr)) call SoundRTPtr(v) + SoundRTs = v + end subroutine + + subroutine SetSoundDwFw(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundDwFwPtr)) call SoundDwFwPtr(v) + SoundDwFws = v + end subroutine + + subroutine SetSoundDwRev(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundDwRevPtr)) call SoundDwRevPtr(v) + SoundDwRevs = v + end subroutine + + subroutine SetSoundDwBrake(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundDwBrakePtr)) call SoundDwBrakePtr(v) + SoundDwBrakes = v + end subroutine + + subroutine SetSoundChokePump(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundChokePumpPtr)) call SoundChokePumpPtr(v) + SoundChokePumps = v + end subroutine + + subroutine SetSoundGasThroughChoke(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundGasThroughChokePtr)) call SoundGasThroughChokePtr(v) + SoundGasThroughChokes = v + end subroutine + + subroutine SetSoundKoomeyAirPump(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundKoomeyAirPumpPtr)) call SoundKoomeyAirPumpPtr(v) + SoundKoomeyAirPumps = v + end subroutine + + subroutine SetSoundKoomeyElectricPump(v) + implicit none + integer, intent(inout) :: v + !if(associated(SoundKoomeyElectricPumpPtr)) call SoundKoomeyElectricPumpPtr(v) + SoundKoomeyElectricPumps = v + end subroutine + + subroutine SetSoundRtGearCrash(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundRtGearCrashPtr)) call SoundRtGearCrashPtr(v) + SoundRtGearCrashs = v + end subroutine + + subroutine SetSoundDwGearCrash(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundDwGearCrashPtr)) call SoundDwGearCrashPtr(v) + SoundDwGearCrashs = v + end subroutine + + subroutine SetSoundFloorCollision(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundFloorCollisionPtr)) call SoundFloorCollisionPtr(v) + SoundFloorCollisions = v + end subroutine + + subroutine SetSoundCrownCollision(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundCrownCollisionPtr)) call SoundCrownCollisionPtr(v) + SoundCrownCollisions = v + end subroutine + + subroutine SetSoundDwClutch(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundDwClutchPtr)) call SoundDwClutchPtr(v) + SoundDwClutchs = v + end subroutine + + subroutine SetSoundBlower(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundBlowerPtr)) call SoundBlowerPtr(v) + SoundBlowers = v + end subroutine + + subroutine SetSoundBlowerMP1(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundBlowerMp1Ptr)) call SoundBlowerMp1Ptr(v) + SoundBlowerMp1s = v + end subroutine + + subroutine SetSoundBlowerMP2(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundBlowerMp2Ptr)) call SoundBlowerMp2Ptr(v) + SoundBlowerMp2s = v + end subroutine + + subroutine SetSoundBlowerMP3(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundBlowerMp3Ptr)) call SoundBlowerMp3Ptr(v) + SoundBlowerMp3s = v + end subroutine + + subroutine SetSoundBlowerRT(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundBlowerRtPtr)) call SoundBlowerRtPtr(v) + SoundBlowerRts = v + end subroutine + + subroutine SetSoundBlowerDW(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundBlowerDwPtr)) call SoundBlowerDwPtr(v) + SoundBlowerDws = v + end subroutine + + + subroutine SetSoundBlowerStart(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundBlowerStartPtr)) call SoundBlowerStartPtr(v) + SoundBlowerStarts = v + end subroutine + + subroutine SetSoundBlowerShutdown(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundBlowerShutdownPtr)) call SoundBlowerShutdownPtr(v) + SoundBlowerShutdowns = v + end subroutine + + + subroutine SetSoundElectricPump(v) + implicit none + logical, intent(inout) :: v + !if(associated(SoundElectricPumpPtr)) call SoundElectricPumpPtr(v) + SoundElectricPumps = v + end subroutine + + + + + + + + + + + + + + + + + + + subroutine SubscribeSoundMP1(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundMP1 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundMP1' :: SubscribeSoundMP1 + implicit none + procedure (ActionInteger) :: v + SoundMP1Ptr => v + end subroutine + + subroutine SubscribeSoundMP2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundMP2 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundMP2' :: SubscribeSoundMP2 + implicit none + procedure (ActionInteger) :: v + SoundMP2Ptr => v + end subroutine + + subroutine SubscribeSoundMP3(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundMP3 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundMP3' :: SubscribeSoundMP3 + implicit none + procedure (ActionInteger) :: v + SoundMP3Ptr => v + end subroutine + + subroutine SubscribeSoundRT(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundRT + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundRT' :: SubscribeSoundRT + implicit none + procedure (ActionInteger) :: v + SoundRTPtr => v + end subroutine + + subroutine SubscribeSoundDwFw(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundDwFw + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundDwFw' :: SubscribeSoundDwFw + implicit none + procedure (ActionInteger) :: v + SoundDwFwPtr => v + end subroutine + + subroutine SubscribeSoundDwRev(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundDwRev + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundDwRev' :: SubscribeSoundDwRev + implicit none + procedure (ActionInteger) :: v + SoundDwRevPtr => v + end subroutine + + subroutine SubscribeSoundDwBrake(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundDwBrake + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundDwBrake' :: SubscribeSoundDwBrake + implicit none + procedure (ActionInteger) :: v + SoundDwBrakePtr => v + end subroutine + + subroutine SubscribeSoundChokePump(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundChokePump + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundChokePump' :: SubscribeSoundChokePump + implicit none + procedure (ActionInteger) :: v + SoundChokePumpPtr => v + end subroutine + + subroutine SubscribeSoundGasThroughChoke(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundGasThroughChoke + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundGasThroughChoke' :: SubscribeSoundGasThroughChoke + implicit none + procedure (ActionInteger) :: v + SoundGasThroughChokePtr => v + end subroutine + + subroutine SubscribeSoundKoomeyAirPump(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundKoomeyAirPump + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundKoomeyAirPump' :: SubscribeSoundKoomeyAirPump + implicit none + procedure (ActionInteger) :: v + SoundKoomeyAirPumpPtr => v + end subroutine + + subroutine SubscribeSoundKoomeyElectricPump(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundKoomeyElectricPump + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundKoomeyElectricPump' :: SubscribeSoundKoomeyElectricPump + implicit none + procedure (ActionInteger) :: v + SoundKoomeyElectricPumpPtr => v + end subroutine + + subroutine SubscribeSoundRtGearCrash(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundRtGearCrash + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundRtGearCrash' :: SubscribeSoundRtGearCrash + implicit none + procedure (ActionBool) :: v + SoundRtGearCrashPtr => v + end subroutine + + subroutine SubscribeSoundDwGearCrash(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundDwGearCrash + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundDwGearCrash' :: SubscribeSoundDwGearCrash + implicit none + procedure (ActionBool) :: v + SoundDwGearCrashPtr => v + end subroutine + + subroutine SubscribeSoundFloorCollision(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundFloorCollision + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundFloorCollision' :: SubscribeSoundFloorCollision + implicit none + procedure (ActionBool) :: v + SoundFloorCollisionPtr => v + end subroutine + + subroutine SubscribeSoundCrownCollision(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundCrownCollision + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundCrownCollision' :: SubscribeSoundCrownCollision + implicit none + procedure (ActionBool) :: v + SoundCrownCollisionPtr => v + end subroutine + + subroutine SubscribeSoundDwClutch(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundDwClutch + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundDwClutch' :: SubscribeSoundDwClutch + implicit none + procedure (ActionBool) :: v + SoundDwClutchPtr => v + end subroutine + + subroutine SubscribeSoundBlower(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundBlower + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundBlower' :: SubscribeSoundBlower + implicit none + procedure (ActionBool) :: v + SoundBlowerPtr => v + end subroutine + + subroutine SubscribeSoundBlowerMp1(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundBlowerMp1 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundBlowerMp1' :: SubscribeSoundBlowerMp1 + implicit none + procedure (ActionBool) :: v + SoundBlowerMp1Ptr => v + end subroutine + + subroutine SubscribeSoundBlowerMp2(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundBlowerMp2 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundBlowerMp2' :: SubscribeSoundBlowerMp2 + implicit none + procedure (ActionBool) :: v + SoundBlowerMp2Ptr => v + end subroutine + + subroutine SubscribeSoundBlowerMp3(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundBlowerMp3 + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundBlowerMp3' :: SubscribeSoundBlowerMp3 + implicit none + procedure (ActionBool) :: v + SoundBlowerMp3Ptr => v + end subroutine + + subroutine SubscribeSoundBlowerRt(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundBlowerRt + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundBlowerRt' :: SubscribeSoundBlowerRt + implicit none + procedure (ActionBool) :: v + SoundBlowerRtPtr => v + end subroutine + + subroutine SubscribeSoundBlowerDw(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundBlowerDw + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundBlowerDw' :: SubscribeSoundBlowerDw + implicit none + procedure (ActionBool) :: v + SoundBlowerDwPtr => v + end subroutine + + subroutine SubscribeSoundBlowerStart(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundBlowerStart + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundBlowerStart' :: SubscribeSoundBlowerStart + implicit none + procedure (ActionBool) :: v + SoundBlowerStartPtr => v + end subroutine + + subroutine SubscribeSoundBlowerShutdown(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundBlowerShutdown + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundBlowerShutdown' :: SubscribeSoundBlowerShutdown + implicit none + procedure (ActionBool) :: v + SoundBlowerShutdownPtr => v + end subroutine + + subroutine SubscribeSoundElectricPump(v) + !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeSoundElectricPump + !DEC$ ATTRIBUTES ALIAS: 'SubscribeSoundElectricPump' :: SubscribeSoundElectricPump + implicit none + procedure (ActionBool) :: v + SoundElectricPumpPtr => v + end subroutine + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + ! Input routines + + ! Output routines + integer function GetSoundMP1() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundMP1 + !DEC$ ATTRIBUTES ALIAS: 'GetSoundMP1' :: GetSoundMP1 + implicit none + GetSoundMP1 = SoundMP1s + end function + + integer function GetSoundMP2() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundMP2 + !DEC$ ATTRIBUTES ALIAS: 'GetSoundMP2' :: GetSoundMP2 + implicit none + GetSoundMP2 = SoundMP2s + end function + + integer function GetSoundMP3() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundMP3 + !DEC$ ATTRIBUTES ALIAS: 'GetSoundMP3' :: GetSoundMP3 + implicit none + GetSoundMP3 = SoundMP3s + end function + + integer function GetSoundRT() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundRT + !DEC$ ATTRIBUTES ALIAS: 'GetSoundRT' :: GetSoundRT + implicit none + GetSoundRT = SoundRTs + end function + + integer function GetSoundDwFw() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundDwFw + !DEC$ ATTRIBUTES ALIAS: 'GetSoundDwFw' :: GetSoundDwFw + implicit none + GetSoundDwFw = SoundDwFws + end function + + integer function GetSoundDwRev() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundDwRev + !DEC$ ATTRIBUTES ALIAS: 'GetSoundDwRev' :: GetSoundDwRev + implicit none + GetSoundDwRev = SoundDwRevs + end function + + integer function GetSoundDwBrake() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundDwBrake + !DEC$ ATTRIBUTES ALIAS: 'GetSoundDwBrake' :: GetSoundDwBrake + implicit none + GetSoundDwBrake = SoundDwBrakes + end function + + integer function GetSoundChokePump() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundChokePump + !DEC$ ATTRIBUTES ALIAS: 'GetSoundChokePump' :: GetSoundChokePump + implicit none + GetSoundChokePump = SoundChokePumps + end function + + integer function GetSoundGasThroughChoke() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundGasThroughChoke + !DEC$ ATTRIBUTES ALIAS: 'GetSoundGasThroughChoke' :: GetSoundGasThroughChoke + implicit none + GetSoundGasThroughChoke = SoundGasThroughChokes + end function + + integer function GetSoundKoomeyAirPump() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundKoomeyAirPump + !DEC$ ATTRIBUTES ALIAS: 'GetSoundKoomeyAirPump' :: GetSoundKoomeyAirPump + implicit none + GetSoundKoomeyAirPump = SoundKoomeyAirPumps + end function + + integer function GetSoundKoomeyElectricPump() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundKoomeyElectricPump + !DEC$ ATTRIBUTES ALIAS: 'GetSoundKoomeyElectricPump' :: GetSoundKoomeyElectricPump + implicit none + GetSoundKoomeyElectricPump = SoundKoomeyElectricPumps + end function + + logical function GetSoundRtGearCrash() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundRtGearCrash + !DEC$ ATTRIBUTES ALIAS: 'GetSoundRtGearCrash' :: GetSoundRtGearCrash + implicit none + GetSoundRtGearCrash = SoundRtGearCrashs + end function + + logical function GetSoundDwGearCrash() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundDwGearCrash + !DEC$ ATTRIBUTES ALIAS: 'GetSoundDwGearCrash' :: GetSoundDwGearCrash + implicit none + GetSoundDwGearCrash = SoundDwGearCrashs + end function + + logical function GetSoundFloorCollision() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundFloorCollision + !DEC$ ATTRIBUTES ALIAS: 'GetSoundFloorCollision' :: GetSoundFloorCollision + implicit none + GetSoundFloorCollision = SoundFloorCollisions + end function + + logical function GetSoundCrownCollision() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundCrownCollision + !DEC$ ATTRIBUTES ALIAS: 'GetSoundCrownCollision' :: GetSoundCrownCollision + implicit none + GetSoundCrownCollision = SoundCrownCollisions + end function + + logical function GetSoundDwClutch() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundDwClutch + !DEC$ ATTRIBUTES ALIAS: 'GetSoundDwClutch' :: GetSoundDwClutch + implicit none + GetSoundDwClutch = SoundDwClutchs + end function + + logical function GetSoundBlower() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundBlower + !DEC$ ATTRIBUTES ALIAS: 'GetSoundBlower' :: GetSoundBlower + implicit none + GetSoundBlower = SoundBlowers + end function + + logical function GetSoundBlowerMp1() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundBlowerMp1 + !DEC$ ATTRIBUTES ALIAS: 'GetSoundBlowerMp1' :: GetSoundBlowerMp1 + implicit none + GetSoundBlowerMp1 = SoundBlowerMp1s + end function + + logical function GetSoundBlowerMp2() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundBlowerMp2 + !DEC$ ATTRIBUTES ALIAS: 'GetSoundBlowerMp2' :: GetSoundBlowerMp2 + implicit none + GetSoundBlowerMp2 = SoundBlowerMp2s + end function + + logical function GetSoundBlowerMp3() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundBlowerMp3 + !DEC$ ATTRIBUTES ALIAS: 'GetSoundBlowerMp3' :: GetSoundBlowerMp3 + implicit none + GetSoundBlowerMp3 = SoundBlowerMp3s + end function + + logical function GetSoundBlowerRt() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundBlowerRt + !DEC$ ATTRIBUTES ALIAS: 'GetSoundBlowerRt' :: GetSoundBlowerRt + implicit none + GetSoundBlowerRt = SoundBlowerRts + end function + + logical function GetSoundBlowerDw() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundBlowerDw + !DEC$ ATTRIBUTES ALIAS: 'GetSoundBlowerDw' :: GetSoundBlowerDw + implicit none + GetSoundBlowerDw = SoundBlowerDws + end function + + logical function GetSoundBlowerStart() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundBlowerStart + !DEC$ ATTRIBUTES ALIAS: 'GetSoundBlowerStart' :: GetSoundBlowerStart + implicit none + GetSoundBlowerStart = SoundBlowerStarts + end function + + logical function GetSoundBlowerShutdown() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundBlowerShutdown + !DEC$ ATTRIBUTES ALIAS: 'GetSoundBlowerShutdown' :: GetSoundBlowerShutdown + implicit none + GetSoundBlowerShutdown = SoundBlowerShutdowns + end function + + logical function GetSoundElectricPump() + !DEC$ ATTRIBUTES DLLEXPORT :: GetSoundElectricPump + !DEC$ ATTRIBUTES ALIAS: 'GetSoundElectricPump' :: GetSoundElectricPump + implicit none + GetSoundElectricPump = SoundElectricPumps + end function + + + + + + + + + + + +end module CSounds \ No newline at end of file diff --git a/Common/DynamicDoubleArray.f90 b/Common/DynamicDoubleArray.f90 new file mode 100644 index 0000000..c7b1091 --- /dev/null +++ b/Common/DynamicDoubleArray.f90 @@ -0,0 +1,157 @@ +module DynamicDoubleArray + implicit none + public + + type, public :: DynamicDoubleArrayType + real(8), allocatable :: Array(:) + contains + procedure :: First => First + procedure :: Last => Last + procedure :: Length => Length + procedure :: Add => Add + procedure :: AddToFirst => AddToFirst + procedure :: AddTo => AddTo + procedure :: Remove => Remove + procedure :: Empty => Empty + end type DynamicDoubleArrayType + + contains + + + real(8) function First(this) + implicit none + class(DynamicDoubleArrayType), intent(in) :: this + if(allocated(this%Array) .and. size(this%Array) > 0) then + First = this%Array(1) + return + end if + First = 0 + end function + + real(8) function Last(this) + implicit none + class(DynamicDoubleArrayType), intent(in) :: this + if(allocated(this%Array) .and. size(this%Array) > 0) then + Last = this%Array(size(this%Array)) + return + end if + Last = 0 + end function + + integer function Length(this) + implicit none + class(DynamicDoubleArrayType), intent(in) :: this + if(allocated(this%Array)) then + Length = size(this%Array) + return + end if + Length = 0 + end function + + + subroutine AddToFirst(this, value) + implicit none + class(DynamicDoubleArrayType), intent(inout) :: this + real(8), allocatable :: tempArr(:) + real(8), intent(in) :: value + integer :: i, isize + + if(allocated(this%Array)) then + isize = size(this%Array) + allocate(tempArr(isize+1)) + tempArr(1) = value + do i=2,isize+1 + tempArr(i) = this%Array(i-1) + end do + deallocate(this%Array) + call move_alloc(tempArr, this%Array) + else + allocate(this%Array(1)) + this%Array(1) = value + end if + + end subroutine + + subroutine AddTo(this, index, value) + implicit none + class(DynamicDoubleArrayType), intent(inout) :: this + real(8), allocatable :: tempArr(:) + integer, intent(in) :: index + real(8), intent(in) :: value + integer :: isize + if(index <= 0) return + if(index > size(this%Array)) then + call this%Add(value) + return + endif + if(allocated(this%Array)) then + isize = size(this%Array) + allocate(tempArr(isize+1)) + tempArr(:index-1) = this%Array(:index-1) + tempArr(index) = value + tempArr(index+1:) = this%Array(index:) + deallocate(this%Array) + call move_alloc(tempArr, this%Array) + end if + end subroutine + + subroutine Add(this, value) + implicit none + class(DynamicDoubleArrayType), intent(inout) :: this + real(8), allocatable :: tempArr(:) + real(8), intent(in) :: value + integer :: i, isize + + if(allocated(this%Array)) then + isize = size(this%Array) + allocate(tempArr(isize+1)) + do i=1,isize + tempArr(i) = this%Array(i) + end do + tempArr(isize+1) = value + deallocate(this%Array) + call move_alloc(tempArr, this%Array) + else + allocate(this%Array(1)) + this%Array(1) = value + end if + + end subroutine + + + subroutine Empty(this) + implicit none + class(DynamicDoubleArrayType), intent(inout) :: this + if(allocated(this%Array)) deallocate(this%Array) + end subroutine + + + subroutine Remove(this, index) + implicit none + class(DynamicDoubleArrayType), intent(inout) :: this + integer, intent(in) :: index + real(8), allocatable :: tempArr(:) + integer :: i + logical :: found + + if(index <= 0 .or. index > size(this%Array)) return + if(.not.allocated(this%Array))return + allocate(tempArr(size(this%Array)-1)) + found = .false. + do i=1, size(this%Array) + if(i==index) then + found = .true. + cycle + end if + if(found) then + tempArr(i-1) = this%Array(i) + else + tempArr(i) = this%Array(i) + endif + end do + deallocate(this%Array) + call move_alloc(tempArr, this%Array) + end subroutine + + +end module DynamicDoubleArray \ No newline at end of file diff --git a/Common/DynamicIntegerArray.f90 b/Common/DynamicIntegerArray.f90 new file mode 100644 index 0000000..c9d7be1 --- /dev/null +++ b/Common/DynamicIntegerArray.f90 @@ -0,0 +1,158 @@ +module DynamicIntegerArray + implicit none + public + + type, public :: DynamicIntegerArrayType + integer, allocatable :: Array(:) + contains + procedure :: First => First + procedure :: Last => Last + procedure :: Length => Length + procedure :: Add => Add + procedure :: AddToFirst => AddToFirst + procedure :: AddTo => AddTo + procedure :: Remove => Remove + procedure :: Empty => Empty + end type DynamicIntegerArrayType + + contains + + + integer function First(this) + implicit none + class(DynamicIntegerArrayType), intent(in) :: this + if(allocated(this%Array) .and. size(this%Array) > 0) then + First = this%Array(1) + return + end if + First = 0 + end function + + integer function Last(this) + implicit none + class(DynamicIntegerArrayType), intent(in) :: this + if(allocated(this%Array) .and. size(this%Array) > 0) then + Last = this%Array(size(this%Array)) + return + end if + Last = 0 + end function + + integer function Length(this) + implicit none + class(DynamicIntegerArrayType), intent(in) :: this + if(allocated(this%Array)) then + Length = size(this%Array) + return + end if + Length = 0 + end function + + + subroutine AddToFirst(this, value) + implicit none + class(DynamicIntegerArrayType), intent(inout) :: this + integer, allocatable :: tempArr(:) + integer, intent(in) :: value + integer :: i, isize + + if(allocated(this%Array)) then + isize = size(this%Array) + allocate(tempArr(isize+1)) + tempArr(1) = value + do i=2,isize+1 + tempArr(i) = this%Array(i-1) + end do + deallocate(this%Array) + call move_alloc(tempArr, this%Array) + else + allocate(this%Array(1)) + this%Array(1) = value + end if + + end subroutine + + subroutine AddTo(this, index, value) + implicit none + class(DynamicIntegerArrayType), intent(inout) :: this + integer, allocatable :: tempArr(:) + integer, intent(in) :: index + integer, intent(in) :: value + integer :: i, isize + if(index <= 0) return + if(index > size(this%Array)) then + call this%Add(value) + return + endif + if(allocated(this%Array)) then + isize = size(this%Array) + allocate(tempArr(isize+1)) + tempArr(:index-1) = this%Array(:index-1) + tempArr(index) = value + tempArr(index+1:) = this%Array(index:) + deallocate(this%Array) + call move_alloc(tempArr, this%Array) + end if + end subroutine + + + subroutine Add(this, value) + implicit none + class(DynamicIntegerArrayType), intent(inout) :: this + integer, allocatable :: tempArr(:) + integer, intent(in) :: value + integer :: i, isize + + if(allocated(this%Array)) then + isize = size(this%Array) + allocate(tempArr(isize+1)) + do i=1,isize + tempArr(i) = this%Array(i) + end do + tempArr(isize+1) = value + deallocate(this%Array) + call move_alloc(tempArr, this%Array) + else + allocate(this%Array(1)) + this%Array(1) = value + end if + + end subroutine + + + subroutine Empty(this) + implicit none + class(DynamicIntegerArrayType), intent(inout) :: this + if(allocated(this%Array)) deallocate(this%Array) + end subroutine + + + subroutine Remove(this, index) + implicit none + class(DynamicIntegerArrayType), intent(inout) :: this + integer, intent(in) :: index + integer, allocatable :: tempArr(:) + integer :: i + logical :: found + + if(index <= 0 .or. index > size(this%Array)) return + if(.not.allocated(this%Array))return + allocate(tempArr(size(this%Array)-1)) + found = .false. + do i=1, size(this%Array) + if(i==index) then + found = .true. + cycle + end if + if(found) then + tempArr(i-1) = this%Array(i) + else + tempArr(i) = this%Array(i) + endif + end do + deallocate(this%Array) + call move_alloc(tempArr, this%Array) + end subroutine + + +end module DynamicIntegerArray \ No newline at end of file diff --git a/Common/DynamicLogicalArray.f90 b/Common/DynamicLogicalArray.f90 new file mode 100644 index 0000000..c22fd1a --- /dev/null +++ b/Common/DynamicLogicalArray.f90 @@ -0,0 +1,157 @@ +module DynamicLogicalArray + implicit none + public + + type, public :: DynamicLogicalArrayType + logical, allocatable :: Array(:) + contains + procedure :: First => First + procedure :: Last => Last + procedure :: Length => Length + procedure :: Add => Add + procedure :: AddToFirst => AddToFirst + procedure :: AddTo => AddTo + procedure :: Remove => Remove + procedure :: Empty => Empty + end type DynamicLogicalArrayType + + contains + + + logical function First(this) + implicit none + class(DynamicLogicalArrayType), intent(in) :: this + if(allocated(this%Array) .and. size(this%Array) > 0) then + First = this%Array(1) + return + end if + First = 0 + end function + + logical function Last(this) + implicit none + class(DynamicLogicalArrayType), intent(in) :: this + if(allocated(this%Array) .and. size(this%Array) > 0) then + Last = this%Array(size(this%Array)) + return + end if + Last = 0 + end function + + integer function Length(this) + implicit none + class(DynamicLogicalArrayType), intent(in) :: this + if(allocated(this%Array)) then + Length = size(this%Array) + return + end if + Length = 0 + end function + + + subroutine AddToFirst(this, value) + implicit none + class(DynamicLogicalArrayType), intent(inout) :: this + logical, allocatable :: tempArr(:) + logical, intent(in) :: value + integer :: i, isize + + if(allocated(this%Array)) then + isize = size(this%Array) + allocate(tempArr(isize+1)) + tempArr(1) = value + do i=2,isize+1 + tempArr(i) = this%Array(i-1) + end do + deallocate(this%Array) + call move_alloc(tempArr, this%Array) + else + allocate(this%Array(1)) + this%Array(1) = value + end if + + end subroutine + + subroutine AddTo(this, index, value) + implicit none + class(DynamicLogicalArrayType), intent(inout) :: this + logical, allocatable :: tempArr(:) + integer, intent(in) :: index + logical, intent(in) :: value + integer :: i, isize + if(index <= 0) return + if(index > size(this%Array)) then + call this%Add(value) + return + endif + if(allocated(this%Array)) then + isize = size(this%Array) + allocate(tempArr(isize+1)) + tempArr(:index-1) = this%Array(:index-1) + tempArr(index) = value + tempArr(index+1:) = this%Array(index:) + deallocate(this%Array) + call move_alloc(tempArr, this%Array) + end if + end subroutine + + subroutine Add(this, value) + implicit none + class(DynamicLogicalArrayType), intent(inout) :: this + logical, allocatable :: tempArr(:) + logical, intent(in) :: value + integer :: i, isize + + if(allocated(this%Array)) then + isize = size(this%Array) + allocate(tempArr(isize+1)) + do i=1,isize + tempArr(i) = this%Array(i) + end do + tempArr(isize+1) = value + deallocate(this%Array) + call move_alloc(tempArr, this%Array) + else + allocate(this%Array(1)) + this%Array(1) = value + end if + + end subroutine + + + subroutine Empty(this) + implicit none + class(DynamicLogicalArrayType), intent(inout) :: this + if(allocated(this%Array)) deallocate(this%Array) + end subroutine + + + subroutine Remove(this, index) + implicit none + class(DynamicLogicalArrayType), intent(inout) :: this + integer, intent(in) :: index + logical, allocatable :: tempArr(:) + integer :: i + logical :: found + + if(index <= 0 .or. index > size(this%Array)) return + if(.not.allocated(this%Array))return + allocate(tempArr(size(this%Array)-1)) + found = .false. + do i=1, size(this%Array) + if(i==index) then + found = .true. + cycle + end if + if(found) then + tempArr(i-1) = this%Array(i) + else + tempArr(i) = this%Array(i) + endif + end do + deallocate(this%Array) + call move_alloc(tempArr, this%Array) + end subroutine + + +end module DynamicLogicalArray \ No newline at end of file diff --git a/Common/DynamicRealArray.f90 b/Common/DynamicRealArray.f90 new file mode 100644 index 0000000..fbb89f8 --- /dev/null +++ b/Common/DynamicRealArray.f90 @@ -0,0 +1,157 @@ +module DynamicRealArray + implicit none + public + + type, public :: DynamicRealArrayType + real, allocatable :: Array(:) + contains + procedure :: First => First + procedure :: Last => Last + procedure :: Length => Length + procedure :: Add => Add + procedure :: AddToFirst => AddToFirst + procedure :: AddTo => AddTo + procedure :: Remove => Remove + procedure :: Empty => Empty + end type DynamicRealArrayType + + contains + + + real function First(this) + implicit none + class(DynamicRealArrayType), intent(in) :: this + if(allocated(this%Array) .and. size(this%Array) > 0) then + First = this%Array(1) + return + end if + First = 0 + end function + + real function Last(this) + implicit none + class(DynamicRealArrayType), intent(in) :: this + if(allocated(this%Array) .and. size(this%Array) > 0) then + Last = this%Array(size(this%Array)) + return + end if + Last = 0 + end function + + integer function Length(this) + implicit none + class(DynamicRealArrayType), intent(in) :: this + if(allocated(this%Array)) then + Length = size(this%Array) + return + end if + Length = 0 + end function + + + subroutine AddToFirst(this, value) + implicit none + class(DynamicRealArrayType), intent(inout) :: this + real, allocatable :: tempArr(:) + real, intent(in) :: value + integer :: i, isize + + if(allocated(this%Array)) then + isize = size(this%Array) + allocate(tempArr(isize+1)) + tempArr(1) = value + do i=2,isize+1 + tempArr(i) = this%Array(i-1) + end do + deallocate(this%Array) + call move_alloc(tempArr, this%Array) + else + allocate(this%Array(1)) + this%Array(1) = value + end if + + end subroutine + + subroutine AddTo(this, index, value) + implicit none + class(DynamicRealArrayType), intent(inout) :: this + real, allocatable :: tempArr(:) + integer, intent(in) :: index + real, intent(in) :: value + integer :: i, isize + if(index <= 0) return + if(index > size(this%Array)) then + call this%Add(value) + return + endif + if(allocated(this%Array)) then + isize = size(this%Array) + allocate(tempArr(isize+1)) + tempArr(:index-1) = this%Array(:index-1) + tempArr(index) = value + tempArr(index+1:) = this%Array(index:) + deallocate(this%Array) + call move_alloc(tempArr, this%Array) + end if + end subroutine + + subroutine Add(this, value) + implicit none + class(DynamicRealArrayType), intent(inout) :: this + real, allocatable :: tempArr(:) + real, intent(in) :: value + integer :: i, isize + + if(allocated(this%Array)) then + isize = size(this%Array) + allocate(tempArr(isize+1)) + do i=1,isize + tempArr(i) = this%Array(i) + end do + tempArr(isize+1) = value + deallocate(this%Array) + call move_alloc(tempArr, this%Array) + else + allocate(this%Array(1)) + this%Array(1) = value + end if + + end subroutine + + + subroutine Empty(this) + implicit none + class(DynamicRealArrayType), intent(inout) :: this + if(allocated(this%Array)) deallocate(this%Array) + end subroutine + + + subroutine Remove(this, index) + implicit none + class(DynamicRealArrayType), intent(inout) :: this + integer, intent(in) :: index + real, allocatable :: tempArr(:) + integer :: i + logical :: found + + if(index <= 0 .or. index > size(this%Array)) return + if(.not.allocated(this%Array))return + allocate(tempArr(size(this%Array)-1)) + found = .false. + do i=1, size(this%Array) + if(i==index) then + found = .true. + cycle + end if + if(found) then + tempArr(i-1) = this%Array(i) + else + tempArr(i) = this%Array(i) + endif + end do + deallocate(this%Array) + call move_alloc(tempArr, this%Array) + end subroutine + + +end module DynamicRealArray \ No newline at end of file diff --git a/Common/json-fortran/json_file_module.F90 b/Common/json-fortran/json_file_module.F90 new file mode 100644 index 0000000..75376ab --- /dev/null +++ b/Common/json-fortran/json_file_module.F90 @@ -0,0 +1,3040 @@ +!***************************************************************************************** +!> author: Jacob Williams +! license: BSD +! +! Higher-level [[json_file]] interface for the [[json_value]] type. +! +!### License +! * JSON-Fortran is released under a BSD-style license. +! See the [LICENSE](https://github.com/jacobwilliams/json-fortran/blob/master/LICENSE) +! file for details. + + module json_file_module + + use,intrinsic :: iso_fortran_env + use json_kinds + use json_parameters, only: unit2str + use json_string_utilities + use json_value_module + + implicit none + + private + +#include "json_macros.inc" + + !********************************************************* + !> author: Jacob Williams + ! date: 12/9/2013 + ! + ! The `json_file` is the main public class that is + ! used to open a file and get data from it. + ! + ! A `json_file` contains only two items: an instance of a [[json_core(type)]], + ! which is used for all data manipulation, and a [[json_value]] pointer, + ! which is used to construct the linked-list data structure. + ! Note that most methods in the `json_file` class are simply wrappers + ! to the lower-level routines in the [[json_value_module]]. + ! + !### Example + ! + !```fortran + ! program test + ! use json_module + ! implicit none + ! type(json_file) :: json + ! integer :: ival + ! real(real64) :: rval + ! character(len=:),allocatable :: cval + ! logical :: found + ! call json%initialize(compact_reals=.true.) + ! call json%load(filename='myfile.json') + ! call json%print() !print to the console + ! call json%get('var.i',ival,found) + ! call json%get('var.r(3)',rval,found) + ! call json%get('var.c',cval,found) + ! call json%destroy() + ! end program test + !``` + ! + !@note The `destroy()` method may be called to free the memory if necessary. + ! [[json_file(type)]] includes a finalizer that also calls + ! `destroy()` when the variable goes out of scope. + + type,public :: json_file + + private + + type(json_core) :: core !! The instance of the [[json_core(type)]] + !! factory used for this file. + type(json_value),pointer :: p => null() !! the JSON structure read from the file + + contains + + generic,public :: initialize => initialize_json_core_in_file,& + set_json_core_in_file + + procedure,public :: get_core => get_json_core_in_file + + !> + ! Load JSON from a file. + procedure,public :: load => json_file_load + + !> + ! The same as `load`, but only here for backward compatibility + procedure,public :: load_file => json_file_load + + !> + ! Load JSON from a string. + generic,public :: deserialize => MAYBEWRAP(json_file_load_from_string) + + !> + ! The same as `deserialize`, but only here for backward compatibility + generic,public :: load_from_string => MAYBEWRAP(json_file_load_from_string) + + !> + ! Print the [[json_value]] structure to an allocatable string + procedure,public :: serialize => json_file_print_to_string + + !> + ! The same as `serialize`, but only here for backward compatibility + procedure,public :: print_to_string => json_file_print_to_string + + procedure,public :: destroy => json_file_destroy + procedure,public :: nullify => json_file_nullify + procedure,public :: move => json_file_move_pointer + generic,public :: info => MAYBEWRAP(json_file_variable_info) + generic,public :: matrix_info => MAYBEWRAP(json_file_variable_matrix_info) + + !error checking: + procedure,public :: failed => json_file_failed + procedure,public :: print_error_message => json_file_print_error_message + procedure,public :: check_for_errors => json_file_check_for_errors + procedure,public :: clear_exceptions => json_file_clear_exceptions + + generic,public :: print => json_file_print_to_console, & + json_file_print_to_unit, & + json_file_print_to_filename + + !> + ! The same as `print`, but only here for backward compatibility + generic,public :: print_file => json_file_print_to_console, & + json_file_print_to_unit, & + json_file_print_to_filename + + !> + ! Rename a variable, specifying it by path + generic,public :: rename => MAYBEWRAP(json_file_rename) +#ifdef USE_UCS4 + generic,public :: rename => json_file_rename_path_ascii, & + json_file_rename_name_ascii +#endif + + !> + ! Verify that a path is valid + ! (i.e., a variable with this path exists in the file). + generic,public :: valid_path => MAYBEWRAP(json_file_valid_path) + + !> + ! Get a variable from a [[json_file(type)]], by specifying the path. + generic,public :: get => MAYBEWRAP(json_file_get_object), & + MAYBEWRAP(json_file_get_integer), & +#ifndef REAL32 + MAYBEWRAP(json_file_get_real32), & +#endif + MAYBEWRAP(json_file_get_real), & +#ifdef REAL128 + MAYBEWRAP(json_file_get_real64), & +#endif + MAYBEWRAP(json_file_get_logical), & + MAYBEWRAP(json_file_get_string), & + MAYBEWRAP(json_file_get_integer_vec), & +#ifndef REAL32 + MAYBEWRAP(json_file_get_real32_vec), & +#endif + MAYBEWRAP(json_file_get_real_vec), & +#ifdef REAL128 + MAYBEWRAP(json_file_get_real64_vec), & +#endif + MAYBEWRAP(json_file_get_logical_vec), & + MAYBEWRAP(json_file_get_string_vec), & + MAYBEWRAP(json_file_get_alloc_string_vec), & + json_file_get_root + + !> + ! Add a variable to a [[json_file(type)]], by specifying the path. + ! + !### Example + ! + !```fortran + ! program test + ! use json_module, rk=>json_rk, ik=>json_ik + ! implicit none + ! type(json_file) :: f + ! call f%initialize() ! specify whatever init options you want. + ! call f%add('inputs.t', 0.0_rk) + ! call f%add('inputs.x', [1.0_rk,2.0_rk,3.0_rk]) + ! call f%add('inputs.flag', .true.) + ! call f%print() ! print to the console + ! end program test + !``` + generic,public :: add => json_file_add, & + MAYBEWRAP(json_file_add_object), & + MAYBEWRAP(json_file_add_integer), & +#ifndef REAL32 + MAYBEWRAP(json_file_add_real32), & +#endif + MAYBEWRAP(json_file_add_real), & +#ifdef REAL128 + MAYBEWRAP(json_file_add_real64), & +#endif + MAYBEWRAP(json_file_add_logical), & + MAYBEWRAP(json_file_add_string), & + MAYBEWRAP(json_file_add_integer_vec), & +#ifndef REAL32 + MAYBEWRAP(json_file_add_real32_vec), & +#endif + MAYBEWRAP(json_file_add_real_vec), & +#ifdef REAL128 + MAYBEWRAP(json_file_add_real64_vec), & +#endif + MAYBEWRAP(json_file_add_logical_vec), & + MAYBEWRAP(json_file_add_string_vec) +#ifdef USE_UCS4 + generic,public :: add => json_file_add_string_path_ascii, & + json_file_add_string_value_ascii,& + json_file_add_string_vec_path_ascii,& + json_file_add_string_vec_vec_ascii +#endif + + !> + ! Update a scalar variable in a [[json_file(type)]], + ! by specifying the path. + ! + !@note These have been mostly supplanted by the `add` + ! methods, which do a similar thing (and can be used for + ! scalars and vectors, etc.) + generic,public :: update => MAYBEWRAP(json_file_update_integer), & + MAYBEWRAP(json_file_update_logical), & +#ifndef REAL32 + MAYBEWRAP(json_file_update_real32), & +#endif + MAYBEWRAP(json_file_update_real), & +#ifdef REAL128 + MAYBEWRAP(json_file_update_real64), & +#endif + MAYBEWRAP(json_file_update_string) +#ifdef USE_UCS4 + generic,public :: update => json_file_update_string_name_ascii, & + json_file_update_string_val_ascii +#endif + + !> + ! Remove a variable from a [[json_file(type)]] + ! by specifying the path. + generic,public :: remove => MAYBEWRAP(json_file_remove) + + !traverse + procedure,public :: traverse => json_file_traverse + + ! *************************************************** + ! operators + ! *************************************************** + + generic,public :: operator(.in.) => MAYBEWRAP(json_file_valid_path_op) + procedure,pass(me) :: MAYBEWRAP(json_file_valid_path_op) + + generic,public :: assignment(=) => assign_json_file,& + assign_json_file_to_string,& + MAYBEWRAP(assign_string_to_json_file) + procedure :: assign_json_file + procedure,pass(me) :: assign_json_file_to_string + procedure :: MAYBEWRAP(assign_string_to_json_file) + + ! *************************************************** + ! private routines + ! *************************************************** + + !load from string: + procedure :: MAYBEWRAP(json_file_load_from_string) + + !initialize + procedure :: initialize_json_core_in_file + procedure :: set_json_core_in_file + + !get info: + procedure :: MAYBEWRAP(json_file_variable_info) + procedure :: MAYBEWRAP(json_file_variable_matrix_info) + + !rename: + procedure :: MAYBEWRAP(json_file_rename) +#ifdef USE_UCS4 + procedure :: json_file_rename_path_ascii + procedure :: json_file_rename_name_ascii +#endif + + !validate path: + procedure :: MAYBEWRAP(json_file_valid_path) + + !get: + procedure :: MAYBEWRAP(json_file_get_object) + procedure :: MAYBEWRAP(json_file_get_integer) +#ifndef REAL32 + procedure :: MAYBEWRAP(json_file_get_real32) +#endif + procedure :: MAYBEWRAP(json_file_get_real) +#ifdef REAL128 + procedure :: MAYBEWRAP(json_file_get_real64) +#endif + procedure :: MAYBEWRAP(json_file_get_logical) + procedure :: MAYBEWRAP(json_file_get_string) + procedure :: MAYBEWRAP(json_file_get_integer_vec) +#ifndef REAL32 + procedure :: MAYBEWRAP(json_file_get_real32_vec) +#endif + procedure :: MAYBEWRAP(json_file_get_real_vec) +#ifdef REAL128 + procedure :: MAYBEWRAP(json_file_get_real64_vec) +#endif + procedure :: MAYBEWRAP(json_file_get_logical_vec) + procedure :: MAYBEWRAP(json_file_get_string_vec) + procedure :: MAYBEWRAP(json_file_get_alloc_string_vec) + procedure :: json_file_get_root + + !add: + procedure :: json_file_add + procedure :: MAYBEWRAP(json_file_add_object) + procedure :: MAYBEWRAP(json_file_add_integer) +#ifndef REAL32 + procedure :: MAYBEWRAP(json_file_add_real32) +#endif + procedure :: MAYBEWRAP(json_file_add_real) +#ifdef REAL128 + procedure :: MAYBEWRAP(json_file_add_real64) +#endif + procedure :: MAYBEWRAP(json_file_add_logical) + procedure :: MAYBEWRAP(json_file_add_string) + procedure :: MAYBEWRAP(json_file_add_integer_vec) +#ifndef REAL32 + procedure :: MAYBEWRAP(json_file_add_real32_vec) +#endif + procedure :: MAYBEWRAP(json_file_add_real_vec) +#ifdef REAL128 + procedure :: MAYBEWRAP(json_file_add_real64_vec) +#endif + procedure :: MAYBEWRAP(json_file_add_logical_vec) + procedure :: MAYBEWRAP(json_file_add_string_vec) +#ifdef USE_UCS4 + procedure :: json_file_add_string_path_ascii + procedure :: json_file_add_string_value_ascii + procedure :: json_file_add_string_vec_path_ascii + procedure :: json_file_add_string_vec_vec_ascii +#endif + + !update: + procedure :: MAYBEWRAP(json_file_update_integer) + procedure :: MAYBEWRAP(json_file_update_logical) +#ifndef REAL32 + procedure :: MAYBEWRAP(json_file_update_real32) +#endif + procedure :: MAYBEWRAP(json_file_update_real) +#ifdef REAL128 + procedure :: MAYBEWRAP(json_file_update_real64) +#endif + procedure :: MAYBEWRAP(json_file_update_string) +#ifdef USE_UCS4 + procedure :: json_file_update_string_name_ascii + procedure :: json_file_update_string_val_ascii +#endif + + !remove: + procedure :: MAYBEWRAP(json_file_remove) + + !print: + procedure :: json_file_print_to_console + procedure :: json_file_print_to_unit + procedure :: json_file_print_to_filename + + final :: finalize_json_file + + end type json_file + !********************************************************* + + !********************************************************* + !> author: Izaak Beekman + ! date: 07/23/2015 + ! + ! Structure constructor to initialize a [[json_file(type)]] + ! object with an existing [[json_value]] object or a JSON + ! string, and either the [[json_core(type)]] settings or a + ! [[json_core(type)]] instance. + ! + !### Example + ! + !```fortran + ! ... + ! type(json_file) :: my_file + ! type(json_value),pointer :: json_object + ! type(json_core) :: json_core_object + ! ... + ! ! Construct a json_object: + ! !could do this: + ! my_file = json_file(json_object) + ! !or: + ! my_file = json_file(json_object,verbose=.true.) + ! !or: + ! my_file = json_file('{"x": [1]}',verbose=.true.) + ! !or: + ! my_file = json_file(json_object,json_core_object) + ! !or: + ! my_file = json_file('{"x": [1]}',json_core_object) + !``` + interface json_file + module procedure initialize_json_file, & + initialize_json_file_v2, & + MAYBEWRAP(initialize_json_file_from_string), & + MAYBEWRAP(initialize_json_file_from_string_v2) + end interface + !************************************************************************************* + + contains +!***************************************************************************************** + +!***************************************************************************************** +!> +! Finalizer for [[json_file]] class. +! +! Just a wrapper for [[json_file_destroy]]. + + subroutine finalize_json_file(me) + + implicit none + + type(json_file),intent(inout) :: me + + call me%destroy(destroy_core=.true.) + + end subroutine finalize_json_file +!***************************************************************************************** + +!***************************************************************************************** +!> +! Check error status in the file. + + pure function json_file_failed(me) result(failed) + + implicit none + + class(json_file),intent(in) :: me + logical(LK) :: failed !! will be true if there has been an error. + + failed = me%core%failed() + + end function json_file_failed +!***************************************************************************************** + +!***************************************************************************************** +!> +! Retrieve error status and message from the class. + + subroutine json_file_check_for_errors(me,status_ok,error_msg) + + implicit none + + class(json_file),intent(inout) :: me + logical(LK),intent(out),optional :: status_ok !! true if there were no errors + character(kind=CK,len=:),allocatable,intent(out),optional :: error_msg !! the error message + !! (if there were errors) + +#if defined __GFORTRAN__ + character(kind=CK,len=:),allocatable :: tmp !! workaround for gfortran bugs + call me%core%check_for_errors(status_ok,tmp) + if (present(error_msg)) error_msg = tmp +#else + call me%core%check_for_errors(status_ok,error_msg) +#endif + + end subroutine json_file_check_for_errors +!***************************************************************************************** + +!***************************************************************************************** +!> +! Clear exceptions in the class. + + pure subroutine json_file_clear_exceptions(me) + + implicit none + + class(json_file),intent(inout) :: me + + call me%core%clear_exceptions() + + end subroutine json_file_clear_exceptions +!***************************************************************************************** + +!***************************************************************************************** +!> +! This is a wrapper for [[json_print_error_message]]. + + subroutine json_file_print_error_message(me,io_unit) + + implicit none + + class(json_file),intent(inout) :: me + integer, intent(in), optional :: io_unit + + call me%core%print_error_message(io_unit) + + end subroutine json_file_print_error_message +!***************************************************************************************** + +!***************************************************************************************** +!> +! Initialize the [[json_core(type)]] for this [[json_file]]. +! This is just a wrapper for [[json_initialize]]. +! +!@note This does not destroy the data in the file. +! +!@note [[initialize_json_core]], [[json_initialize]], +! [[initialize_json_core_in_file]], [[initialize_json_file]], +! [[initialize_json_file_v2]], [[initialize_json_file_from_string]], +! and [[initialize_json_file_from_string_v2]] +! all have a similar interface. + + subroutine initialize_json_core_in_file(me,& +#include "json_initialize_dummy_arguments.inc" + ) + + implicit none + + class(json_file),intent(inout) :: me +#include "json_initialize_arguments.inc" + + call me%core%initialize(& +#include "json_initialize_dummy_arguments.inc" + ) + end subroutine initialize_json_core_in_file +!***************************************************************************************** + +!***************************************************************************************** +!> +! Set the [[json_core(type)]] for this [[json_file]]. +! +!@note This does not destroy the data in the file. +! +!@note This one is used if you want to initialize the file with +! an already-existing [[json_core(type)]] (presumably, this was already +! initialized by a call to [[initialize_json_core]] or similar). + + subroutine set_json_core_in_file(me,core) + + implicit none + + class(json_file),intent(inout) :: me + type(json_core),intent(in) :: core + + me%core = core + + end subroutine set_json_core_in_file +!***************************************************************************************** + +!***************************************************************************************** +!> +! Get a copy of the [[json_core(type)]] in this [[json_file]]. + + subroutine get_json_core_in_file(me,core) + + implicit none + + class(json_file),intent(in) :: me + type(json_core),intent(out) :: core + + core = me%core + + end subroutine get_json_core_in_file +!***************************************************************************************** + +!***************************************************************************************** +!> author: Izaak Beekman +! date: 07/23/2015 +! +! Cast a [[json_value]] object as a [[json_file(type)]] object. +! It also calls the `initialize()` method. +! +!@note [[initialize_json_core]], [[json_initialize]], +! [[initialize_json_core_in_file]], [[initialize_json_file]], +! [[initialize_json_file_v2]], [[initialize_json_file_from_string]], +! and [[initialize_json_file_from_string_v2]] +! all have a similar interface. + + function initialize_json_file(p,& +#include "json_initialize_dummy_arguments.inc" + ) result(file_object) + + implicit none + + type(json_file) :: file_object + type(json_value),pointer,optional :: p !! `json_value` object to cast + !! as a `json_file` object. This + !! will be nullified. +#include "json_initialize_arguments.inc" + + call file_object%initialize(& +#include "json_initialize_dummy_arguments.inc" + ) + + if (present(p)) then + file_object%p => p + ! we have to nullify it to avoid + ! a dangling pointer when the file + ! goes out of scope + nullify(p) + end if + + end function initialize_json_file +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 4/26/2016 +! +! Cast a [[json_value]] pointer and a [[json_core(type)]] object +! as a [[json_file(type)]] object. + + function initialize_json_file_v2(json_value_object,json_core_object) & + result(file_object) + + implicit none + + type(json_file) :: file_object + type(json_value),pointer,intent(in) :: json_value_object + type(json_core),intent(in) :: json_core_object + + file_object%p => json_value_object + file_object%core = json_core_object + + end function initialize_json_file_v2 +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 01/19/2019 +! +! Cast a JSON string as a [[json_file(type)]] object. +! It also calls the `initialize()` method. +! +!### Example +! +!```fortran +! type(json_file) :: f +! f = json_file('{"key ": 1}', trailing_spaces_significant=.true.) +!``` +! +!@note [[initialize_json_core]], [[json_initialize]], +! [[initialize_json_core_in_file]], [[initialize_json_file]], +! [[initialize_json_file_v2]], [[initialize_json_file_from_string]], +! and [[initialize_json_file_from_string_v2]] +! all have a similar interface. + + function initialize_json_file_from_string(str,& +#include "json_initialize_dummy_arguments.inc" + ) result(file_object) + + implicit none + + type(json_file) :: file_object + character(kind=CK,len=*),intent(in) :: str !! string to load JSON data from +#include "json_initialize_arguments.inc" + + call file_object%initialize(& +#include "json_initialize_dummy_arguments.inc" + ) + call file_object%deserialize(str) + + end function initialize_json_file_from_string +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[initialize_json_file_from_string]], where "str" is kind=CDK. + + function wrap_initialize_json_file_from_string(str,& +#include "json_initialize_dummy_arguments.inc" + ) result(file_object) + + implicit none + + type(json_file) :: file_object + character(kind=CDK,len=*),intent(in) :: str !! string to load JSON data from +#include "json_initialize_arguments.inc" + + file_object = initialize_json_file_from_string(& + to_unicode(str),& +#include "json_initialize_dummy_arguments.inc" + ) + + end function wrap_initialize_json_file_from_string +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/19/2019 +! +! Cast a JSON string and a [[json_core(type)]] object +! as a [[json_file(type)]] object. + + function initialize_json_file_from_string_v2(str, json_core_object) & + result(file_object) + + implicit none + + type(json_file) :: file_object + character(kind=CK,len=*),intent(in) :: str !! string to load JSON data from + type(json_core),intent(in) :: json_core_object + + file_object%core = json_core_object + call file_object%deserialize(str) + + end function initialize_json_file_from_string_v2 +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[initialize_json_file_from_string_v2]], where "str" is kind=CDK. + + function wrap_initialize_json_file_from_string_v2(str,json_core_object) & + result(file_object) + + implicit none + + type(json_file) :: file_object + character(kind=CDK,len=*),intent(in) :: str !! string to load JSON data from + type(json_core),intent(in) :: json_core_object + + file_object = initialize_json_file_from_string_v2(to_unicode(str),json_core_object) + + end function wrap_initialize_json_file_from_string_v2 +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Nullify the [[json_value]] pointer in a [[json_file(type)]], +! but do not destroy it. +! +! This should normally only be done if the pointer is the target of +! another pointer outside the class that is still intended to be in +! scope after the [[json_file(type)]] has gone out of scope. +! Otherwise, this would result in a memory leak. +! +!### See also +! * [[json_file_destroy]] +! +!### History +! * 6/30/2019 : Created + + subroutine json_file_nullify(me) + + implicit none + + class(json_file),intent(inout) :: me + + nullify(me%p) + + end subroutine json_file_nullify +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Destroy the [[json_value]] data in a [[json_file(type)]]. +! This may be done when the variable is no longer needed, +! or will be reused to open a different file. +! Otherwise a memory leak will occur. +! +! Optionally, also destroy the [[json_core(type)]] instance (this +! is not necessary to prevent memory leaks, since a [[json_core(type)]] +! does not use pointers). +! +!### See also +! * [[json_file_nullify]] +! +!### History +! * 12/9/2013 : Created +! * 4/26/2016 : Added optional `destroy_core` argument +! +!@note This routine will be called automatically when the variable +! goes out of scope. + + subroutine json_file_destroy(me,destroy_core) + + implicit none + + class(json_file),intent(inout) :: me + logical,intent(in),optional :: destroy_core !! to also destroy the [[json_core(type)]]. + !! default is to leave it as is. + + if (associated(me%p)) call me%core%destroy(me%p) + + if (present(destroy_core)) then + if (destroy_core) call me%core%destroy() + end if + + end subroutine json_file_destroy +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/5/2014 +! +! Move the [[json_value]] pointer from one [[json_file(type)]] to another. +! The "from" pointer is then nullified, but not destroyed. +! +!@note If "from%p" is not associated, then an error is thrown. + + subroutine json_file_move_pointer(to,from) + + implicit none + + class(json_file),intent(inout) :: to + class(json_file),intent(inout) :: from + + if (associated(from%p)) then + + if (from%failed()) then + !Don't get the data if the FROM file has an + !active exception, since it may not be valid. + call to%core%throw_exception('Error in json_file_move_pointer: '//& + 'error exception in FROM file.') + else + call to%initialize() !initialize and clear any exceptions that may be present + to%p => from%p + nullify(from%p) + end if + + else + call to%core%throw_exception('Error in json_file_move_pointer: '//& + 'pointer is not associated.') + end if + + end subroutine json_file_move_pointer +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/9/2013 +! +! Load the JSON data from a file. +! +!### Example +! +!```fortran +! program main +! use json_module +! implicit none +! type(json_file) :: f +! call f%load('my_file.json') +! !... +! call f%destroy() +! end program main +!``` + + subroutine json_file_load(me, filename, unit) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: filename !! the filename to open + integer(IK),intent(in),optional :: unit !! the unit number to use + !! (if not present, a newunit + !! is used) + + call me%core%load(file=filename, p=me%p, unit=unit) + + end subroutine json_file_load +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/13/2015 +! +! Load the JSON data from a string. +! +!### Example +! +! Load JSON from a string: +!```fortran +! type(json_file) :: f +! call f%deserialize('{ "name": "Leonidas" }') +!``` + + subroutine json_file_load_from_string(me, str) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: str !! string to load JSON data from + + call me%core%deserialize(me%p, str) + + end subroutine json_file_load_from_string +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_load_from_string]], where "str" is kind=CDK. + + subroutine wrap_json_file_load_from_string(me, str) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: str + + call me%deserialize(to_unicode(str)) + + end subroutine wrap_json_file_load_from_string +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/11/2015 +! +! Print the JSON file to the console. + + subroutine json_file_print_to_console(me) + + implicit none + + class(json_file),intent(inout) :: me + + call me%core%print(me%p,iunit=int(output_unit,IK)) + + end subroutine json_file_print_to_console +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/9/2013 +! +! Prints the JSON file to the specified file unit number. + + subroutine json_file_print_to_unit(me, iunit) + + implicit none + + class(json_file),intent(inout) :: me + integer(IK),intent(in) :: iunit !! file unit number (must not be -1) + + if (iunit/=unit2str) then + call me%core%print(me%p,iunit=iunit) + else + call me%core%throw_exception('Error in json_file_print_to_unit: iunit must not be -1.') + end if + + end subroutine json_file_print_to_unit +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/11/2015 +! +! Print the JSON structure to the specified filename. +! The file is opened, printed, and then closed. +! +!### Example +! Example loading a JSON file, changing a value, and then printing +! result to a new file: +!```fortran +! type(json_file) :: f +! logical :: found +! call f%load('my_file.json') !open the original file +! call f%update('version',4,found) !change the value of a variable +! call f%print('my_file_2.json') !save file as new name +!``` + + subroutine json_file_print_to_filename(me,filename) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: filename !! filename to print to + + call me%core%print(me%p,filename) + + end subroutine json_file_print_to_filename +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/11/2015 +! +! Print the JSON file to a string. +! +!### Example +! +! Open a JSON file, and then print the contents to a string: +!```fortran +! type(json_file) :: f +! character(kind=CK,len=:),allocatable :: str +! call f%load('my_file.json') +! call f%serialize(str) +!``` + + subroutine json_file_print_to_string(me,str) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=:),allocatable,intent(out) :: str !! string to print JSON data to + + call me%core%serialize(me%p,str) + + end subroutine json_file_print_to_string +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 2/3/2014 +! +! Returns information about a variable in a [[json_file(type)]]. +! +!@note If `found` is present, no exceptions will be thrown if an +! error occurs. Otherwise, an exception will be thrown if the +! variable is not found. + + subroutine json_file_variable_info(me,path,found,var_type,n_children,name) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! path to the variable + logical(LK),intent(out),optional :: found !! the variable exists in the structure + integer(IK),intent(out),optional :: var_type !! variable type + integer(IK),intent(out),optional :: n_children !! number of children + character(kind=CK,len=:),allocatable,intent(out),optional :: name !! variable name + + call me%core%info(me%p,path,found,var_type,n_children,name) + + end subroutine json_file_variable_info +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_variable_info]], where "path" is kind=CDK. +! +!@note If `found` is present, no exceptions will be thrown if an +! error occurs. Otherwise, an exception will be thrown if the +! variable is not found. + + subroutine wrap_json_file_variable_info(me,path,found,var_type,n_children,name) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path + logical(LK),intent(out),optional :: found + integer(IK),intent(out),optional :: var_type + integer(IK),intent(out),optional :: n_children + character(kind=CK,len=:),allocatable,intent(out),optional :: name !! variable name + + call me%info(to_unicode(path),found,var_type,n_children,name) + + end subroutine wrap_json_file_variable_info +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 6/26/2016 +! +! Returns matrix information about a variable in a [[json_file(type)]]. +! +!@note If `found` is present, no exceptions will be thrown if an +! error occurs. Otherwise, an exception will be thrown if the +! variable is not found. + + subroutine json_file_variable_matrix_info(me,path,is_matrix,found,& + var_type,n_sets,set_size,name) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! path to the variable + logical(LK),intent(out) :: is_matrix !! true if it is a valid matrix + logical(LK),intent(out),optional :: found !! true if it was found + integer(IK),intent(out),optional :: var_type !! variable type of data in + !! the matrix (if all elements have + !! the same type) + integer(IK),intent(out),optional :: n_sets !! number of data sets (i.e., matrix + !! rows if using row-major order) + integer(IK),intent(out),optional :: set_size !! size of each data set (i.e., matrix + !! cols if using row-major order) + character(kind=CK,len=:),allocatable,intent(out),optional :: name !! variable name + + call me%core%matrix_info(me%p,path,is_matrix,found,var_type,n_sets,set_size,name) + + end subroutine json_file_variable_matrix_info +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_variable_matrix_info]], where "path" is kind=CDK. +! +!@note If `found` is present, no exceptions will be thrown if an +! error occurs. Otherwise, an exception will be thrown if the +! variable is not found. + + subroutine wrap_json_file_variable_matrix_info(me,path,is_matrix,found,& + var_type,n_sets,set_size,name) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! path to the variable + logical(LK),intent(out) :: is_matrix !! true if it is a valid matrix + logical(LK),intent(out),optional :: found !! true if it was found + integer(IK),intent(out),optional :: var_type !! variable type of data in + !! the matrix (if all elements have + !! the same type) + integer(IK),intent(out),optional :: n_sets !! number of data sets (i.e., matrix + !! rows if using row-major order) + integer(IK),intent(out),optional :: set_size !! size of each data set (i.e., matrix + !! cols if using row-major order) + character(kind=CK,len=:),allocatable,intent(out),optional :: name !! variable name + + call me%matrix_info(to_unicode(path),is_matrix,found,var_type,n_sets,set_size,name) + + end subroutine wrap_json_file_variable_matrix_info +!***************************************************************************************** + +!***************************************************************************************** +!> author: Izaak Beekman +! date: 7/23/2015 +! +! Get a [[json_value]] pointer to the JSON file root. +! +!@note This is equivalent to calling ```[[json_file]]%get('$',p)``` + + subroutine json_file_get_root(me,p) + + implicit none + + class(json_file),intent(inout) :: me + type(json_value),pointer,intent(out) :: p !! pointer to the variable + + p => me%p + + end subroutine json_file_get_root +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Assignment operator for [[json_core(type)]] = [[json_core(type)]]. +! This will duplicate the [[json_core(type)]] and also +! perform a deep copy of the [[json_value(type)]] data structure. + + subroutine assign_json_file(me,f) + + implicit none + + class(json_file),intent(out) :: me + type(json_file),intent(in) :: f + + me%core = f%core ! no pointers here so OK to copy + call me%core%clone(f%p,me%p) + + end subroutine assign_json_file +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Assignment operator for character = [[json_core(type)]]. +! This is just a wrapper for the [[json_value_to_string]] routine. +! +!### Note +! * If an exception is raised or the file contains no data, +! this will return an empty string. + + subroutine assign_json_file_to_string(str,me) + + implicit none + + character(kind=CK,len=:),allocatable,intent(out) :: str + class(json_file),intent(in) :: me + + type(json_core) :: core_copy !! a copy of `core` from `me` + + if (me%core%failed() .or. .not. associated(me%p)) then + str = CK_'' + else + + ! This is sort of a hack. Since `me` has to have `intent(in)` + ! for the assignment to work, we need to make a copy of `me%core` + ! so we can call the low level routine (since it needs it to + ! be `intent(inout)`) because it's possible for this + ! function to raise an exception. + + core_copy = me%core ! copy the parser settings + + call core_copy%serialize(me%p,str) + if (me%core%failed()) str = CK_'' + + end if + + end subroutine assign_json_file_to_string +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Assignment operator for [[json_core(type)]] = character. +! This is just a wrapper for the [[json_file_load_from_string]] routine. + + subroutine assign_string_to_json_file(me,str) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: str + + if (associated(me%p)) call me%destroy() + if (me%core%failed()) call me%core%clear_exceptions() + call me%deserialize(str) + + end subroutine assign_string_to_json_file +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[assign_string_to_json_file]], where "str" is kind=CDK. + + subroutine wrap_assign_string_to_json_file(me,str) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: str + + call me%assign_string_to_json_file(to_unicode(str)) + + end subroutine wrap_assign_string_to_json_file +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! A wrapper for [[json_file_valid_path]] for the `.in.` operator + + function json_file_valid_path_op(path,me) result(found) + + implicit none + + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + class(json_file),intent(in) :: me !! the JSON file + logical(LK) :: found !! if the variable was found + + type(json_core) :: core_copy !! a copy of `core` from `me` + + ! This is sort of a hack. Since `me` has to have `intent(in)` + ! for the operator to work, we need to make a copy of `me%core` + ! so we can call the low level routine (since it needs it to + ! be `intent(inout)`) because it's technically possible for this + ! function to raise an exception. This normally should never + ! happen here unless the JSON structure is malformed. + + core_copy = me%core ! copy the settings (need them to know + ! how to interpret the path) + + found = core_copy%valid_path(me%p, path) ! call the low-level routine + + call core_copy%destroy() ! just in case (but not really necessary) + + end function json_file_valid_path_op +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_valid_path_op]], where "path" is kind=CDK. + + function wrap_json_file_valid_path_op(path,me) result(found) + + implicit none + + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + class(json_file),intent(in) :: me !! the JSON file + logical(LK) :: found !! if the variable was found + + found = to_unicode(path) .in. me + + end function wrap_json_file_valid_path_op +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Returns true if the `path` is present in the JSON file. + + function json_file_valid_path(me,path) result(found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + logical(LK) :: found !! if the variable was found + + found = me%core%valid_path(me%p, path) + + end function json_file_valid_path +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_valid_path]], where "path" is kind=CDK. + + function wrap_json_file_valid_path(me,path) result(found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + logical(LK) :: found !! if the variable was found + + found = me%valid_path(to_unicode(path)) + + end function wrap_json_file_valid_path +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Rename a variable in a JSON file. + + subroutine json_file_rename(me,path,name,found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + character(kind=CK,len=*),intent(in) :: name !! the new name + logical(LK),intent(out),optional :: found !! if the variable was found + + call me%core%rename(me%p, path, name, found) + + end subroutine json_file_rename +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_rename]], where "path" and "name" are kind=CDK. + + subroutine wrap_json_file_rename(me,path,name,found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + character(kind=CDK,len=*),intent(in) :: name !! the new name + logical(LK),intent(out),optional :: found !! if the variable was found + + call me%json_file_rename(to_unicode(path),to_unicode(name),found) + + end subroutine wrap_json_file_rename +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Wrapper for [[json_file_rename]] where "path" is kind=CDK). + + subroutine json_file_rename_path_ascii(me,path,name,found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + character(kind=CK,len=*),intent(in) :: name !! the new name + logical(LK),intent(out),optional :: found !! if the variable was found + + call me%json_file_rename(to_unicode(path),name,found) + + end subroutine json_file_rename_path_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Wrapper for [[json_file_rename]] where "name" is kind=CDK). + + subroutine json_file_rename_name_ascii(me,path,name,found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + character(kind=CDK,len=*),intent(in) :: name !! the new name + logical(LK),intent(out),optional :: found !! if the variable was found + + call me%json_file_rename(path,to_unicode(name),found) + + end subroutine json_file_rename_name_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 2/3/2014 +! +! Get a [[json_value]] pointer to an object from a JSON file. + + subroutine json_file_get_object(me, path, p, found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + type(json_value),pointer,intent(out) :: p !! pointer to the variable + logical(LK),intent(out),optional :: found !! if it was really found + + call me%core%get(me%p, path, p, found) + + end subroutine json_file_get_object +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_get_object]], where "path" is kind=CDK. + + subroutine wrap_json_file_get_object(me, path, p, found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + type(json_value),pointer,intent(out) :: p !! pointer to the variable + logical(LK),intent(out),optional :: found !! if it was really found + + call me%get(to_unicode(path), p, found) + + end subroutine wrap_json_file_get_object +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/9/2013 +! +! Get an integer value from a JSON file. + + subroutine json_file_get_integer(me, path, val, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + integer(IK),intent(out) :: val !! value + logical(LK),intent(out),optional :: found !! if it was really found + integer(IK),intent(in),optional :: default + + call me%core%get(me%p, path, val, found, default) + + end subroutine json_file_get_integer +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_get_integer]], where "path" is kind=CDK. + + subroutine wrap_json_file_get_integer(me, path, val, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + integer(IK),intent(out) :: val !! value + logical(LK),intent(out),optional :: found !! if it was really found + integer(IK),intent(in),optional :: default + + call me%get(to_unicode(path), val, found, default) + + end subroutine wrap_json_file_get_integer +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/20/2014 +! +! Get an integer vector from a JSON file. + + subroutine json_file_get_integer_vec(me, path, vec, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + integer(IK),dimension(:),allocatable,intent(out) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if it was really found + integer(IK),dimension(:),intent(in),optional :: default + + call me%core%get(me%p, path, vec, found, default) + + end subroutine json_file_get_integer_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_get_integer_vec]], where "path" is kind=CDK. + + subroutine wrap_json_file_get_integer_vec(me, path, vec, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + integer(IK),dimension(:),allocatable,intent(out) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if it was really found + integer(IK),dimension(:),intent(in),optional :: default + + call me%get(to_unicode(path), vec, found, default) + + end subroutine wrap_json_file_get_integer_vec +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/9/2013 +! +! Get a real(RK) variable value from a JSON file. + + subroutine json_file_get_real (me, path, val, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(RK),intent(out) :: val !! value + logical(LK),intent(out),optional :: found !! if it was really found + real(RK),intent(in),optional :: default + + call me%core%get(me%p, path, val, found, default) + + end subroutine json_file_get_real +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_get_real]], where "path" is kind=CDK. + + subroutine wrap_json_file_get_real (me, path, val, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(RK),intent(out) :: val !! value + logical(LK),intent(out),optional :: found !! if it was really found + real(RK),intent(in),optional :: default + + call me%get(to_unicode(path), val, found, default) + + end subroutine wrap_json_file_get_real +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/19/2014 +! +! Get a real(RK) vector from a JSON file. + + subroutine json_file_get_real_vec(me, path, vec, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(RK),dimension(:),allocatable,intent(out) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if it was really found + real(RK),dimension(:),intent(in),optional :: default + + call me%core%get(me%p, path, vec, found, default) + + end subroutine json_file_get_real_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_get_real_vec]], where "path" is kind=CDK. + + subroutine wrap_json_file_get_real_vec(me, path, vec, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(RK),dimension(:),allocatable,intent(out) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if it was really found + real(RK),dimension(:),intent(in),optional :: default + + call me%get(to_unicode(path), vec, found, default) + + end subroutine wrap_json_file_get_real_vec +!***************************************************************************************** + +#ifndef REAL32 +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/21/2019 +! +! Alternate version of [[json_file_get_real]] where `val` is `real32`. + + subroutine json_file_get_real32 (me, path, val, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(real32),intent(out) :: val !! value + logical(LK),intent(out),optional :: found !! if it was really found + real(real32),intent(in),optional :: default + + call me%core%get(me%p, path, val, found, default) + + end subroutine json_file_get_real32 +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_get_real32]], where "path" is kind=CDK. + + subroutine wrap_json_file_get_real32 (me, path, val, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(real32),intent(out) :: val !! value + logical(LK),intent(out),optional :: found !! if it was really found + real(real32),intent(in),optional :: default + + call me%get(to_unicode(path), val, found, default) + + end subroutine wrap_json_file_get_real32 +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/21/2019 +! +! Alternate version of [[json_file_get_real_vec]] where `vec` is `real32`. + + subroutine json_file_get_real32_vec(me, path, vec, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(real32),dimension(:),allocatable,intent(out) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if it was really found + real(real32),dimension(:),intent(in),optional :: default + + call me%core%get(me%p, path, vec, found, default) + + end subroutine json_file_get_real32_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_get_real32_vec]], where "path" is kind=CDK. + + subroutine wrap_json_file_get_real32_vec(me, path, vec, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(real32),dimension(:),allocatable,intent(out) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if it was really found + real(real32),dimension(:),intent(in),optional :: default + + call me%get(to_unicode(path), vec, found, default) + + end subroutine wrap_json_file_get_real32_vec +!***************************************************************************************** +#endif + +#ifdef REAL128 +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/21/2019 +! +! Alternate version of [[json_file_get_real]] where `val` is `real64`. + + subroutine json_file_get_real64 (me, path, val, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(real64),intent(out) :: val !! value + logical(LK),intent(out),optional :: found !! if it was really found + real(real64),intent(in),optional :: default + + call me%core%get(me%p, path, val, found, default) + + end subroutine json_file_get_real64 +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_get_real64]], where "path" is kind=CDK. + + subroutine wrap_json_file_get_real64 (me, path, val, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(real64),intent(out) :: val !! value + logical(LK),intent(out),optional :: found !! if it was really found + real(real64),intent(in),optional :: default + + call me%get(to_unicode(path), val, found, default) + + end subroutine wrap_json_file_get_real64 +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/21/2019 +! +! Alternate version of [[json_file_get_real_vec]] where `vec` is `real64`. + + subroutine json_file_get_real64_vec(me, path, vec, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(real64),dimension(:),allocatable,intent(out) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if it was really found + real(real64),dimension(:),intent(in),optional :: default + + call me%core%get(me%p, path, vec, found, default) + + end subroutine json_file_get_real64_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_get_real64_vec]], where "path" is kind=CDK. + + subroutine wrap_json_file_get_real64_vec(me, path, vec, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(real64),dimension(:),allocatable,intent(out) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if it was really found + real(real64),dimension(:),intent(in),optional :: default + + call me%get(to_unicode(path), vec, found, default) + + end subroutine wrap_json_file_get_real64_vec +!***************************************************************************************** +#endif + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/9/2013 +! +! Get a logical(LK) value from a JSON file. + + subroutine json_file_get_logical(me,path,val,found,default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + logical(LK),intent(out) :: val !! value + logical(LK),intent(out),optional :: found !! if it was really found + logical(LK),intent(in),optional :: default + + call me%core%get(me%p, path, val, found, default) + + end subroutine json_file_get_logical +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_get_logical]], where "path" is kind=CDK. + + subroutine wrap_json_file_get_logical(me,path,val,found,default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + logical(LK),intent(out) :: val !! value + logical(LK),intent(out),optional :: found !! if it was really found + logical(LK),intent(in),optional :: default + + call me%get(to_unicode(path), val, found, default) + + end subroutine wrap_json_file_get_logical +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/20/2014 +! +! Get a logical(LK) vector from a JSON file. + + subroutine json_file_get_logical_vec(me, path, vec, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + logical(LK),dimension(:),allocatable,intent(out) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if it was really found + logical(LK),dimension(:),intent(in),optional :: default + + call me%core%get(me%p, path, vec, found, default) + + end subroutine json_file_get_logical_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_get_logical_vec]], where "path" is kind=CDK. + + subroutine wrap_json_file_get_logical_vec(me, path, vec, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + logical(LK),dimension(:),allocatable,intent(out) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if it was really found + logical(LK),dimension(:),intent(in),optional :: default + + call me%get(to_unicode(path), vec, found, default) + + end subroutine wrap_json_file_get_logical_vec +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/9/2013 +! +! Get a character string from a json file. +! The output val is an allocatable character string. + + subroutine json_file_get_string(me, path, val, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + character(kind=CK,len=:),allocatable,intent(out) :: val !! value + logical(LK),intent(out),optional :: found !! if it was really found + character(kind=CK,len=*),intent(in),optional :: default + + call me%core%get(me%p, path, val, found, default) + + end subroutine json_file_get_string +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_get_string]], where "path" is kind=CDK. + + subroutine wrap_json_file_get_string(me, path, val, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + character(kind=CK,len=:),allocatable,intent(out) :: val !! value + logical(LK),intent(out),optional :: found !! if it was really found + character(kind=CK,len=*),intent(in),optional :: default + + call me%get(to_unicode(path), val, found, default) + + end subroutine wrap_json_file_get_string +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/19/2014 +! +! Get a string vector from a JSON file. + + subroutine json_file_get_string_vec(me, path, vec, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + character(kind=CK,len=*),dimension(:),allocatable,intent(out) :: vec !! value vector + logical(LK),intent(out),optional :: found !! if it was really found + character(kind=CK,len=*),dimension(:),intent(in),optional :: default + + call me%core%get(me%p, path, vec, found, default) + + end subroutine json_file_get_string_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_get_string_vec]], where "path" is kind=CDK. + + subroutine wrap_json_file_get_string_vec(me, path, vec, found, default) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + character(kind=CK,len=*),dimension(:),allocatable,intent(out) :: vec !! value vector + logical(LK),intent(out),optional :: found !! if it was really found + character(kind=CK,len=*),dimension(:),intent(in),optional :: default + + call me%get(to_unicode(path), vec, found, default) + + end subroutine wrap_json_file_get_string_vec +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/17/2016 +! +! Get an (allocatable length) string vector from a JSON file. +! This is just a wrapper for [[json_get_alloc_string_vec_by_path]]. + + subroutine json_file_get_alloc_string_vec(me, path, vec, ilen, found, default, default_ilen) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + character(kind=CK,len=:),dimension(:),allocatable,intent(out) :: vec !! value vector + integer(IK),dimension(:),allocatable,intent(out) :: ilen !! the actual length + !! of each character + !! string in the array + logical(LK),intent(out),optional :: found + character(kind=CK,len=*),dimension(:),intent(in),optional :: default + integer(IK),dimension(:),intent(in),optional :: default_ilen !! the actual + !! length of `default` + + call me%core%get(me%p, path, vec, ilen, found, default, default_ilen) + + end subroutine json_file_get_alloc_string_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_get_alloc_string_vec]], where "path" is kind=CDK. +! This is just a wrapper for [[wrap_json_get_alloc_string_vec_by_path]]. + + subroutine wrap_json_file_get_alloc_string_vec(me, path, vec, ilen, found, default, default_ilen) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + character(kind=CK,len=:),dimension(:),allocatable,intent(out) :: vec !! value vector + integer(IK),dimension(:),allocatable,intent(out) :: ilen !! the actual length + !! of each character + !! string in the array + logical(LK),intent(out),optional :: found + character(kind=CK,len=*),dimension(:),intent(in),optional :: default + integer(IK),dimension(:),intent(in),optional :: default_ilen !! the actual + !! length of `default` + + call me%get(to_unicode(path), vec, ilen, found, default, default_ilen) + + end subroutine wrap_json_file_get_alloc_string_vec +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Add a [[json_value]] pointer as the root object to a JSON file. +! +!### Note +! +! This is mostly equivalent to: +!```fortran +! f = [[json_file]](p) +!``` +! But without the finalization calls. +! +! And: +!```fortran +! if (destroy_original) call [[json_file]]%destroy() +! call [[json_file]]%add('$',p) +!``` + + subroutine json_file_add(me,p,destroy_original) + + implicit none + + class(json_file),intent(inout) :: me + type(json_value),pointer,intent(in) :: p !! pointer to the variable to add + logical(LK),intent(in),optional :: destroy_original !! if the file currently contains + !! an associated pointer, it is + !! destroyed. [Default is True] + + logical(LK) :: destroy !! if `me%p` is to be destroyed + + if (present(destroy_original)) then + destroy = destroy_original + else + destroy = .true. ! default + end if + + if (destroy) call me%core%destroy(me%p) + + me%p => p + + end subroutine json_file_add +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Add a [[json_value]] pointer to an object to a JSON file. + + subroutine json_file_add_object(me,path,p,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + type(json_value),pointer,intent(in) :: p !! pointer to the variable to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + if (.not. associated(me%p)) call me%core%create_object(me%p,ck_'') ! create root + + call me%core%add_by_path(me%p,path,p,found,was_created) + + end subroutine json_file_add_object +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_object]], where "path" is kind=CDK. + + subroutine wrap_json_file_add_object(me,path,p,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + type(json_value),pointer,intent(in) :: p !! pointer to the variable to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call me%json_file_add_object(to_unicode(path),p,found,was_created) + + end subroutine wrap_json_file_add_object +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Add an integer value to a JSON file. + + subroutine json_file_add_integer(me,path,val,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + integer(IK),intent(in) :: val !! value + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + if (.not. associated(me%p)) call me%core%create_object(me%p,ck_'') ! create root + + call me%core%add_by_path(me%p,path,val,found,was_created) + + end subroutine json_file_add_integer +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_integer]], where "path" is kind=CDK. + + subroutine wrap_json_file_add_integer(me,path,val,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + integer(IK),intent(in) :: val !! value + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call me%json_file_add_integer(to_unicode(path),val,found,was_created) + + end subroutine wrap_json_file_add_integer +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Add an integer vector to a JSON file. + + subroutine json_file_add_integer_vec(me,path,vec,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + integer(IK),dimension(:),intent(in) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + if (.not. associated(me%p)) call me%core%create_object(me%p,ck_'') ! create root + + call me%core%add_by_path(me%p,path,vec,found,was_created) + + end subroutine json_file_add_integer_vec +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_integer_vec]], where "path" is kind=CDK. + + subroutine wrap_json_file_add_integer_vec(me,path,vec,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + integer(IK),dimension(:),intent(in) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call me%json_file_add_integer_vec(to_unicode(path),vec,found,was_created) + + end subroutine wrap_json_file_add_integer_vec +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Add a real(RK) variable value to a JSON file. + + subroutine json_file_add_real(me,path,val,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(RK),intent(in) :: val !! value + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + if (.not. associated(me%p)) call me%core%create_object(me%p,ck_'') ! create root + + call me%core%add_by_path(me%p,path,val,found,was_created) + + end subroutine json_file_add_real +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_real]], where "path" is kind=CDK. + + subroutine wrap_json_file_add_real(me,path,val,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(RK),intent(in) :: val !! value + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call me%json_file_add_real(to_unicode(path),val,found,was_created) + + end subroutine wrap_json_file_add_real +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Add a real(RK) vector to a JSON file. + + subroutine json_file_add_real_vec(me,path,vec,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(RK),dimension(:),intent(in) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + if (.not. associated(me%p)) call me%core%create_object(me%p,ck_'') ! create root + + call me%core%add_by_path(me%p,path,vec,found,was_created) + + end subroutine json_file_add_real_vec +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_real_vec]], where "path" is kind=CDK. + + subroutine wrap_json_file_add_real_vec(me,path,vec,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(RK),dimension(:),intent(in) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call me%json_file_add_real_vec(to_unicode(path),vec,found,was_created) + + end subroutine wrap_json_file_add_real_vec +!***************************************************************************************** + +#ifndef REAL32 +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_real]] where `val` is `real32`. + + subroutine json_file_add_real32(me,path,val,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(real32),intent(in) :: val !! value + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call me%core%add_by_path(me%p,path,val,found,was_created) + + end subroutine json_file_add_real32 +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_real32]], where "path" is kind=CDK. + + subroutine wrap_json_file_add_real32(me,path,val,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(real32),intent(in) :: val !! value + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call me%json_file_add_real32(to_unicode(path),val,found,was_created) + + end subroutine wrap_json_file_add_real32 +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_real_vec]] where `vec` is `real32`. + + subroutine json_file_add_real32_vec(me,path,vec,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(real32),dimension(:),intent(in) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call me%core%add_by_path(me%p,path,vec,found,was_created) + + end subroutine json_file_add_real32_vec +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_real32_vec]], where "path" is kind=CDK. + + subroutine wrap_json_file_add_real32_vec(me,path,vec,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(real32),dimension(:),intent(in) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call me%json_file_add_real32_vec(to_unicode(path),vec,found,was_created) + + end subroutine wrap_json_file_add_real32_vec +!***************************************************************************************** +#endif + +#ifdef REAL128 +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_real]] where `val` is `real64`. + + subroutine json_file_add_real64(me,path,val,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(real64),intent(in) :: val !! value + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call me%core%add_by_path(me%p,path,val,found,was_created) + + end subroutine json_file_add_real64 +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_real64]], where "path" is kind=CDK. + + subroutine wrap_json_file_add_real64(me,path,val,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(real64),intent(in) :: val !! value + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call me%json_file_add_real64(to_unicode(path),val,found,was_created) + + end subroutine wrap_json_file_add_real64 +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_real_vec]] where `vec` is `real64`. + + subroutine json_file_add_real64_vec(me,path,vec,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(real64),dimension(:),intent(in) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call me%core%add_by_path(me%p,path,vec,found,was_created) + + end subroutine json_file_add_real64_vec +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_real64_vec]], where "path" is kind=CDK. + + subroutine wrap_json_file_add_real64_vec(me,path,vec,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(real64),dimension(:),intent(in) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call me%json_file_add_real64_vec(to_unicode(path),vec,found,was_created) + + end subroutine wrap_json_file_add_real64_vec +!***************************************************************************************** +#endif + +!***************************************************************************************** +!> author: Jacob Williams +! +! Add a logical(LK) value to a JSON file. + + subroutine json_file_add_logical(me,path,val,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + logical(LK),intent(in) :: val !! value + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + if (.not. associated(me%p)) call me%core%create_object(me%p,ck_'') ! create root + + call me%core%add_by_path(me%p,path,val,found,was_created) + + end subroutine json_file_add_logical +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_logical]], where "path" is kind=CDK. + + subroutine wrap_json_file_add_logical(me,path,val,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + logical(LK),intent(in) :: val !! value + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call me%json_file_add_logical(to_unicode(path),val,found,was_created) + + end subroutine wrap_json_file_add_logical +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Add a logical(LK) vector to a JSON file. + + subroutine json_file_add_logical_vec(me,path,vec,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + logical(LK),dimension(:),intent(in) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + if (.not. associated(me%p)) call me%core%create_object(me%p,ck_'') ! create root + + call me%core%add_by_path(me%p,path,vec,found,was_created) + + end subroutine json_file_add_logical_vec +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_logical_vec]], where "path" is kind=CDK. + + subroutine wrap_json_file_add_logical_vec(me,path,vec,found,was_created) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + logical(LK),dimension(:),intent(in) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call me%json_file_add_logical_vec(to_unicode(path),vec,found,was_created) + + end subroutine wrap_json_file_add_logical_vec +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Add a character string to a json file. + + subroutine json_file_add_string(me,path,val,found,was_created,trim_str,adjustl_str) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + character(kind=CK,len=*),intent(in) :: val !! value + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + !! (note that ADJUSTL is done before TRIM) + + if (.not. associated(me%p)) call me%core%create_object(me%p,ck_'') ! create root + + call me%core%add_by_path(me%p,path,val,found,was_created,trim_str,adjustl_str) + + end subroutine json_file_add_string +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_string]], where "path" and "val" are kind=CDK. + + subroutine wrap_json_file_add_string(me,path,val,found,was_created,trim_str,adjustl_str) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + character(kind=CDK,len=*),intent(in) :: val !! value + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + !! (note that ADJUSTL is done before TRIM) + + call me%json_file_add_string(to_unicode(path),to_unicode(val),found,& + was_created,trim_str,adjustl_str) + + end subroutine wrap_json_file_add_string +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Wrapper for [[json_file_add_string]] where "path" is kind=CDK). + + subroutine json_file_add_string_path_ascii(me,path,val,found,& + was_created,trim_str,adjustl_str) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + character(kind=CK,len=*),intent(in) :: val !! value + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + !! (note that ADJUSTL is done before TRIM) + + if (.not. associated(me%p)) call me%core%create_object(me%p,ck_'') ! create root + + call me%json_file_add_string(to_unicode(path),val,found,& + was_created,trim_str,adjustl_str) + + end subroutine json_file_add_string_path_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Wrapper for [[json_file_add_string]] where "val" is kind=CDK). + + subroutine json_file_add_string_value_ascii(me,path,val,found,& + was_created,trim_str,adjustl_str) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + character(kind=CDK,len=*),intent(in) :: val !! value + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + !! (note that ADJUSTL is done before TRIM) + + if (.not. associated(me%p)) call me%core%create_object(me%p,ck_'') ! create root + + call me%json_file_add_string(path,to_unicode(val),found,& + was_created,trim_str,adjustl_str) + + end subroutine json_file_add_string_value_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Add a string vector to a JSON file. + + subroutine json_file_add_string_vec(me,path,vec,found,& + was_created,ilen,trim_str,adjustl_str) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + character(kind=CK,len=*),dimension(:),intent(in) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + integer(IK),dimension(:),intent(in),optional :: ilen !! the string lengths of each + !! element in `value`. If not present, + !! the full `len(value)` string is added + !! for each element. + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for each element + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for each element + !! (note that ADJUSTL is done before TRIM) + + if (.not. associated(me%p)) call me%core%create_object(me%p,ck_'') ! create root + + call me%core%add_by_path(me%p,path,vec,found,was_created,ilen,trim_str,adjustl_str) + + end subroutine json_file_add_string_vec +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_string_vec]], where "path" and "vec" are kind=CDK. + + subroutine wrap_json_file_add_string_vec(me,path,vec,found,& + was_created,ilen,trim_str,adjustl_str) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + character(kind=CDK,len=*),dimension(:),intent(in):: vec !! the value vector + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + integer(IK),dimension(:),intent(in),optional :: ilen !! the string lengths of each + !! element in `value`. If not present, + !! the full `len(value)` string is added + !! for each element. + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for each element + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for each element + !! (note that ADJUSTL is done before TRIM) + + call me%json_file_add_string_vec(to_unicode(path),to_unicode(vec),found,& + was_created,ilen,trim_str,adjustl_str) + + end subroutine wrap_json_file_add_string_vec +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_string_vec]], where "path" is kind=CDK. + + subroutine json_file_add_string_vec_path_ascii(me,path,vec,found,& + was_created,ilen,trim_str,adjustl_str) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + character(kind=CK,len=*),dimension(:),intent(in) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + integer(IK),dimension(:),intent(in),optional :: ilen !! the string lengths of each + !! element in `value`. If not present, + !! the full `len(value)` string is added + !! for each element. + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for each element + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for each element + !! (note that ADJUSTL is done before TRIM) + + call me%json_file_add_string_vec(to_unicode(path),vec,found,& + was_created,ilen,trim_str,adjustl_str) + + end subroutine json_file_add_string_vec_path_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Alternate version of [[json_file_add_string_vec]], where "vec" is kind=CDK. + + subroutine json_file_add_string_vec_vec_ascii(me,path,vec,found,& + was_created,ilen,trim_str,adjustl_str) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + character(kind=CDK,len=*),dimension(:),intent(in) :: vec !! the value vector + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + integer(IK),dimension(:),intent(in),optional :: ilen !! the string lengths of each + !! element in `value`. If not present, + !! the full `len(value)` string is added + !! for each element. + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for each element + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for each element + !! (note that ADJUSTL is done before TRIM) + + call me%json_file_add_string_vec(path,to_unicode(vec),found,& + was_created,ilen,trim_str,adjustl_str) + + end subroutine json_file_add_string_vec_vec_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/10/2015 +! +! Given the path string, if the variable is present in the file, +! and is a scalar, then update its value. +! If it is not present, then create it and set its value. +! +!### See also +! * [[json_update_integer]] + + subroutine json_file_update_integer(me,path,val,found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path + integer(IK),intent(in) :: val + logical(LK),intent(out) :: found + + if (.not. me%core%failed()) call me%core%update(me%p,path,val,found) + + end subroutine json_file_update_integer +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_update_integer]], where "path" is kind=CDK. + + subroutine wrap_json_file_update_integer(me,path,val,found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path + integer(IK),intent(in) :: val + logical(LK),intent(out) :: found + + call me%update(to_unicode(path),val,found) + + end subroutine wrap_json_file_update_integer +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/10/2015 +! +! Given the path string, if the variable is present in the file, +! and is a scalar, then update its value. +! If it is not present, then create it and set its value. +! +!### See also +! * [[json_update_logical]] + + subroutine json_file_update_logical(me,path,val,found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path + logical(LK),intent(in) :: val + logical(LK),intent(out) :: found + + if (.not. me%core%failed()) call me%core%update(me%p,path,val,found) + + end subroutine json_file_update_logical +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_update_logical]], where "path" is kind=CDK. + + subroutine wrap_json_file_update_logical(me,path,val,found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path + logical(LK),intent(in) :: val + logical(LK),intent(out) :: found + + call me%update(to_unicode(path),val,found) + + end subroutine wrap_json_file_update_logical +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/10/2015 +! +! Given the path string, if the variable is present in the file, +! and is a scalar, then update its value. +! If it is not present, then create it and set its value. + + subroutine json_file_update_real(me,path,val,found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path + real(RK),intent(in) :: val + logical(LK),intent(out) :: found + + if (.not. me%core%failed()) call me%core%update(me%p,path,val,found) + + end subroutine json_file_update_real +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_update_real]], where "path" is kind=CDK. + + subroutine wrap_json_file_update_real(me,path,val,found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path + real(RK),intent(in) :: val + logical(LK),intent(out) :: found + + call me%update(to_unicode(path),val,found) + + end subroutine wrap_json_file_update_real +!***************************************************************************************** + +#ifndef REAL32 +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/21/2019 +! +! Alternate version of [[json_file_update_real]] where `val` is `real32`. + + subroutine json_file_update_real32(me,path,val,found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path + real(real32),intent(in) :: val + logical(LK),intent(out) :: found + + call me%update(path,real(val,RK),found) + + end subroutine json_file_update_real32 +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_update_real32]], where "path" is kind=CDK. + + subroutine wrap_json_file_update_real32(me,path,val,found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path + real(real32),intent(in) :: val + logical(LK),intent(out) :: found + + call me%update(to_unicode(path),val,found) + + end subroutine wrap_json_file_update_real32 +!***************************************************************************************** +#endif + +#ifdef REAL128 +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/21/2019 +! +! Alternate version of [[json_file_update_real]] where `val` is `real64`. + + subroutine json_file_update_real64(me,path,val,found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path + real(real64),intent(in) :: val + logical(LK),intent(out) :: found + + call me%update(path,real(val,RK),found) + + end subroutine json_file_update_real64 +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_update_real64]], where "path" is kind=CDK. + + subroutine wrap_json_file_update_real64(me,path,val,found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path + real(real64),intent(in) :: val + logical(LK),intent(out) :: found + + call me%update(to_unicode(path),val,found) + + end subroutine wrap_json_file_update_real64 +!***************************************************************************************** +#endif + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/10/2015 +! +! Given the path string, if the variable is present in the file, +! and is a scalar, then update its value. +! If it is not present, then create it and set its value. +! +!### See also +! * [[json_update_string]] + + subroutine json_file_update_string(me,path,val,found,trim_str,adjustl_str) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path + character(kind=CK,len=*),intent(in) :: val + logical(LK),intent(out) :: found + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + !! (note that ADJUSTL is done before TRIM) + + if (.not. me%core%failed()) call me%core%update(me%p,path,val,found,trim_str,adjustl_str) + + end subroutine json_file_update_string +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_update_string]], where "path" and "val" are kind=CDK. + + subroutine wrap_json_file_update_string(me,path,val,found,trim_str,adjustl_str) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path + character(kind=CDK,len=*),intent(in) :: val + logical(LK),intent(out) :: found + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + !! (note that ADJUSTL is done before TRIM) + + call me%update(to_unicode(path),to_unicode(val),found,trim_str,adjustl_str) + + end subroutine wrap_json_file_update_string +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_update_string]], where "path" is kind=CDK. + + subroutine json_file_update_string_name_ascii(me,path,val,found,trim_str,adjustl_str) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path + character(kind=CK, len=*),intent(in) :: val + logical(LK),intent(out) :: found + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + !! (note that ADJUSTL is done before TRIM) + + call me%update(to_unicode(path),val,found,trim_str,adjustl_str) + + end subroutine json_file_update_string_name_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_update_string]], where "val" is kind=CDK. + + subroutine json_file_update_string_val_ascii(me,path,val,found,trim_str,adjustl_str) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK, len=*),intent(in) :: path + character(kind=CDK,len=*),intent(in) :: val + logical(LK),intent(out) :: found + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + !! (note that ADJUSTL is done before TRIM) + + call me%update(path,to_unicode(val),found,trim_str,adjustl_str) + + end subroutine json_file_update_string_val_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 6/11/2016 +! +! Traverse the JSON structure in the file. +! This routine calls the user-specified [[json_traverse_callback_func]] +! for each element of the structure. + + subroutine json_file_traverse(me,traverse_callback) + + implicit none + + class(json_file),intent(inout) :: me + procedure(json_traverse_callback_func) :: traverse_callback + + call me%core%traverse(me%p,traverse_callback) + + end subroutine json_file_traverse +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 7/7/2018 +! +! Remove a variable from a JSON file. +! +!@note This is just a wrapper to [[remove_if_present]]. + + subroutine json_file_remove(me,path) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + + call me%core%remove_if_present(me%p,path) + + end subroutine json_file_remove +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_file_remove]], where "path" is kind=CDK. + + subroutine wrap_json_file_remove(me,path) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + + call me%remove(to_unicode(path)) + + end subroutine wrap_json_file_remove +!***************************************************************************************** + +!***************************************************************************************** + end module json_file_module +!***************************************************************************************** diff --git a/Common/json-fortran/json_get_scalar_by_path.inc b/Common/json-fortran/json_get_scalar_by_path.inc new file mode 100644 index 0000000..03f4c57 --- /dev/null +++ b/Common/json-fortran/json_get_scalar_by_path.inc @@ -0,0 +1,32 @@ + type(json_value),pointer :: p + + if (present(default)) then + value = default + else + value = default_if_not_specified + end if + + if ( json%exception_thrown ) then + call flag_not_found(found) + return + end if + + nullify(p) + call json%get(me=me, path=path, p=p) + + if (.not. associated(p)) then + call json%throw_exception('Error in '//routine//':'//& + ' Unable to resolve path: '// trim(path),found) + else + call json%get(p,value) + end if + + if ( json%exception_thrown ) then + if ( present(found) .or. present(default)) then + call flag_not_found(found) + if (present(default)) value = default + call json%clear_exceptions() + end if + else + if ( present(found) ) found = .true. + end if diff --git a/Common/json-fortran/json_get_vec_by_path.inc b/Common/json-fortran/json_get_vec_by_path.inc new file mode 100644 index 0000000..00b8ca7 --- /dev/null +++ b/Common/json-fortran/json_get_vec_by_path.inc @@ -0,0 +1,27 @@ + type(json_value),pointer :: p + + if ( json%exception_thrown ) then + if (present(default)) vec = default + call flag_not_found(found) + return + end if + + nullify(p) + call json%get(me=me, path=path, p=p) + + if (.not. associated(p)) then + call json%throw_exception('Error in '//routine//':'//& + ' Unable to resolve path: '// trim(path),found) + else + call json%get(p,vec) + end if + + if ( json%exception_thrown ) then + if ( present(found) .or. present(default)) then + call flag_not_found(found) + if (present(default)) vec = default + call json%clear_exceptions() + end if + else + if ( present(found) ) found = .true. + end if diff --git a/Common/json-fortran/json_get_vec_by_path_alloc.inc b/Common/json-fortran/json_get_vec_by_path_alloc.inc new file mode 100644 index 0000000..958447c --- /dev/null +++ b/Common/json-fortran/json_get_vec_by_path_alloc.inc @@ -0,0 +1,43 @@ + type(json_value),pointer :: p + + if ( json%exception_thrown ) then + if (present(default)) then + vec = default + if (present(default_ilen)) then + ilen = default_ilen + else + allocate(ilen(size(default))) + ilen = len(default) + end if + end if + call flag_not_found(found) + return + end if + + nullify(p) + call json%get(me=me, path=path, p=p) + + if (.not. associated(p)) then + call json%throw_exception('Error in '//routine//':'//& + ' Unable to resolve path: '// trim(path),found) + else + call json%get(p,vec,ilen) + end if + + if ( json%exception_thrown ) then + if ( present(found) .or. present(default)) then + call flag_not_found(found) + if (present(default)) then + vec = default + if (present(default_ilen)) then + ilen = default_ilen + else + allocate(ilen(size(default))) + ilen = len(default) + end if + end if + call json%clear_exceptions() + end if + else + if ( present(found) ) found = .true. + end if diff --git a/Common/json-fortran/json_initialize_arguments.inc b/Common/json-fortran/json_initialize_arguments.inc new file mode 100644 index 0000000..d8b3b4f --- /dev/null +++ b/Common/json-fortran/json_initialize_arguments.inc @@ -0,0 +1,114 @@ +! The argument list for the various `initialize` subroutines. +! +! See also: json_initialize_dummy_arguments.inc + +logical(LK),intent(in),optional :: verbose + !! mainly useful for debugging (default is false) +logical(LK),intent(in),optional :: compact_reals + !! to compact the real number strings for output (default is true) +logical(LK),intent(in),optional :: print_signs + !! always print numeric sign (default is false) +character(kind=CDK,len=*),intent(in),optional :: real_format + !! Real number format: 'E' [default], '*', 'G', 'EN', or 'ES' +integer(IK),intent(in),optional :: spaces_per_tab + !! number of spaces per tab for indenting (default is 2) +logical(LK),intent(in),optional :: strict_type_checking + !! if true, no integer, double, or logical type + !! conversions are done for the `get` routines + !! (default is false). +logical(LK),intent(in),optional :: trailing_spaces_significant + !! for name and path comparisons, is trailing + !! space to be considered significant. + !! (default is false) +logical(LK),intent(in),optional :: case_sensitive_keys + !! for name and path comparisons, are they + !! case sensitive. (default is true) +logical(LK),intent(in),optional :: no_whitespace + !! if true, printing the JSON structure is + !! done without adding any non-significant + !! spaces or linebreaks (default is false) +logical(LK),intent(in),optional :: unescape_strings + !! If false, then the raw escaped + !! string is returned from [[json_get_string]] + !! and similar routines. If true [default], + !! then the string is returned unescaped. +character(kind=CK,len=*),intent(in),optional :: comment_char + !! If present, these characters are used + !! to denote comments in the JSON file, + !! which will be ignored if present. + !! Example: `!`, `#`, or `/!#`. Setting this + !! to a blank string disables the + !! ignoring of comments. (Default is `/!#`). +integer(IK),intent(in),optional :: path_mode + !! How the path strings are interpreted in the + !! `get_by_path` routines: + !! + !! * 1 : Default mode (see [[json_get_by_path_default]]) + !! * 2 : as RFC 6901 "JSON Pointer" paths + !! (see [[json_get_by_path_rfc6901]]) + !! * 3 : JSONPath "bracket-notation" + !! see [[json_get_by_path_jsonpath_bracket]]) +character(kind=CK,len=1),intent(in),optional :: path_separator + !! The `path` separator to use + !! in the "default" mode for + !! the paths in the various + !! `get_by_path` routines. + !! Example: `.` [default] or `%`. + !! Note: if `path_mode/=1` + !! then this is ignored. +logical(LK),intent(in),optional :: compress_vectors + !! If true, then arrays of integers, + !! nulls, doubles, and logicals are + !! printed all on one line. + !! [Note: `no_whitespace` will + !! override this option if necessary]. + !! (Default is False). +logical(LK),intent(in),optional :: allow_duplicate_keys + !! * If True [default] then no special checks + !! are done to check for duplicate keys. + !! * If False, then after parsing, if any duplicate + !! keys are found, an error is thrown. A call to + !! [[json_value_validate]] will also check for + !! duplicates. +logical(LK),intent(in),optional :: escape_solidus + !! * If True then the solidus "`/`" is always escaped + !! "`\/`" when serializing JSON + !! * If False [default], then it is not escaped. + !! + !! Note that this option does not affect parsing + !! (both escaped and unescaped are still valid in + !! all cases). +logical(LK),intent(in),optional :: stop_on_error + !! If an exception is raised, then immediately quit. + !! (Default is False). +integer(IK),intent(in),optional :: null_to_real_mode + !! if `strict_type_checking=false`: + !! + !! * 1 : an exception will be raised if + !! try to retrieve a `null` as a real. + !! * 2 : a `null` retrieved as a real + !! will return a NaN. [default] + !! * 3 : a `null` retrieved as a real + !! will return 0.0. +integer(IK),intent(in),optional :: non_normal_mode + !! How to serialize NaN, Infinity, and + !! -Infinity real values: + !! + !! * 1 : as strings (e.g., "NaN", + !! "Infinity", "-Infinity") [default] + !! * 2 : as JSON `null` values +logical(LK),intent(in),optional :: use_quiet_nan + !! * If true [default], `null_to_real_mode=2` + !! and [[string_to_real]] will use + !! `ieee_quiet_nan` for NaN values. + !! * If false, + !! `ieee_signaling_nan` will be used. +logical(LK),intent(in),optional :: strict_integer_type_checking + !! * If false, when parsing JSON, if an integer numeric value + !! cannot be converted to an integer (`integer(IK)`), + !! then an attempt is then make to convert it + !! to a real (`real(RK)`). + !! * If true, an exception will be raised if the integer + !! value cannot be read. + !! + !! (default is true) \ No newline at end of file diff --git a/Common/json-fortran/json_initialize_dummy_arguments.inc b/Common/json-fortran/json_initialize_dummy_arguments.inc new file mode 100644 index 0000000..008cbd9 --- /dev/null +++ b/Common/json-fortran/json_initialize_dummy_arguments.inc @@ -0,0 +1,25 @@ +! The dummy argument list for the various `initialize` subroutines. +! +! See also: json_initialize_argument.inc + +verbose,& +compact_reals,& +print_signs,& +real_format,& +spaces_per_tab,& +strict_type_checking,& +trailing_spaces_significant,& +case_sensitive_keys,& +no_whitespace,& +unescape_strings,& +comment_char,& +path_mode,& +path_separator,& +compress_vectors,& +allow_duplicate_keys,& +escape_solidus,& +stop_on_error,& +null_to_real_mode,& +non_normal_mode,& +use_quiet_nan, & +strict_integer_type_checking & \ No newline at end of file diff --git a/Common/json-fortran/json_kinds.F90 b/Common/json-fortran/json_kinds.F90 new file mode 100644 index 0000000..fac6e76 --- /dev/null +++ b/Common/json-fortran/json_kinds.F90 @@ -0,0 +1,148 @@ +!***************************************************************************************** +!> author: Jacob Williams +! license: BSD +! +! JSON-Fortran kind definitions. +! +!### License +! * JSON-Fortran is released under a BSD-style license. +! See the [LICENSE](https://github.com/jacobwilliams/json-fortran/blob/master/LICENSE) +! file for details. +! +!@note ```-DUSE_UCS4``` is an optional preprocessor flag. +! When present, Unicode support is enabled. Note that this +! is currently only supported with the gfortran compiler. +! Example: ```gfortran -DUSE_UCS4 ... ``` +#ifdef USE_UCS4 +# pragma push_macro("USE_UCS4") +# undef USE_UCS4 +! The documentation given here assumes ```USE_UCS4``` **is** defined. +# pragma pop_macro("USE_UCS4") +#else +! The documentation given here assumes ```USE_UCS4``` **is not** defined. +#endif +! +!@warning ```CK``` and ```CDK``` are the JSON-Fortran character kind and JSON-Fortran default +! character kind respectively. Client code **MUST** ensure characters of ```kind=CK``` +! are used for all character variables and strings passed to the JSON-Fortran +! library *EXCEPT* for file names which must be of ```'DEFAULT'``` character kind, +! provided here as ```CDK```. In particular, any variable that is a: json path, string +! value or object name passed to the JSON-Fortran library **MUST** be of type ```CK```. +! +!@note Most string literal constants of default kind are fine to pass as arguments to +! JSON-Fortran procedures since they have been overloaded to accept ```intent(in)``` +! character arguments of the default (```CDK```) kind. If you find a procedure which does +! not accept an ```intent(in)``` literal string argument of default kind, please +! [file an issue](https://github.com/jacobwilliams/json-fortran/issues/new) on GitHub. +! +!@note The default real kind (`RK`) and the default integer kind (`IK`) can be +! changed using optional preprocessor flags. This library was built with kinds: +#ifdef REAL32 +! real(kind=real32) [4 bytes] +#elif REAL64 +! real(kind=real64) [8 bytes] +#elif REAL128 +! real(kind=real128) [16 bytes] +#else +! real(kind=real64) [8 bytes] +#endif +! and +#ifdef INT8 +! integer(kind=int8) [1 byte] +#elif INT16 +! integer(kind=int16) [2 bytes] +#elif INT32 +! integer(kind=int32) [4 bytes] +#elif INT64 +! integer(kind=int64) [8 bytes] +#else +! integer(kind=int32) [4 bytes] +#endif +! . +! +!@note In addition to the real kind specified by `RK`, interfaces for +! the real kinds with less precision are also provided in the library, +! but all are converted to `real(RK)` variables internally. + + module json_kinds + + use,intrinsic :: iso_fortran_env + + implicit none + + private + +! used for the reals with less precision +! than the default precision: +#ifndef REAL32 + public :: real32 +#endif +#ifdef REAL128 + public :: real64 +#endif + +#ifdef REAL32 + integer,parameter,public :: RK = real32 !! Default real kind [4 bytes] +#elif REAL64 + integer,parameter,public :: RK = real64 !! Default real kind [8 bytes] +#elif REAL128 + integer,parameter,public :: RK = real128 !! Default real kind [16 bytes] +#else + integer,parameter,public :: RK = real64 !! Default real kind if not specified [8 bytes] +#endif + +#ifdef INT8 + integer,parameter,public :: IK = int8 !! Default integer kind [1 byte] +#elif INT16 + integer,parameter,public :: IK = int16 !! Default integer kind [2 bytes] +#elif INT32 + integer,parameter,public :: IK = int32 !! Default integer kind [4 bytes] +#elif INT64 + integer,parameter,public :: IK = int64 !! Default integer kind [8 bytes] +#else + integer,parameter,public :: IK = int32 !! Default integer kind if not specified [4 bytes] +#endif + + !********************************************************* + !> + ! Processor dependent 'DEFAULT' character kind. + ! This is 1 byte for the Intel and Gfortran compilers. + integer,parameter,public :: CDK = selected_char_kind('DEFAULT') + !********************************************************* + + !********************************************************* + !> + ! Default logical kind. + ! This is 4 bytes for the Intel and Gfortran compilers + ! (and perhaps others). + ! The declaration ensures a valid kind + ! if the compiler doesn't have a logical_kinds(3). + integer,parameter,public :: LK = logical_kinds(min(3,size(logical_kinds))) + !********************************************************* + + !********************************************************* + !> + ! String kind preprocessor macro. +#if defined __GFORTRAN__ && defined USE_UCS4 + ! gfortran compiler AND UCS4 support requested: + character(kind=CDK,len=*),parameter :: json_fortran_string_kind = 'ISO_10646' +#else + ! this is the string kind to use unless compiling with GFortran AND + ! UCS4/ISO 10646 support is requested + character(kind=CDK,len=*),parameter :: json_fortran_string_kind = 'DEFAULT' +#endif + !********************************************************* + + !********************************************************* + !> + ! Default character kind used by JSON-Fortran. + ! If ISO 10646 (UCS4) support is available, use that, + ! otherwise, gracefully fall back on 'DEFAULT' characters. + ! Currently only gfortran >= 4.9.2 will correctly support + ! UCS4 which is stored in 4 bytes. + ! (and perhaps others). + integer,parameter,public :: CK = selected_char_kind(json_fortran_string_kind) + !********************************************************* + + end module json_kinds +!***************************************************************************************** diff --git a/Common/json-fortran/json_macros.inc b/Common/json-fortran/json_macros.inc new file mode 100644 index 0000000..c0573a0 --- /dev/null +++ b/Common/json-fortran/json_macros.inc @@ -0,0 +1,58 @@ +! JSON-Fortran preprocessor macros. +! +! License +! JSON-Fortran is released under a BSD-style license. +! See the [LICENSE](https://github.com/jacobwilliams/json-fortran/blob/master/LICENSE) +! file for details. + +!********************************************************* +! File encoding preprocessor macro. +! +#if defined __GFORTRAN__ && defined USE_UCS4 +! gfortran compiler AND UCS4 support requested, & silence redefine warning: +! Make sure we output files with utf-8 encoding too +#define FILE_ENCODING ,encoding='UTF-8' +#else +! don't ask for utf-8 file encoding unless using UCS4 +! this may let us use unformatted stream io to read in files more quickly +! even with unicode support turned on `inquire( ... encoding=FL_ENCODING)` +! may be able to detect json files in which each character is exactly one +! byte +#define FILE_ENCODING +#endif +!********************************************************* + +!********************************************************* +! This C preprocessor macro will take a procedure name as an +! input, and output either that same procedure name if the +! code is compiled without USE_UCS4 being defined or it will +! expand the procedure name to the original procedure name, +! followed by a comma and then the original procedure name +! with 'wrap_' prepended to it. This is suitable for creating +! overloaded interfaces that will accept UCS4 character actual +! arguments as well as DEFAULT/ASCII character arguments, +! based on whether or not ISO 10646 is supported and requested. +! +# ifdef USE_UCS4 +# ifdef __GFORTRAN__ +! gfortran uses cpp in old-school compatibility mode so +! the # stringify and ## concatenate operators don't work +! but we can use C/C++ style comment to ensure PROCEDURE is +! correctly tokenized and prepended with 'wrap_' when the +! macro is expanded +# define MAYBEWRAP(PROCEDURE) PROCEDURE , wrap_/**/PROCEDURE +# endif +! ifdef __INTEL_COMPILER +! Intel's fpp does support the more contemporary ## concatenation +! operator, but doesn't treat the C/C++ comments the same way. +! If you use the gfortran approach and pass the -noB switch to +! fpp, the macro will expand, but with a space between wrap_ and +! whatever PROCEDURE expands to +! Intel doesn't support ISO 10646 yet, but this is here to +! ease the transition once they do. +! define MAYBEWRAP(PROCEDURE) PROCEDURE , wrap_##PROCEDURE +! endif +# else +# define MAYBEWRAP(PROCEDURE) PROCEDURE +# endif +!********************************************************* diff --git a/Common/json-fortran/json_module.F90 b/Common/json-fortran/json_module.F90 new file mode 100644 index 0000000..46284e9 --- /dev/null +++ b/Common/json-fortran/json_module.F90 @@ -0,0 +1,104 @@ +!***************************************************************************************** +!> author: Jacob Williams +! license: BSD +! +! A Modern Fortran JSON (JavaScript Object Notation) API. +! +! This module provides access to [[json_value_module]] and +! [[json_file_module]]. For normal JSON-Fortran use, using this module +! is all that is necessary. +! +! Note that this module renames the kind definition variables from [[json_kinds]] +! from [`RK`, `IK`, `LK`, `CK`, and `CDK`] to [`json_RK`, `json_IK`, `json_LK`, +! `json_CK`, and `json_CDK`] so as to avoid namespace pollution with short +! variable names. +! +#ifdef USE_UCS4 +#pragma push_macro("USE_UCS4") +#undef USE_UCS4 +! Since ```USE_UCS4``` **is** defined, this module also exports the +! operators `==`, `/=`, and `//` from [[json_string_utilities]] for +! `CK` and `CDK` operations. +#pragma pop_macro("USE_UCS4") +#endif +! +!### License +! * JSON-Fortran is released under a BSD-style license. +! See the [LICENSE](https://github.com/jacobwilliams/json-fortran/blob/master/LICENSE) +! file for details. +! +!### History +! * Joseph A. Levin : March 2012 : Original [FSON](https://github.com/josephalevin/fson) +! code [retrieved on 12/2/2013]. +! * Jacob Williams : 2/8/2014 : Extensive modifications to the original FSON code. +! The original F95 code was split into four files: +! fson_path_m.f95, fson_string_m.f95, fson_value_m.f95, and fson.f95. +! The new code has been extensively updated, refactored and combined into this +! one module (json_module.f90). +! Various Fortran 2003/2008 features are now used +! (e.g., allocatable strings, newunit, generic, class, and abstract interface). +! * Development continues at: [Github](https://github.com/jacobwilliams/json-fortran) +! +!### See also +! * [json-fortran development site](https://github.com/jacobwilliams/json-fortran) +! * [json-fortran online documentation](https://jacobwilliams.github.io/json-fortran) +! * [JSON website](http://www.json.org/) +! * [JSON validator](http://jsonlint.com/) +! +!@note Originally JSON-Fortran was entirely contained within this module. + + module json_module + + use json_kinds, only: json_RK => RK, & + json_IK => IK, & + json_LK => LK, & + json_CK => CK, & + json_CDK => CDK +#ifdef USE_UCS4 + use json_string_utilities, only: operator(==),& + operator(//),& + operator(/=) +#endif + use json_parameters, only: json_unknown,& + json_null, & + json_object, & + json_array, & + json_logical,& + json_integer,& + json_real, & + json_double, & + json_string + use json_value_module + use json_file_module + + implicit none + + character(kind=json_CK,len=*),parameter,private :: version = '8.3.0' + !! JSON-Fortran version. + !! + !!@note This string should match the one in the `.VERSION` file (which is used + !! for the documentation generation.) + + public + + contains +!***************************************************************************************** + +!***************************************************************************************** +!> +! Returns the JSON-Fortran version string. + + function json_fortran_version() result(ver) + + implicit none + + character(len=:),allocatable :: ver !! JSON-Fortran version string + + ver = version + + end function json_fortran_version +!***************************************************************************************** + +!***************************************************************************************** + end module json_module +!***************************************************************************************** diff --git a/Common/json-fortran/json_parameters.F90 b/Common/json-fortran/json_parameters.F90 new file mode 100644 index 0000000..ebd33c8 --- /dev/null +++ b/Common/json-fortran/json_parameters.F90 @@ -0,0 +1,144 @@ +!***************************************************************************************** +!> author: Jacob Williams +! license: BSD +! +! Other parameters used by JSON-Fortran. +! This is a low-level module not meant to be used by a JSON-Fortran user. +! +!### License +! * JSON-Fortran is released under a BSD-style license. +! See the [LICENSE](https://github.com/jacobwilliams/json-fortran/blob/master/LICENSE) +! file for details. + + module json_parameters + + use json_kinds + + implicit none + + public + + character(kind=CDK,len=*),parameter :: json_ext = '.json' !! JSON file extension + + ! The types of JSON data. + integer(IK),parameter :: json_unknown = 0 !! Unknown JSON data type + !! (see [[json_file_variable_info]] and [[json_info]]) + integer(IK),parameter :: json_null = 1 !! Null JSON data type + !! (see [[json_file_variable_info]] and [[json_info]]) + integer(IK),parameter :: json_object = 2 !! Object JSON data type + !! (see [[json_file_variable_info]] and [[json_info]]) + integer(IK),parameter :: json_array = 3 !! Array JSON data type + !! (see [[json_file_variable_info]] and [[json_info]]) + integer(IK),parameter :: json_logical = 4 !! Logical JSON data type (`logical(LK)`) + !! (see [[json_file_variable_info]] and [[json_info]]) + integer(IK),parameter :: json_integer = 5 !! Integer JSON data type (`integer(IK)`) + !! (see [[json_file_variable_info]] and [[json_info]]). + integer(IK),parameter :: json_real = 6 !! Real number JSON data type (`real(RK)`) + !! (see [[json_file_variable_info]] and [[json_info]]) + integer(IK),parameter :: json_string = 7 !! String JSON data type (`character(kind=CK)`) + !! (see [[json_file_variable_info]] and [[json_info]]) + integer(IK),parameter :: json_double = json_real !! Equivalent to `json_real` for + !! backward compatibility. + + !special JSON characters + character(kind=CK,len=*),parameter :: space = CK_' ' !! space character + character(kind=CK,len=*),parameter :: start_object = CK_'{' !! start of a JSON object + character(kind=CK,len=*),parameter :: end_object = CK_'}' !! end of a JSON object + character(kind=CK,len=*),parameter :: start_array = CK_'[' !! start of a JSON array + character(kind=CK,len=*),parameter :: end_array = CK_']' !! end of a JSON array + character(kind=CK,len=*),parameter :: delimiter = CK_',' !! delimiter for JSON + character(kind=CK,len=*),parameter :: colon_char = CK_':' !! colon character for JSON + character(kind=CK,len=*),parameter :: start_array_alt = CK_'(' !! alternate start of JSON array for + !! [[json_get_by_path_default]] + character(kind=CK,len=*),parameter :: end_array_alt = CK_')' !! alternate end of JSON array for + !! [[json_get_by_path_default]] + character(kind=CK,len=*),parameter :: root = achar(36, kind=CK) !! (`$`) root for [[json_get_by_path_default]] + character(kind=CK,len=*),parameter :: this = CK_'@' !! 'this' for [[json_get_by_path_default]] + character(kind=CK,len=*),parameter :: dot = CK_'.' !! path separator for [[json_get_by_path_default]] + character(kind=CK,len=*),parameter :: tilde = CK_'~' !! RFC 6901 escape character + character(kind=CK,len=*),parameter :: single_quote = CK_"'" !! for JSONPath bracket-notation + character(kind=CK,len=*),parameter :: quotation_mark = CK_'"' !! JSON special character + character(kind=CK,len=*),parameter :: bspace = achar(8, kind=CK) !! JSON special character + character(kind=CK,len=*),parameter :: horizontal_tab = achar(9, kind=CK) !! JSON special character + character(kind=CK,len=*),parameter :: newline = achar(10, kind=CK) !! JSON special character + character(kind=CK,len=*),parameter :: formfeed = achar(12, kind=CK) !! JSON special character + character(kind=CK,len=*),parameter :: carriage_return = achar(13, kind=CK) !! JSON special character + character(kind=CK,len=*),parameter :: slash = achar(47, kind=CK) !! JSON special character + character(kind=CK,len=*),parameter :: backslash = achar(92, kind=CK) !! JSON special character + + !> default real number format statement (for writing real values to strings and files). + ! Note that this can be overridden by calling [[json_initialize]]. +#ifdef REAL32 + character(kind=CDK,len=*),parameter :: default_real_fmt = '(ss,E17.8E3)' +#elif REAL128 + character(kind=CDK,len=*),parameter :: default_real_fmt = '(ss,E46.35E5)' +#else + character(kind=CDK,len=*),parameter :: default_real_fmt = '(ss,E27.17E4)' +#endif + + character(kind=CK,len=*),parameter :: star = CK_'*' !! for invalid numbers and + !! list-directed real output + +#if defined __GFORTRAN__ + !not parameters due to gfortran bug (https://gcc.gnu.org/bugzilla/show_bug.cgi?id=65141) + character(kind=CK,len=26),protected :: upper = CK_'ABCDEFGHIJKLMNOPQRSTUVWXYZ' !! uppercase characters + character(kind=CK,len=26),protected :: lower = CK_'abcdefghijklmnopqrstuvwxyz' !! lowercase characters +#else + character(kind=CK,len=*),parameter :: upper = CK_'ABCDEFGHIJKLMNOPQRSTUVWXYZ' !! uppercase characters + character(kind=CK,len=*),parameter :: lower = CK_'abcdefghijklmnopqrstuvwxyz' !! lowercase characters +#endif + +#if defined __GFORTRAN__ + !not parameters due to gfortran bug (https://gcc.gnu.org/bugzilla/show_bug.cgi?id=65141) + character(kind=CK,len=4),protected :: null_str = CK_'null' !! JSON Null variable string + character(kind=CK,len=4),protected :: true_str = CK_'true' !! JSON logical True string + character(kind=CK,len=5),protected :: false_str = CK_'false' !! JSON logical False string +#else + character(kind=CK,len=*),parameter :: null_str = CK_'null' !! JSON Null variable string + character(kind=CK,len=*),parameter :: true_str = CK_'true' !! JSON logical True string + character(kind=CK,len=*),parameter :: false_str = CK_'false' !! JSON logical False string +#endif + + integer, private :: i_ !! just a counter for `control_chars` array + character(kind=CK,len=*),dimension(32),parameter :: control_chars = & + [(achar(i_,kind=CK),i_=1,31), achar(127,kind=CK)] !! Control characters, possibly in unicode + + !find out the precision of the floating point number system + !and set safety factors + integer(IK),parameter :: rp_safety_factor = 1_IK + integer(IK),parameter :: rp_addl_safety = 2_IK + integer(IK),parameter :: real_precision = rp_safety_factor*precision(1.0_RK) + & + rp_addl_safety + + !Get the number of possible digits in the exponent when using decimal number system + integer(IK),parameter :: maxexp = maxexponent(1.0_RK) + integer(IK),parameter :: minexp = minexponent(1.0_RK) + integer(IK),parameter :: real_exponent_digits = floor( 1_IK + log10( & + real(max(maxexp,abs(maxexp)),& + kind=RK) ) ) + + integer(IK),parameter :: max_numeric_str_len = real_precision + real_exponent_digits + 6_IK + !! 6 = sign + leading 0 + decimal + 'E' + exponent sign + 1 extra + character(kind=CDK,len=*),parameter :: int_fmt = '(ss,I0)' !! minimum width format for integers + + integer(IK),parameter :: max_integer_str_len = 256_IK !! maximum string length of an integer. + !! This is totally arbitrary (any way + !! to get the compiler to tell us this?) + + integer(IK),parameter :: chunk_size = 256_IK !! for allocatable strings: allocate chunks of this size + integer(IK),parameter :: unit2str = -1_IK !! unit number to cause stuff to be + !! output to strings rather than files. + !! See 9.5.6.12 in the F2003/08 standard + character(kind=CK,len=*),parameter :: blank_chunk = repeat(space, chunk_size) !! a blank string + + integer(IK),parameter :: seq_chunk_size = 256_IK !! chunk size for reading sequential files + + integer(IK),parameter :: stream_chunk_size = 256_IK !! chunk size for reading stream files + + integer(IK),parameter :: print_str_chunk_size = 1000_IK !! chunk size for writing JSON to a string + + integer(IK),parameter :: pushed_char_size = 10_IK !! size for `pushed_char` + !! array in [[json_core(type)]] + + end module json_parameters +!***************************************************************************************** diff --git a/Common/json-fortran/json_string_utilities.F90 b/Common/json-fortran/json_string_utilities.F90 new file mode 100644 index 0000000..74f2801 --- /dev/null +++ b/Common/json-fortran/json_string_utilities.F90 @@ -0,0 +1,932 @@ +!***************************************************************************************** +!> author: Jacob Williams +! license: BSD +! +! JSON-Fortran support module for string manipulation. +! +!### License +! * JSON-Fortran is released under a BSD-style license. +! See the [LICENSE](https://github.com/jacobwilliams/json-fortran/blob/master/LICENSE) +! file for details. + + module json_string_utilities + + use,intrinsic :: ieee_arithmetic + use json_kinds + use json_parameters + + implicit none + + private + + !****************************************************** + !> + ! Convert a 'DEFAULT' kind character input to + ! 'ISO_10646' kind and return it + interface to_unicode + module procedure to_uni, to_uni_vec + end interface + !****************************************************** + +#ifdef USE_UCS4 + !****************************************************** + !> + ! Provide a means to convert to UCS4 while + ! concatenating UCS4 and default strings + interface operator(//) + module procedure ucs4_join_default, default_join_ucs4 + end interface + public :: operator(//) + !****************************************************** + + !****************************************************** + !> + ! Provide a string `==` operator that works + ! with mixed kinds + interface operator(==) + module procedure ucs4_comp_default, default_comp_ucs4 + end interface + public :: operator(==) + !****************************************************** + + !****************************************************** + !> + ! Provide a string `/=` operator that works + ! with mixed kinds + interface operator(/=) + module procedure ucs4_neq_default, default_neq_ucs4 + end interface + public :: operator(/=) + !****************************************************** +#endif + + public :: integer_to_string + public :: real_to_string + public :: string_to_integer + public :: string_to_real + public :: valid_json_hex + public :: to_unicode + public :: escape_string + public :: unescape_string + public :: lowercase_string + public :: replace_string + public :: decode_rfc6901 + public :: encode_rfc6901 + + contains +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/4/2013 +! +! Convert an integer to a string. + + pure subroutine integer_to_string(ival,int_fmt,str) + + implicit none + + integer(IK),intent(in) :: ival !! integer value. + character(kind=CDK,len=*),intent(in) :: int_fmt !! format for integers + character(kind=CK,len=*),intent(out) :: str !! `ival` converted to a string. + + integer(IK) :: istat + + write(str,fmt=int_fmt,iostat=istat) ival + + if (istat==0) then + str = adjustl(str) + else + str = repeat(star,len(str)) + end if + + end subroutine integer_to_string +!***************************************************************************************** + +!***************************************************************************************** +!> +! Convert a string into an integer. +! +!# History +! * Jacob Williams : 12/10/2013 : Rewrote original `parse_integer` routine. +! Added error checking. +! * Modified by Izaak Beekman +! * Jacob Williams : 2/4/2017 : moved core logic to this routine. + + subroutine string_to_integer(str,ival,status_ok) + + implicit none + + character(kind=CK,len=*),intent(in) :: str !! the string to convert to an integer + integer(IK),intent(out) :: ival !! the integer value + logical(LK),intent(out) :: status_ok !! true if there were no errors + + character(kind=CDK,len=:),allocatable :: digits + integer(IK) :: ndigits_digits,ndigits,ierr + + ! Compute how many digits we need to read + ndigits = 2*len_trim(str) + if (ndigits/=0) then + ndigits_digits = floor(log10(real(ndigits)))+1 + allocate(character(kind=CDK,len=ndigits_digits) :: digits) + write(digits,'(I0)') ndigits !gfortran will have a runtime error with * edit descriptor here + ! gfortran bug: '*' edit descriptor for ISO_10646 strings does bad stuff. + read(str,'(I'//trim(digits)//')',iostat=ierr) ival !string to integer + ! error check: + status_ok = (ierr==0) + else + status_ok = .false. + end if + if (.not. status_ok) ival = 0_IK + + end subroutine string_to_integer +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/4/2013 +! +! Convert a real value to a string. +! +!### Modified +! * Izaak Beekman : 02/24/2015 : added the compact option. +! * Jacob Williams : 10/27/2015 : added the star option. +! * Jacob Williams : 07/07/2019 : added null and ieee options. + + subroutine real_to_string(rval,real_fmt,compact_real,non_normals_to_null,str) + + implicit none + + real(RK),intent(in) :: rval !! real value. + character(kind=CDK,len=*),intent(in) :: real_fmt !! format for real numbers + logical(LK),intent(in) :: compact_real !! compact the string so that it is + !! displayed with fewer characters + logical(LK),intent(in) :: non_normals_to_null !! If True, NaN, Infinity, or -Infinity are returned as `null`. + !! If False, the string value will be returned in quotes + !! (e.g., "NaN", "Infinity", or "-Infinity" ) + character(kind=CK,len=*),intent(out) :: str !! `rval` converted to a string. + + integer(IK) :: istat !! write `iostat` flag + + if (ieee_is_finite(rval) .and. .not. ieee_is_nan(rval)) then + + ! normal real numbers + + if (real_fmt==star) then + write(str,fmt=*,iostat=istat) rval + else + write(str,fmt=real_fmt,iostat=istat) rval + end if + + if (istat==0) then + !in this case, the default string will be compacted, + ! so that the same value is displayed with fewer characters. + if (compact_real) call compact_real_string(str) + else + str = repeat(star,len(str)) ! error + end if + + else + ! special cases for NaN, Infinity, and -Infinity + + if (non_normals_to_null) then + ! return it as a JSON null value + str = null_str + else + ! Let the compiler do the real to string conversion + ! like before, but put the result in quotes so it + ! gets printed as a string + write(str,fmt=*,iostat=istat) rval + if (istat==0) then + str = quotation_mark//trim(adjustl(str))//quotation_mark + else + str = repeat(star,len(str)) ! error + end if + end if + + end if + + end subroutine real_to_string +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/19/2014 +! +! Convert a string into a `real(RK)`. +! +!# History +! * Jacob Williams, 10/27/2015 : Now using `fmt=*`, rather than +! `fmt=real_fmt`, since it doesn't work for some unusual cases +! (e.g., when `str='1E-5'`). +! * Jacob Williams : 2/6/2017 : moved core logic to this routine. + + subroutine string_to_real(str,use_quiet_nan,rval,status_ok) + + implicit none + + character(kind=CK,len=*),intent(in) :: str !! the string to convert to a real + logical(LK),intent(in) :: use_quiet_nan !! if true, return NaN's as `ieee_quiet_nan`. + !! otherwise, use `ieee_signaling_nan`. + real(RK),intent(out) :: rval !! `str` converted to a real value + logical(LK),intent(out) :: status_ok !! true if there were no errors + + integer(IK) :: ierr !! read iostat error code + + read(str,fmt=*,iostat=ierr) rval + status_ok = (ierr==0) + if (.not. status_ok) then + rval = 0.0_RK + else + if (ieee_support_nan(rval)) then + if (ieee_is_nan(rval)) then + ! make sure to return the correct NaN + if (use_quiet_nan) then + rval = ieee_value(rval,ieee_quiet_nan) + else + rval = ieee_value(rval,ieee_signaling_nan) + end if + end if + end if + end if + + end subroutine string_to_real +!***************************************************************************************** + +!***************************************************************************************** +!> author: Izaak Beekman +! date: 02/24/2015 +! +! Compact a string representing a real number, so that +! the same value is displayed with fewer characters. +! +!# See also +! * [[real_to_string]] + + subroutine compact_real_string(str) + + implicit none + + character(kind=CK,len=*),intent(inout) :: str !! string representation of a real number. + + character(kind=CK,len=len(str)) :: significand + character(kind=CK,len=len(str)) :: expnt + character(kind=CK,len=2) :: separator + integer(IK) :: exp_start + integer(IK) :: decimal_pos + integer(IK) :: sig_trim + integer(IK) :: exp_trim + integer(IK) :: i !! counter + + str = adjustl(str) + exp_start = scan(str,CK_'eEdD') + if (exp_start == 0) exp_start = scan(str,CK_'-+',back=.true.) + decimal_pos = scan(str,CK_'.') + if (exp_start /= 0) separator = str(exp_start:exp_start) + + if ( exp_start < decimal_pos ) then !possibly signed, exponent-less float + + significand = str + sig_trim = len(trim(significand)) + do i = len(trim(significand)),decimal_pos+2,-1 !look from right to left at 0s + !but save one after the decimal place + if (significand(i:i) == '0') then + sig_trim = i-1 + else + exit + end if + end do + str = trim(significand(1:sig_trim)) + + else if (exp_start > decimal_pos) then !float has exponent + + significand = str(1:exp_start-1) + sig_trim = len(trim(significand)) + do i = len(trim(significand)),decimal_pos+2,-1 !look from right to left at 0s + if (significand(i:i) == '0') then + sig_trim = i-1 + else + exit + end if + end do + expnt = adjustl(str(exp_start+1:)) + if (expnt(1:1) == '+' .or. expnt(1:1) == '-') then + separator = trim(adjustl(separator))//expnt(1:1) + exp_start = exp_start + 1 + expnt = adjustl(str(exp_start+1:)) + end if + exp_trim = 1 + do i = 1,(len(trim(expnt))-1) !look at exponent leading zeros saving last + if (expnt(i:i) == '0') then + exp_trim = i+1 + else + exit + end if + end do + str = trim(adjustl(significand(1:sig_trim)))// & + trim(adjustl(separator))// & + trim(adjustl(expnt(exp_trim:))) + + !else ! mal-formed real, BUT this code should be unreachable + + end if + + end subroutine compact_real_string +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/21/2014 +! +! Add the escape characters to a string for adding to JSON. + + subroutine escape_string(str_in, str_out, escape_solidus) + + implicit none + + character(kind=CK,len=*),intent(in) :: str_in + character(kind=CK,len=:),allocatable,intent(out) :: str_out + logical(LK),intent(in) :: escape_solidus !! if the solidus (forward slash) + !! is also to be escaped + + integer(IK) :: i !! counter + integer(IK) :: ipos !! accumulated string size + !! (so we can allocate it in chunks for + !! greater runtime efficiency) + character(kind=CK,len=1) :: c !! for reading `str_in` one character at a time. +#if defined __GFORTRAN__ + character(kind=CK,len=:),allocatable :: tmp !! workaround for bug in gfortran 6.1 +#endif + logical :: to_be_escaped !! if there are characters to be escaped + + character(kind=CK,len=*),parameter :: specials_no_slash = quotation_mark//& + backslash//& + bspace//& + formfeed//& + newline//& + carriage_return//& + horizontal_tab + + character(kind=CK,len=*),parameter :: specials = specials_no_slash//slash + + !Do a quick scan for the special characters, + ! if any are present, then process the string, + ! otherwise, return the string as is. + if (escape_solidus) then + to_be_escaped = scan(str_in,specials)>0 + else + to_be_escaped = scan(str_in,specials_no_slash)>0 + end if + + if (to_be_escaped) then + + str_out = repeat(space,chunk_size) + ipos = 1 + + !go through the string and look for special characters: + do i=1,len(str_in) + + c = str_in(i:i) !get next character in the input string + + !if the string is not big enough, then add another chunk: + if (ipos+3>len(str_out)) str_out = str_out // blank_chunk + + select case(c) + case(backslash) + + !test for unicode sequence: '\uXXXX' + ![don't add an extra '\' for those] + if (i+5<=len(str_in)) then + if (str_in(i+1:i+1)==CK_'u' .and. & + valid_json_hex(str_in(i+2:i+5))) then + str_out(ipos:ipos) = c + ipos = ipos + 1 + cycle + end if + end if + + str_out(ipos:ipos+1) = backslash//c + ipos = ipos + 2 + + case(quotation_mark) + str_out(ipos:ipos+1) = backslash//c + ipos = ipos + 2 + case(slash) + if (escape_solidus) then + str_out(ipos:ipos+1) = backslash//c + ipos = ipos + 2 + else + str_out(ipos:ipos) = c + ipos = ipos + 1 + end if + case(bspace) + str_out(ipos:ipos+1) = '\b' + ipos = ipos + 2 + case(formfeed) + str_out(ipos:ipos+1) = '\f' + ipos = ipos + 2 + case(newline) + str_out(ipos:ipos+1) = '\n' + ipos = ipos + 2 + case(carriage_return) + str_out(ipos:ipos+1) = '\r' + ipos = ipos + 2 + case(horizontal_tab) + str_out(ipos:ipos+1) = '\t' + ipos = ipos + 2 + case default + str_out(ipos:ipos) = c + ipos = ipos + 1 + end select + + end do + + !trim the string if necessary: + if (ipos +! Remove the escape characters from a JSON string and return it. +! +! The escaped characters are denoted by the `\` character: +! +! * `\"` - quotation mark +! * `\\` - reverse solidus +! * `\/` - solidus +! * `\b` - backspace +! * `\f` - formfeed +! * `\n` - newline (LF) +! * `\r` - carriage return (CR) +! * `\t` - horizontal tab +! * `\uXXXX` - 4 hexadecimal digits + + subroutine unescape_string(str, error_message) + + implicit none + + character(kind=CK,len=:),allocatable,intent(inout) :: str !! in: string as stored + !! in a [[json_value]]. + !! out: decoded string. + character(kind=CK,len=:),allocatable,intent(out) :: error_message !! will be allocated if + !! there was an error + + integer :: i !! counter + integer :: n !! length of `str` + integer :: m !! length of `str_tmp` + character(kind=CK,len=1) :: c !! for scanning each character in string + character(kind=CK,len=:),allocatable :: str_tmp !! temp decoded string (if the input + !! string contains an escape character + !! and needs to be decoded). + + if (scan(str,backslash)>0) then + + !there is at least one escape character, so process this string: + + n = len(str) + str_tmp = repeat(space,n) !size the output string (will be trimmed later) + m = 0 !counter in str_tmp + i = 0 !counter in str + + do + + i = i + 1 + if (i>n) exit ! finished + c = str(i:i) ! get next character in the string + + if (c == backslash) then + + if (i author: Jacob Williams +! date:6/14/2014 +! +! Returns true if the string is a valid 4-digit hex string. +! +!# Examples +!```fortran +! valid_json_hex('0000') !returns true +! valid_json_hex('ABC4') !returns true +! valid_json_hex('AB') !returns false (< 4 characters) +! valid_json_hex('WXYZ') !returns false (invalid characters) +!``` + + pure function valid_json_hex(str) result(valid) + + implicit none + + logical(LK) :: valid !! is str a value 4-digit hex string + character(kind=CK,len=*),intent(in) :: str !! the string to check. + + integer(IK) :: n !! length of `str` + integer(IK) :: i !! counter + + !> an array of the valid hex characters + character(kind=CK,len=1),dimension(22),parameter :: valid_chars = & + [ (achar(i),i=48,57), & ! decimal digits + (achar(i),i=65,70), & ! capital A-F + (achar(i),i=97,102) ] ! lowercase a-f + + !initialize + valid = .false. + + !check all the characters in the string: + n = len(str) + if (n==4) then + do i=1,n + if (.not. any(str(i:i)==valid_chars)) return + end do + valid = .true. !all are in the set, so it is OK + end if + + end function valid_json_hex +!***************************************************************************************** + +!***************************************************************************************** +!> author: Izaak Beekman +! +! Convert string to unicode (CDK to CK). + + pure function to_uni(str) + + implicit none + + character(kind=CDK,len=*), intent(in) :: str + character(kind=CK,len=len(str)) :: to_uni + + to_uni = str + + end function to_uni +!***************************************************************************************** + +!***************************************************************************************** +!> author: Izaak Beekman +! +! Convert array of strings to unicode (CDK to CK). +! +!@note JW: may be able to remove this by making [[to_uni]] PURE ELEMENTAL ? + + pure function to_uni_vec(str) + + implicit none + + character(kind=CDK,len=*), dimension(:), intent(in) :: str + character(kind=CK,len=len(str)), dimension(size(str)) :: to_uni_vec + + to_uni_vec = str + + end function to_uni_vec +!***************************************************************************************** + +!***************************************************************************************** +!> author: Izaak Beekman +! +! `CK`//`CDK` operator. + + pure function ucs4_join_default(ucs4_str,def_str) result(res) + + implicit none + + character(kind=CK, len=*), intent(in) :: ucs4_str + character(kind=CDK,len=*), intent(in) :: def_str + character(kind=CK,len=(len(ucs4_str)+len(def_str))) :: res + + res = ucs4_str//to_unicode(def_str) + + end function ucs4_join_default +!***************************************************************************************** + +!***************************************************************************************** +!> author: Izaak Beekman +! +! `CDK`//`CK` operator. + + pure function default_join_ucs4(def_str,ucs4_str) result(res) + + implicit none + + character(kind=CDK,len=*), intent(in) :: def_str + character(kind=CK, len=*), intent(in) :: ucs4_str + character(kind=CK,len=(len(def_str)+len(ucs4_str))) :: res + + res = to_unicode(def_str)//ucs4_str + + end function default_join_ucs4 +!***************************************************************************************** + +!***************************************************************************************** +!> author: Izaak Beekman +! +! `CK`==`CDK` operator. + + pure elemental function ucs4_comp_default(ucs4_str,def_str) result(res) + + implicit none + + character(kind=CK, len=*), intent(in) :: ucs4_str + character(kind=CDK,len=*), intent(in) :: def_str + logical(LK) :: res + + res = ( ucs4_str == to_unicode(def_str) ) + + end function ucs4_comp_default +!***************************************************************************************** + +!***************************************************************************************** +!> author: Izaak Beekman +! +! `CDK`==`CK` operator. + + pure elemental function default_comp_ucs4(def_str,ucs4_str) result(res) + + implicit none + + character(kind=CDK,len=*), intent(in) :: def_str + character(kind=CK, len=*), intent(in) :: ucs4_str + logical(LK) :: res + + res = (to_unicode(def_str) == ucs4_str) + + end function default_comp_ucs4 +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! `CK`/=`CDK` operator. + + pure elemental function ucs4_neq_default(ucs4_str,def_str) result(res) + + implicit none + + character(kind=CK, len=*), intent(in) :: ucs4_str + character(kind=CDK,len=*), intent(in) :: def_str + logical(LK) :: res + + res = ( ucs4_str /= to_unicode(def_str) ) + + end function ucs4_neq_default +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! `CDK`/=`CK` operator. + + pure elemental function default_neq_ucs4(def_str,ucs4_str) result(res) + + implicit none + + character(kind=CDK,len=*), intent(in) :: def_str + character(kind=CK, len=*), intent(in) :: ucs4_str + logical(LK) :: res + + res = (to_unicode(def_str) /= ucs4_str) + + end function default_neq_ucs4 +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Returns lowercase version of the `CK` string. + + pure function lowercase_string(str) result(s_lower) + + implicit none + + character(kind=CK,len=*),intent(in) :: str !! input string + character(kind=CK,len=(len(str))) :: s_lower !! lowercase version of the string + + integer :: i !! counter + integer :: j !! index of uppercase character + + s_lower = str + + do i = 1, len_trim(str) + j = index(upper,s_lower(i:i)) + if (j>0) s_lower(i:i) = lower(j:j) + end do + + end function lowercase_string +!***************************************************************************************** + +!***************************************************************************************** +!> +! Replace all occurrences of `s1` in `str` with `s2`. +! +! A case-sensitive match is used. +! +!@note `str` must be allocated. + + pure subroutine replace_string(str,s1,s2) + + implicit none + + character(kind=CK,len=:),allocatable,intent(inout) :: str + character(kind=CK,len=*),intent(in) :: s1 + character(kind=CK,len=*),intent(in) :: s2 + + character(kind=CK,len=:),allocatable :: tmp !! temporary string for accumulating result + integer(IK) :: i !! counter + integer(IK) :: n !! for accumulating the string + integer(IK) :: ilen !! length of `str` string + integer(IK) :: ilen1 !! length of `s1` string + + if (len(str)>0) then + + tmp = CK_'' ! initialize + ilen1 = len(s1) + + ! . + ! '123ab789' + + do + ilen = len(str) + i = index(str,s1) + if (i>0) then + if (i>1) tmp = tmp//str(1:i-1) + tmp = tmp//s2 ! replace s1 with s2 in new string + n = i+ilen1 ! start of remainder of str to keep + if (n<=ilen) then + str = str(n:ilen) + else + ! done + exit + end if + else + ! done: get remainder of string + tmp = tmp//str + exit + end if + end do + + str = tmp + + end if + + end subroutine replace_string +!***************************************************************************************** + +!***************************************************************************************** +!> +! Decode a string from the "JSON Pointer" RFC 6901 format. +! +! It replaces `~1` with `/` and `~0` with `~`. + + pure function decode_rfc6901(str) result(str_out) + + implicit none + + character(kind=CK,len=*),intent(in) :: str + character(kind=CK,len=:),allocatable :: str_out + + str_out = str + + call replace_string(str_out,tilde//CK_'1',slash) + call replace_string(str_out,tilde//CK_'0',tilde) + + end function decode_rfc6901 +!***************************************************************************************** + +!***************************************************************************************** +!> +! Encode a string into the "JSON Pointer" RFC 6901 format. +! +! It replaces `~` with `~0` and `/` with `~1`. + + pure function encode_rfc6901(str) result(str_out) + + implicit none + + character(kind=CK,len=*),intent(in) :: str + character(kind=CK,len=:),allocatable :: str_out + + str_out = str + + call replace_string(str_out,tilde,tilde//CK_'0') + call replace_string(str_out,slash,tilde//CK_'1') + + end function encode_rfc6901 +!***************************************************************************************** + + end module json_string_utilities +!***************************************************************************************** diff --git a/Common/json-fortran/json_value_module.F90 b/Common/json-fortran/json_value_module.F90 new file mode 100644 index 0000000..4bae98a --- /dev/null +++ b/Common/json-fortran/json_value_module.F90 @@ -0,0 +1,11549 @@ +!***************************************************************************************** +!> author: Jacob Williams +! license: BSD +! +! This module provides a low-level interface for manipulation of JSON data. +! The two public entities are [[json_value]], and [[json_core(type)]]. +! The [[json_file_module]] provides a higher-level interface to some +! of these routines. +! +!### License +! * JSON-Fortran is released under a BSD-style license. +! See the [LICENSE](https://github.com/jacobwilliams/json-fortran/blob/master/LICENSE) +! file for details. + + module json_value_module + + use,intrinsic :: iso_fortran_env, only: iostat_end,error_unit,output_unit + use,intrinsic :: ieee_arithmetic + use json_kinds + use json_parameters + use json_string_utilities + + implicit none + + private + +#include "json_macros.inc" + + !********************************************************* + !> + ! If Unicode is not enabled, then + ! JSON files are opened using access='STREAM' and + ! form='UNFORMATTED'. This allows the file to + ! be read faster. + ! +#ifdef USE_UCS4 + logical,parameter :: use_unformatted_stream = .false. +#else + logical,parameter :: use_unformatted_stream = .true. +#endif + !********************************************************* + + !********************************************************* + !> + ! If Unicode is not enabled, then + ! JSON files are opened using access='STREAM' and + ! form='UNFORMATTED'. This allows the file to + ! be read faster. + ! +#ifdef USE_UCS4 + character(kind=CDK,len=*),parameter :: access_spec = 'SEQUENTIAL' +#else + character(kind=CDK,len=*),parameter :: access_spec = 'STREAM' +#endif + !********************************************************* + + !********************************************************* + !> + ! If Unicode is not enabled, then + ! JSON files are opened using access='STREAM' and + ! form='UNFORMATTED'. This allows the file to + ! be read faster. + ! +#ifdef USE_UCS4 + character(kind=CDK,len=*),parameter :: form_spec = 'FORMATTED' +#else + character(kind=CDK,len=*),parameter :: form_spec = 'UNFORMATTED' +#endif + !********************************************************* + + !********************************************************* + !> + ! Type used to construct the linked-list JSON structure. + ! Normally, this should always be a pointer variable. + ! This type should only be used by an instance of [[json_core(type)]]. + ! + !### Example + ! + ! The following test program: + ! + !````fortran + ! program test + ! use json_module + ! implicit none + ! type(json_core) :: json + ! type(json_value),pointer :: p + ! call json%create_object(p,'') !create the root + ! call json%add(p,'year',1805) !add some data + ! call json%add(p,'value',1.0_RK) !add some data + ! call json%print(p,'test.json') !write it to a file + ! call json%destroy(p) !cleanup + ! end program test + !```` + ! + ! Produces the JSON file **test.json**: + ! + !````json + ! { + ! "year": 1805, + ! "value": 0.1E+1 + ! } + !```` + ! + !@warning Pointers of this type should only be allocated + ! using the methods from [[json_core(type)]]. + + type,public :: json_value + + !force the constituents to be stored contiguously + ![note: on Intel, the order of the variables below + ! is significant to avoid the misaligned field warnings] + sequence + + private + + !for the linked list: + type(json_value),pointer :: previous => null() !! previous item in the list + type(json_value),pointer :: next => null() !! next item in the list + type(json_value),pointer :: parent => null() !! parent item of this + type(json_value),pointer :: children => null() !! first child item of this + type(json_value),pointer :: tail => null() !! last child item of this + + character(kind=CK,len=:),allocatable :: name !! variable name (unescaped) + + real(RK),allocatable :: dbl_value !! real data for this variable + logical(LK),allocatable :: log_value !! logical data for this variable + character(kind=CK,len=:),allocatable :: str_value !! string data for this variable + !! (unescaped) + integer(IK),allocatable :: int_value !! integer data for this variable + + integer(IK) :: var_type = json_unknown !! variable type + + integer(IK),private :: n_children = 0 !! number of children + + end type json_value + !********************************************************* + + !********************************************************* + !> + ! To access the core routines for manipulation + ! of [[json_value]] pointer variables. This class allows + ! for thread safe use of the module. + ! + !### Usage + !````fortran + ! program test + ! use json_module, wp=>json_RK + ! implicit none + ! type(json_core) :: json !<--have to declare this + ! type(json_value),pointer :: p + ! call json%create_object(p,'') !create the root + ! call json%add(p,'year',1805) !add some data + ! call json%add(p,'value',1.0_wp) !add some data + ! call json%print(p,'test.json') !write it to a file + ! call json%destroy(p) !cleanup + ! end program test + !```` + type,public :: json_core + + private + + integer(IK) :: spaces_per_tab = 2 !! number of spaces for indenting + + logical(LK) :: compact_real = .true. !! to use the "compact" form of real + !! numbers for output + character(kind=CDK,len=:),allocatable :: real_fmt !! the format string to use + !! for converting real numbers to strings. + !! It can be set in [[json_initialize]], + !! and used in [[json_value_print]] + !! If not set, then `default_real_fmt` + !! is used instead. + + logical(LK) :: is_verbose = .false. !! if true, all exceptions are + !! immediately printed to console. + + logical(LK) :: stop_on_error = .false. !! if true, then the program is + !! stopped immediately when an + !! exception is raised. + + logical(LK) :: exception_thrown = .false. !! The error flag. Will be set to true + !! when an error is thrown in the class. + !! Many of the methods will check this + !! and return immediately if it is true. + character(kind=CK,len=:),allocatable :: err_message + !! the error message. + !! if `exception_thrown=False` then + !! this variable is not allocated. + + integer(IK) :: char_count = 0 !! character position in the current line + integer(IK) :: line_count = 1 !! lines read counter + integer(IK) :: pushed_index = 0 !! used when parsing lines in file + character(kind=CK,len=pushed_char_size) :: pushed_char = CK_'' !! used when parsing + !! lines in file + + integer(IK) :: ipos = 1 !! for allocatable strings: next character to read + + logical(LK) :: strict_type_checking = .false. !! if true, then no type conversions are done + !! in the `get` routines if the actual variable + !! type is different from the return type (for + !! example, integer to real). + + logical(LK) :: trailing_spaces_significant = .false. !! for name and path comparisons, if trailing + !! space is to be considered significant. + + logical(LK) :: case_sensitive_keys = .true. !! if name and path comparisons + !! are case sensitive. + + logical(LK) :: no_whitespace = .false. !! when printing a JSON string, don't include + !! non-significant spaces or line breaks. + !! If true, the entire structure will be + !! printed on one line. + + logical(LK) :: unescaped_strings = .true. !! If false, then the escaped + !! string is returned from [[json_get_string]] + !! and similar routines. If true [default], + !! then the string is returned unescaped. + + logical(LK) :: allow_comments = .true. !! if true, any comments will be ignored when + !! parsing a file. The comment tokens are defined + !! by the `comment_char` character variable. + character(kind=CK,len=:),allocatable :: comment_char !! comment tokens when + !! `allow_comments` is true. + !! Examples: '`!`' or '`#`'. + !! Default is `CK_'/!#'`. + + integer(IK) :: path_mode = 1_IK !! How the path strings are interpreted in the + !! `get_by_path` routines: + !! + !! * 1 -- Default mode (see [[json_get_by_path_default]]) + !! * 2 -- as RFC 6901 "JSON Pointer" paths + !! (see [[json_get_by_path_rfc6901]]) + !! * 3 -- JSONPath "bracket-notation" + !! see [[json_get_by_path_jsonpath_bracket]]) + + character(kind=CK,len=1) :: path_separator = dot !! The `path` separator to use + !! in the "default" mode for + !! the paths in the various + !! `get_by_path` routines. + !! Note: if `path_mode/=1` + !! then this is ignored. + + logical(LK) :: compress_vectors = .false. !! If true, then arrays of integers, + !! nulls, reals, & logicals are + !! printed all on one line. + !! [Note: `no_whitespace` will + !! override this option if necessary] + + logical(LK) :: allow_duplicate_keys = .true. !! If False, then after parsing, if any + !! duplicate keys are found, an error is + !! thrown. A call to [[json_value_validate]] + !! will also check for duplicates. If True + !! [default] then no special checks are done + + logical(LK) :: escape_solidus = .false. !! If True then the solidus "`/`" is always escaped + !! ("`\/`") when serializing JSON. + !! If False [default], then it is not escaped. + !! Note that this option does not affect parsing + !! (both escaped and unescaped versions are still + !! valid in all cases). + + integer(IK) :: null_to_real_mode = 2_IK !! if `strict_type_checking=false`: + !! + !! * 1 : an exception will be raised if + !! try to retrieve a `null` as a real. + !! * 2 : a `null` retrieved as a real + !! will return NaN. [default] + !! * 3 : a `null` retrieved as a real + !! will return 0.0. + + logical(LK) :: non_normals_to_null = .false. !! How to serialize NaN, Infinity, + !! and -Infinity real values: + !! + !! * If true : as JSON `null` values + !! * If false : as strings (e.g., "NaN", + !! "Infinity", "-Infinity") [default] + + logical(LK) :: use_quiet_nan = .true. !! if true [default], `null_to_real_mode=2` + !! and [[string_to_real]] will use + !! `ieee_quiet_nan` for NaN values. If false, + !! `ieee_signaling_nan` will be used. + + logical(LK) :: strict_integer_type_checking = .true. + !! * If false, when parsing JSON, if an integer numeric value + !! cannot be converted to an integer (`integer(IK)`), + !! then an attempt is then make to convert it + !! to a real (`real(RK)`). + !! * If true [default], an exception will be raised if an integer + !! value cannot be read when parsing JSON. + + integer :: ichunk = 0 !! index in `chunk` for [[pop_char]] + !! when `use_unformatted_stream=True` + integer :: filesize = 0 !! the file size when when `use_unformatted_stream=True` + character(kind=CK,len=:),allocatable :: chunk !! a chunk read from a stream file + !! when `use_unformatted_stream=True` + + contains + + private + + !> + ! Return a child of a [[json_value]] structure. + generic,public :: get_child => json_value_get_child_by_index, & + json_value_get_child,& + MAYBEWRAP(json_value_get_child_by_name) + procedure,private :: json_value_get_child_by_index + procedure,private :: MAYBEWRAP(json_value_get_child_by_name) + procedure,private :: json_value_get_child + + !> + ! Add objects to a linked list of [[json_value]]s. + ! + !@note It might make more sense to call this `add_child`. + generic,public :: add => json_value_add_member, & + MAYBEWRAP(json_value_add_null), & + MAYBEWRAP(json_value_add_integer), & + MAYBEWRAP(json_value_add_integer_vec), & +#ifndef REAL32 + MAYBEWRAP(json_value_add_real32), & + MAYBEWRAP(json_value_add_real32_vec), & +#endif + MAYBEWRAP(json_value_add_real), & + MAYBEWRAP(json_value_add_real_vec), & +#ifdef REAL128 + MAYBEWRAP(json_value_add_real64), & + MAYBEWRAP(json_value_add_real64_vec), & +#endif + MAYBEWRAP(json_value_add_logical), & + MAYBEWRAP(json_value_add_logical_vec), & + MAYBEWRAP(json_value_add_string), & + MAYBEWRAP(json_value_add_string_vec) +#ifdef USE_UCS4 + generic,public :: add => json_value_add_string_name_ascii, & + json_value_add_string_val_ascii, & + json_value_add_string_vec_name_ascii, & + json_value_add_string_vec_val_ascii +#endif + + procedure,private :: json_value_add_member + procedure,private :: MAYBEWRAP(json_value_add_integer) + procedure,private :: MAYBEWRAP(json_value_add_null) + procedure,private :: MAYBEWRAP(json_value_add_integer_vec) +#ifndef REAL32 + procedure,private :: MAYBEWRAP(json_value_add_real32) + procedure,private :: MAYBEWRAP(json_value_add_real32_vec) +#endif + procedure,private :: MAYBEWRAP(json_value_add_real) + procedure,private :: MAYBEWRAP(json_value_add_real_vec) +#ifdef REAL128 + procedure,private :: MAYBEWRAP(json_value_add_real64) + procedure,private :: MAYBEWRAP(json_value_add_real64_vec) +#endif + procedure,private :: MAYBEWRAP(json_value_add_logical) + procedure,private :: MAYBEWRAP(json_value_add_logical_vec) + procedure,private :: MAYBEWRAP(json_value_add_string) + procedure,private :: MAYBEWRAP(json_value_add_string_vec) +#ifdef USE_UCS4 + procedure,private :: json_value_add_string_name_ascii + procedure,private :: json_value_add_string_val_ascii + procedure,private :: json_value_add_string_vec_name_ascii + procedure,private :: json_value_add_string_vec_val_ascii +#endif + + !> + ! These are like the `add` methods, except if a variable with the + ! same path is already present, then its value is simply updated. + ! Note that currently, these only work for scalar variables. + ! These routines can also change the variable's type (but an error will be + ! thrown if the existing variable is not a scalar). + ! + !### See also + ! * [[json_core(type):add_by_path]] - this one can be used to change + ! arrays and objects to scalars if so desired. + ! + !@note Unlike some routines, the `found` output is not optional, + ! so it doesn't present exceptions from being thrown. + ! + !@note These have been mostly supplanted by the [[json_core(type):add_by_path]] + ! methods, which do a similar thing (and can be used for + ! scalars and vectors, etc.) + generic,public :: update => MAYBEWRAP(json_update_logical),& +#ifndef REAL32 + MAYBEWRAP(json_update_real32),& +#endif + MAYBEWRAP(json_update_real),& +#ifdef REAL128 + MAYBEWRAP(json_update_real64),& +#endif + + MAYBEWRAP(json_update_integer),& + MAYBEWRAP(json_update_string) +#ifdef USE_UCS4 + generic,public :: update => json_update_string_name_ascii,& + json_update_string_val_ascii +#endif + procedure,private :: MAYBEWRAP(json_update_logical) +#ifndef REAL32 + procedure,private :: MAYBEWRAP(json_update_real32) +#endif + procedure,private :: MAYBEWRAP(json_update_real) +#ifdef REAL128 + procedure,private :: MAYBEWRAP(json_update_real64) +#endif + procedure,private :: MAYBEWRAP(json_update_integer) + procedure,private :: MAYBEWRAP(json_update_string) +#ifdef USE_UCS4 + procedure,private :: json_update_string_name_ascii + procedure,private :: json_update_string_val_ascii +#endif + + !> + ! Add variables to a [[json_value]] linked list + ! by specifying their paths. + ! + !### Example + ! + !````fortran + ! use, intrinsic :: iso_fortran_env, only: output_unit + ! use json_module, wp=>json_RK + ! type(json_core) :: json + ! type(json_value) :: p + ! call json%create_object(p,'root') ! create the root + ! ! now add some variables using the paths: + ! call json%add_by_path(p,'inputs.t', 0.0_wp ) + ! call json%add_by_path(p,'inputs.x(1)', 100.0_wp) + ! call json%add_by_path(p,'inputs.x(2)', 200.0_wp) + ! call json%print(p) ! now print to console + !```` + ! + !### Notes + ! * This uses [[json_create_by_path]] + ! + !### See also + ! * The `json_core%update` methods. + ! * [[json_create_by_path]] + + generic,public :: add_by_path => MAYBEWRAP(json_add_member_by_path),& + MAYBEWRAP(json_add_integer_by_path),& +#ifndef REAL32 + MAYBEWRAP(json_add_real32_by_path),& +#endif + MAYBEWRAP(json_add_real_by_path),& +#ifdef REAL128 + MAYBEWRAP(json_add_real64_by_path),& +#endif + MAYBEWRAP(json_add_logical_by_path),& + MAYBEWRAP(json_add_string_by_path),& + MAYBEWRAP(json_add_integer_vec_by_path),& +#ifndef REAL32 + MAYBEWRAP(json_add_real32_vec_by_path),& +#endif + MAYBEWRAP(json_add_real_vec_by_path),& +#ifdef REAL128 + MAYBEWRAP(json_add_real64_vec_by_path),& +#endif + MAYBEWRAP(json_add_logical_vec_by_path),& + MAYBEWRAP(json_add_string_vec_by_path) +#ifdef USE_UCS4 + generic,public :: add_by_path => json_add_string_by_path_value_ascii,& + json_add_string_by_path_path_ascii,& + json_add_string_vec_by_path_value_ascii,& + json_add_string_vec_by_path_path_ascii +#endif + procedure :: MAYBEWRAP(json_add_member_by_path) + procedure :: MAYBEWRAP(json_add_integer_by_path) +#ifndef REAL32 + procedure :: MAYBEWRAP(json_add_real32_by_path) +#endif + procedure :: MAYBEWRAP(json_add_real_by_path) +#ifdef REAL128 + procedure :: MAYBEWRAP(json_add_real64_by_path) +#endif + procedure :: MAYBEWRAP(json_add_logical_by_path) + procedure :: MAYBEWRAP(json_add_string_by_path) + procedure :: MAYBEWRAP(json_add_integer_vec_by_path) +#ifndef REAL32 + procedure :: MAYBEWRAP(json_add_real32_vec_by_path) +#endif + procedure :: MAYBEWRAP(json_add_real_vec_by_path) +#ifdef REAL128 + procedure :: MAYBEWRAP(json_add_real64_vec_by_path) +#endif + procedure :: MAYBEWRAP(json_add_logical_vec_by_path) + procedure :: MAYBEWRAP(json_add_string_vec_by_path) +#ifdef USE_UCS4 + procedure :: json_add_string_by_path_value_ascii + procedure :: json_add_string_by_path_path_ascii + procedure :: json_add_string_vec_by_path_value_ascii + procedure :: json_add_string_vec_by_path_path_ascii +#endif + + !> + ! Create a [[json_value]] linked list using the + ! path to the variables. Optionally return a + ! pointer to the variable. + ! + ! (This will create a `null` variable) + ! + !### See also + ! * [[json_core(type):add_by_path]] + + generic,public :: create => MAYBEWRAP(json_create_by_path) + procedure :: MAYBEWRAP(json_create_by_path) + + !> + ! Get data from a [[json_value]] linked list. + ! + !@note There are two versions (e.g. [[json_get_integer]] and [[json_get_integer_by_path]]). + ! The first one gets the value from the [[json_value]] passed into the routine, + ! while the second one gets the value from the [[json_value]] found by parsing the + ! path. The path version is split up into unicode and non-unicode versions. + + generic,public :: get => & + MAYBEWRAP(json_get_by_path), & + json_get_integer, MAYBEWRAP(json_get_integer_by_path), & + json_get_integer_vec, MAYBEWRAP(json_get_integer_vec_by_path), & +#ifndef REAL32 + json_get_real32, MAYBEWRAP(json_get_real32_by_path), & + json_get_real32_vec, MAYBEWRAP(json_get_real32_vec_by_path), & +#endif + json_get_real, MAYBEWRAP(json_get_real_by_path), & + json_get_real_vec, MAYBEWRAP(json_get_real_vec_by_path), & +#ifdef REAL128 + json_get_real64, MAYBEWRAP(json_get_real64_by_path), & + json_get_real64_vec, MAYBEWRAP(json_get_real64_vec_by_path), & +#endif + json_get_logical, MAYBEWRAP(json_get_logical_by_path), & + json_get_logical_vec, MAYBEWRAP(json_get_logical_vec_by_path), & + json_get_string, MAYBEWRAP(json_get_string_by_path), & + json_get_string_vec, MAYBEWRAP(json_get_string_vec_by_path), & + json_get_alloc_string_vec, MAYBEWRAP(json_get_alloc_string_vec_by_path),& + json_get_array, MAYBEWRAP(json_get_array_by_path) + + procedure,private :: json_get_integer + procedure,private :: json_get_integer_vec +#ifndef REAL32 + procedure,private :: json_get_real32 + procedure,private :: json_get_real32_vec +#endif + procedure,private :: json_get_real + procedure,private :: json_get_real_vec +#ifdef REAL128 + procedure,private :: json_get_real64 + procedure,private :: json_get_real64_vec +#endif + procedure,private :: json_get_logical + procedure,private :: json_get_logical_vec + procedure,private :: json_get_string + procedure,private :: json_get_string_vec + procedure,private :: json_get_alloc_string_vec + procedure,private :: json_get_array + procedure,private :: MAYBEWRAP(json_get_by_path) + procedure,private :: MAYBEWRAP(json_get_integer_by_path) + procedure,private :: MAYBEWRAP(json_get_integer_vec_by_path) +#ifndef REAL32 + procedure,private :: MAYBEWRAP(json_get_real32_by_path) + procedure,private :: MAYBEWRAP(json_get_real32_vec_by_path) +#endif + procedure,private :: MAYBEWRAP(json_get_real_by_path) + procedure,private :: MAYBEWRAP(json_get_real_vec_by_path) +#ifdef REAL128 + procedure,private :: MAYBEWRAP(json_get_real64_by_path) + procedure,private :: MAYBEWRAP(json_get_real64_vec_by_path) +#endif + procedure,private :: MAYBEWRAP(json_get_logical_by_path) + procedure,private :: MAYBEWRAP(json_get_logical_vec_by_path) + procedure,private :: MAYBEWRAP(json_get_string_by_path) + procedure,private :: MAYBEWRAP(json_get_string_vec_by_path) + procedure,private :: MAYBEWRAP(json_get_array_by_path) + procedure,private :: MAYBEWRAP(json_get_alloc_string_vec_by_path) + procedure,private :: json_get_by_path_default + procedure,private :: json_get_by_path_rfc6901 + procedure,private :: json_get_by_path_jsonpath_bracket + + !> + ! Print the [[json_value]] to an output unit or file. + ! + !### Example + ! + !````fortran + ! type(json_core) :: json + ! type(json_value) :: p + ! !... + ! call json%print(p,'test.json') !this is [[json_print_to_filename]] + !```` + generic,public :: print => json_print_to_console,& + json_print_to_unit,& + json_print_to_filename + procedure :: json_print_to_console + procedure :: json_print_to_unit + procedure :: json_print_to_filename + + !> + ! Destructor routine for a [[json_value]] pointer. + ! This must be called explicitly if it is no longer needed, + ! before it goes out of scope. Otherwise, a memory leak will result. + ! + !### Example + ! + ! Destroy the [[json_value]] pointer before the variable goes out of scope: + !````fortran + ! subroutine example1() + ! type(json_core) :: json + ! type(json_value),pointer :: p + ! call json%create_object(p,'') + ! call json%add(p,'year',2015) + ! call json%print(p) + ! call json%destroy(p) + ! end subroutine example1 + !```` + ! + ! Note: it should NOT be called for a [[json_value]] pointer than has already been + ! added to another [[json_value]] structure, since doing so may render the + ! other structure invalid. Consider the following example: + !````fortran + ! subroutine example2(p) + ! type(json_core) :: json + ! type(json_value),pointer,intent(out) :: p + ! type(json_value),pointer :: q + ! call json%create_object(p,'') + ! call json%add(p,'year',2015) + ! call json%create_object(q,'q') + ! call json%add(q,'val',1) + ! call json%add(p, q) !add q to p structure + ! ! do NOT call json%destroy(q) here, because q is + ! ! now part of the output structure p. p should be destroyed + ! ! somewhere upstream by the caller of this routine. + ! nullify(q) !OK, but not strictly necessary + ! end subroutine example2 + !```` + generic,public :: destroy => json_value_destroy,destroy_json_core + procedure :: json_value_destroy + procedure :: destroy_json_core + + !> + ! If the child variable is present, then remove it. + generic,public :: remove_if_present => MAYBEWRAP(json_value_remove_if_present) + procedure :: MAYBEWRAP(json_value_remove_if_present) + + !> + ! Allocate a [[json_value]] pointer and make it a real variable. + ! The pointer should not already be allocated. + ! + !### Example + ! + !````fortran + ! type(json_core) :: json + ! type(json_value),pointer :: p + ! call json%create_real(p,'value',1.0_RK) + !```` + ! + !### Note + ! * [[json_core(type):create_real]] is just an alias + ! to this one for backward compatibility. + generic,public :: create_real => MAYBEWRAP(json_value_create_real) + procedure :: MAYBEWRAP(json_value_create_real) +#ifndef REAL32 + generic,public :: create_real => MAYBEWRAP(json_value_create_real32) + procedure :: MAYBEWRAP(json_value_create_real32) +#endif +#ifdef REAL128 + generic,public :: create_real => MAYBEWRAP(json_value_create_real64) + procedure :: MAYBEWRAP(json_value_create_real64) +#endif + + !> + ! This is equivalent to [[json_core(type):create_real]], + ! and is here only for backward compatibility. + generic,public :: create_double => MAYBEWRAP(json_value_create_real) +#ifndef REAL32 + generic,public :: create_double => MAYBEWRAP(json_value_create_real32) +#endif +#ifdef REAL128 + generic,public :: create_double => MAYBEWRAP(json_value_create_real64) +#endif + + !> + ! Allocate a [[json_value]] pointer and make it an array variable. + ! The pointer should not already be allocated. + ! + !### Example + ! + !````fortran + ! type(json_core) :: json + ! type(json_value),pointer :: p + ! call json%create_array(p,'arrayname') + !```` + generic,public :: create_array => MAYBEWRAP(json_value_create_array) + procedure :: MAYBEWRAP(json_value_create_array) + + !> + ! Allocate a [[json_value]] pointer and make it an object variable. + ! The pointer should not already be allocated. + ! + !### Example + ! + !````fortran + ! type(json_core) :: json + ! type(json_value),pointer :: p + ! call json%create_object(p,'objectname') + !```` + ! + !@note The name is not significant for the root structure or an array element. + ! In those cases, an empty string can be used. + generic,public :: create_object => MAYBEWRAP(json_value_create_object) + procedure :: MAYBEWRAP(json_value_create_object) + + !> + ! Allocate a json_value pointer and make it a null variable. + ! The pointer should not already be allocated. + ! + !### Example + ! + !````fortran + ! type(json_core) :: json + ! type(json_value),pointer :: p + ! call json%create_null(p,'value') + !```` + generic,public :: create_null => MAYBEWRAP(json_value_create_null) + procedure :: MAYBEWRAP(json_value_create_null) + + !> + ! Allocate a json_value pointer and make it a string variable. + ! The pointer should not already be allocated. + ! + !### Example + ! + !````fortran + ! type(json_core) :: json + ! type(json_value),pointer :: p + ! call json%create_string(p,'value','foobar') + !```` + generic,public :: create_string => MAYBEWRAP(json_value_create_string) + procedure :: MAYBEWRAP(json_value_create_string) + + !> + ! Allocate a json_value pointer and make it an integer variable. + ! The pointer should not already be allocated. + ! + !### Example + ! + !````fortran + ! type(json_core) :: json + ! type(json_value),pointer :: p + ! call json%create_integer(p,42,'value') + !```` + generic,public :: create_integer => MAYBEWRAP(json_value_create_integer) + procedure :: MAYBEWRAP(json_value_create_integer) + + !> + ! Allocate a json_value pointer and make it a logical variable. + ! The pointer should not already be allocated. + ! + !### Example + ! + !````fortran + ! type(json_core) :: json + ! type(json_value),pointer :: p + ! call json%create_logical(p,'value',.true.) + !```` + generic,public :: create_logical => MAYBEWRAP(json_value_create_logical) + procedure :: MAYBEWRAP(json_value_create_logical) + + !> + ! Parse the JSON file and populate the [[json_value]] tree. + generic,public :: load => json_parse_file + procedure :: json_parse_file + + !> + ! Print the [[json_value]] structure to an allocatable string + procedure,public :: serialize => json_value_to_string + + !> + ! The same as `serialize`, but only here for backward compatibility + procedure,public :: print_to_string => json_value_to_string + + !> + ! Parse the JSON string and populate the [[json_value]] tree. + generic,public :: deserialize => MAYBEWRAP(json_parse_string) + procedure :: MAYBEWRAP(json_parse_string) + + !> + ! Same as `load` and `deserialize` but only here for backward compatibility. + generic,public :: parse => json_parse_file, & + MAYBEWRAP(json_parse_string) + + !> + ! Throw an exception. + generic,public :: throw_exception => MAYBEWRAP(json_throw_exception) + procedure :: MAYBEWRAP(json_throw_exception) + + !> + ! Rename a [[json_value]] variable. + generic,public :: rename => MAYBEWRAP(json_value_rename),& + MAYBEWRAP(json_rename_by_path) + procedure :: MAYBEWRAP(json_value_rename) + procedure :: MAYBEWRAP(json_rename_by_path) +#ifdef USE_UCS4 + generic,public :: rename => json_rename_by_path_name_ascii,& + json_rename_by_path_path_ascii + procedure :: json_rename_by_path_name_ascii + procedure :: json_rename_by_path_path_ascii +#endif + + !> + ! get info about a [[json_value]] + generic,public :: info => json_info, MAYBEWRAP(json_info_by_path) + procedure :: json_info + procedure :: MAYBEWRAP(json_info_by_path) + + !> + ! get string info about a [[json_value]] + generic,public :: string_info => json_string_info + procedure :: json_string_info + + !> + ! get matrix info about a [[json_value]] + generic,public :: matrix_info => json_matrix_info, MAYBEWRAP(json_matrix_info_by_path) + procedure :: json_matrix_info + procedure :: MAYBEWRAP(json_matrix_info_by_path) + + !> + ! insert a new element after an existing one, + ! updating the JSON structure accordingly + generic,public :: insert_after => json_value_insert_after, & + json_value_insert_after_child_by_index + procedure :: json_value_insert_after + procedure :: json_value_insert_after_child_by_index + + !> + ! get the path to a JSON variable in a structure: + generic,public :: get_path => MAYBEWRAP(json_get_path) + procedure :: MAYBEWRAP(json_get_path) + + !> + ! verify if a path is valid + ! (i.e., a variable with this path exists in the file). + generic,public :: valid_path => MAYBEWRAP(json_valid_path) + procedure :: MAYBEWRAP(json_valid_path) + + procedure,public :: remove => json_value_remove !! Remove a [[json_value]] from a + !! linked-list structure. + procedure,public :: replace => json_value_replace !! Replace a [[json_value]] in a + !! linked-list structure. + procedure,public :: reverse => json_value_reverse !! Reverse the order of the children + !! of an array of object. + procedure,public :: check_for_errors => json_check_for_errors !! check for error and get error message + procedure,public :: clear_exceptions => json_clear_exceptions !! clear exceptions + procedure,public :: count => json_count !! count the number of children + procedure,public :: clone => json_clone !! clone a JSON structure (deep copy) + procedure,public :: failed => json_failed !! check for error + procedure,public :: get_parent => json_get_parent !! get pointer to json_value parent + procedure,public :: get_next => json_get_next !! get pointer to json_value next + procedure,public :: get_previous => json_get_previous !! get pointer to json_value previous + procedure,public :: get_tail => json_get_tail !! get pointer to json_value tail + procedure,public :: initialize => json_initialize !! to initialize some parsing parameters + procedure,public :: traverse => json_traverse !! to traverse all elements of a JSON + !! structure + procedure,public :: print_error_message => json_print_error_message !! simply routine to print error + !! messages + procedure,public :: swap => json_value_swap !! Swap two [[json_value]] pointers + !! in a structure (or two different + !! structures). + procedure,public :: is_child_of => json_value_is_child_of !! Check if a [[json_value]] is a + !! descendant of another. + procedure,public :: validate => json_value_validate !! Check that a [[json_value]] linked + !! list is valid (i.e., is properly + !! constructed). This may be useful + !! if it has been constructed externally. + procedure,public :: check_for_duplicate_keys & + => json_check_all_for_duplicate_keys !! Check entire JSON structure + !! for duplicate keys (recursively) + procedure,public :: check_children_for_duplicate_keys & + => json_check_children_for_duplicate_keys !! Check a `json_value` object's + !! children for duplicate keys + + !other private routines: + procedure :: name_equal + procedure :: name_strings_equal + procedure :: json_value_print + procedure :: string_to_int + procedure :: string_to_dble + procedure :: prepare_parser => json_prepare_parser + procedure :: parse_end => json_parse_end + procedure :: parse_value + procedure :: parse_number + procedure :: parse_string + procedure :: parse_for_chars + procedure :: parse_object + procedure :: parse_array + procedure :: annotate_invalid_json + procedure :: pop_char + procedure :: push_char + procedure :: get_current_line_from_file_stream + procedure,nopass :: get_current_line_from_file_sequential + procedure :: convert + procedure :: to_string + procedure :: to_logical + procedure :: to_integer + procedure :: to_real + procedure :: to_null + procedure :: to_object + procedure :: to_array + procedure,nopass :: json_value_clone_func + procedure :: is_vector => json_is_vector + + end type json_core + !********************************************************* + + !********************************************************* + !> + ! Structure constructor to initialize a + ! [[json_core(type)]] object + ! + !### Example + ! + !```fortran + ! type(json_file) :: json_core + ! json_core = json_core() + !``` + interface json_core + module procedure initialize_json_core + end interface + !********************************************************* + + !************************************************************************************* + abstract interface + + subroutine json_array_callback_func(json, element, i, count) + !! Array element callback function. Used by [[json_get_array]] + import :: json_value,json_core,IK + implicit none + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: element + integer(IK),intent(in) :: i !! index + integer(IK),intent(in) :: count !! size of array + end subroutine json_array_callback_func + + subroutine json_traverse_callback_func(json,p,finished) + !! Callback function used by [[json_traverse]] + import :: json_value,json_core,LK + implicit none + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p + logical(LK),intent(out) :: finished !! set true to stop traversing + end subroutine json_traverse_callback_func + + end interface + public :: json_array_callback_func + public :: json_traverse_callback_func + !************************************************************************************* + + contains +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 4/17/2016 +! +! Destructor for the [[json_core(type)]] type. + + subroutine destroy_json_core(me) + + implicit none + + class(json_core),intent(out) :: me + + end subroutine destroy_json_core +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 4/26/2016 +! +! Function constructor for a [[json_core(type)]]. +! This is just a wrapper for [[json_initialize]]. +! +!@note [[initialize_json_core]], [[json_initialize]], +! [[initialize_json_core_in_file]], and [[initialize_json_file]] +! all have a similar interface. + + function initialize_json_core(& +#include "json_initialize_dummy_arguments.inc" + ) result(json_core_object) + + implicit none + + type(json_core) :: json_core_object +#include "json_initialize_arguments.inc" + + call json_core_object%initialize(& +#include "json_initialize_dummy_arguments.inc" + ) + + end function initialize_json_core +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/4/2013 +! +! Initialize the [[json_core(type)]] instance. +! +! The routine may be called before any of the [[json_core(type)]] methods are used in +! order to specify certain parameters. If it is not called, then the defaults +! are used. This routine is also called internally by various routines. +! It can also be called to clear exceptions, or to reset some +! of the variables (note that only the arguments present are changed). +! +!### Modified +! * Izaak Beekman : 02/24/2015 +! +!@note [[initialize_json_core]], [[json_initialize]], +! [[initialize_json_core_in_file]], and [[initialize_json_file]] +! all have a similar interface. + + subroutine json_initialize(me,& +#include "json_initialize_dummy_arguments.inc" + ) + + implicit none + + class(json_core),intent(inout) :: me +#include "json_initialize_arguments.inc" + + character(kind=CDK,len=10) :: w !! max string length + character(kind=CDK,len=10) :: d !! real precision digits + character(kind=CDK,len=10) :: e !! real exponent digits + character(kind=CDK,len=2) :: sgn !! sign flag: `ss` or `sp` + character(kind=CDK,len=2) :: rl_edit_desc !! `G`, `E`, `EN`, or `ES` + integer(IK) :: istat !! `iostat` flag for + !! write statements + logical(LK) :: sgn_prnt !! print sign flag + character(kind=CK,len=max_integer_str_len) :: istr !! for integer to + !! string conversion + + !reset exception to false: + call me%clear_exceptions() + + !Just in case, clear these global variables also: + me%pushed_index = 0 + me%pushed_char = CK_'' + me%char_count = 0 + me%line_count = 1 + me%ipos = 1 + if (use_unformatted_stream) then + me%filesize = 0 + me%ichunk = 0 + me%chunk = repeat(space, stream_chunk_size) ! default chunk size + end if + +#ifdef USE_UCS4 + ! reopen stdout and stderr with utf-8 encoding + open(output_unit,encoding='utf-8') + open(error_unit, encoding='utf-8') +#endif + + !various optional inputs: + if (present(spaces_per_tab)) & + me%spaces_per_tab = spaces_per_tab + if (present(stop_on_error)) & + me%stop_on_error = stop_on_error + if (present(verbose)) & + me%is_verbose = verbose + if (present(strict_type_checking)) & + me%strict_type_checking = strict_type_checking + if (present(trailing_spaces_significant)) & + me%trailing_spaces_significant = trailing_spaces_significant + if (present(case_sensitive_keys)) & + me%case_sensitive_keys = case_sensitive_keys + if (present(no_whitespace)) & + me%no_whitespace = no_whitespace + if (present(unescape_strings)) & + me%unescaped_strings = unescape_strings + if (present(path_mode)) then + if (path_mode==1_IK .or. path_mode==2_IK .or. path_mode==3_IK) then + me%path_mode = path_mode + else + me%path_mode = 1_IK ! just to have a valid value + call me%throw_exception('Invalid path_mode.') + end if + end if + + ! if we are allowing comments in the file: + ! [an empty string disables comments] + if (present(comment_char)) then + me%allow_comments = comment_char/=CK_'' + me%comment_char = trim(adjustl(comment_char)) + end if + + ! path separator: + if (present(path_separator)) then + me%path_separator = path_separator + end if + + ! printing vectors in compressed form: + if (present(compress_vectors)) then + me%compress_vectors = compress_vectors + end if + + ! checking for duplicate keys: + if (present(allow_duplicate_keys)) then + me%allow_duplicate_keys = allow_duplicate_keys + end if + + ! if escaping the forward slash: + if (present(escape_solidus)) then + me%escape_solidus = escape_solidus + end if + + ! how to handle null to read conversions: + if (present(null_to_real_mode)) then + select case (null_to_real_mode) + case(1_IK:3_IK) + me%null_to_real_mode = null_to_real_mode + case default + me%null_to_real_mode = 2_IK ! just to have a valid value + call integer_to_string(null_to_real_mode,int_fmt,istr) + call me%throw_exception('Invalid null_to_real_mode: '//istr) + end select + end if + + ! how to handle NaN and Infinities: + if (present(non_normal_mode)) then + select case (non_normal_mode) + case(1_IK) ! use strings + me%non_normals_to_null = .false. + case(2_IK) ! use null + me%non_normals_to_null = .true. + case default + call integer_to_string(non_normal_mode,int_fmt,istr) + call me%throw_exception('Invalid non_normal_mode: '//istr) + end select + end if + + if (present(use_quiet_nan)) then + me%use_quiet_nan = use_quiet_nan + end if + + if (present(strict_integer_type_checking)) then + me%strict_integer_type_checking = strict_integer_type_checking + end if + + !Set the format for real numbers: + ! [if not changing it, then it remains the same] + + if ( (.not. allocated(me%real_fmt)) .or. & ! if this hasn't been done yet + present(compact_reals) .or. & + present(print_signs) .or. & + present(real_format) ) then + + !allow the special case where real format is '*': + ! [this overrides the other options] + if (present(real_format)) then + if (real_format==star) then + if (present(compact_reals)) then + ! we will also allow for compact reals with + ! '*' format, if both arguments are present. + me%compact_real = compact_reals + else + me%compact_real = .false. + end if + me%real_fmt = star + return + end if + end if + + if (present(compact_reals)) me%compact_real = compact_reals + + !set defaults + sgn_prnt = .false. + if ( present( print_signs) ) sgn_prnt = print_signs + if ( sgn_prnt ) then + sgn = 'sp' + else + sgn = 'ss' + end if + + rl_edit_desc = 'E' + if ( present( real_format ) ) then + select case ( real_format ) + case ('g','G','e','E','en','EN','es','ES') + rl_edit_desc = real_format + case default + call me%throw_exception('Invalid real format, "' // & + trim(real_format) // '", passed to json_initialize.'// & + new_line('a') // 'Acceptable formats are: "G", "E", "EN", and "ES".' ) + end select + end if + + ! set the default output/input format for reals: + write(w,'(ss,I0)',iostat=istat) max_numeric_str_len + if (istat==0) write(d,'(ss,I0)',iostat=istat) real_precision + if (istat==0) write(e,'(ss,I0)',iostat=istat) real_exponent_digits + if (istat==0) then + me%real_fmt = '(' // sgn // ',' // trim(rl_edit_desc) //& + trim(w) // '.' // trim(d) // 'E' // trim(e) // ')' + else + me%real_fmt = '(' // sgn // ',' // trim(rl_edit_desc) // & + '27.17E4)' !just use this one (should never happen) + end if + + end if + + end subroutine json_initialize +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Returns true if `name` is equal to `p%name`, using the specified +! settings for case sensitivity and trailing whitespace. +! +!### History +! * 4/30/2016 : original version +! * 8/25/2017 : now just a wrapper for [[name_strings_equal]] + + function name_equal(json,p,name) result(is_equal) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),intent(in) :: p !! the json object + character(kind=CK,len=*),intent(in) :: name !! the name to check for + logical(LK) :: is_equal !! true if the string are + !! lexically equal + + if (allocated(p%name)) then + ! call the low-level routines for the name strings: + is_equal = json%name_strings_equal(p%name,name) + else + is_equal = name == CK_'' ! check a blank name + end if + + end function name_equal +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 8/25/2017 +! +! Returns true if the name strings `name1` is equal to `name2`, using +! the specified settings for case sensitivity and trailing whitespace. + + function name_strings_equal(json,name1,name2) result(is_equal) + + implicit none + + class(json_core),intent(inout) :: json + character(kind=CK,len=*),intent(in) :: name1 !! the name to check + character(kind=CK,len=*),intent(in) :: name2 !! the name to check + logical(LK) :: is_equal !! true if the string are + !! lexically equal + + !must be the same length if we are treating + !trailing spaces as significant, so do a + !quick test of this first: + if (json%trailing_spaces_significant) then + is_equal = len(name1) == len(name2) + if (.not. is_equal) return + end if + + if (json%case_sensitive_keys) then + is_equal = name1 == name2 + else + is_equal = lowercase_string(name1) == lowercase_string(name2) + end if + + end function name_strings_equal +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 10/31/2015 +! +! Create a deep copy of a [[json_value]] linked-list structure. +! +!### Notes +! +! * If `from` has children, then they are also cloned. +! * The parent of `from` is not linked to `to`. +! * If `from` is an element of an array, then the previous and +! next entries are not cloned (only that element and it's children, if any). +! +!### Example +! +!````fortran +! program test +! use json_module +! implicit none +! type(json_core) :: json +! type(json_value),pointer :: j1, j2 +! call json%load('../files/inputs/test1.json',j1) +! call json%clone(j1,j2) !now have two independent copies +! call json%destroy(j1) !destroys j1, but j2 remains +! call json%print(j2,'j2.json') +! call json%destroy(j2) +! end program test +!```` + + subroutine json_clone(json,from,to) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: from !! this is the structure to clone + type(json_value),pointer :: to !! the clone is put here + !! (it must not already be associated) + + !call the main function: + call json%json_value_clone_func(from,to) + + end subroutine json_clone +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 10/31/2015 +! +! Recursive deep copy function called by [[json_clone]]. +! +!@note If new data is added to the [[json_value]] type, +! then this would need to be updated. + + recursive subroutine json_value_clone_func(from,to,parent,previous,tail) + + implicit none + + type(json_value),pointer :: from !! this is the structure to clone + type(json_value),pointer :: to !! the clone is put here (it + !! must not already be associated) + type(json_value),pointer,optional :: parent !! to%parent + type(json_value),pointer,optional :: previous !! to%previous + logical,optional :: tail !! if "to" is the tail of + !! its parent's children + + nullify(to) + + if (associated(from)) then + + allocate(to) + + !copy over the data variables: + ! [note: the allocate() statements don't work here for the + ! deferred-length characters in gfortran-4.9] + if (allocated(from%name)) to%name = from%name + if (allocated(from%dbl_value)) allocate(to%dbl_value,source=from%dbl_value) + if (allocated(from%log_value)) allocate(to%log_value,source=from%log_value) + if (allocated(from%str_value)) to%str_value = from%str_value + if (allocated(from%int_value)) allocate(to%int_value,source=from%int_value) + to%var_type = from%var_type + to%n_children = from%n_children + + ! allocate and associate the pointers as necessary: + if (present(parent)) to%parent => parent + if (present(previous)) to%previous => previous + if (present(tail)) then + if (tail .and. associated(to%parent)) to%parent%tail => to + end if + + if (associated(from%next) .and. associated(to%parent)) then + ! we only clone the next entry in an array + ! if the parent has also been cloned + call json_value_clone_func(from = from%next,& + to = to%next,& + previous = to,& + parent = to%parent,& + tail = (.not. associated(from%next%next))) + end if + + if (associated(from%children)) then + call json_value_clone_func(from = from%children,& + to = to%children,& + parent = to,& + tail = (.not. associated(from%children%next))) + end if + + end if + + end subroutine json_value_clone_func +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Destroy the data within a [[json_value]], and reset type to `json_unknown`. + + pure subroutine destroy_json_data(d) + + implicit none + + type(json_value),intent(inout) :: d + + d%var_type = json_unknown + + if (allocated(d%log_value)) deallocate(d%log_value) + if (allocated(d%int_value)) deallocate(d%int_value) + if (allocated(d%dbl_value)) deallocate(d%dbl_value) + if (allocated(d%str_value)) deallocate(d%str_value) + + end subroutine destroy_json_data +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 2/13/2014 +! +! Returns information about a [[json_value]]. + + subroutine json_info(json,p,var_type,n_children,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + integer(IK),intent(out),optional :: var_type !! variable type + integer(IK),intent(out),optional :: n_children !! number of children + character(kind=CK,len=:),allocatable,intent(out),optional :: name !! variable name + + if (.not. json%exception_thrown .and. associated(p)) then + + if (present(var_type)) var_type = p%var_type + if (present(n_children)) n_children = json%count(p) + if (present(name)) then + if (allocated(p%name)) then + name = p%name + else + name = CK_'' + end if + end if + + else ! error + + if (.not. json%exception_thrown) then + call json%throw_exception('Error in json_info: '//& + 'pointer is not associated.' ) + end if + if (present(var_type)) var_type = json_unknown + if (present(n_children)) n_children = 0 + if (present(name)) name = CK_'' + + end if + + end subroutine json_info +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/18/2016 +! +! Returns information about character strings returned from a [[json_value]]. + + subroutine json_string_info(json,p,ilen,max_str_len,found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + integer(IK),dimension(:),allocatable,intent(out),optional :: ilen !! if `p` is an array, this + !! is the actual length + !! of each character + !! string in the array. + !! if not an array, this + !! is returned unallocated. + integer(IK),intent(out),optional :: max_str_len !! The maximum length required to + !! hold the string representation returned + !! by a call to a `get` routine. If a scalar, + !! this is just the length of the scalar. If + !! a vector, this is the maximum length of + !! any element. + logical(LK),intent(out),optional :: found !! true if there were no errors. + !! if not present, an error will + !! throw an exception + + character(kind=CK,len=:),allocatable :: cval !! for getting values as strings. + logical(LK) :: initialized !! if the output array has been sized + logical(LK) :: get_max_len !! if we are returning the `max_str_len` + logical(LK) :: get_ilen !! if we are returning the `ilen` array + integer(IK) :: var_type !! variable type + + get_max_len = present(max_str_len) + get_ilen = present(ilen) + + if (.not. json%exception_thrown) then + + if (present(found)) found = .true. + initialized = .false. + + if (get_max_len) max_str_len = 0 + + select case (p%var_type) + + case (json_array) ! it's an array + + ! call routine for each element + call json%get(p, array_callback=get_string_lengths) + + case default ! not an array + + if (json%strict_type_checking) then + ! only allowing strings to be returned + ! as strings, so we can check size directly + call json%info(p,var_type=var_type) + if (var_type==json_string) then + if (allocated(p%str_value) .and. get_max_len) & + max_str_len = len(p%str_value) + else + ! it isn't a string, so there is no length + call json%throw_exception('Error in json_string_info: '//& + 'When strict_type_checking is true '//& + 'the variable must be a character string.',& + found) + end if + else + ! in this case, we have to get the value + ! as a string to know what size it is. + call json%get(p, value=cval) + if (.not. json%exception_thrown) then + if (allocated(cval) .and. get_max_len) & + max_str_len = len(cval) + end if + end if + + end select + + end if + + if (json%exception_thrown) then + if (present(found)) then + call json%clear_exceptions() + found = .false. + end if + if (get_max_len) max_str_len = 0 + if (get_ilen) then + if (allocated(ilen)) deallocate(ilen) + end if + end if + + contains + + subroutine get_string_lengths(json, element, i, count) + + !! callback function to call for each element in the array. + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: element + integer(IK),intent(in) :: i !! index + integer(IK),intent(in) :: count !! size of array + + character(kind=CK,len=:),allocatable :: cval + integer(IK) :: var_type + + if (json%exception_thrown) return + + if (.not. initialized) then + if (get_ilen) allocate(ilen(count)) + initialized = .true. + end if + + if (json%strict_type_checking) then + ! only allowing strings to be returned + ! as strings, so we can check size directly + call json%info(element,var_type=var_type) + if (var_type==json_string) then + if (allocated(element%str_value)) then + if (get_max_len) then + if (len(element%str_value)>max_str_len) & + max_str_len = len(element%str_value) + end if + if (get_ilen) ilen(i) = len(element%str_value) + else + if (get_ilen) ilen(i) = 0 + end if + else + ! it isn't a string, so there is no length + call json%throw_exception('Error in json_string_info: '//& + 'When strict_type_checking is true '//& + 'the array must contain only '//& + 'character strings.',found) + end if + else + ! in this case, we have to get the value + ! as a string to know what size it is. + call json%get(element, value=cval) + if (json%exception_thrown) return + if (allocated(cval)) then + if (get_max_len) then + if (len(cval)>max_str_len) max_str_len = len(cval) + end if + if (get_ilen) ilen(i) = len(cval) + else + if (get_ilen) ilen(i) = 0 + end if + end if + + end subroutine get_string_lengths + + end subroutine json_string_info +!***************************************************************************************** + +!***************************************************************************************** +! +! Returns information about a [[json_value]], given the path. +! +!### See also +! * [[json_info]] +! +!@note If `found` is present, no exceptions will be thrown if an +! error occurs. Otherwise, an exception will be thrown if the +! variable is not found. + + subroutine json_info_by_path(json,p,path,found,var_type,n_children,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p !! a JSON linked list + character(kind=CK,len=*),intent(in) :: path !! path to the variable + logical(LK),intent(out),optional :: found !! true if it was found + integer(IK),intent(out),optional :: var_type !! variable type + integer(IK),intent(out),optional :: n_children !! number of children + character(kind=CK,len=:),allocatable,intent(out),optional :: name !! variable name + + type(json_value),pointer :: p_var !! temporary pointer + logical(LK) :: ok !! if the variable was found +#if defined __GFORTRAN__ + character(kind=CK,len=:),allocatable :: p_name !! temporary variable for getting name +#endif + + call json%get(p,path,p_var,found) + + !check if it was found: + if (present(found)) then + ok = found + else + ok = .not. json%exception_thrown + end if + + if (.not. ok) then + if (present(var_type)) var_type = json_unknown + if (present(n_children)) n_children = 0 + if (present(name)) name = CK_'' + else + !get info: + +#if defined __GFORTRAN__ + call json%info(p_var,var_type,n_children) + if (present(name)) then !workaround for gfortran bug + if (allocated(p_var%name)) then + p_name = p_var%name + name = p_name + else + name = CK_'' + end if + end if +#else + call json%info(p_var,var_type,n_children,name) +#endif + + end if + + end subroutine json_info_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_info_by_path]] where "path" is kind=CDK. + + subroutine wrap_json_info_by_path(json,p,path,found,var_type,n_children,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p !! a JSON linked list + character(kind=CDK,len=*),intent(in) :: path !! path to the variable + logical(LK),intent(out),optional :: found !! true if it was found + integer(IK),intent(out),optional :: var_type !! variable type + integer(IK),intent(out),optional :: n_children !! number of children + character(kind=CK,len=:),allocatable,intent(out),optional :: name !! variable name + + call json%info(p,to_unicode(path),found,var_type,n_children,name) + + end subroutine wrap_json_info_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 10/16/2015 +! +! Alternate version of [[json_info]] that returns matrix +! information about a [[json_value]]. +! +! A [[json_value]] is a valid rank 2 matrix if all of the following are true: +! +! * The var_type is *json_array* +! * Each child is also a *json_array*, each of which has the same number of elements +! * Each individual element has the same variable type (integer, logical, etc.) +! +! The idea here is that if it is a valid matrix, it can be interoperable with +! a Fortran rank 2 array of the same type. +! +!### Example +! +! The following example is an array with `var_type=json_integer`, +! `n_sets=3`, and `set_size=4` +! +!```json +! { +! "matrix": [ +! [1,2,3,4], +! [5,6,7,8], +! [9,10,11,12] +! ] +! } +!``` + + subroutine json_matrix_info(json,p,is_matrix,var_type,n_sets,set_size,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p !! a JSON linked list + logical(LK),intent(out) :: is_matrix !! true if it is a valid matrix + integer(IK),intent(out),optional :: var_type !! variable type of data in the matrix + !! (if all elements have the same type) + integer(IK),intent(out),optional :: n_sets !! number of data sets (i.e., matrix + !! rows if using row-major order) + integer(IK),intent(out),optional :: set_size !! size of each data set (i.e., matrix + !! cols if using row-major order) + character(kind=CK,len=:),allocatable,intent(out),optional :: name !! variable name + + type(json_value),pointer :: p_row !! for getting a set + type(json_value),pointer :: p_element !! for getting an element in a set + integer(IK) :: vartype !! json variable type of `p` + integer(IK) :: row_vartype !! json variable type of a row + integer(IK) :: element_vartype !! json variable type of an element in a row + integer(IK) :: nr !! number of children of `p` + integer(IK) :: nc !! number of elements in first child of `p` + integer(IK) :: icount !! number of elements in a set + integer(IK) :: i !! counter + integer(IK) :: j !! counter +#if defined __GFORTRAN__ + character(kind=CK,len=:),allocatable :: p_name !! temporary variable for getting name +#endif + + !get info about the variable: +#if defined __GFORTRAN__ + call json%info(p,vartype,nr) + if (present(name)) then !workaround for gfortran bug + if (allocated(p%name)) then + p_name = p%name + name = p_name + else + name = CK_'' + end if + end if +#else + call json%info(p,vartype,nr,name) +#endif + + is_matrix = (vartype==json_array) + + if (is_matrix) then + + main : do i=1,nr + + nullify(p_row) + call json%get_child(p,i,p_row) + if (.not. associated(p_row)) then + is_matrix = .false. + call json%throw_exception('Error in json_matrix_info: '//& + 'Malformed JSON linked list') + exit main + end if + call json%info(p_row,var_type=row_vartype,n_children=icount) + + if (row_vartype==json_array) then + if (i==1) nc = icount !number of columns in first row + if (icount==nc) then !make sure each row has the same number of columns + !see if all the variables in this row are the same type: + do j=1,icount + nullify(p_element) + call json%get_child(p_row,j,p_element) + if (.not. associated(p_element)) then + is_matrix = .false. + call json%throw_exception('Error in json_matrix_info: '//& + 'Malformed JSON linked list') + exit main + end if + call json%info(p_element,var_type=element_vartype) + if (i==1 .and. j==1) vartype = element_vartype !type of first element + !in the row + if (vartype/=element_vartype) then + !not all variables are the same time + is_matrix = .false. + exit main + end if + end do + else + is_matrix = .false. + exit main + end if + else + is_matrix = .false. + exit main + end if + + end do main + + end if + + if (is_matrix) then + if (present(var_type)) var_type = vartype + if (present(n_sets)) n_sets = nr + if (present(set_size)) set_size = nc + else + if (present(var_type)) var_type = json_unknown + if (present(n_sets)) n_sets = 0 + if (present(set_size)) set_size = 0 + end if + + end subroutine json_matrix_info +!***************************************************************************************** + +!***************************************************************************************** +!> +! Returns matrix information about a [[json_value]], given the path. +! +!### See also +! * [[json_matrix_info]] +! +!@note If `found` is present, no exceptions will be thrown if an +! error occurs. Otherwise, an exception will be thrown if the +! variable is not found. + + subroutine json_matrix_info_by_path(json,p,path,is_matrix,found,& + var_type,n_sets,set_size,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p !! a JSON linked list + character(kind=CK,len=*),intent(in) :: path !! path to the variable + logical(LK),intent(out) :: is_matrix !! true if it is a valid matrix + logical(LK),intent(out),optional :: found !! true if it was found + integer(IK),intent(out),optional :: var_type !! variable type of data in + !! the matrix (if all elements have + !! the same type) + integer(IK),intent(out),optional :: n_sets !! number of data sets (i.e., matrix + !! rows if using row-major order) + integer(IK),intent(out),optional :: set_size !! size of each data set (i.e., matrix + !! cols if using row-major order) + character(kind=CK,len=:),allocatable,intent(out),optional :: name !! variable name + + type(json_value),pointer :: p_var + logical(LK) :: ok +#if defined __GFORTRAN__ + character(kind=CK,len=:),allocatable :: p_name !! temporary variable for getting name +#endif + + call json%get(p,path,p_var,found) + + !check if it was found: + if (present(found)) then + ok = found + else + ok = .not. json%exception_thrown + end if + + if (.not. ok) then + if (present(var_type)) var_type = json_unknown + if (present(n_sets)) n_sets = 0 + if (present(set_size)) set_size = 0 + if (present(name)) name = CK_'' + else + + !get info about the variable: +#if defined __GFORTRAN__ + call json%matrix_info(p_var,is_matrix,var_type,n_sets,set_size) + if (present(name)) then !workaround for gfortran bug + if (allocated(p_var%name)) then + p_name = p_var%name + name = p_name + else + name = CK_'' + end if + end if +#else + call json%matrix_info(p_var,is_matrix,var_type,n_sets,set_size,name) +#endif + if (json%exception_thrown .and. present(found)) then + found = .false. + call json%clear_exceptions() + end if + end if + + end subroutine json_matrix_info_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_matrix_info_by_path]] where "path" is kind=CDK. + + subroutine wrap_json_matrix_info_by_path(json,p,path,is_matrix,found,& + var_type,n_sets,set_size,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p !! a JSON linked list + character(kind=CDK,len=*),intent(in) :: path !! path to the variable + logical(LK),intent(out) :: is_matrix !! true if it is a valid matrix + logical(LK),intent(out),optional :: found !! true if it was found + integer(IK),intent(out),optional :: var_type !! variable type of data in + !! the matrix (if all elements have + !! the same type) + integer(IK),intent(out),optional :: n_sets !! number of data sets (i.e., matrix + !! rows if using row-major order) + integer(IK),intent(out),optional :: set_size !! size of each data set (i.e., matrix + !! cols if using row-major order) + character(kind=CK,len=:),allocatable,intent(out),optional :: name !! variable name + + call json%matrix_info(p,to_unicode(path),is_matrix,found,var_type,n_sets,set_size,name) + + end subroutine wrap_json_matrix_info_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 4/29/2016 +! +! Rename a [[json_value]]. + + subroutine json_value_rename(json,p,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p + character(kind=CK,len=*),intent(in) :: name !! new variable name + + if (json%trailing_spaces_significant) then + p%name = name + else + p%name = trim(name) + end if + + end subroutine json_value_rename +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 4/29/2016 +! +! Alternate version of [[json_value_rename]], where `name` is kind=CDK. + + subroutine wrap_json_value_rename(json,p,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p + character(kind=CDK,len=*),intent(in) :: name !! new variable name + + call json%rename(p,to_unicode(name)) + + end subroutine wrap_json_value_rename +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/4/2013 +! +! Clear exceptions in the [[json_core(type)]]. + + pure subroutine json_clear_exceptions(json) + + implicit none + + class(json_core),intent(inout) :: json + + !clear the flag and message: + json%exception_thrown = .false. + if (allocated(json%err_message)) deallocate(json%err_message) + + end subroutine json_clear_exceptions +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/4/2013 +! +! Throw an exception in the [[json_core(type)]]. +! This routine sets the error flag, and prevents any subsequent routine +! from doing anything, until [[json_clear_exceptions]] is called. +! +!@note If `is_verbose` is true, this will also print a +! traceback if the Intel compiler is used. +! +!@note If `stop_on_error` is true, then the program is stopped. + + subroutine json_throw_exception(json,msg,found) + +#ifdef __INTEL_COMPILER + use ifcore, only: tracebackqq +#endif + + implicit none + + class(json_core),intent(inout) :: json + character(kind=CK,len=*),intent(in) :: msg !! the error message + logical(LK),intent(inout),optional :: found !! if the caller is handling the + !! exception with an optimal return + !! argument. If so, `json%stop_on_error` + !! is ignored. + + logical(LK) :: stop_on_error + + json%exception_thrown = .true. + json%err_message = trim(msg) + stop_on_error = json%stop_on_error .and. .not. present(found) + + if (stop_on_error) then + +#ifdef __INTEL_COMPILER + ! for Intel, we raise a traceback and quit + call tracebackqq(string=trim(msg), user_exit_code=0) +#else + write(error_unit,'(A)') 'JSON-Fortran Exception: '//trim(msg) + error stop 1 +#endif + + elseif (json%is_verbose) then + + write(output_unit,'(A)') '***********************' + write(output_unit,'(A)') 'JSON-Fortran Exception: '//trim(msg) + +!#if defined __GFORTRAN__ +! call backtrace() ! (have to compile with -fbacktrace -fall-intrinsics flags) +!#endif + +#ifdef __INTEL_COMPILER + call tracebackqq(user_exit_code=-1) ! print a traceback and return +#endif + + write(output_unit,'(A)') '***********************' + + end if + + end subroutine json_throw_exception +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_throw_exception]], where `msg` is kind=CDK. + + subroutine wrap_json_throw_exception(json,msg,found) + + implicit none + + class(json_core),intent(inout) :: json + character(kind=CDK,len=*),intent(in) :: msg !! the error message + logical(LK),intent(inout),optional :: found !! if the caller is handling the + !! exception with an optimal return + !! argument. If so, `json%stop_on_error` + !! is ignored. + + call json%throw_exception(to_unicode(msg),found) + + end subroutine wrap_json_throw_exception +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/4/2013 +! +! Retrieve error code from the [[json_core(type)]]. +! This should be called after `parse` to check for errors. +! If an error is thrown, before using the class again, [[json_initialize]] +! should be called to clean up before it is used again. +! +!### Example +! +!````fortran +! type(json_file) :: json +! logical :: status_ok +! character(kind=CK,len=:),allocatable :: error_msg +! call json%load(filename='myfile.json') +! call json%check_for_errors(status_ok, error_msg) +! if (.not. status_ok) then +! write(*,*) 'Error: '//error_msg +! call json%clear_exceptions() +! call json%destroy() +! end if +!```` +! +!### See also +! * [[json_failed]] +! * [[json_throw_exception]] + + subroutine json_check_for_errors(json,status_ok,error_msg) + + implicit none + + class(json_core),intent(in) :: json + logical(LK),intent(out),optional :: status_ok !! true if there were no errors + character(kind=CK,len=:),allocatable,intent(out),optional :: error_msg !! the error message. + !! (not allocated if + !! there were no errors) + +#if defined __GFORTRAN__ + character(kind=CK,len=:),allocatable :: tmp !! workaround for gfortran bugs +#endif + + if (present(status_ok)) status_ok = .not. json%exception_thrown + + if (present(error_msg)) then + if (json%exception_thrown) then + ! if an exception has been thrown, + ! then this will always be allocated + ! [see json_throw_exception] +#if defined __GFORTRAN__ + tmp = json%err_message + error_msg = tmp +#else + error_msg = json%err_message +#endif + end if + end if + + end subroutine json_check_for_errors +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/5/2013 +! +! Logical function to indicate if an exception has been thrown in a [[json_core(type)]]. +! +!### Example +! +!````fortran +! type(json_core) :: json +! type(json_value),pointer :: p +! logical :: status_ok +! character(len=:),allocatable :: error_msg +! call json%load(filename='myfile.json',p) +! if (json%failed()) then +! call json%check_for_errors(status_ok, error_msg) +! write(*,*) 'Error: '//error_msg +! call json%clear_exceptions() +! call json%destroy(p) +! end if +!```` +! +! Note that [[json_file]] contains a wrapper for this routine, which is used like: +!````fortran +! type(json_file) :: f +! logical :: status_ok +! character(len=:),allocatable :: error_msg +! call f%load(filename='myfile.json') +! if (f%failed()) then +! call f%check_for_errors(status_ok, error_msg) +! write(*,*) 'Error: '//error_msg +! call f%clear_exceptions() +! call f%destroy() +! end if +!```` +! +!### See also +! * [[json_check_for_errors]] + + pure function json_failed(json) result(failed) + + implicit none + + class(json_core),intent(in) :: json + logical(LK) :: failed !! will be true if an exception + !! has been thrown. + + failed = json%exception_thrown + + end function json_failed +!***************************************************************************************** + +!***************************************************************************************** +!> +! Allocate a [[json_value]] pointer variable. +! This should be called before adding data to it. +! +!### Example +! +!````fortran +! type(json_value),pointer :: var +! call json_value_create(var) +! call json%to_real(var,1.0_RK) +!```` +! +!### Notes +! 1. This routine does not check for exceptions. +! 2. The pointer should not already be allocated, or a memory leak will occur. + + subroutine json_value_create(p) + + implicit none + + type(json_value),pointer :: p + + nullify(p) + allocate(p) + + end subroutine json_value_create +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/22/2014 +! +! Destroy a [[json_value]] linked-list structure. +! +!@note The original FSON version of this +! routine was not properly freeing the memory. +! It was rewritten. +! +!@note This routine destroys this variable, it's children, and +! (if `destroy_next` is true) the subsequent elements in +! an object or array. It does not destroy the parent or +! previous elements. +! +!@Note There is some protection here to enable destruction of +! improperly-created linked lists. However, likely there +! are cases not handled. Use the [[json_value_validate]] +! method to validate a JSON structure that was manually +! created using [[json_value]] pointers. + + pure recursive subroutine json_value_destroy(json,p,destroy_next) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p !! variable to destroy + logical(LK),intent(in),optional :: destroy_next !! if true, then `p%next` + !! is also destroyed (default is true) + + logical(LK) :: des_next !! local copy of `destroy_next` + !! optional argument + type(json_value),pointer :: child !! for getting child elements + logical :: circular !! to check to malformed linked lists + + if (associated(p)) then + + if (present(destroy_next)) then + des_next = destroy_next + else + des_next = .true. + end if + + if (allocated(p%name)) deallocate(p%name) + + call destroy_json_data(p) + + if (associated(p%next)) then + ! check for circular references: + if (associated(p, p%next)) nullify(p%next) + end if + + if (associated(p%children)) then + do while (p%n_children > 0) + child => p%children + if (associated(child)) then + p%children => p%children%next + p%n_children = p%n_children - 1 + ! check children for circular references: + circular = (associated(p%children) .and. & + associated(p%children,child)) + call json%destroy(child,destroy_next=.false.) + if (circular) exit + else + ! it is a malformed JSON object. But, we will + ! press ahead with the destroy process, since + ! otherwise, there would be no way to destroy it. + exit + end if + end do + nullify(p%children) + nullify(child) + end if + + if (associated(p%next) .and. des_next) call json%destroy(p%next) + + nullify(p%previous) + nullify(p%parent) + nullify(p%tail) + + if (associated(p)) deallocate(p) + nullify(p) + + end if + + end subroutine json_value_destroy +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 9/9/2014 +! +! Remove a [[json_value]] (and all its children) +! from a linked-list structure, preserving the rest of the structure. +! +!### Examples +! +! To extract an object from one JSON structure, and add it to another: +!````fortran +! type(json_core) :: json +! type(json_value),pointer :: json1,json2,p +! logical :: found +! !create and populate json1 and json2 +! call json%get(json1,'name',p,found) ! get pointer to name element of json1 +! call json%remove(p,destroy=.false.) ! remove it from json1 (don't destroy) +! call json%add(json2,p) ! add it to json2 +!```` +! +! To remove an object from a JSON structure (and destroy it): +!````fortran +! type(json_core) :: json +! type(json_value),pointer :: json1,p +! logical :: found +! !create and populate json1 +! call json%get(json1,'name',p,found) ! get pointer to name element of json1 +! call json%remove(p) ! remove and destroy it +!```` +! +!### History +! * Jacob Williams : 12/28/2014 : added destroy optional argument. +! * Jacob Williams : 12/04/2020 : bug fix. + + subroutine json_value_remove(json,p,destroy) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + logical(LK),intent(in),optional :: destroy !! Option to destroy `p` after it is removed: + !! + !! * If `destroy` is not present, it is also destroyed. + !! * If `destroy` is present and true, it is destroyed. + !! * If `destroy` is present and false, it is not destroyed. + + type(json_value),pointer :: parent !! pointer to parent + type(json_value),pointer :: previous !! pointer to previous + type(json_value),pointer :: next !! pointer to next + logical(LK) :: destroy_it !! if `p` should be destroyed + + if (associated(p)) then + + !optional input argument: + if (present(destroy)) then + destroy_it = destroy + else + destroy_it = .true. + end if + + if (associated(p%parent)) then + + parent => p%parent + + if (associated(p%next)) then + + !there are later items in the list: + next => p%next + + if (associated(p%previous)) then + !there are earlier items in the list + previous => p%previous + previous%next => next + next%previous => previous + else + !this is the first item in the list + parent%children => next + nullify(next%previous) + end if + + else + + if (associated(p%previous)) then + !there are earlier items in the list: + previous => p%previous + nullify(previous%next) + parent%tail => previous + else + !this is the only item in the list: + nullify(parent%children) + nullify(parent%tail) + end if + + end if + + ! nullify all pointers to original structure: + nullify(p%next) + nullify(p%previous) + nullify(p%parent) + + parent%n_children = parent%n_children - 1 + + end if + + if (destroy_it) call json%destroy(p) + + end if + + end subroutine json_value_remove +!***************************************************************************************** + +!***************************************************************************************** +!> +! Replace `p1` with `p2` in a JSON structure. +! +!@note The replacement is done using an insert and remove +! See [[json_value_insert_after]] and [[json_value_remove]] +! for details. + + subroutine json_value_replace(json,p1,p2,destroy) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p1 !! the item to replace + type(json_value),pointer :: p2 !! item to take the place of `p1` + logical(LK),intent(in),optional :: destroy !! Should `p1` also be destroyed + !! (default is True). Normally, + !! this should be true to avoid + !! a memory leak. + + logical(LK) :: destroy_p1 !! if `p1` is to be destroyed + + if (present(destroy)) then + destroy_p1 = destroy + else + destroy_p1 = .true. ! default + end if + + call json%insert_after(p1,p2) + call json%remove(p1,destroy_p1) + + end subroutine json_value_replace +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 4/11/2017 +! +! Reverse the order of the children of an array or object. + + subroutine json_value_reverse(json,p) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + + type(json_value),pointer :: tmp !! temp variable for traversing the list + type(json_value),pointer :: current !! temp variable for traversing the list + integer(IK) :: var_type !! for getting the variable type + + if (associated(p)) then + + call json%info(p,var_type=var_type) + + ! can only reverse objects or arrays + if (var_type==json_object .or. var_type==json_array) then + + nullify(tmp) + current => p%children + p%tail => current + + ! Swap next and previous for all nodes: + do + if (.not. associated(current)) exit + tmp => current%previous + current%previous => current%next + current%next => tmp + current => current%previous + end do + + if (associated(tmp)) then + p%children => tmp%previous + end if + + end if + + end if + + end subroutine json_value_reverse +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 4/26/2016 +! +! Swap two elements in a JSON structure. +! All of the children are carried along as well. +! +!@note If both are not associated, then an error is thrown. +! +!@note The assumption here is that both variables are part of a valid +! [[json_value]] linked list (so the normal `parent`, `previous`, +! `next`, etc. pointers are properly associated if necessary). +! +!@warning This cannot be used to swap a parent/child pair, since that +! could lead to a circular linkage. An exception is thrown if +! this is tried. +! +!@warning There are also other situations where using this routine may +! produce a malformed JSON structure, such as moving an array +! element outside of an array. This is not checked for. +! +!@note If `p1` and `p2` have a common parent, it is always safe to swap them. + + subroutine json_value_swap(json,p1,p2) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p1 !! swap with `p2` + type(json_value),pointer :: p2 !! swap with `p1` + + logical :: same_parent !! if `p1` and `p2` have the same parent + logical :: first_last !! if `p1` and `p2` are the first,last or + !! last,first children of a common parent + logical :: adjacent !! if `p1` and `p2` are adjacent + !! elements in an array + type(json_value),pointer :: a !! temporary variable + type(json_value),pointer :: b !! temporary variable + + if (json%exception_thrown) return + + !both have to be associated: + if (associated(p1) .and. associated(p2)) then + + !simple check to make sure that they both + !aren't pointing to the same thing: + if (.not. associated(p1,p2)) then + + !we will not allow swapping an item with one of its descendants: + if (json%is_child_of(p1,p2) .or. json%is_child_of(p2,p1)) then + call json%throw_exception('Error in json_value_swap: '//& + 'cannot swap an item with one of its descendants') + else + + same_parent = ( associated(p1%parent) .and. & + associated(p2%parent) .and. & + associated(p1%parent,p2%parent) ) + if (same_parent) then + first_last = (associated(p1%parent%children,p1) .and. & + associated(p2%parent%tail,p2)) .or. & + (associated(p1%parent%tail,p1) .and. & + associated(p2%parent%children,p2)) + else + first_last = .false. + end if + + !first, we fix children,tail pointers: + + if (same_parent .and. first_last) then + + !this is all we have to do for the parent in this case: + call swap_pointers(p1%parent%children,p2%parent%tail) + + else if (same_parent .and. .not. first_last) then + + if (associated(p1%parent%children,p1)) then + p1%parent%children => p2 ! p1 is the first child of the parent + else if (associated(p1%parent%children,p2)) then + p1%parent%children => p1 ! p2 is the first child of the parent + end if + if (associated(p1%parent%tail,p1)) then + p1%parent%tail => p2 ! p1 is the last child of the parent + else if (associated(p1%parent%tail,p2)) then + p1%parent%tail => p1 ! p2 is the last child of the parent + end if + + else ! general case: different parents + + if (associated(p1%parent)) then + if (associated(p1%parent%children,p1)) p1%parent%children => p2 + if (associated(p1%parent%tail,p1)) p1%parent%tail => p2 + end if + if (associated(p2%parent)) then + if (associated(p2%parent%children,p2)) p2%parent%children => p1 + if (associated(p2%parent%tail,p2)) p2%parent%tail => p1 + end if + call swap_pointers(p1%parent, p2%parent) + + end if + + !now, have to fix previous,next pointers: + + !first, see if they are adjacent: + adjacent = associated(p1%next,p2) .or. & + associated(p2%next,p1) + if (associated(p2%next,p1)) then !p2,p1 + a => p2 + b => p1 + else !p1,p2 (or not adjacent) + a => p1 + b => p2 + end if + if (associated(a%previous)) a%previous%next => b + if (associated(b%next)) b%next%previous => a + + if (adjacent) then + !a comes before b in the original list + b%previous => a%previous + a%next => b%next + a%previous => b + b%next => a + else + if (associated(a%next)) a%next%previous => b + if (associated(b%previous)) b%previous%next => a + call swap_pointers(a%previous,b%previous) + call swap_pointers(a%next, b%next) + end if + + end if + + else + call json%throw_exception('Error in json_value_swap: '//& + 'both pointers must be associated') + end if + + end if + + contains + + pure subroutine swap_pointers(s1,s2) + + implicit none + + type(json_value),pointer,intent(inout) :: s1 + type(json_value),pointer,intent(inout) :: s2 + + type(json_value),pointer :: tmp !! temporary pointer + + if (.not. associated(s1,s2)) then + tmp => s1 + s1 => s2 + s2 => tmp + end if + + end subroutine swap_pointers + + end subroutine json_value_swap +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 4/28/2016 +! +! Returns True if `p2` is a descendant of `p1` +! (i.e, a child, or a child of child, etc.) + + function json_value_is_child_of(json,p1,p2) result(is_child_of) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p1 + type(json_value),pointer :: p2 + logical(LK) :: is_child_of + + is_child_of = .false. + + if (json%exception_thrown) return + + if (associated(p1) .and. associated(p2)) then + if (associated(p1%children)) then + call json%traverse(p1%children,is_child_of_callback) + end if + end if + + contains + + subroutine is_child_of_callback(json,p,finished) + !! Traverse until `p` is `p2`. + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p + logical(LK),intent(out) :: finished + + is_child_of = associated(p,p2) + finished = is_child_of ! stop searching if found + + end subroutine is_child_of_callback + + end function json_value_is_child_of +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 5/2/2016 +! +! Validate a [[json_value]] linked list by checking to make sure +! all the pointers are properly associated, arrays and objects +! have the correct number of children, and the correct data is +! allocated for the variable types. +! +! It recursively traverses the entire structure and checks every element. +! +!### History +! * Jacob Williams, 8/26/2017 : added duplicate key check. +! +!@note It will return on the first error it encounters. +! +!@note This routine does not check or throw any exceptions. +! If `json` is currently in a state of exception, it will +! remain so after calling this routine. + + subroutine json_value_validate(json,p,is_valid,error_msg) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p + logical(LK),intent(out) :: is_valid !! True if the structure is valid. + character(kind=CK,len=:),allocatable,intent(out) :: error_msg !! if not valid, this will contain + !! a description of the problem + + logical(LK) :: has_duplicate !! to check for duplicate keys + character(kind=CK,len=:),allocatable :: path !! path to duplicate key + logical(LK) :: status_ok !! to check for existing exception + character(kind=CK,len=:),allocatable :: exception_msg !! error message for an existing exception + character(kind=CK,len=:),allocatable :: exception_msg2 !! error message for a new exception + + if (associated(p)) then + + is_valid = .true. + call check_if_valid(p,require_parent=associated(p%parent)) + + if (is_valid .and. .not. json%allow_duplicate_keys) then + ! if no errors so far, also check the + ! entire structure for duplicate keys: + + ! note: check_for_duplicate_keys does call routines + ! that check and throw exceptions, so let's clear any + ! first. (save message for later) + call json%check_for_errors(status_ok, exception_msg) + call json%clear_exceptions() + + call json%check_for_duplicate_keys(p,has_duplicate,path=path) + if (json%failed()) then + ! if an exception was thrown during this call, + ! then clear it but make that the error message + ! returned by this routine. Normally this should + ! never actually occur since we have already + ! validated the structure. + call json%check_for_errors(is_valid, exception_msg2) + error_msg = exception_msg2 + call json%clear_exceptions() + is_valid = .false. + else + if (has_duplicate) then + error_msg = 'duplicate key found: '//path + is_valid = .false. + end if + end if + + if (.not. status_ok) then + ! restore any existing exception if necessary + call json%throw_exception(exception_msg) + end if + + ! cleanup: + if (allocated(path)) deallocate(path) + if (allocated(exception_msg)) deallocate(exception_msg) + if (allocated(exception_msg2)) deallocate(exception_msg2) + + end if + + else + error_msg = 'The pointer is not associated' + is_valid = .false. + end if + + contains + + recursive subroutine check_if_valid(p,require_parent) + + implicit none + + type(json_value),pointer,intent(in) :: p + logical,intent(in) :: require_parent !! the first one may be a root (so no parent), + !! but all descendants must have a parent. + + integer(IK) :: i !! counter + type(json_value),pointer :: element + type(json_value),pointer :: previous + + if (is_valid .and. associated(p)) then + + ! data type: + select case (p%var_type) + case(json_null,json_object,json_array) + if (allocated(p%log_value) .or. allocated(p%int_value) .or. & + allocated(p%dbl_value) .or. allocated(p%str_value)) then + error_msg = 'incorrect data allocated for '//& + 'json_null, json_object, or json_array variable type' + is_valid = .false. + return + end if + case(json_logical) + if (.not. allocated(p%log_value)) then + error_msg = 'log_value should be allocated for json_logical variable type' + is_valid = .false. + return + else if (allocated(p%int_value) .or. & + allocated(p%dbl_value) .or. allocated(p%str_value)) then + error_msg = 'incorrect data allocated for json_logical variable type' + is_valid = .false. + return + end if + case(json_integer) + if (.not. allocated(p%int_value)) then + error_msg = 'int_value should be allocated for json_integer variable type' + is_valid = .false. + return + else if (allocated(p%log_value) .or. & + allocated(p%dbl_value) .or. allocated(p%str_value)) then + error_msg = 'incorrect data allocated for json_integer variable type' + is_valid = .false. + return + end if + case(json_real) + if (.not. allocated(p%dbl_value)) then + error_msg = 'dbl_value should be allocated for json_real variable type' + is_valid = .false. + return + else if (allocated(p%log_value) .or. allocated(p%int_value) .or. & + allocated(p%str_value)) then + error_msg = 'incorrect data allocated for json_real variable type' + is_valid = .false. + return + end if + case(json_string) + if (.not. allocated(p%str_value)) then + error_msg = 'str_value should be allocated for json_string variable type' + is_valid = .false. + return + else if (allocated(p%log_value) .or. allocated(p%int_value) .or. & + allocated(p%dbl_value)) then + error_msg = 'incorrect data allocated for json_string variable type' + is_valid = .false. + return + end if + case default + error_msg = 'invalid JSON variable type' + is_valid = .false. + return + end select + + if (require_parent .and. .not. associated(p%parent)) then + error_msg = 'parent pointer is not associated' + is_valid = .false. + return + end if + + if (.not. allocated(p%name)) then + if (associated(p%parent)) then + if (p%parent%var_type/=json_array) then + error_msg = 'JSON variable must have a name if not an '//& + 'array element or the root' + is_valid = .false. + return + end if + end if + end if + + if (associated(p%children) .neqv. associated(p%tail)) then + error_msg = 'both children and tail pointers must be associated' + is_valid = .false. + return + end if + + ! now, check next one: + if (associated(p%next)) then + if (associated(p,p%next)) then + error_msg = 'circular linked list' + is_valid = .false. + return + else + ! if it's an element in an + ! array, then require a parent: + call check_if_valid(p%next,require_parent=.true.) + end if + end if + + if (associated(p%children)) then + + if (p%var_type/=json_array .and. p%var_type/=json_object) then + error_msg = 'only arrays and objects can have children' + is_valid = .false. + return + end if + + ! first validate children pointers: + + previous => null() + element => p%children + do i = 1_IK, p%n_children + if (.not. associated(element%parent,p)) then + error_msg = 'child''s parent pointer not properly associated' + is_valid = .false. + return + end if + if (i==1 .and. associated(element%previous)) then + error_msg = 'first child shouldn''t have a previous' + is_valid = .false. + return + end if + if (i1) then + if (.not. associated(previous,element%previous)) then + error_msg = 'previous pointer not properly associated' + is_valid = .false. + return + end if + end if + if (i==p%n_children .and. & + .not. associated(element%parent%tail,element)) then + error_msg = 'parent''s tail pointer not properly associated' + is_valid = .false. + return + end if + if (i element + element => element%next + end if + end do + + !now check all the children: + call check_if_valid(p%children,require_parent=.true.) + + end if + + end if + + end subroutine check_if_valid + + end subroutine json_value_validate +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/6/2014 +! +! Given the path string, remove the variable +! from [[json_value]], if it exists. + + subroutine json_value_remove_if_present(json,p,path) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: path !! the path to the variable to remove + + type(json_value),pointer :: p_var + logical(LK) :: found + + call json%get(p,path,p_var,found) + if (found) call json%remove(p_var) + + end subroutine json_value_remove_if_present +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_remove_if_present]], where `path` is kind=CDK. + + subroutine wrap_json_value_remove_if_present(json,p,path) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: path + + call json%remove_if_present(p,to_unicode(path)) + + end subroutine wrap_json_value_remove_if_present +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/6/2014 +! +! Given the path string, if the variable is present, +! and is a scalar, then update its value. +! If it is not present, then create it and set its value. +! +!@note If the variable is not a scalar, an exception will be thrown. + + subroutine json_update_logical(json,p,path,val,found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: path !! path to the variable in the structure + logical(LK),intent(in) :: val !! the new value + logical(LK),intent(out) :: found !! if the variable was found and was a scalar. + + type(json_value),pointer :: p_var + integer(IK) :: var_type + + call json%get(p,path,p_var,found) + if (found) then + + call json%info(p_var,var_type) + select case (var_type) + case (json_null,json_logical,json_integer,json_real,json_string) + call json%to_logical(p_var,val) !update the value + case default + found = .false. + call json%throw_exception('Error in json_update_logical: '//& + 'the variable is not a scalar value',found) + end select + + else + call json%add_by_path(p,path,val) !add the new element + end if + + end subroutine json_update_logical +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_update_logical]], where `path` is kind=CDK. + + subroutine wrap_json_update_logical(json,p,path,val,found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: path !! path to the variable in the structure + logical(LK),intent(in) :: val !! the new value + logical(LK),intent(out) :: found !! if the variable was found and was a scalar. + + call json%update(p,to_unicode(path),val,found) + + end subroutine wrap_json_update_logical +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/6/2014 +! +! Given the path string, if the variable is present, +! and is a scalar, then update its value. +! If it is not present, then create it and set its value. +! +!@note If the variable is not a scalar, an exception will be thrown. + + subroutine json_update_real(json,p,path,val,found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: path !! path to the variable in the structure + real(RK),intent(in) :: val !! the new value + logical(LK),intent(out) :: found !! if the variable was found and was a scalar. + + type(json_value),pointer :: p_var + integer(IK) :: var_type + + call json%get(p,path,p_var,found) + if (found) then + + call json%info(p_var,var_type) + select case (var_type) + case (json_null,json_logical,json_integer,json_real,json_string) + call json%to_real(p_var,val) !update the value + case default + found = .false. + call json%throw_exception('Error in json_update_real: '//& + 'the variable is not a scalar value',found) + end select + + else + call json%add_by_path(p,path,val) !add the new element + end if + + end subroutine json_update_real +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_update_real]], where `path` is kind=CDK. + + subroutine wrap_json_update_real(json,p,path,val,found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: path !! path to the variable in the structure + real(RK),intent(in) :: val !! the new value + logical(LK),intent(out) :: found !! if the variable was found and was a scalar. + + call json%update(p,to_unicode(path),val,found) + + end subroutine wrap_json_update_real +!***************************************************************************************** + +#ifndef REAL32 +!***************************************************************************************** +!> +! Alternate version of [[json_update_real]], where `val` is `real32`. + + subroutine json_update_real32(json,p,path,val,found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: path !! path to the variable in the structure + real(real32),intent(in) :: val !! the new value + logical(LK),intent(out) :: found !! if the variable was found and was a scalar. + + call json%update(p,path,real(val,RK),found) + + end subroutine json_update_real32 +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_update_real32]], where `path` is kind=CDK. + + subroutine wrap_json_update_real32(json,p,path,val,found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: path !! path to the variable in the structure + real(real32),intent(in) :: val !! the new value + logical(LK),intent(out) :: found !! if the variable was found and was a scalar. + + call json%update(p,to_unicode(path),real(val,RK),found) + + end subroutine wrap_json_update_real32 +!***************************************************************************************** +#endif + +#ifdef REAL128 +!***************************************************************************************** +!> +! Alternate version of [[json_update_real]], where `val` is `real64`. + + subroutine json_update_real64(json,p,path,val,found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: path !! path to the variable in the structure + real(real64),intent(in) :: val !! the new value + logical(LK),intent(out) :: found !! if the variable was found and was a scalar. + + call json%update(p,path,real(val,RK),found) + + end subroutine json_update_real64 +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_update_real64]], where `path` is kind=CDK. + + subroutine wrap_json_update_real64(json,p,path,val,found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: path !! path to the variable in the structure + real(real64),intent(in) :: val !! the new value + logical(LK),intent(out) :: found !! if the variable was found and was a scalar. + + call json%update(p,to_unicode(path),real(val,RK),found) + + end subroutine wrap_json_update_real64 +!***************************************************************************************** +#endif + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/6/2014 +! +! Given the path string, if the variable is present, +! and is a scalar, then update its value. +! If it is not present, then create it and set its value. +! +!@note If the variable is not a scalar, an exception will be thrown. + + subroutine json_update_integer(json,p,path,val,found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: path !! path to the variable in the structure + integer(IK),intent(in) :: val !! the new value + logical(LK),intent(out) :: found !! if the variable was found and was a scalar. + + type(json_value),pointer :: p_var + integer(IK) :: var_type + + call json%get(p,path,p_var,found) + if (found) then + + call json%info(p_var,var_type) + select case (var_type) + case (json_null,json_logical,json_integer,json_real,json_string) + call json%to_integer(p_var,val) !update the value + case default + found = .false. + call json%throw_exception('Error in json_update_integer: '//& + 'the variable is not a scalar value',found) + end select + + else + call json%add_by_path(p,path,val) !add the new element + end if + + end subroutine json_update_integer +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_update_integer]], where `path` is kind=CDK. + + subroutine wrap_json_update_integer(json,p,path,val,found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: path !! path to the variable in the structure + integer(IK),intent(in) :: val !! the new value + logical(LK),intent(out) :: found !! if the variable was found and was a scalar. + + call json%update(p,to_unicode(path),val,found) + + end subroutine wrap_json_update_integer +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/6/2014 +! +! Given the path string, if the variable is present, +! and is a scalar, then update its value. +! If it is not present, then create it and set its value. +! +!@note If the variable is not a scalar, an exception will be thrown. + + subroutine json_update_string(json,p,path,val,found,trim_str,adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: path !! path to the variable in the structure + character(kind=CK,len=*),intent(in) :: val !! the new value + logical(LK),intent(out) :: found !! if the variable was found and was a scalar. + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + !! (only used if `val` is present) + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + !! (only used if `val` is present) + !! (note that ADJUSTL is done before TRIM) + + type(json_value),pointer :: p_var + integer(IK) :: var_type + + call json%get(p,path,p_var,found) + if (found) then + + call json%info(p_var,var_type) + select case (var_type) + case (json_null,json_logical,json_integer,json_real,json_string) + call json%to_string(p_var,val,trim_str=trim_str,adjustl_str=adjustl_str) ! update the value + case default + found = .false. + call json%throw_exception('Error in json_update_string: '//& + 'the variable is not a scalar value',found) + end select + + else + call json%add_by_path(p,path,val) !add the new element + end if + + end subroutine json_update_string +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_update_string]], where `path` and `value` are kind=CDK. + + subroutine wrap_json_update_string(json,p,path,val,found,trim_str,adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: path !! path to the variable in the structure + character(kind=CDK,len=*),intent(in) :: val !! the new value + logical(LK),intent(out) :: found !! if the variable was found and was a scalar. + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + !! (only used if `val` is present) + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + !! (only used if `val` is present) + !! (note that ADJUSTL is done before TRIM) + + call json%update(p,to_unicode(path),to_unicode(val),found,trim_str,adjustl_str) + + end subroutine wrap_json_update_string +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_update_string]], where `path` is kind=CDK. + + subroutine json_update_string_name_ascii(json,p,path,val,found,trim_str,adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: path !! path to the variable in the structure + character(kind=CK, len=*),intent(in) :: val !! the new value + logical(LK),intent(out) :: found !! if the variable was found and was a scalar. + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + !! (only used if `val` is present) + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + !! (only used if `val` is present) + !! (note that ADJUSTL is done before TRIM) + + call json%update(p,to_unicode(path),val,found,trim_str,adjustl_str) + + end subroutine json_update_string_name_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_update_string]], where `val` is kind=CDK. + + subroutine json_update_string_val_ascii(json,p,path,val,found,trim_str,adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK, len=*),intent(in) :: path !! path to the variable in the structure + character(kind=CDK,len=*),intent(in) :: val !! the new value + logical(LK),intent(out) :: found !! if the variable was found and was a scalar. + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + !! (only used if `val` is present) + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + !! (only used if `val` is present) + !! (note that ADJUSTL is done before TRIM) + + call json%update(p,path,to_unicode(val),found,trim_str,adjustl_str) + + end subroutine json_update_string_val_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> +! Adds `member` as a child of `p`. + + subroutine json_value_add_member(json,p,member) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p !! `p` must be a `json_object` + !! or a `json_array` + type(json_value),pointer :: member !! the child member + !! to add to `p` + + integer(IK) :: var_type !! variable type of `p` + + if (.not. json%exception_thrown) then + + if (associated(p)) then + + call json%info(p,var_type=var_type) + + select case (var_type) + case(json_object, json_array) + + ! associate the parent + member%parent => p + + ! add to linked list + if (associated(p%children)) then + p%tail%next => member + member%previous => p%tail + else + p%children => member + member%previous => null() !first in the list + end if + + ! new member is now the last one in the list + p%tail => member + p%n_children = p%n_children + 1 + + case default + call json%throw_exception('Error in json_value_add_member: '//& + 'can only add child to object or array') + end select + + else + call json%throw_exception('Error in json_value_add_member: '//& + 'the pointer is not associated') + end if + + end if + + end subroutine json_value_add_member +!***************************************************************************************** + +!***************************************************************************************** +!> +! Inserts `element` after `p`, and updates the JSON structure accordingly. +! +!### Example +! +!````fortran +! program test +! use json_module +! implicit none +! logical(json_LK) :: found +! type(json_core) :: json +! type(json_value),pointer :: p,new,element +! call json%load(file='myfile.json', p=p) +! call json%get(p,'x(3)',element,found) ! get pointer to an array element in the file +! call json%create_integer(new,1,'') ! create a new element +! call json%insert_after(element,new) ! insert new element after x(3) +! call json%print(p,'myfile2.json') ! write it to a file +! call json%destroy(p) ! cleanup +! end program test +!```` +! +!### Details +! +! * This routine can be used to insert a new element (or set of elements) +! into an array or object at a specific index. +! See [[json_value_insert_after_child_by_index]] +! * Children and subsequent elements of `element` are carried along. +! * If the inserted elements are part of an existing list, then +! they are removed from that list. +! +!```` +! p +! [1] - [2] - [3] - [4] +! | +! [5] - [6] - [7] n=3 elements inserted +! element last +! +! Result is: +! +! [1] - [2] - [5] - [6] - [7] - [3] - [4] +! +!```` + + subroutine json_value_insert_after(json,p,element) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p !! a value from a JSON structure + !! (presumably, this is a child of + !! an object or array). + type(json_value),pointer :: element !! the element to insert after `p` + + type(json_value),pointer :: parent !! the parent of `p` + type(json_value),pointer :: next !! temp pointer for traversing structure + type(json_value),pointer :: last !! the last of the items being inserted + integer :: n !! number of items being inserted + + if (.not. json%exception_thrown) then + + parent => p%parent + + ! set first parent of inserted list: + element%parent => parent + + ! Count the number of inserted elements. + ! and set their parents. + n = 1 ! initialize counter + next => element%next + last => element + do + if (.not. associated(next)) exit + n = n + 1 + next%parent => parent + last => next + next => next%next + end do + + if (associated(parent)) then + ! update parent's child counter: + parent%n_children = parent%n_children + n + ! if p is last of parents children then + ! also have to update parent tail pointer: + if (associated(parent%tail,p)) then + parent%tail => last + end if + end if + + if (associated(element%previous)) then + ! element is apparently part of an existing list, + ! so have to update that as well. + if (associated(element%previous%parent)) then + element%previous%parent%n_children = & + element%previous%parent%n_children - n + element%previous%parent%tail => & + element%previous ! now the last one in the list + else + ! this would be a memory leak if the previous entries + ! are not otherwise being pointed too + ! [throw an error in this case???] + end if + !remove element from the other list: + element%previous%next => null() + end if + element%previous => p + + if (associated(p%next)) then + ! if there are any in the list after p: + last%next => p%next + last%next%previous => element + else + last%next => null() + end if + p%next => element + + end if + + end subroutine json_value_insert_after +!***************************************************************************************** + +!***************************************************************************************** +!> +! Inserts `element` after the `idx`-th child of `p`, +! and updates the JSON structure accordingly. This is just +! a wrapper for [[json_value_insert_after]]. + + subroutine json_value_insert_after_child_by_index(json,p,idx,element) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p !! a JSON object or array. + integer(IK),intent(in) :: idx !! the index of the child of `p` to + !! insert the new element after + !! (this is a 1-based Fortran + !! style array index) + type(json_value),pointer :: element !! the element to insert + + type(json_value),pointer :: tmp !! for getting the `idx`-th child of `p` + + if (.not. json%exception_thrown) then + + ! get the idx-th child of p: + call json%get_child(p,idx,tmp) + + ! call json_value_insert_after: + if (.not. json%exception_thrown) call json%insert_after(tmp,element) + + end if + + end subroutine json_value_insert_after_child_by_index +!***************************************************************************************** + +!***************************************************************************************** +!> +! Add a new member (`json_value` pointer) to a JSON structure, given the path. +! +!@warning If the path points to an existing variable in the structure, +! then this routine will destroy it and replace it with the +! new value. + + subroutine json_add_member_by_path(json,me,path,p,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + type(json_value),pointer,intent(in) :: p !! the value to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + type(json_value),pointer :: tmp + character(kind=CK,len=:),allocatable :: name !! name of the variable + + if ( .not. json%exception_thrown ) then + + if (.not. associated(p)) then + call json%throw_exception('Error in json_add_member_by_path:'//& + ' Input pointer p is not associated.',found) + if (present(found)) then + found = .false. + call json%clear_exceptions() + end if + if ( present(was_created) ) was_created = .false. + else + + ! return a pointer to the path (possibly creating it) + call json%create(me,path,tmp,found,was_created) + + if (.not. associated(tmp)) then + + call json%throw_exception('Error in json_add_member_by_path:'//& + ' Unable to resolve path: '//trim(path),found) + if (present(found)) then + found = .false. + call json%clear_exceptions() + end if + + else + + call json%info(tmp,name=name) + + ! replace it with the new one: + call json%replace(tmp,p,destroy=.true.) + call json%rename(p,name) + + end if + + end if + + else + if ( present(found) ) found = .false. + if ( present(was_created) ) was_created = .false. + end if + + end subroutine json_add_member_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper to [[json_add_member_by_path]] where "path" is kind=CDK. + + subroutine wrap_json_add_member_by_path(json,me,path,p,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + type(json_value),pointer,intent(in) :: p !! the value to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call json%json_add_member_by_path(me,to_unicode(path),p,found,was_created) + + end subroutine wrap_json_add_member_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Add an integer value to a [[json_value]], given the path. +! +!@warning If the path points to an existing variable in the structure, +! then this routine will destroy it and replace it with the +! new value. + + subroutine json_add_integer_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + integer(IK),intent(in) :: value !! the value to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + type(json_value),pointer :: p + type(json_value),pointer :: tmp + character(kind=CK,len=:),allocatable :: name !! variable name + + if ( .not. json%exception_thrown ) then + + nullify(p) + + ! return a pointer to the path (possibly creating it) + ! If the variable had to be created, then + ! it will be a json_null variable. + call json%create(me,path,p,found,was_created) + + if (.not. associated(p)) then + + call json%throw_exception('Error in json_add_integer_by_path:'//& + ' Unable to resolve path: '//trim(path),found) + if (present(found)) then + found = .false. + call json%clear_exceptions() + end if + + else + + !NOTE: a new object is created, and the old one + ! is replaced and destroyed. This is to + ! prevent memory leaks if the type is + ! being changed (for example, if an array + ! is being replaced with a scalar). + + if (p%var_type==json_integer) then + p%int_value = value + else + call json%info(p,name=name) + call json%create_integer(tmp,value,name) + call json%replace(p,tmp,destroy=.true.) + end if + + end if + + else + if ( present(found) ) found = .false. + if ( present(was_created) ) was_created = .false. + end if + + end subroutine json_add_integer_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper to [[json_add_integer_by_path]] where "path" is kind=CDK. + + subroutine wrap_json_add_integer_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + integer(IK),intent(in) :: value !! the value to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call json%json_add_integer_by_path(me,to_unicode(path),value,found,was_created) + + end subroutine wrap_json_add_integer_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Add an real value to a [[json_value]], given the path. +! +!@warning If the path points to an existing variable in the structure, +! then this routine will destroy it and replace it with the +! new value. + + subroutine json_add_real_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(RK),intent(in) :: value !! the value to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + type(json_value),pointer :: p + type(json_value),pointer :: tmp + character(kind=CK,len=:),allocatable :: name !! variable name + + if ( .not. json%exception_thrown ) then + + nullify(p) + + ! return a pointer to the path (possibly creating it) + ! If the variable had to be created, then + ! it will be a json_null variable. + call json%create(me,path,p,found,was_created) + + if (.not. associated(p)) then + + call json%throw_exception('Error in json_add_real_by_path:'//& + ' Unable to resolve path: '//trim(path),found) + if (present(found)) then + found = .false. + call json%clear_exceptions() + end if + + else + + !NOTE: a new object is created, and the old one + ! is replaced and destroyed. This is to + ! prevent memory leaks if the type is + ! being changed (for example, if an array + ! is being replaced with a scalar). + + if (p%var_type==json_real) then + p%dbl_value = value + else + call json%info(p,name=name) + call json%create_real(tmp,value,name) + call json%replace(p,tmp,destroy=.true.) + end if + + end if + + else + if ( present(found) ) found = .false. + if ( present(was_created) ) was_created = .false. + end if + + end subroutine json_add_real_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper to [[json_add_real_by_path]] where "path" is kind=CDK. + + subroutine wrap_json_add_real_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(RK),intent(in) :: value !! the value to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call json%json_add_real_by_path(me,to_unicode(path),value,found,was_created) + + end subroutine wrap_json_add_real_by_path +!***************************************************************************************** + +#ifndef REAL32 +!***************************************************************************************** +!> +! Alternate version of [[json_add_real_by_path]] where value=real32. + + subroutine json_add_real32_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(real32),intent(in) :: value !! the value to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call json%add_by_path(me,path,real(value,RK),found,was_created) + + end subroutine json_add_real32_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper to [[json_add_real32_by_path]] where "path" is kind=CDK. + + subroutine wrap_json_add_real32_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(real32),intent(in) :: value !! the value to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call json%add_by_path(me,to_unicode(path),real(value,RK),found,was_created) + + end subroutine wrap_json_add_real32_by_path +!***************************************************************************************** +#endif + +#ifdef REAL128 +!***************************************************************************************** +!> +! Alternate version of [[json_add_real_by_path]] where value=real32. + + subroutine json_add_real64_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(real64),intent(in) :: value !! the value to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call json%add_by_path(me,path,real(value,RK),found,was_created) + + end subroutine json_add_real64_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper to [[json_add_real64_by_path]] where "path" is kind=CDK. + + subroutine wrap_json_add_real64_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(real64),intent(in) :: value !! the value to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call json%add_by_path(me,to_unicode(path),real(value,RK),found,was_created) + + end subroutine wrap_json_add_real64_by_path +!***************************************************************************************** +#endif + +!***************************************************************************************** +!> +! Add a logical value to a [[json_value]], given the path. +! +!@warning If the path points to an existing variable in the structure, +! then this routine will destroy it and replace it with the +! new value. + + subroutine json_add_logical_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + logical(LK),intent(in) :: value !! the value to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + type(json_value),pointer :: p + type(json_value),pointer :: tmp + character(kind=CK,len=:),allocatable :: name !! variable name + + if ( .not. json%exception_thrown ) then + + nullify(p) + + ! return a pointer to the path (possibly creating it) + ! If the variable had to be created, then + ! it will be a json_null variable. + call json%create(me,path,p,found,was_created) + + if (.not. associated(p)) then + + call json%throw_exception('Error in json_add_logical_by_path:'//& + ' Unable to resolve path: '//trim(path),found) + if (present(found)) then + found = .false. + call json%clear_exceptions() + end if + + else + + !NOTE: a new object is created, and the old one + ! is replaced and destroyed. This is to + ! prevent memory leaks if the type is + ! being changed (for example, if an array + ! is being replaced with a scalar). + + if (p%var_type==json_logical) then + p%log_value = value + else + call json%info(p,name=name) + call json%create_logical(tmp,value,name) + call json%replace(p,tmp,destroy=.true.) + end if + + end if + + else + if ( present(found) ) found = .false. + if ( present(was_created) ) was_created = .false. + end if + + end subroutine json_add_logical_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper to [[json_add_logical_by_path]] where "path" is kind=CDK. + + subroutine wrap_json_add_logical_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + logical(LK),intent(in) :: value !! the value to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call json%json_add_logical_by_path(me,to_unicode(path),value,found,was_created) + + end subroutine wrap_json_add_logical_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Add a string value to a [[json_value]], given the path. +! +!@warning If the path points to an existing variable in the structure, +! then this routine will destroy it and replace it with the +! new value. + + subroutine json_add_string_by_path(json,me,path,value,found,& + was_created,trim_str,adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + character(kind=CK,len=*),intent(in) :: value !! the value to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for each element + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for each element + + type(json_value),pointer :: p + type(json_value),pointer :: tmp + character(kind=CK,len=:),allocatable :: name !! variable name + + if ( .not. json%exception_thrown ) then + + nullify(p) + + ! return a pointer to the path (possibly creating it) + ! If the variable had to be created, then + ! it will be a json_null variable. + call json%create(me,path,p,found,was_created) + + if (.not. associated(p)) then + + call json%throw_exception('Error in json_add_string_by_path:'//& + ' Unable to resolve path: '//trim(path),found) + if (present(found)) then + found = .false. + call json%clear_exceptions() + end if + + else + + !NOTE: a new object is created, and the old one + ! is replaced and destroyed. This is to + ! prevent memory leaks if the type is + ! being changed (for example, if an array + ! is being replaced with a scalar). + + if (p%var_type==json_string) then + p%str_value = value + else + call json%info(p,name=name) + call json%create_string(tmp,value,name,trim_str,adjustl_str) + call json%replace(p,tmp,destroy=.true.) + end if + + end if + + else + if ( present(found) ) found = .false. + if ( present(was_created) ) was_created = .false. + end if + + end subroutine json_add_string_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper to [[json_add_string_by_path]] where "path" is kind=CDK. + + subroutine wrap_json_add_string_by_path(json,me,path,value,found,& + was_created,trim_str,adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + character(kind=CDK,len=*),intent(in) :: value !! the value to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for each element + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for each element + + call json%json_add_string_by_path(me,to_unicode(path),to_unicode(value),& + found,was_created,trim_str,adjustl_str) + + end subroutine wrap_json_add_string_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper for [[json_add_string_by_path]] where "path" is kind=CDK. + + subroutine json_add_string_by_path_path_ascii(json,me,path,value,found,& + was_created,trim_str,adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + character(kind=CK,len=*),intent(in) :: value !! the value to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for each element + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for each element + + call json%json_add_string_by_path(me,to_unicode(path),value,found,was_created,trim_str,adjustl_str) + + end subroutine json_add_string_by_path_path_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper for [[json_add_string_by_path]] where "value" is kind=CDK. + + subroutine json_add_string_by_path_value_ascii(json,me,path,value,found,& + was_created,trim_str,adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + character(kind=CDK,len=*),intent(in) :: value !! the value to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for each element + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for each element + + call json%json_add_string_by_path(me,path,to_unicode(value),found,was_created,trim_str,adjustl_str) + + end subroutine json_add_string_by_path_value_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper to [[json_add_integer_by_path]] for adding an integer vector by path. + + subroutine json_add_integer_vec_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + integer(IK),dimension(:),intent(in) :: value !! the vector to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + type(json_value),pointer :: p !! pointer to path (which may exist) + type(json_value),pointer :: var !! new variable that is created + integer(IK) :: i !! counter + character(kind=CK,len=:),allocatable :: name !! the variable name + logical(LK) :: p_found !! if the path was successfully found (or created) + + if ( .not. json%exception_thrown ) then + + !get a pointer to the variable + !(creating it if necessary) + call json%create(me,path,p,found=p_found) + if (p_found) then + call json%info(p,name=name) ! want to keep the existing name + call json%create_array(var,name) ! create a new array variable + call json%replace(p,var,destroy=.true.) ! replace p with this array (destroy p) + !populate each element of the array: + do i=1,size(value) + call json%add(var, CK_'', value(i)) + end do + end if + + else + if ( present(found) ) found = .false. + if ( present(was_created) ) was_created = .false. + end if + + end subroutine json_add_integer_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper for [[json_add_integer_vec_by_path]] where "path" is kind=CDK). + + subroutine wrap_json_add_integer_vec_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + integer(IK),dimension(:),intent(in) :: value !! the vector to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call json%json_add_integer_vec_by_path(me,to_unicode(path),value,found,was_created) + + end subroutine wrap_json_add_integer_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper to [[json_add_logical_by_path]] for adding a logical vector by path. + + subroutine json_add_logical_vec_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + logical(LK),dimension(:),intent(in) :: value !! the vector to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + type(json_value),pointer :: p !! pointer to path (which may exist) + type(json_value),pointer :: var !! new variable that is created + integer(IK) :: i !! counter + character(kind=CK,len=:),allocatable :: name !! the variable name + logical(LK) :: p_found !! if the path was successfully found (or created) + + if ( .not. json%exception_thrown ) then + + !get a pointer to the variable + !(creating it if necessary) + call json%create(me,path,p,found=p_found) + if (p_found) then + call json%info(p,name=name) ! want to keep the existing name + call json%create_array(var,name) ! create a new array variable + call json%replace(p,var,destroy=.true.) ! replace p with this array (destroy p) + !populate each element of the array: + do i=1,size(value) + call json%add(var, CK_'', value(i)) + end do + end if + + else + if ( present(found) ) found = .false. + if ( present(was_created) ) was_created = .false. + end if + + end subroutine json_add_logical_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper for [[json_add_logical_vec_by_path]] where "path" is kind=CDK). + + subroutine wrap_json_add_logical_vec_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + logical(LK),dimension(:),intent(in) :: value !! the vector to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call json%json_add_logical_vec_by_path(me,to_unicode(path),value,found,was_created) + + end subroutine wrap_json_add_logical_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper to [[json_add_real_by_path]] for adding a real vector by path. + + subroutine json_add_real_vec_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(RK),dimension(:),intent(in) :: value !! the vector to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + type(json_value),pointer :: p !! pointer to path (which may exist) + type(json_value),pointer :: var !! new variable that is created + integer(IK) :: i !! counter + character(kind=CK,len=:),allocatable :: name !! the variable name + logical(LK) :: p_found !! if the path was successfully found (or created) + + if ( .not. json%exception_thrown ) then + + !get a pointer to the variable + !(creating it if necessary) + call json%create(me,path,p,found=p_found) + if (p_found) then + call json%info(p,name=name) ! want to keep the existing name + call json%create_array(var,name) ! create a new array variable + call json%replace(p,var,destroy=.true.) ! replace p with this array (destroy p) + !populate each element of the array: + do i=1,size(value) + call json%add(var, CK_'', value(i)) + end do + end if + + else + if ( present(found) ) found = .false. + if ( present(was_created) ) was_created = .false. + end if + + end subroutine json_add_real_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper for [[json_add_real_vec_by_path]] where "path" is kind=CDK). + + subroutine wrap_json_add_real_vec_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(RK),dimension(:),intent(in) :: value !! the vector to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call json%json_add_real_vec_by_path(me,to_unicode(path),value,found,was_created) + + end subroutine wrap_json_add_real_vec_by_path +!***************************************************************************************** + +#ifndef REAL32 +!***************************************************************************************** +!> +! Wrapper to [[json_add_real_by_path]] for adding a real vector by path. + + subroutine json_add_real32_vec_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(real32),dimension(:),intent(in) :: value !! the vector to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call json%add_by_path(me,path,real(value,RK),found,was_created) + + end subroutine json_add_real32_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper for [[json_add_real32_vec_by_path]] where "path" is kind=CDK). + + subroutine wrap_json_add_real32_vec_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(real32),dimension(:),intent(in) :: value !! the vector to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call json%add_by_path(me,to_unicode(path),real(value,RK),found,was_created) + + end subroutine wrap_json_add_real32_vec_by_path +!***************************************************************************************** +#endif + +#ifdef REAL128 +!***************************************************************************************** +!> +! Wrapper to [[json_add_real_by_path]] for adding a real vector by path. + + subroutine json_add_real64_vec_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + real(real64),dimension(:),intent(in) :: value !! the vector to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call json%add_by_path(me,path,real(value,RK),found,was_created) + + end subroutine json_add_real64_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper for [[json_add_real64_vec_by_path]] where "path" is kind=CDK). + + subroutine wrap_json_add_real64_vec_by_path(json,me,path,value,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + real(real64),dimension(:),intent(in) :: value !! the vector to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + + call json%add_by_path(me,to_unicode(path),real(value,RK),found,was_created) + + end subroutine wrap_json_add_real64_vec_by_path +!***************************************************************************************** +#endif + +!***************************************************************************************** +!> +! Wrapper to [[json_add_string_by_path]] for adding a string vector by path. +! +!@note The `ilen` input can be used to specify the actual lengths of the +! the strings in the array. They must all be `<= len(value)`. + + subroutine json_add_string_vec_by_path(json,me,path,value,found,was_created,ilen,trim_str,adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + character(kind=CK,len=*),dimension(:),intent(in) :: value !! the vector to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + integer(IK),dimension(:),intent(in),optional :: ilen !! the string lengths of each + !! element in `value`. If not present, + !! the full `len(value)` string is added + !! for each element. + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for each element + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for each element + + type(json_value),pointer :: p !! pointer to path (which may exist) + type(json_value),pointer :: var !! new variable that is created + integer(IK) :: i !! counter + character(kind=CK,len=:),allocatable :: name !! the variable name + logical(LK) :: p_found !! if the path was successfully found (or created) + + if ( .not. json%exception_thrown ) then + + ! validate ilen array if present: + if (present(ilen)) then + if (size(ilen)/=size(value)) then + call json%throw_exception('Error in json_add_string_vec_by_path: '//& + 'Invalid size of ilen input vector.',found) + if (present(found)) then + found = .false. + call json%clear_exceptions() + end if + if (present(was_created)) was_created = .false. + return + else + ! also have to validate the specified lengths. + ! (must not be greater than input string length) + do i = 1, size(value) + if (ilen(i)>len(value)) then + call json%throw_exception('Error in json_add_string_vec_by_path: '//& + 'Invalid ilen element.',found) + if (present(found)) then + found = .false. + call json%clear_exceptions() + end if + if (present(was_created)) was_created = .false. + return + end if + end do + end if + end if + + !get a pointer to the variable + !(creating it if necessary) + call json%create(me,path,p,found=p_found) + if (p_found) then + call json%info(p,name=name) ! want to keep the existing name + call json%create_array(var,name) ! create a new array variable + call json%replace(p,var,destroy=.true.) ! replace p with this array (destroy p) + !populate each element of the array: + do i=1,size(value) + if (present(ilen)) then + call json%add(var, CK_'', value(i)(1:ilen(i)), & + trim_str=trim_str, adjustl_str=adjustl_str) + else + call json%add(var, CK_'', value(i), & + trim_str=trim_str, adjustl_str=adjustl_str) + end if + end do + end if + + else + if ( present(found) ) found = .false. + if ( present(was_created) ) was_created = .false. + end if + + end subroutine json_add_string_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper for [[json_add_string_vec_by_path]] where "path" and "value" are kind=CDK). + + subroutine wrap_json_add_string_vec_by_path(json,me,path,value,& + found,was_created,ilen,& + trim_str,adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + character(kind=CDK,len=*),dimension(:),intent(in):: value !! the vector to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + integer(IK),dimension(:),intent(in),optional :: ilen !! the string lengths of each + !! element in `value`. If not present, + !! the full `len(value)` string is added + !! for each element. + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for each element + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for each element + + call json%json_add_string_vec_by_path(me,to_unicode(path),to_unicode(value),& + found,was_created,ilen,trim_str,adjustl_str) + + end subroutine wrap_json_add_string_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper for [[json_add_string_vec_by_path]] where "value" is kind=CDK). + + subroutine json_add_string_vec_by_path_value_ascii(json,me,path,value,& + found,was_created,ilen,& + trim_str,adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CK,len=*),intent(in) :: path !! the path to the variable + character(kind=CDK,len=*),dimension(:),intent(in):: value !! the vector to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + integer(IK),dimension(:),intent(in),optional :: ilen !! the string lengths of each + !! element in `value`. If not present, + !! the full `len(value)` string is added + !! for each element. + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for each element + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for each element + + call json%json_add_string_vec_by_path(me,path,to_unicode(value),& + found,was_created,ilen,trim_str,adjustl_str) + + end subroutine json_add_string_vec_by_path_value_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper for [[json_add_string_vec_by_path]] where "path" is kind=CDK). + + subroutine json_add_string_vec_by_path_path_ascii(json,me,path,value,& + found,was_created,ilen,& + trim_str,adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me !! the JSON structure + character(kind=CDK,len=*),intent(in) :: path !! the path to the variable + character(kind=CK,len=*),dimension(:),intent(in) :: value !! the vector to add + logical(LK),intent(out),optional :: found !! if the variable was found + logical(LK),intent(out),optional :: was_created !! if the variable had to be created + integer(IK),dimension(:),intent(in),optional :: ilen !! the string lengths of each + !! element in `value`. If not present, + !! the full `len(value)` string is added + !! for each element. + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for each element + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for each element + + call json%json_add_string_vec_by_path(me,to_unicode(path),value,& + found,was_created,ilen,trim_str,adjustl_str) + + end subroutine json_add_string_vec_by_path_path_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/19/2014 +! +! Add a real value child to the [[json_value]] variable. +! +!@note This routine is part of the public API that can be +! used to build a JSON structure using [[json_value]] pointers. + + subroutine json_value_add_real(json,p,name,val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: name !! variable name + real(RK),intent(in) :: val !! real value + + type(json_value),pointer :: var + + !create the variable: + call json%create_real(var,val,name) + + !add it: + call json%add(p, var) + + end subroutine json_value_add_real +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_real]] where `name` is kind=CDK. + + subroutine wrap_json_value_add_real(json,p,name,val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name !! variable name + real(RK),intent(in) :: val !! real value + + call json%add(p, to_unicode(name), val) + + end subroutine wrap_json_value_add_real +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/20/2014 +! +! Add a real vector child to the [[json_value]] variable. +! +!@note This routine is part of the public API that can be +! used to build a JSON structure using [[json_value]] pointers. + + subroutine json_value_add_real_vec(json, p, name, val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: name + real(RK),dimension(:),intent(in) :: val + + type(json_value),pointer :: var + integer(IK) :: i !! counter + + !create the variable as an array: + call json%create_array(var,name) + + !populate the array: + do i=1,size(val) + call json%add(var, CK_'', val(i)) + end do + + !add it: + call json%add(p, var) + + end subroutine json_value_add_real_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_real_vec]] where `name` is kind=CDK. + + subroutine wrap_json_value_add_real_vec(json, p, name, val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name + real(RK),dimension(:),intent(in) :: val + + call json%add(p, to_unicode(name), val) + + end subroutine wrap_json_value_add_real_vec +!***************************************************************************************** + +#ifndef REAL32 +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_real]] where `val` is `real32`. + + subroutine json_value_add_real32(json,p,name,val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: name !! variable name + real(real32),intent(in) :: val !! real value + + call json%add(p,name,real(val,RK)) + + end subroutine json_value_add_real32 +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_real32]] where `name` is kind=CDK. + + subroutine wrap_json_value_add_real32(json,p,name,val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name !! variable name + real(real32),intent(in) :: val !! real value + + call json%add(p, to_unicode(name), val) + + end subroutine wrap_json_value_add_real32 +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_real_vec]] where `val` is `real32`. + + subroutine json_value_add_real32_vec(json, p, name, val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: name + real(real32),dimension(:),intent(in) :: val + + call json%add(p,name,real(val,RK)) + + end subroutine json_value_add_real32_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_real32_vec]] where `name` is kind=CDK. + + subroutine wrap_json_value_add_real32_vec(json, p, name, val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name + real(real32),dimension(:),intent(in) :: val + + call json%add(p, to_unicode(name), val) + + end subroutine wrap_json_value_add_real32_vec +!***************************************************************************************** +#endif + +#ifdef REAL128 +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_real]] where `val` is `real64`. + + subroutine json_value_add_real64(json,p,name,val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: name !! variable name + real(real64),intent(in) :: val !! real value + + call json%add(p,name,real(val,RK)) + + end subroutine json_value_add_real64 +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_real64]] where `name` is kind=CDK. + + subroutine wrap_json_value_add_real64(json,p,name,val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name !! variable name + real(real64),intent(in) :: val !! real value + + call json%add(p, to_unicode(name), val) + + end subroutine wrap_json_value_add_real64 +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_real_vec]] where `val` is `real64`. + + subroutine json_value_add_real64_vec(json, p, name, val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: name + real(real64),dimension(:),intent(in) :: val + + call json%add(p, name, real(val,RK)) + + end subroutine json_value_add_real64_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_real64_vec]] where `name` is kind=CDK. + + subroutine wrap_json_value_add_real64_vec(json, p, name, val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name + real(real64),dimension(:),intent(in) :: val + + call json%add(p, to_unicode(name), val) + + end subroutine wrap_json_value_add_real64_vec +!***************************************************************************************** +#endif + +!***************************************************************************************** +!> +! Add a NULL value child to the [[json_value]] variable. +! +!@note This routine is part of the public API that can be +! used to build a JSON structure using [[json_value]] pointers. + + subroutine json_value_add_null(json, p, name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: name + + type(json_value),pointer :: var + + !create the variable: + call json%create_null(var,name) + + !add it: + call json%add(p, var) + + end subroutine json_value_add_null +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_null]] where `name` is kind=CDK. + + subroutine wrap_json_value_add_null(json, p, name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name !! name of the variable + + call json%add(p, to_unicode(name)) + + end subroutine wrap_json_value_add_null +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/20/2014 +! +! Add an integer value child to the [[json_value]] variable. +! +!@note This routine is part of the public API that can be +! used to build a JSON structure using [[json_value]] pointers. + + subroutine json_value_add_integer(json, p, name, val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: name + integer(IK),intent(in) :: val + + type(json_value),pointer :: var + + !create the variable: + call json%create_integer(var,val,name) + + !add it: + call json%add(p, var) + + end subroutine json_value_add_integer +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_integer]] where `name` is kind=CDK. + + subroutine wrap_json_value_add_integer(json, p, name, val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name !! name of the variable + integer(IK),intent(in) :: val !! value + + call json%add(p, to_unicode(name), val) + + end subroutine wrap_json_value_add_integer +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/20/2014 +! +! Add a integer vector child to the [[json_value]] variable. +! +!@note This routine is part of the public API that can be +! used to build a JSON structure using [[json_value]] pointers. + + subroutine json_value_add_integer_vec(json, p, name, val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: name !! name of the variable + integer(IK),dimension(:),intent(in) :: val !! value + + type(json_value),pointer :: var + integer(IK) :: i !! counter + + !create a variable as an array: + call json%create_array(var,name) + + !populate the array: + do i=1,size(val) + call json%add(var, CK_'', val(i)) + end do + + !add it: + call json%add(p, var) + + end subroutine json_value_add_integer_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_integer_vec]] where `name` is kind=CDK. + + subroutine wrap_json_value_add_integer_vec(json, p, name, val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name !! name of the variable + integer(IK),dimension(:),intent(in) :: val !! value + + call json%add(p, to_unicode(name), val) + + end subroutine wrap_json_value_add_integer_vec +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/20/2014 +! +! Add a logical value child to the [[json_value]] variable. +! +!@note This routine is part of the public API that can be +! used to build a JSON structure using [[json_value]] pointers. + + subroutine json_value_add_logical(json, p, name, val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: name !! name of the variable + logical(LK),intent(in) :: val !! value + + type(json_value),pointer :: var + + !create the variable: + call json%create_logical(var,val,name) + + !add it: + call json%add(p, var) + + end subroutine json_value_add_logical +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_logical]] where `name` is kind=CDK. + + subroutine wrap_json_value_add_logical(json, p, name, val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name !! name of the variable + logical(LK),intent(in) :: val !! value + + call json%add(p, to_unicode(name), val) + + end subroutine wrap_json_value_add_logical +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/20/2014 +! +! Add a logical vector child to the [[json_value]] variable. +! +!@note This routine is part of the public API that can be +! used to build a JSON structure using [[json_value]] pointers. + + subroutine json_value_add_logical_vec(json, p, name, val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: name !! name of the vector + logical(LK),dimension(:),intent(in) :: val !! value + + type(json_value),pointer :: var + integer(IK) :: i !! counter + + !create the variable as an array: + call json%create_array(var,name) + + !populate the array: + do i=1,size(val) + call json%add(var, CK_'', val(i)) + end do + + !add it: + call json%add(p, var) + + end subroutine json_value_add_logical_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_logical_vec]] where `name` is kind=CDK. + + subroutine wrap_json_value_add_logical_vec(json, p, name, val) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name !! name of the variable + logical(LK),dimension(:),intent(in) :: val !! value + + call json%add(p, to_unicode(name), val) + + end subroutine wrap_json_value_add_logical_vec +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/19/2014 +! +! Add a character string child to the [[json_value]] variable. +! +!@note This routine is part of the public API that can be +! used to build a JSON structure using [[json_value]] pointers. + + subroutine json_value_add_string(json, p, name, val, trim_str, adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: name !! name of the variable + character(kind=CK,len=*),intent(in) :: val !! value + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + + type(json_value),pointer :: var + + !create the variable: + call json%create_string(var,val,name,trim_str,adjustl_str) + + !add it: + call json%add(p, var) + + end subroutine json_value_add_string +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_string]] where `name` and `val` are kind=CDK. + + subroutine wrap_json_value_add_string(json, p, name, val, trim_str, adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name !! name of the variable + character(kind=CDK,len=*),intent(in) :: val !! value + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + + call json%add(p, to_unicode(name), to_unicode(val), trim_str, adjustl_str) + + end subroutine wrap_json_value_add_string +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_string]] where `name` is kind=CDK. + + subroutine json_value_add_string_name_ascii(json, p, name, val, trim_str, adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name !! name of the variable + character(kind=CK, len=*),intent(in) :: val !! value + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + + call json%add(p, to_unicode(name), val, trim_str, adjustl_str) + + end subroutine json_value_add_string_name_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_string]] where `val` is kind=CDK. + + subroutine json_value_add_string_val_ascii(json, p, name, val, trim_str, adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK, len=*),intent(in) :: name !! name of the variable + character(kind=CDK,len=*),intent(in) :: val !! value + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + + call json%add(p, name, to_unicode(val), trim_str, adjustl_str) + + end subroutine json_value_add_string_val_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/19/2014 +! +! Add a character string vector child to the [[json_value]] variable. +! +!@note This routine is part of the public API that can be +! used to build a JSON structure using [[json_value]] pointers. + + subroutine json_value_add_string_vec(json, p, name, val, trim_str, adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: name !! variable name + character(kind=CK,len=*),dimension(:),intent(in) :: val !! array of strings + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for each element + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for each element + + type(json_value),pointer :: var + integer(IK) :: i !! counter + + !create the variable as an array: + call json%create_array(var,name) + + !populate the array: + do i=1,size(val) + call json%add(var, CK_'', val(i), trim_str, adjustl_str) + end do + + !add it: + call json%add(p, var) + + end subroutine json_value_add_string_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_string_vec]] where `name` and `val` are kind=CDK. + + subroutine wrap_json_value_add_string_vec(json, p, name, val, trim_str, adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name + character(kind=CDK,len=*),dimension(:),intent(in) :: val + logical(LK),intent(in),optional :: trim_str + logical(LK),intent(in),optional :: adjustl_str + + call json%add(p, to_unicode(name), to_unicode(val), trim_str, adjustl_str) + + end subroutine wrap_json_value_add_string_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_string_vec]] where `name` is kind=CDK. + + subroutine json_value_add_string_vec_name_ascii(json, p, name, val, trim_str, adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name + character(kind=CK, len=*),dimension(:),intent(in) :: val + logical(LK),intent(in),optional :: trim_str + logical(LK),intent(in),optional :: adjustl_str + + call json%add(p, to_unicode(name), val, trim_str, adjustl_str) + + end subroutine json_value_add_string_vec_name_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_add_string_vec]] where `val` is kind=CDK. + + subroutine json_value_add_string_vec_val_ascii(json, p, name, val, trim_str, adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK, len=*),intent(in) :: name + character(kind=CDK,len=*),dimension(:),intent(in) :: val + logical(LK),intent(in),optional :: trim_str + logical(LK),intent(in),optional :: adjustl_str + + call json%add(p, name, to_unicode(val), trim_str, adjustl_str) + + end subroutine json_value_add_string_vec_val_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> +! Count the number of children in the object or array. +! +!### History +! * JW : 1/4/2014 : Original routine removed. +! Now using `n_children` variable. +! Renamed from `json_value_count`. + + function json_count(json,p) result(count) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p !! this should normally be a `json_object` + !! or a `json_array`. For any other + !! variable type this will return 0. + integer(IK) :: count !! number of children in `p`. + + if (associated(p)) then + count = p%n_children + else + call json%throw_exception('Error in json_count: '//& + 'pointer is not associated.') + end if + + end function json_count +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 10/16/2015 +! +! Returns a pointer to the parent of a [[json_value]]. +! If there is no parent, then a `null()` pointer is returned. + + subroutine json_get_parent(json,p,parent) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p !! JSON object + type(json_value),pointer,intent(out) :: parent !! pointer to `parent` + + if (associated(p)) then + parent => p%parent + else + nullify(parent) + call json%throw_exception('Error in json_get_parent: '//& + 'pointer is not associated.') + end if + + end subroutine json_get_parent +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 10/31/2015 +! +! Returns a pointer to the next of a [[json_value]]. +! If there is no next, then a `null()` pointer is returned. + + subroutine json_get_next(json,p,next) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p !! JSON object + type(json_value),pointer,intent(out) :: next !! pointer to `next` + + if (associated(p)) then + next => p%next + else + nullify(next) + call json%throw_exception('Error in json_get_next: '//& + 'pointer is not associated.') + end if + + end subroutine json_get_next +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 10/31/2015 +! +! Returns a pointer to the previous of a [[json_value]]. +! If there is no previous, then a `null()` pointer is returned. + + subroutine json_get_previous(json,p,previous) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p !! JSON object + type(json_value),pointer,intent(out) :: previous !! pointer to `previous` + + if (associated(p)) then + previous => p%previous + else + nullify(previous) + call json%throw_exception('Error in json_get_previous: '//& + 'pointer is not associated.') + end if + + end subroutine json_get_previous +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 10/31/2015 +! +! Returns a pointer to the tail of a [[json_value]] +! (the last child of an array of object). +! If there is no tail, then a `null()` pointer is returned. + + subroutine json_get_tail(json,p,tail) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p !! JSON object + type(json_value),pointer,intent(out) :: tail !! pointer to `tail` + + if (associated(p)) then + tail => p%tail + else + nullify(tail) + call json%throw_exception('Error in json_get_tail: '//& + 'pointer is not associated.') + end if + + end subroutine json_get_tail +!***************************************************************************************** + +!***************************************************************************************** +!> +! Returns a child in the object or array given the index. + + subroutine json_value_get_child_by_index(json, p, idx, child, found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p !! object or array JSON data + integer(IK),intent(in) :: idx !! index of the child + !! (this is a 1-based Fortran + !! style array index). + type(json_value),pointer :: child !! pointer to the child + logical(LK),intent(out),optional :: found !! true if the value was found + !! (if not present, an exception + !! will be thrown if it was not + !! found. If present and not + !! found, no exception will be + !! thrown). + + integer(IK) :: i !! counter + + nullify(child) + + if (.not. json%exception_thrown) then + + if (associated(p%children)) then + + ! If getting first or last child, we can do this quickly. + ! Otherwise, traverse the list. + if (idx==1) then + + child => p%children ! first one + + elseif (idx==p%n_children) then + + if (associated(p%tail)) then + child => p%tail ! last one + else + call json%throw_exception('Error in json_value_get_child_by_index:'//& + ' child%tail is not associated.',found) + end if + + elseif (idx<1 .or. idx>p%n_children) then + + call json%throw_exception('Error in json_value_get_child_by_index:'//& + ' idx is out of range.',found) + + else + + ! if idx is closer to the end, we traverse the list backward from tail, + ! otherwise we traverse it forward from children: + + if (p%n_children-idx < idx) then ! traverse backward + + child => p%tail + + do i = 1, p%n_children - idx + + if (associated(child%previous)) then + child => child%previous + else + call json%throw_exception('Error in json_value_get_child_by_index:'//& + ' child%previous is not associated.',found) + nullify(child) + exit + end if + + end do + + else ! traverse forward + + child => p%children + + do i = 1, idx - 1 + + if (associated(child%next)) then + child => child%next + else + call json%throw_exception('Error in json_value_get_child_by_index:'//& + ' child%next is not associated.',found) + nullify(child) + exit + end if + + end do + + end if + + end if + + else + + call json%throw_exception('Error in json_value_get_child_by_index:'//& + ' p%children is not associated.',found) + + end if + + ! found output: + if (json%exception_thrown) then + if (present(found)) then + call json%clear_exceptions() + found = .false. + end if + else + if (present(found)) found = .true. + end if + + else + if (present(found)) found = .false. + end if + + end subroutine json_value_get_child_by_index +!***************************************************************************************** + +!***************************************************************************************** +!> +! Returns pointer to the first child of the object +! (or `null()` if it is not associated). + + subroutine json_value_get_child(json, p, child) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p !! object or array JSON data + type(json_value),pointer :: child !! pointer to the child + + if (associated(p)) then + child => p%children + else + nullify(child) + call json%throw_exception('Error in json_value_get_child: '//& + 'pointer is not associated.') + end if + + end subroutine json_value_get_child +!***************************************************************************************** + +!***************************************************************************************** +!> +! Returns a child in the object or array given the name string. +! +! The name search can be case-sensitive or not, and can have significant trailing +! whitespace or not, depending on the settings in the [[json_core(type)]] class. +! +!@note The `name` input is not a path, and is not parsed like it is in [[json_get_by_path]]. + + subroutine json_value_get_child_by_name(json, p, name, child, found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p + character(kind=CK,len=*),intent(in) :: name !! the name of a child of `p` + type(json_value),pointer :: child !! pointer to the child + logical(LK),intent(out),optional :: found !! true if the value was found + !! (if not present, an exception + !! will be thrown if it was not + !! found. If present and not + !! found, no exception will be + !! thrown). + + integer(IK) :: i,n_children + logical :: error + + nullify(child) + + if (.not. json%exception_thrown) then + + if (associated(p)) then + + error = .true. ! will be false if it is found + if (p%var_type==json_object) then + n_children = json%count(p) + child => p%children !start with first one + do i=1, n_children + if (.not. associated(child)) then + call json%throw_exception(& + 'Error in json_value_get_child_by_name: '//& + 'Malformed JSON linked list',found) + exit + end if + if (allocated(child%name)) then + !name string matching routine: + if (json%name_equal(child,name)) then + error = .false. + exit + end if + end if + child => child%next + end do + end if + + if (error) then + !did not find anything: + call json%throw_exception(& + 'Error in json_value_get_child_by_name: '//& + 'child variable '//trim(name)//' was not found.',found) + nullify(child) + end if + + else + call json%throw_exception(& + 'Error in json_value_get_child_by_name: '//& + 'pointer is not associated.',found) + end if + + ! found output: + if (json%exception_thrown) then + if (present(found)) then + call json%clear_exceptions() + found = .false. + end if + else + if (present(found)) found = .true. + end if + + else + if (present(found)) found = .false. + end if + + end subroutine json_value_get_child_by_name +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 8/25/2017 +! +! Checks a JSON object for duplicate child names. +! +! It uses the specified settings for name matching (see [[name_strings_equal]]). +! +!@note This will only check for one duplicate, +! it will return the first one that it finds. + + subroutine json_check_children_for_duplicate_keys(json,p,has_duplicate,name,path) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p !! the object to search. If `p` is + !! not a `json_object`, then `has_duplicate` + !! will be false. + logical(LK),intent(out) :: has_duplicate !! true if there is at least + !! two children have duplicate + !! `name` values. + character(kind=CK,len=:),allocatable,intent(out),optional :: name !! the duplicate name + !! (unallocated if no + !! duplicate was found) + character(kind=CK,len=:),allocatable,intent(out),optional :: path !! the full path to the + !! duplicate name + !! (unallocated if no + !! duplicate was found) + + integer(IK) :: i !! counter + integer(IK) :: j !! counter + type(json_value),pointer :: child !! pointer to a child of `p` + integer(IK) :: n_children !! number of children of `p` + logical(LK) :: found !! flag for `get_child` + + type :: alloc_str + !! so we can have an array of allocatable strings + character(kind=CK,len=:),allocatable :: str !! name string + end type alloc_str + type(alloc_str),dimension(:),allocatable :: names !! array of all the + !! child name strings + + ! initialize: + has_duplicate =.false. + + if (.not. json%exception_thrown) then + + if (associated(p)) then + + if (p%var_type==json_object) then + + ! number of items to check: + n_children = json%count(p) + allocate(names(n_children)) + + ! first get a list of all the name keys: + do i=1, n_children + call json%get_child(p,i,child,found) ! get by index + if (.not. found) then + call json%throw_exception(& + 'Error in json_check_children_for_duplicate_keys: '//& + 'Malformed JSON linked list') + exit + end if + if (allocated(child%name)) then + names(i)%str = child%name + else + call json%throw_exception(& + 'Error in json_check_children_for_duplicate_keys: '//& + 'Object child name is not allocated') + exit + end if + end do + + if (.not. json%exception_thrown) then + ! now check the list for duplicates: + main: do i=1,n_children + do j=1,i-1 + if (json%name_strings_equal(names(i)%str,names(j)%str)) then + has_duplicate = .true. + if (present(name)) then + name = names(i)%str + end if + if (present(path)) then + call json%get_child(p,names(i)%str,child,found) ! get by name + if (found) then + call json%get_path(child,path,found) + if (.not. found) then + ! should never happen since we know it is there + call json%throw_exception(& + 'Error in json_check_children_for_duplicate_keys: '//& + 'Could not get path') + end if + else + ! should never happen since we know it is there + call json%throw_exception(& + 'Error in json_check_children_for_duplicate_keys: '//& + 'Could not get child: '//trim(names(i)%str)) + end if + end if + exit main + end if + end do + end do main + end if + + ! cleanup + do i=1,n_children + if (allocated(names(i)%str)) deallocate(names(i)%str) + end do + if (allocated(names)) deallocate(names) + + end if + + end if + + end if + + end subroutine json_check_children_for_duplicate_keys +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 8/25/2017 +! +! Checks a JSON structure for duplicate child names. +! This one recursively traverses the entire structure +! (calling [[json_check_children_for_duplicate_keys]] +! recursively for each element). +! +!@note This will only check for one duplicate, +! it will return the first one that it finds. + + subroutine json_check_all_for_duplicate_keys(json,p,has_duplicate,name,path) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p !! the object to search. If `p` is + !! not a `json_object`, then `has_duplicate` + !! will be false. + logical(LK),intent(out) :: has_duplicate !! true if there is at least + !! one duplicate `name` key anywhere + !! in the structure. + character(kind=CK,len=:),allocatable,intent(out),optional :: name !! the duplicate name + !! (unallocated if no + !! duplicates were found) + character(kind=CK,len=:),allocatable,intent(out),optional :: path !! the full path to the + !! duplicate name + !! (unallocated if no + !! duplicate was found) + + has_duplicate = .false. + if (.not. json%exception_thrown) then + call json%traverse(p,duplicate_key_func) + end if + + contains + + subroutine duplicate_key_func(json,p,finished) + + !! Callback function to check each element + !! for duplicate child names. + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p + logical(LK),intent(out) :: finished + +#if defined __GFORTRAN__ + + ! this is a workaround for a gfortran bug (6 and 7), + + character(kind=CK,len=:),allocatable :: tmp_name !! temp variable for `name` string + character(kind=CK,len=:),allocatable :: tmp_path !! temp variable for `path` string + + if (present(name) .and. present(path)) then + call json%check_children_for_duplicate_keys(p,has_duplicate,name=tmp_name,path=tmp_path) + else if (present(name) .and. .not. present(path)) then + call json%check_children_for_duplicate_keys(p,has_duplicate,name=tmp_name) + else if (.not. present(name) .and. present(path)) then + call json%check_children_for_duplicate_keys(p,has_duplicate,path=tmp_path) + else + call json%check_children_for_duplicate_keys(p,has_duplicate) + end if + + if (has_duplicate) then + if (present(name)) name = tmp_name + if (present(path)) path = tmp_path + end if + +#else + call json%check_children_for_duplicate_keys(p,has_duplicate,name,path) +#endif + + finished = has_duplicate .or. json%exception_thrown + + end subroutine duplicate_key_func + + end subroutine json_check_all_for_duplicate_keys +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_get_child_by_name]] where `name` is kind=CDK. + + subroutine wrap_json_value_get_child_by_name(json, p, name, child, found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p + character(kind=CDK,len=*),intent(in) :: name + type(json_value),pointer :: child + logical(LK),intent(out),optional :: found + + call json%get(p,to_unicode(name),child,found) + + end subroutine wrap_json_value_get_child_by_name +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 2/12/2014 +! +! Print the [[json_value]] structure to an allocatable string. + + subroutine json_value_to_string(json,p,str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p + character(kind=CK,len=:),intent(out),allocatable :: str !! prints structure to this string + + integer(IK) :: iloc !! used to keep track of size of str + !! since it is being allocated in chunks. + + str = repeat(space, print_str_chunk_size) + iloc = 0_IK + call json%json_value_print(p, iunit=unit2str, str=str, iloc=iloc, indent=1_IK, colon=.true.) + + ! trim the string if necessary: + if (len(str)>iloc) str = str(1:iloc) + + end subroutine json_value_to_string +!***************************************************************************************** + +!***************************************************************************************** +!> +! Print the [[json_value]] structure to the console (`output_unit`). +! +!### Note +! * Just a wrapper for [[json_print_to_unit]]. + + subroutine json_print_to_console(json,p) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p + + call json%print(p,int(output_unit,IK)) + + end subroutine json_print_to_console +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 6/20/2014 +! +! Print the [[json_value]] structure to a file. + + subroutine json_print_to_unit(json,p,iunit) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p + integer(IK),intent(in) :: iunit !! the file unit (the file must + !! already have been opened, can't be -1). + + character(kind=CK,len=:),allocatable :: dummy !! dummy for `str` argument + !! to [[json_value_print]] + integer(IK) :: idummy !! dummy for `iloc` argument + !! to [[json_value_print]] + + if (iunit/=unit2str) then + idummy = 0_IK + call json%json_value_print(p,iunit,str=dummy,iloc=idummy,indent=1_IK,colon=.true.) + else + call json%throw_exception('Error in json_print_to_unit: iunit must not be -1.') + end if + + end subroutine json_print_to_unit +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/23/2014 +! +! Print the [[json_value]] structure to a file. + + subroutine json_print_to_filename(json,p,filename) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p + character(kind=CDK,len=*),intent(in) :: filename !! the filename to print to + !! (should not already be open) + + integer(IK) :: iunit !! file unit for `open` statement + integer(IK) :: istat !! `iostat` code for `open` statement + + open(newunit=iunit,file=filename,status='REPLACE',iostat=istat FILE_ENCODING ) + if (istat==0) then + call json%print(p,iunit) + close(iunit,iostat=istat) + else + call json%throw_exception('Error in json_print_to_filename: could not open file: '//& + trim(filename)) + end if + + end subroutine json_print_to_filename +!***************************************************************************************** + +!***************************************************************************************** +!> +! Print the JSON structure to a string or a file. +! +!### Notes +! * This is an internal routine called by the various wrapper routines. +! * The reason the `str` argument is non-optional is because of a +! bug in v4.9 of the gfortran compiler. + + recursive subroutine json_value_print(json,p,iunit,str,indent,& + need_comma,colon,is_array_element,& + is_compressed_vector,iloc) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p + integer(IK),intent(in) :: iunit !! file unit to write to (the + !! file is assumed to be open) + integer(IK),intent(in),optional :: indent !! indention level + logical(LK),intent(in),optional :: is_array_element !! if this is an array element + logical(LK),intent(in),optional :: need_comma !! if it needs a comma after it + logical(LK),intent(in),optional :: colon !! if the colon was just written + character(kind=CK,len=:),intent(inout),allocatable :: str + !! if `iunit==unit2str` (-1) then + !! the structure is printed to this + !! string rather than a file. This mode + !! is used by [[json_value_to_string]]. + integer(IK),intent(inout) :: iloc !! current index in `str`. should be set to 0 initially. + !! [only used when `str` is used.] + logical(LK),intent(in),optional :: is_compressed_vector !! if True, this is an element + !! from an array being printed + !! on one line [default is False] + + character(kind=CK,len=max_numeric_str_len) :: tmp !! for value to string conversions + character(kind=CK,len=:),allocatable :: s_indent !! the string of spaces for + !! indenting (see `tab` and `spaces`) + character(kind=CK,len=:),allocatable :: s !! the string appended to `str` + type(json_value),pointer :: element !! for getting children + integer(IK) :: tab !! number of `tabs` for indenting + integer(IK) :: spaces !! number of spaces for indenting + integer(IK) :: i !! counter + integer(IK) :: count !! number of children + logical(LK) :: print_comma !! if the comma will be printed after the value + logical(LK) :: write_file !! if we are writing to a file + logical(LK) :: write_string !! if we are writing to a string + logical(LK) :: is_array !! if this is an element in an array + logical(LK) :: is_vector !! if all elements of a vector + !! are scalars of the same type + character(kind=CK,len=:),allocatable :: str_escaped !! escaped version of + !! `name` or `str_value` + + if (.not. json%exception_thrown) then + + if (.not. associated(p)) then + ! note: a null() pointer will trigger this error. + ! However, if the pointer is undefined, then this will + ! crash (if this wasn't here it would crash below when + ! we try to access the contents) + call json%throw_exception('Error in json_value_print: '//& + 'the pointer is not associated') + return + end if + + if (present(is_compressed_vector)) then + is_vector = is_compressed_vector + else + is_vector = .false. + end if + + !whether to write a string or a file (one or the other): + write_string = (iunit==unit2str) + write_file = .not. write_string + + !if the comma will be printed after the value + ! [comma not printed for the last elements] + if (present(need_comma)) then + print_comma = need_comma + else + print_comma = .false. + end if + + !number of "tabs" to indent: + if (present(indent) .and. .not. json%no_whitespace) then + tab = indent + else + tab = 0 + end if + !convert to number of spaces: + spaces = tab*json%spaces_per_tab + + !if this is an element in an array: + if (present(is_array_element)) then + is_array = is_array_element + else + is_array = .false. + end if + + !if the colon was the last thing written + if (present(colon)) then + s_indent = CK_'' + else + s_indent = repeat(space, spaces) + end if + + select case (p%var_type) + + case (json_object) + + count = json%count(p) + + if (count==0) then !special case for empty object + + s = s_indent//start_object//end_object + call write_it( comma=print_comma ) + + else + + s = s_indent//start_object + call write_it() + + !if an object is in an array, there is an extra tab: + if (is_array) then + if ( .not. json%no_whitespace) tab = tab+1 + spaces = tab*json%spaces_per_tab + end if + + nullify(element) + element => p%children + do i = 1, count + + if (.not. associated(element)) then + call json%throw_exception('Error in json_value_print: '//& + 'Malformed JSON linked list') + return + end if + + ! print the name + if (allocated(element%name)) then + call escape_string(element%name,str_escaped,json%escape_solidus) + if (json%no_whitespace) then + !compact printing - no extra space + s = repeat(space, spaces)//quotation_mark//& + str_escaped//quotation_mark//colon_char + call write_it(advance=.false.) + else + s = repeat(space, spaces)//quotation_mark//& + str_escaped//quotation_mark//colon_char//space + call write_it(advance=.false.) + end if + else + call json%throw_exception('Error in json_value_print:'//& + ' element%name not allocated') + nullify(element) + return + end if + + ! recursive print of the element + call json%json_value_print(element, iunit=iunit, indent=tab + 1_IK, & + need_comma=i element%next + + end do + + ! [one fewer tab if it isn't an array element] + if (.not. is_array) then + s = repeat(space, max(0_IK,spaces-json%spaces_per_tab))//end_object + else + s = s_indent//end_object + end if + call write_it( comma=print_comma ) + nullify(element) + + end if + + case (json_array) + + count = json%count(p) + + if (count==0) then ! special case for empty array + + s = s_indent//start_array//end_array + call write_it( comma=print_comma ) + + else + + ! if every child is the same type & a scalar: + is_vector = json%is_vector(p) + if (json%failed()) return + + s = s_indent//start_array + call write_it( advance=(.not. is_vector) ) + + !if an array is in an array, there is an extra tab: + if (is_array) then + if ( .not. json%no_whitespace) tab = tab+1 + spaces = tab*json%spaces_per_tab + end if + + nullify(element) + element => p%children + do i = 1, count + + if (.not. associated(element)) then + call json%throw_exception('Error in json_value_print: '//& + 'Malformed JSON linked list') + return + end if + + ! recursive print of the element + if (is_vector) then + call json%json_value_print(element, iunit=iunit, indent=0_IK,& + need_comma=i element%next + + end do + + !indent the closing array character: + if (is_vector) then + s = end_array + call write_it( comma=print_comma ) + else + s = repeat(space, max(0_IK,spaces-json%spaces_per_tab))//end_array + call write_it( comma=print_comma ) + end if + nullify(element) + + end if + + case (json_null) + + s = s_indent//null_str + call write_it( comma=print_comma, & + advance=(.not. is_vector),& + space_after_comma=is_vector ) + + case (json_string) + + if (allocated(p%str_value)) then + ! have to escape the string for printing: + call escape_string(p%str_value,str_escaped,json%escape_solidus) + s = s_indent//quotation_mark//str_escaped//quotation_mark + call write_it( comma=print_comma, & + advance=(.not. is_vector),& + space_after_comma=is_vector ) + else + call json%throw_exception('Error in json_value_print:'//& + ' p%value_string not allocated') + return + end if + + case (json_logical) + + if (p%log_value) then + s = s_indent//true_str + call write_it( comma=print_comma, & + advance=(.not. is_vector),& + space_after_comma=is_vector ) + else + s = s_indent//false_str + call write_it( comma=print_comma, & + advance=(.not. is_vector),& + space_after_comma=is_vector ) + end if + + case (json_integer) + + call integer_to_string(p%int_value,int_fmt,tmp) + + s = s_indent//trim(tmp) + call write_it( comma=print_comma, & + advance=(.not. is_vector),& + space_after_comma=is_vector ) + + case (json_real) + + if (allocated(json%real_fmt)) then + call real_to_string(p%dbl_value,json%real_fmt,json%compact_real,json%non_normals_to_null,tmp) + else + !use the default format (user has not called initialize() or specified one): + call real_to_string(p%dbl_value,default_real_fmt,json%compact_real,json%non_normals_to_null,tmp) + end if + + s = s_indent//trim(tmp) + call write_it( comma=print_comma, & + advance=(.not. is_vector),& + space_after_comma=is_vector ) + + case default + + call integer_to_string(p%var_type,int_fmt,tmp) + call json%throw_exception('Error in json_value_print: '//& + 'unknown data type: '//trim(tmp)) + + end select + + end if + + contains + + subroutine write_it(advance,comma,space_after_comma) + + !! write the string `s` to the file (or the output string) + + implicit none + + logical(LK),intent(in),optional :: advance !! to add line break or not + logical(LK),intent(in),optional :: comma !! print comma after the string + logical(LK),intent(in),optional :: space_after_comma !! print a space after the comma + + logical(LK) :: add_comma !! if a delimiter is to be added after string + logical(LK) :: add_line_break !! if a line break is to be added after string + logical(LK) :: add_space !! if a space is to be added after the comma + integer(IK) :: n !! length of actual string `s` appended to `str` + integer(IK) :: room_left !! number of characters left in `str` + integer(IK) :: n_chunks_to_add !! number of chunks to add to `str` for appending `s` + + if (present(comma)) then + add_comma = comma + else + add_comma = .false. !default is not to add comma + end if + if (json%no_whitespace) then + add_space = .false. + else + if (present(space_after_comma)) then + add_space = space_after_comma + else + add_space = .false. !default is not to add space + end if + end if + if (present(advance)) then + if (json%no_whitespace) then + ! overrides input value: + add_line_break = .false. + else + add_line_break = advance + end if + else + add_line_break = .not. json%no_whitespace ! default is to advance if + ! we are printing whitespace + end if + + ! string to print: + if (add_comma) then + if (add_space) then + s = s // delimiter // space + else + s = s // delimiter + end if + end if + + if (write_file) then + + if (add_line_break) then + write(iunit,fmt='(A)') s + else + write(iunit,fmt='(A)',advance='NO') s + end if + + else !write string + + if (add_line_break) s = s // newline + + n = len(s) + room_left = len(str)-iloc + if (room_left < n) then + ! need to add another chunk to fit this string: + n_chunks_to_add = max(1_IK, ceiling( real(len(s)-room_left,RK) / real(chunk_size,RK), IK ) ) + str = str // repeat(space, print_str_chunk_size*n_chunks_to_add) + end if + ! append s to str: + str(iloc+1:iloc+n) = s + iloc = iloc + n + + end if + + end subroutine write_it + + end subroutine json_value_print +!***************************************************************************************** + +!***************************************************************************************** +!> +! Returns true if all the children are the same type (and a scalar). +! Note that integers and reals are considered the same type for this purpose. +! This routine is used for the `compress_vectors` option. + + function json_is_vector(json, p) result(is_vector) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + logical(LK) :: is_vector !! if all elements of a vector + !! are scalars of the same type + + integer(IK) :: var_type_prev !! for getting the variable type of children + integer(IK) :: var_type !! for getting the variable type of children + type(json_value),pointer :: element !! for getting children + integer(IK) :: i !! counter + integer(IK) :: count !! number of children + + integer(IK),parameter :: json_invalid = -1_IK !! to initialize the flag. an invalid value + integer(IK),parameter :: json_numeric = -2_IK !! indicates `json_integer` or `json_real` + + if (json%compress_vectors) then + ! check to see if every child is the same type, + ! and a scalar: + is_vector = .true. + var_type_prev = json_invalid + count = json%count(p) + element => p%children + do i = 1_IK, count + if (.not. associated(element)) then + call json%throw_exception('Error in json_is_vector: '//& + 'Malformed JSON linked list') + return + end if + ! check variable type of all the children. + ! They must all be the same, and a scalar. + call json%info(element,var_type=var_type) + ! special check for numeric values: + if (var_type==json_integer .or. var_type==json_real) var_type = json_numeric + if (var_type==json_object .or. & + var_type==json_array .or. & + (i>1_IK .and. var_type/=var_type_prev)) then + is_vector = .false. + exit + end if + var_type_prev = var_type + ! get the next child the list: + element => element%next + end do + else + is_vector = .false. + end if + + end function json_is_vector +!***************************************************************************************** + +!***************************************************************************************** +!> +! Returns true if the `path` is present in the `p` JSON structure. +! +!@note Just a wrapper for [[json_get_by_path]], so it uses the +! specified `path_mode` and other settings. + + function json_valid_path(json, p, path) result(found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p !! a JSON linked list + character(kind=CK,len=*),intent(in) :: path !! path to the variable + logical(LK) :: found !! true if it was found + + type(json_value),pointer :: tmp !! pointer to the variable specified by `path` + + call json%get(p, path, tmp, found) + + end function json_valid_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_valid_path]] where "path" is kind=CDK. + + function wrap_json_valid_path(json, p, path) result(found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p !! a JSON linked list + character(kind=CDK,len=*),intent(in) :: path !! path to the variable + logical(LK) :: found !! true if it was found + + found = json%valid_path(p, to_unicode(path)) + + end function wrap_json_valid_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Returns the [[json_value]] pointer given the path string. +! +! It uses one of three methods: +! +! * The original JSON-Fortran defaults +! * [RFC 6901](https://tools.ietf.org/html/rfc6901) +! * [JSONPath](http://goessner.net/articles/JsonPath/) "bracket-notation" + + subroutine json_get_by_path(json, me, path, p, found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me !! a JSON linked list + character(kind=CK,len=*),intent(in) :: path !! path to the variable + type(json_value),pointer,intent(out) :: p !! pointer to the variable + !! specified by `path` + logical(LK),intent(out),optional :: found !! true if it was found + + character(kind=CK,len=max_integer_str_len),allocatable :: path_mode_str !! string version + !! of `json%path_mode` + + nullify(p) + + if (.not. json%exception_thrown) then + + select case (json%path_mode) + case(1_IK) + call json%json_get_by_path_default(me, path, p, found) + case(2_IK) + call json%json_get_by_path_rfc6901(me, path, p, found) + case(3_IK) + call json%json_get_by_path_jsonpath_bracket(me, path, p, found) + case default + call integer_to_string(json%path_mode,int_fmt,path_mode_str) + call json%throw_exception('Error in json_get_by_path: Unsupported path_mode: '//& + trim(path_mode_str)) + if (present(found)) found = .false. + end select + + if (present(found)) then + if (.not. found) call json%clear_exceptions() + end if + + else + if (present(found)) found = .false. + end if + + end subroutine json_get_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Returns the [[json_value]] pointer given the path string, +! If necessary, by creating the variables as needed. +! +! By default, the leaf node and any empty array elements +! are created as `json_null` values. +! +! It only works for `path_mode=1` or `path_mode=3`. +! An error will be thrown for `path_mode=2` (RFC 6901). +! +!### See also +! * [[json_get_by_path]] + + subroutine json_create_by_path(json,me,path,p,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me !! a JSON linked list + character(kind=CK,len=*),intent(in) :: path !! path to the variable + type(json_value),pointer,intent(out),optional :: p !! pointer to the variable + !! specify by `path` + logical(LK),intent(out),optional :: found !! true if there were no errors + !! (variable found or created) + logical(LK),intent(out),optional :: was_created !! true if it was actually created + !! (as opposed to already being there) + + type(json_value),pointer :: tmp + character(kind=CK,len=max_integer_str_len) :: path_mode_str !! string version + !! of `json%path_mode` + + if (present(p)) nullify(p) + + if (.not. json%exception_thrown) then + + select case (json%path_mode) + case(1_IK) + call json%json_get_by_path_default(me,path,tmp,found,& + create_it=.true.,& + was_created=was_created) + if (present(p)) p => tmp + case(3_IK) + call json%json_get_by_path_jsonpath_bracket(me,path,tmp,found,& + create_it=.true.,& + was_created=was_created) + if (present(p)) p => tmp + + case default + + if (json%path_mode==2_IK) then + ! the problem here is there isn't really a way to disambiguate + ! the array elements, so '/a/0' could be 'a(1)' or 'a.0'. + call json%throw_exception('Error in json_create_by_path: '//& + 'Create by path not supported in RFC 6901 path mode.') + else + call integer_to_string(json%path_mode,int_fmt,path_mode_str) + call json%throw_exception('Error in json_create_by_path: Unsupported path_mode: '//& + trim(path_mode_str)) + end if + if (present(found)) then + call json%clear_exceptions() + found = .false. + end if + if (present(was_created)) was_created = .false. + end select + + else + if (present(was_created)) was_created = .false. + if (present(found)) found = .false. + end if + + end subroutine json_create_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_create_by_path]] where "path" is kind=CDK. + + subroutine wrap_json_create_by_path(json,me,path,p,found,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me !! a JSON linked list + character(kind=CDK,len=*),intent(in) :: path !! path to the variable + type(json_value),pointer,intent(out),optional :: p !! pointer to the variable + !! specify by `path` + logical(LK),intent(out),optional :: found !! true if there were no errors + !! (variable found or created) + logical(LK),intent(out),optional :: was_created !! true if it was actually created + !! (as opposed to already being there) + + call json%create(me,to_unicode(path),p,found,was_created) + + end subroutine wrap_json_create_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Rename a [[json_value]], given the path. +! +!@note this is a wrapper for [[json_value_rename]]. + + subroutine json_rename_by_path(json, me, path, name, found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=*),intent(in) :: path !! path to the variable to rename + character(kind=CK,len=*),intent(in) :: name !! the new name + logical(LK),intent(out),optional :: found !! if there were no errors + + type(json_value),pointer :: p + + if ( json%exception_thrown ) then + if ( present(found) ) found = .false. + return + end if + + nullify(p) + call json%get(me=me, path=path, p=p) + + if (.not. associated(p)) then + call json%throw_exception('Error in json_rename_by_path:'//& + ' Unable to resolve path: '//trim(path),found) + else + call json%rename(p,name) + nullify(p) + end if + + if (json%exception_thrown) then + if (present(found)) then + found = .false. + call json%clear_exceptions() + end if + else + if (present(found)) found = .true. + end if + + end subroutine json_rename_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_rename_by_path]], where "path" and "name" are kind=CDK + + subroutine wrap_json_rename_by_path(json, me, path, name, found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CDK,len=*),intent(in) :: path + character(kind=CDK,len=*),intent(in) :: name + logical(LK),intent(out),optional :: found + + call json%rename(me,to_unicode(path),to_unicode(name),found) + + end subroutine wrap_json_rename_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_rename_by_path]], where "name" is kind=CDK + + subroutine json_rename_by_path_name_ascii(json, me, path, name, found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=*),intent(in) :: path + character(kind=CDK,len=*),intent(in) :: name + logical(LK),intent(out),optional :: found + + call json%rename(me,path,to_unicode(name),found) + + end subroutine json_rename_by_path_name_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_rename_by_path]], where "path" is kind=CDK + + subroutine json_rename_by_path_path_ascii(json, me, path, name, found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CDK,len=*),intent(in) :: path + character(kind=CK,len=*),intent(in) :: name + logical(LK),intent(out),optional :: found + + call json%rename(me,to_unicode(path),name,found) + + end subroutine json_rename_by_path_path_ascii +!***************************************************************************************** + +!***************************************************************************************** +!> +! Returns the [[json_value]] pointer given the path string. +! +!### Example +! +!````fortran +! type(json_core) :: json +! type(json_value),pointer :: dat,p +! logical :: found +! !... +! call json%initialize(path_mode=1) ! this is the default so not strictly necessary. +! call json%get(dat,'data(2).version',p,found) +!```` +! +!### Notes +! The syntax used here is a subset of the +! [http://goessner.net/articles/JsonPath/](JSONPath) "dot–notation". +! The following special characters are used to denote paths: +! +! * `$` - root +! * `@` - this +! * `.` - child object member (note this can be changed using `json%path_separator`) +! * `[]` or `()` - child array element (note that indices are 1-based) +! +! Thus, if any of these characters are present in the name key, +! this routine cannot be used to get the value. +! In that case, the `get_child` methods would need to be used. +! Or, the alternate [[json_get_by_path_rfc6901]] could be used. +! +!### See also +! * [[json_get_by_path_rfc6901]] +! * [[json_get_by_path_jsonpath_bracket]] +! +!@note The syntax is inherited from FSON, and is basically a subset +! of JSONPath "dot-notation", with the additional allowance of +! () for array elements. +! +!@note JSON `null` values are used here for unknown variables when `create_it` is True. +! So, it is possible that an existing null variable can be converted to another +! type (object or array) if a child is specified in the path. Doing it this way +! to avoid having to use another type (say `json_unknown`) that would have to be +! converted to null once all the variables have been created (user would have +! had to do this). +! +!@warning See (**) in code. I think we need to protect for memory leaks when +! changing the type of a variable that already exists. + + subroutine json_get_by_path_default(json,me,path,p,found,create_it,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me !! a JSON linked list + character(kind=CK,len=*),intent(in) :: path !! path to the variable + type(json_value),pointer,intent(out) :: p !! pointer to the variable + !! specify by `path` + logical(LK),intent(out),optional :: found !! true if it was found + logical(LK),intent(in),optional :: create_it !! if a variable is not present + !! in the path, then it is created. + !! the leaf node is returned as + !! a `null` json type and can be + !! changed by the caller. + logical(LK),intent(out),optional :: was_created !! if `create_it` is true, this + !! will be true if the variable + !! was actually created. Otherwise + !! it will be false. + + integer(IK) :: i !! counter of characters in `path` + integer(IK) :: length !! significant length of `path` + integer(IK) :: child_i !! index for getting children + character(kind=CK,len=1) :: c !! a character in the `path` + logical(LK) :: array !! flag when searching for array index in `path` + type(json_value),pointer :: tmp !! temp variables for getting child objects + logical(LK) :: child_found !! if the child value was found + logical(LK) :: create !! if the object is to be created + logical(LK) :: created !! if `create` is true, then this will be + !! true if the leaf object had to be created + integer(IK) :: j !! counter of children when creating object + logical(LK) :: status_ok !! integer to string conversion flag + + nullify(p) + + if (.not. json%exception_thrown) then + + if (present(create_it)) then + create = create_it + else + create = .false. + end if + + ! default to assuming relative to me + p => me + + child_i = 1 + array = .false. + created = .false. + + !keep trailing space or not: + if (json%trailing_spaces_significant) then + length = len(path) + else + length = len_trim(path) + end if + + do i=1, length + + c = path(i:i) + + select case (c) + case (root) + + ! root + do while (associated (p%parent)) + p => p%parent + end do + child_i = i + 1 + if (create) created = .false. ! should always exist + + case (this) + + ! this + p => me + child_i = i + 1 + if (create) created = .false. ! should always exist + + case (start_array,start_array_alt) + + ! start looking for the array element index + array = .true. + + ! get child member from p + if (child_i < i) then + nullify(tmp) + if (create) then + + ! Example: + ! 'aaa.bbb(1)' + ! -> and aaa is a null, need to make it an object + ! + ! What about the case: aaa.bbb(1)(3) ? + ! Is that already handled? + + if (p%var_type==json_null) then ! (**) + ! if p was also created, then we need to + ! convert it into an object here: + p%var_type = json_object + end if + + ! don't want to throw exceptions in this case + call json%get_child(p, path(child_i:i-1), tmp, child_found) + if (.not. child_found) then + ! have to create this child + ! [make it an array] + call json_value_create(tmp) + call json%to_array(tmp,path(child_i:i-1)) + call json%add(p,tmp) + created = .true. + else + created = .false. + end if + else + ! call the normal way + call json%get_child(p, path(child_i:i-1), tmp) + end if + p => tmp + else + child_i = i + 1 ! say, '@(' + cycle + end if + if (.not. associated(p)) then + call json%throw_exception('Error in json_get_by_path_default:'//& + ' Error getting array element',found) + exit + end if + child_i = i + 1 + + case (end_array,end_array_alt) + + if (.not. array) then + call json%throw_exception('Error in json_get_by_path_default:'//& + ' Unexpected '//c,found) + exit + end if + array = .false. + call string_to_integer(path(child_i:i-1),child_i,status_ok) + if (.not. status_ok) then + call json%throw_exception('Error in json_get_by_path_default:'//& + ' Could not convert array index to integer: '//& + trim(path(child_i:i-1)),found) + exit + end if + + nullify(tmp) + if (create) then + ! don't want to throw exceptions in this case + call json%get_child(p, child_i, tmp, child_found) + if (.not. child_found) then + + if (p%var_type==json_null) then ! (**) + ! if p was also created, then we need to + ! convert it into an array here: + p%var_type = json_array + end if + + ! have to create this element + ! [make it a null] + ! (and any missing ones before it) + do j = 1, child_i + nullify(tmp) + call json%get_child(p, j, tmp, child_found) + if (.not. child_found) then + call json_value_create(tmp) + call json%to_null(tmp) ! array element doesn't need a name + call json%add(p,tmp) + if (j==child_i) created = .true. + else + if (j==child_i) created = .false. + end if + end do + + else + created = .false. + end if + + else + ! call the normal way: + call json%get_child(p, child_i, tmp) + end if + + p => tmp + + child_i = i + 1 + + case default + + if (c==json%path_separator) then + + ! get child member from p + if (child_i < i) then + nullify(tmp) + if (create) then + if (p%var_type==json_null) then ! (**) + ! if p was also created, then we need to + ! convert it into an object here: + p%var_type = json_object + end if + + ! don't want to throw exceptions in this case + call json%get_child(p, path(child_i:i-1), tmp, child_found) + if (.not. child_found) then + ! have to create this child + ! [make it an object] + call json_value_create(tmp) + call json%to_object(tmp,path(child_i:i-1)) + call json%add(p,tmp) + created = .true. + else + created = .false. + end if + else + ! call the normal way + call json%get_child(p, path(child_i:i-1), tmp) + end if + p => tmp + else + child_i = i + 1 ! say '$.', '@.', or ').' + cycle + end if + + if (.not. associated(p)) then + call json%throw_exception('Error in json_get_by_path_default:'//& + ' Error getting child member.',found) + exit + end if + + child_i = i + 1 + + end if + + end select + + end do + + if (json%exception_thrown) then + + if (present(found)) then + nullify(p) ! just in case + found = .false. + call json%clear_exceptions() + end if + + else + + ! grab the last child if present in the path + if (child_i <= length) then + nullify(tmp) + if (create) then + if (p%var_type==json_null) then ! (**) + ! if p was also created, then we need to + ! convert it into an object here: + p%var_type = json_object + end if + + call json%get_child(p, path(child_i:i-1), tmp, child_found) + if (.not. child_found) then + ! have to create this child + ! (make it a null since it is the leaf) + call json_value_create(tmp) + call json%to_null(tmp,path(child_i:i-1)) + call json%add(p,tmp) + created = .true. + else + created = .false. + end if + else + ! call the normal way + call json%get_child(p, path(child_i:i-1), tmp) + end if + p => tmp + else + ! we already have p + if (create .and. created) then + ! make leaf p a null, but only + ! if it wasn't there + call json%to_null(p) + end if + end if + + ! error checking + if (associated(p)) then + if (present(found)) found = .true. !everything seems to be ok + else + call json%throw_exception('Error in json_get_by_path_default:'//& + ' variable not found: '//trim(path),found) + if (present(found)) then + found = .false. + call json%clear_exceptions() + end if + end if + + end if + + ! if it had to be created: + if (present(was_created)) was_created = created + + else + if (present(found)) found = .false. + if (present(was_created)) was_created = .false. + end if + + end subroutine json_get_by_path_default +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 2/4/2017 +! +! Returns the [[json_value]] pointer given the path string, +! using the "JSON Pointer" path specification defined by RFC 6901. +! +! Note that trailing whitespace significance and case sensitivity +! are user-specified. To fully conform to the RFC 6901 standard, +! should probably set (via `initialize`): +! +! * `case_sensitive_keys = .true.` [this is the default setting] +! * `trailing_spaces_significant = .true.` [this is *not* the default setting] +! * `allow_duplicate_keys = .false.` [this is *not* the default setting] +! +!### Example +! +!````fortran +! type(json_core) :: json +! type(json_value),pointer :: dat,p +! logical :: found +! !... +! call json%initialize(path_mode=2) +! call json%get(dat,'/data/2/version',p,found) +!```` +! +!### See also +! * [[json_get_by_path_default]] +! * [[json_get_by_path_jsonpath_bracket]] +! +!### Reference +! * [JavaScript Object Notation (JSON) Pointer](https://tools.ietf.org/html/rfc6901) +! +!@note Not doing anything special about the `-` character to index an array. +! This is considered a normal error. +! +!@note Unlike in the default path mode, the array indices here are 0-based +! (in accordance with the RFC 6901 standard) +! +!@warning Not checking if the member that is referenced is unique. +! (according to the standard, evaluation of non-unique references +! should fail). Like [[json_get_by_path_default]], this one will just return +! the first instance it encounters. This might be changed in the future. +! +!@warning I think the standard indicates that the input paths should use +! escaped JSON strings (currently we are assuming they are not escaped). + + subroutine json_get_by_path_rfc6901(json, me, path, p, found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me !! a JSON linked list + character(kind=CK,len=*),intent(in) :: path !! path to the variable + !! (an RFC 6901 "JSON Pointer") + type(json_value),pointer,intent(out) :: p !! pointer to the variable + !! specify by `path` + logical(LK),intent(out),optional :: found !! true if it was found + + character(kind=CK,len=:),allocatable :: token !! a token in the path (between the `/` characters) + integer(IK) :: i !! counter + integer(IK) :: islash_curr !! location of current '/' character in the path + integer(IK) :: islash_next !! location of next '/' character in the path + integer(IK) :: ilen !! length of `path` string + type(json_value),pointer :: tmp !! temporary variable for traversing the structure + integer(IK) :: ival !! integer array index value (0-based) + logical(LK) :: status_ok !! error flag + logical(LK) :: child_found !! for getting child values + + nullify(p) + + if (.not. json%exception_thrown) then + + p => me ! initialize + + if (path/=CK_'') then + + if (path(1:1)==slash) then ! the first character must be a slash + + islash_curr = 1 ! initialize current slash index + + !keep trailing space or not: + if (json%trailing_spaces_significant) then + ilen = len(path) + else + ilen = len_trim(path) + end if + + do + + ! get the next token by finding the slashes + ! + ! 1 2 3 + ! /abc/d/efg + + if (islash_curr==ilen) then + !the last token is an empty string + token = CK_'' + islash_next = 0 ! will signal to stop + else + + ! . + ! '/123/567/' + + ! index in remaining string: + islash_next = index(path(islash_curr+1:ilen),slash) + if (islash_next<=0) then + !last token: + token = path(islash_curr+1:ilen) + else + ! convert to actual index in path: + islash_next = islash_curr + index(path(islash_curr+1:ilen),slash) + if (islash_next>islash_curr+1) then + token = path(islash_curr+1:islash_next-1) + else + !empty token: + token = CK_'' + end if + end if + + end if + + ! remove trailing spaces in the token here if necessary: + if (.not. json%trailing_spaces_significant) & + token = trim(token) + + ! decode the token: + token = decode_rfc6901(token) + + ! now, parse the token: + + ! first see if there is a child with this name + call json%get_child(p,token,tmp,child_found) + if (child_found) then + ! it was found + p => tmp + else + ! No key with this name. + ! Is it an integer? If so, + ! it might be an array index. + status_ok = (len(token)>0) + if (status_ok) then + do i=1,len(token) + ! It must only contain (0..9) characters + ! (it must be unsigned) + if (scan(token(i:i),CK_'0123456789')<1) then + status_ok = .false. + exit + end if + end do + if (status_ok) then + if (len(token)>1 .and. token(1:1)==CK_'0') then + ! leading zeros not allowed for some reason + status_ok = .false. + end if + end if + if (status_ok) then + ! if we make it this far, it should be + ! convertible to an integer, so do it. + call string_to_integer(token,ival,status_ok) + end if + end if + if (status_ok) then + ! ival is an array index (0-based) + call json%get_child(p,ival+1_IK,tmp,child_found) + if (child_found) then + p => tmp + else + ! not found + status_ok = .false. + end if + end if + if (.not. status_ok) then + call json%throw_exception('Error in json_get_by_path_rfc6901: '//& + 'invalid path specification: '//trim(path),found) + exit + end if + end if + + if (islash_next<=0) exit ! finished + + ! set up for next token: + islash_curr = islash_next + + end do + + else + call json%throw_exception('Error in json_get_by_path_rfc6901: '//& + 'invalid path specification: '//trim(path),found) + end if + end if + + if (json%exception_thrown) then + nullify(p) + if (present(found)) then + found = .false. + call json%clear_exceptions() + end if + else + if (present(found)) found = .true. + end if + + else + if (present(found)) found = .false. + end if + + end subroutine json_get_by_path_rfc6901 +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 9/2/2017 +! +! Returns the [[json_value]] pointer given the path string, +! using the "JSON Pointer" path specification defined by the +! JSONPath "bracket-notation". +! +! The first character `$` is optional, and signifies the root +! of the structure. If it is not present, then the first key +! is taken to be in the `me` object. +! +! Single or real quotes may be used. +! +!### Example +! +!````fortran +! type(json_core) :: json +! type(json_value),pointer :: dat,p +! logical :: found +! !... +! call json%initialize(path_mode=3) +! call json%get(dat,"$['store']['book'][1]['title']",p,found) +!```` +! +!### See also +! * [[json_get_by_path_default]] +! * [[json_get_by_path_rfc6901]] +! +!### Reference +! * [JSONPath](http://goessner.net/articles/JsonPath/) +! +!@note Uses 1-based array indices (same as [[json_get_by_path_default]], +! but unlike [[json_get_by_path_rfc6901]] which uses 0-based indices). +! +!@note When `create_it=True`, if the variable already exists and is a type +! that is not compatible with the usage in the `path`, then it is +! destroyed and replaced with what is specified in the `path`. Note that +! this applies the all variables in the path as it is created. Currently, +! this behavior is different from [[json_get_by_path_default]]. +! +!@note JSON `null` values are used here for unknown variables +! when `create_it` is True. +! +!@warning Note that if using single quotes, this routine cannot parse +! a key containing `']`. If using real quotes, this routine +! cannot parse a key containing `"]`. If the key contains both +! `']` and `"]`, there is no way to parse it using this routine. + + subroutine json_get_by_path_jsonpath_bracket(json,me,path,p,found,create_it,was_created) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me !! a JSON linked list + character(kind=CK,len=*),intent(in) :: path !! path to the variable + !! (using JSONPath + !! "bracket-notation") + type(json_value),pointer,intent(out) :: p !! pointer to the variable + !! specify by `path` + logical(LK),intent(out),optional :: found !! true if it was found + logical(LK),intent(in),optional :: create_it !! if a variable is not present + !! in the path, then it is created. + !! the leaf node is returned as + !! a `null` json type and can be + !! changed by the caller. + logical(LK),intent(out),optional :: was_created !! if `create_it` is true, this + !! will be true if the variable + !! was actually created. Otherwise + !! it will be false. + + character(kind=CK,len=:),allocatable :: token !! a token in the path + !! (between the `['']` or + !! `[]` characters) + integer(IK) :: istart !! location of current '[' + !! character in the path + integer(IK) :: iend !! location of current ']' + !! character in the path + integer(IK) :: ival !! integer array index value + logical(LK) :: status_ok !! error flag + type(json_value),pointer :: tmp !! temporary variable for + !! traversing the structure + integer(IK) :: i !! counter + integer(IK) :: ilen !! length of `path` string + logical(LK) :: real_quotes !! if the keys are enclosed in `"`, + !! rather than `'` tokens. + logical(LK) :: create !! if the object is to be created + logical(LK) :: created !! if `create` is true, then this will be + !! true if the leaf object had to be created + integer(IK) :: j !! counter of children when creating object + + !TODO instead of reallocating `token` all the time, just + ! allocate a big size and keep track of the length, + ! then just reallocate only if necessary. + ! [would probably be inefficient if there was a very large token, + ! and then a bunch of small ones... but for similarly-sized ones + ! it should be way more efficient since it would avoid most + ! reallocations.] + + nullify(p) + + if (.not. json%exception_thrown) then + + if (present(create_it)) then + create = create_it + else + create = .false. + end if + + p => me ! initialize + created = .false. + + if (path==CK_'') then + call json%throw_exception('Error in json_get_by_path_jsonpath_bracket: '//& + 'invalid path specification: '//trim(path),found) + else + + if (path(1:1)==root .or. path(1:1)==start_array) then ! the first character must be + ! a `$` (root) or a `[` + ! (element of `me`) + + if (path(1:1)==root) then + ! go to the root + do while (associated (p%parent)) + p => p%parent + end do + if (create) created = .false. ! should always exist + end if + + !path length (don't need trailing spaces:) + ilen = len_trim(path) + + if (ilen>1) then + + istart = 2 ! initialize first '[' location index + + do + + if (istart>ilen) exit ! finished + + ! must be the next start bracket: + if (path(istart:istart) /= start_array) then + call json%throw_exception(& + 'Error in json_get_by_path_jsonpath_bracket: '//& + 'expecting "[", found: "'//trim(path(istart:istart))//& + '" in path: '//trim(path),found) + exit + end if + + ! get the next token by checking: + ! + ! * [''] -- is the token after istart a quote? + ! if so, then search for the next `']` + ! + ! * [1] -- if not, then maybe it is a number, + ! so search for the next `]` + + ! verify length of remaining string + if (istart+2<=ilen) then + + real_quotes = path(istart+1:istart+1) == quotation_mark ! [" + + if (real_quotes .or. path(istart+1:istart+1)==single_quote) then ! [' + + ! it might be a key value: ['abc'] + + istart = istart + 1 ! move counter to ' index + if (real_quotes) then + iend = istart + index(path(istart+1:ilen),& + quotation_mark//end_array) ! "] + else + iend = istart + index(path(istart+1:ilen),& + single_quote//end_array) ! '] + end if + if (iend>istart) then + + ! istart iend + ! | | + ! ['p']['abcdefg'] + + if (iend>istart+1) then + token = path(istart+1:iend-1) + else + token = CK_'' ! blank string + end if + ! remove trailing spaces in + ! the token here if necessary: + if (.not. json%trailing_spaces_significant) & + token = trim(token) + + if (create) then + ! have a token, create it if necessary + + ! we need to convert it into an object here + ! (e.g., if p was also just created) + ! and destroy its data to prevent a memory leak + call json%convert(p,json_object) + + ! don't want to throw exceptions in this case + call json%get_child(p,token,tmp,status_ok) + if (.not. status_ok) then + ! have to create this child + ! [make it a null since we don't + ! know what it is yet] + call json_value_create(tmp) + call json%to_null(tmp,token) + call json%add(p,tmp) + status_ok = .true. + created = .true. + else + ! it was already there. + created = .false. + end if + else + ! have a token, see if it is valid: + call json%get_child(p,token,tmp,status_ok) + end if + + if (status_ok) then + ! it was found + p => tmp + else + call json%throw_exception(& + 'Error in json_get_by_path_jsonpath_bracket: '//& + 'invalid token found: "'//token//& + '" in path: '//trim(path),found) + exit + end if + iend = iend + 1 ! move counter to ] index + else + call json%throw_exception(& + 'Error in json_get_by_path_jsonpath_bracket: '//& + 'invalid path: '//trim(path),found) + exit + end if + + else + + ! it might be an integer value: [123] + + iend = istart + index(path(istart+1:ilen),end_array) ! ] + if (iend>istart+1) then + + ! this should be an integer: + token = path(istart+1:iend-1) + + ! verify that there are no spaces or other + ! characters in the string: + status_ok = .true. + do i=1,len(token) + ! It must only contain (0..9) characters + ! (it must be unsigned) + if (scan(token(i:i),CK_'0123456789')<1) then + status_ok = .false. + exit + end if + end do + if (status_ok) then + call string_to_integer(token,ival,status_ok) + if (status_ok) status_ok = ival>0 ! assuming 1-based array indices + end if + + if (status_ok) then + + ! have a valid integer to use as an index + ! see if this element is really there: + call json%get_child(p,ival,tmp,status_ok) + + if (create .and. .not. status_ok) then + + ! have to create it: + + if (.not.(p%var_type==json_object .or. p%var_type==json_array)) then + ! we need to convert it into an array here + ! (e.g., if p was also just created) + ! and destroy its data to prevent a memory leak + call json%convert(p,json_array) + end if + + ! have to create this element + ! [make it a null] + ! (and any missing ones before it) + do j = 1, ival + nullify(tmp) + call json%get_child(p, j, tmp, status_ok) + if (.not. status_ok) then + call json_value_create(tmp) + call json%to_null(tmp) ! array element doesn't need a name + call json%add(p,tmp) + if (j==ival) created = .true. + else + if (j==ival) created = .false. + end if + end do + status_ok = .true. + + else + created = .false. + end if + + if (status_ok) then + ! found it + p => tmp + else + ! not found + call json%throw_exception(& + 'Error in json_get_by_path_jsonpath_bracket: '//& + 'invalid array index found: "'//token//& + '" in path: '//trim(path),found) + exit + end if + else + call json%throw_exception(& + 'Error in json_get_by_path_jsonpath_bracket: '//& + 'invalid token: "'//token//& + '" in path: '//trim(path),found) + exit + end if + + else + call json%throw_exception(& + 'Error in json_get_by_path_jsonpath_bracket: '//& + 'invalid path: '//trim(path),found) + exit + end if + + end if + + else + call json%throw_exception(& + 'Error in json_get_by_path_jsonpath_bracket: '//& + 'invalid path: '//trim(path),found) + exit + end if + + ! set up for next token: + istart = iend + 1 + + end do + + end if + + else + call json%throw_exception(& + 'Error in json_get_by_path_jsonpath_bracket: '//& + 'expecting "'//root//'", found: "'//path(1:1)//& + '" in path: '//trim(path),found) + end if + + end if + + if (json%exception_thrown) then + nullify(p) + if (present(found)) then + found = .false. + call json%clear_exceptions() + end if + else + if (present(found)) found = .true. + end if + + ! if it had to be created: + if (present(was_created)) was_created = created + + else + if (present(found)) found = .false. + if (present(was_created)) was_created = .false. + end if + + end subroutine json_get_by_path_jsonpath_bracket +!***************************************************************************************** + +!***************************************************************************************** +!> +! Convert an existing JSON variable `p` to a different variable type. +! The existing variable (and its children) is destroyed. It is replaced +! in the structure by a new variable of type `var_type` +! (which can be a `json_null`, `json_object` or `json_array`). +! +!@note This is an internal routine used when creating variables by path. + + subroutine convert(json,p,var_type) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p !! the variable to convert + integer(IK),intent(in) :: var_type !! the variable type to convert `p` to + + type(json_value),pointer :: tmp !! temporary variable + character(kind=CK,len=:),allocatable :: name !! the name of a JSON variable + + logical :: convert_it !! if `p` needs to be converted + + convert_it = p%var_type /= var_type + + if (convert_it) then + + call json%info(p,name=name) ! get existing name + + select case (var_type) + case(json_object) + call json%create_object(tmp,name) + case(json_array) + call json%create_array(tmp,name) + case(json_null) + call json%create_null(tmp,name) + case default + call json%throw_exception('Error in convert: invalid var_type value.') + return + end select + + call json%replace(p,tmp,destroy=.true.) + p => tmp + nullify(tmp) + + end if + + end subroutine convert +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_by_path]] where "path" is kind=CDK. + + subroutine wrap_json_get_by_path(json, me, path, p, found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CDK,len=*),intent(in) :: path + type(json_value),pointer,intent(out) :: p + logical(LK),intent(out),optional :: found + + call json%get(me, to_unicode(path), p, found) + + end subroutine wrap_json_get_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Returns the path to a JSON object that is part +! of a linked list structure. +! +! The path returned would be suitable for input to +! [[json_get_by_path]] and related routines. +! +!@note If an error occurs (which in this case means a malformed +! JSON structure) then an exception will be thrown, unless +! `found` is present, which will be set to `false`. `path` +! will be a blank string. +! +!@note If `json%path_mode/=1`, then the `use_alt_array_tokens` +! and `path_sep` inputs are ignored if present. +! +!@note [http://goessner.net/articles/JsonPath/](JSONPath) (`path_mode=3`) +! does not specify whether or not the keys should be escaped (this routine +! assumes not, as does http://jsonpath.com). +! Also, we are using Fortran-style 1-based array indices, +! not 0-based, to agree with the assumption in `path_mode=1` + + subroutine json_get_path(json, p, path, found, use_alt_array_tokens, path_sep) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p !! a JSON linked list object + character(kind=CK,len=:),allocatable,intent(out) :: path !! path to the variable + logical(LK),intent(out),optional :: found !! true if there were no problems + logical(LK),intent(in),optional :: use_alt_array_tokens !! if true, then '()' are used for array elements + !! otherwise, '[]' are used [default] + !! (only used if `path_mode=1`) + character(kind=CK,len=1),intent(in),optional :: path_sep !! character to use for path separator + !! (otherwise use `json%path_separator`) + !! (only used if `path_mode=1`) + + character(kind=CK,len=:),allocatable :: name !! variable name + character(kind=CK,len=:),allocatable :: parent_name !! variable's parent name + character(kind=CK,len=max_integer_str_len) :: istr !! for integer to string conversion + !! (array indices) + type(json_value),pointer :: tmp !! for traversing the structure + type(json_value),pointer :: element !! for traversing the structure + integer(IK) :: var_type !! JSON variable type flag + integer(IK) :: i !! counter + integer(IK) :: n_children !! number of children for parent + logical(LK) :: use_brackets !! to use '[]' characters for arrays + logical(LK) :: parent_is_root !! if the parent is the root + character(kind=CK,len=1) :: array_start !! for `path_mode=1`, the character to start arrays + character(kind=CK,len=1) :: array_end !! for `path_mode=1`, the character to end arrays + logical :: consecutive_arrays !! check for array of array case + integer(IK) :: parents_parent_var_type !! `var_type` for parent's parent + + !optional input: + if (present(use_alt_array_tokens)) then + use_brackets = .not. use_alt_array_tokens + else + use_brackets = .true. + end if + + if (json%path_mode==1_IK) then + if (use_brackets) then + array_start = start_array + array_end = end_array + else + array_start = start_array_alt + array_end = end_array_alt + end if + end if + + ! initialize: + consecutive_arrays = .false. + + if (associated(p)) then + + !traverse the structure via parents up to the root + tmp => p + do + + if (.not. associated(tmp)) exit !finished + + !get info about the current variable: + call json%info(tmp,name=name) + if (json%path_mode==2_IK) then + name = encode_rfc6901(name) + end if + + ! if tmp a child of an object, or an element of an array + if (associated(tmp%parent)) then + + !get info about the parent: + call json%info(tmp%parent,var_type=var_type,& + n_children=n_children,name=parent_name) + if (json%path_mode==2_IK) then + parent_name = encode_rfc6901(parent_name) + end if + if (associated(tmp%parent%parent)) then + call json%info(tmp%parent%parent,var_type=parents_parent_var_type) + consecutive_arrays = parents_parent_var_type == json_array .and. & + var_type == json_array + else + consecutive_arrays = .false. + end if + + select case (var_type) + case (json_array) + + !get array index of this element: + element => tmp%parent%children + do i = 1, n_children + if (.not. associated(element)) then + call json%throw_exception('Error in json_get_path: '//& + 'malformed JSON structure. ',found) + exit + end if + if (associated(element,tmp)) then + exit + else + element => element%next + end if + if (i==n_children) then ! it wasn't found (should never happen) + call json%throw_exception('Error in json_get_path: '//& + 'malformed JSON structure. ',found) + exit + end if + end do + select case(json%path_mode) + case(3_IK) + ! JSONPath "bracket-notation" + ! example: `$['key'][1]` + ! [note: this uses 1-based indices] + call integer_to_string(i,int_fmt,istr) + if (consecutive_arrays) then + call add_to_path(start_array//trim(adjustl(istr))//end_array,CK_'') + else + call add_to_path(start_array//single_quote//parent_name//& + single_quote//end_array//& + start_array//trim(adjustl(istr))//end_array,CK_'') + end if + case(2_IK) + ! rfc6901 + ! Example: '/key/0' + call integer_to_string(i-1_IK,int_fmt,istr) ! 0-based index + if (consecutive_arrays) then + call add_to_path(trim(adjustl(istr))) + else + call add_to_path(parent_name//slash//trim(adjustl(istr))) + end if + case(1_IK) + ! default + ! Example: `key[1]` + call integer_to_string(i,int_fmt,istr) + if (consecutive_arrays) then + call add_to_path(array_start//trim(adjustl(istr))//array_end,path_sep) + else + call add_to_path(parent_name//array_start//& + trim(adjustl(istr))//array_end,path_sep) + end if + end select + + if (.not. consecutive_arrays) tmp => tmp%parent ! already added parent name + + case (json_object) + + if (.not. consecutive_arrays) then + ! idea is not to print the array name if + ! it was already printed with the array + + !process parent on the next pass + select case(json%path_mode) + case(3_IK) + call add_to_path(start_array//single_quote//name//& + single_quote//end_array,CK_'') + case default + call add_to_path(name,path_sep) + end select + + end if + + case default + + call json%throw_exception('Error in json_get_path: '//& + 'malformed JSON structure. '//& + 'A variable that is not an object '//& + 'or array should not have a child.',found) + exit + + end select + + else + !the last one: + select case(json%path_mode) + case(3_IK) + call add_to_path(start_array//single_quote//name//& + single_quote//end_array,CK_'') + case default + call add_to_path(name,path_sep) + end select + end if + + if (associated(tmp%parent)) then + !check if the parent is the root: + parent_is_root = (.not. associated(tmp%parent%parent)) + if (parent_is_root) exit + end if + + !go to parent: + tmp => tmp%parent + + end do + + else + call json%throw_exception('Error in json_get_path: '//& + 'input pointer is not associated',found) + end if + + !for errors, return blank string: + if (json%exception_thrown .or. .not. allocated(path)) then + path = CK_'' + else + select case (json%path_mode) + case(3_IK) + ! add the outer level object identifier: + path = root//path + case(2_IK) + ! add the root slash: + path = slash//path + end select + end if + + !optional output: + if (present(found)) then + if (json%exception_thrown) then + found = .false. + call json%clear_exceptions() + else + found = .true. + end if + end if + + contains + + subroutine add_to_path(str,path_sep) + !! prepend the string to the path + implicit none + character(kind=CK,len=*),intent(in) :: str !! string to prepend to `path` + character(kind=CK,len=*),intent(in),optional :: path_sep + !! path separator (default is '.'). + !! (ignored if `json%path_mode/=1`) + + select case (json%path_mode) + case(3_IK) + ! in this case, the options are ignored + if (.not. allocated(path)) then + path = str + else + path = str//path + end if + case(2_IK) + ! in this case, the options are ignored + if (.not. allocated(path)) then + path = str + else + path = str//slash//path + end if + case(1_IK) + ! default path format + if (.not. allocated(path)) then + path = str + else + ! shouldn't add the path_sep for cases like x[1][2] + ! [if current is an array element, and the previous was + ! also an array element] so check for that here: + if (.not. ( str(len(str):len(str))==array_end .and. & + path(1:1)==array_start )) then + if (present(path_sep)) then + ! use user specified: + path = str//path_sep//path + else + ! use the default: + path = str//json%path_separator//path + end if + else + path = str//path + end if + end if + end select + + end subroutine add_to_path + + end subroutine json_get_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Wrapper for [[json_get_path]] where "path" and "path_sep" are kind=CDK. + + subroutine wrap_json_get_path(json, p, path, found, use_alt_array_tokens, path_sep) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p !! a JSON linked list object + character(kind=CDK,len=:),allocatable,intent(out) :: path !! path to the variable + logical(LK),intent(out),optional :: found !! true if there were no problems + logical(LK),intent(in),optional :: use_alt_array_tokens !! if true, then '()' are used + !! for array elements otherwise, + !! '[]' are used [default] + character(kind=CDK,len=1),intent(in),optional :: path_sep !! character to use for path + !! separator (default is '.') + + character(kind=CK,len=:),allocatable :: ck_path !! path to the variable + + ! call the main routine: + if (present(path_sep)) then + call json%get_path(p,ck_path,found,use_alt_array_tokens,to_unicode(path_sep)) + else + call json%get_path(p,ck_path,found,use_alt_array_tokens) + end if + + ! from unicode: + path = ck_path + + end subroutine wrap_json_get_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Convert a string into an integer. +! +!@note Replacement for the `parse_integer` function in the original code. + + function string_to_int(json,str) result(ival) + + implicit none + + class(json_core),intent(inout) :: json + character(kind=CK,len=*),intent(in) :: str !! a string + integer(IK) :: ival !! `str` converted to an integer + + logical(LK) :: status_ok !! error flag for [[string_to_integer]] + + ! call the core routine: + call string_to_integer(str,ival,status_ok) + + if (.not. status_ok) then + ival = 0 + call json%throw_exception('Error in string_to_int: '//& + 'string cannot be converted to an integer: '//& + trim(str)) + end if + + end function string_to_int +!***************************************************************************************** + +!***************************************************************************************** +!> +! Convert a string into a `real(RK)` value. + + function string_to_dble(json,str) result(rval) + + implicit none + + class(json_core),intent(inout) :: json + character(kind=CK,len=*),intent(in) :: str !! a string + real(RK) :: rval !! `str` converted to a `real(RK)` + + logical(LK) :: status_ok !! error flag for [[string_to_real]] + + call string_to_real(str,json%use_quiet_nan,rval,status_ok) + + if (.not. status_ok) then !if there was an error + rval = 0.0_RK + call json%throw_exception('Error in string_to_dble: '//& + 'string cannot be converted to a real: '//& + trim(str)) + end if + + end function string_to_dble +!***************************************************************************************** + +!***************************************************************************************** +!> +! Get an integer value from a [[json_value]]. + + subroutine json_get_integer(json, me, value) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + integer(IK),intent(out) :: value !! the integer value + + logical(LK) :: status_ok !! for [[string_to_integer]] + + value = 0_IK + if ( json%exception_thrown ) return + + if (me%var_type == json_integer) then + value = me%int_value + else + if (json%strict_type_checking) then + if (allocated(me%name)) then + call json%throw_exception('Error in json_get_integer:'//& + ' Unable to resolve value to integer: '//me%name) + else + call json%throw_exception('Error in json_get_integer:'//& + ' Unable to resolve value to integer') + end if + else + !type conversions + select case(me%var_type) + case (json_real) + value = int(me%dbl_value, IK) + case (json_logical) + if (me%log_value) then + value = 1_IK + else + value = 0_IK + end if + case (json_string) + call string_to_integer(me%str_value,value,status_ok) + if (.not. status_ok) then + value = 0_IK + if (allocated(me%name)) then + call json%throw_exception('Error in json_get_integer:'//& + ' Unable to convert string value to integer: '//& + me%name//' = '//trim(me%str_value)) + else + call json%throw_exception('Error in json_get_integer:'//& + ' Unable to convert string value to integer: '//& + trim(me%str_value)) + end if + end if + case default + if (allocated(me%name)) then + call json%throw_exception('Error in json_get_integer:'//& + ' Unable to resolve value to integer: '//me%name) + else + call json%throw_exception('Error in json_get_integer:'//& + ' Unable to resolve value to integer') + end if + end select + end if + end if + + end subroutine json_get_integer +!***************************************************************************************** + +!***************************************************************************************** +!> +! Get an integer value from a [[json_value]], given the path string. + + subroutine json_get_integer_by_path(json, me, path, value, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=*),intent(in) :: path + integer(IK),intent(out) :: value + logical(LK),intent(out),optional :: found + integer(IK),intent(in),optional :: default !! default value if not found + + integer(IK),parameter :: default_if_not_specified = 0_IK + character(kind=CK,len=*),parameter :: routine = CK_'json_get_integer_by_path' + +#include "json_get_scalar_by_path.inc" + + end subroutine json_get_integer_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_integer_by_path]], where "path" is kind=CDK. + + subroutine wrap_json_get_integer_by_path(json, me, path, value, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CDK,len=*),intent(in) :: path + integer(IK),intent(out) :: value + logical(LK),intent(out),optional :: found + integer(IK),intent(in),optional :: default !! default value if not found + + call json%get(me, to_unicode(path), value, found, default) + + end subroutine wrap_json_get_integer_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 5/14/2014 +! +! Get an integer vector from a [[json_value]]. + + subroutine json_get_integer_vec(json, me, vec) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me + integer(IK),dimension(:),allocatable,intent(out) :: vec + + logical(LK) :: initialized + + if ( json%exception_thrown ) return + + ! check for 0-length arrays first: + select case (me%var_type) + case (json_array) + if (json%count(me)==0) then + allocate(vec(0)) + return + end if + end select + + initialized = .false. + + !the callback function is called for each element of the array: + call json%get(me, array_callback=get_int_from_array) + + if (json%exception_thrown .and. allocated(vec)) deallocate(vec) + + contains + + subroutine get_int_from_array(json, element, i, count) + + !! callback function for integer + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: element + integer(IK),intent(in) :: i !! index + integer(IK),intent(in) :: count !! size of array + + !size the output array: + if (.not. initialized) then + allocate(vec(count)) + initialized = .true. + end if + + !populate the elements: + call json%get(element, value=vec(i)) + + end subroutine get_int_from_array + + end subroutine json_get_integer_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! If `found` is present, set it it false. + + subroutine flag_not_found(found) + + implicit none + + logical(LK),intent(out),optional :: found + + if (present(found)) found = .false. + + end subroutine flag_not_found +!***************************************************************************************** + +!***************************************************************************************** +!> +! Get an integer vector from a [[json_value]], given the path string. + + subroutine json_get_integer_vec_by_path(json, me, path, vec, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=*),intent(in) :: path + integer(IK),dimension(:),allocatable,intent(out) :: vec + logical(LK),intent(out),optional :: found + integer(IK),dimension(:),intent(in),optional :: default !! default value if not found + + character(kind=CK,len=*),parameter :: routine = CK_'json_get_integer_vec_by_path' + +#include "json_get_vec_by_path.inc" + + end subroutine json_get_integer_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_integer_vec_by_path]], where "path" is kind=CDK + + subroutine wrap_json_get_integer_vec_by_path(json, me, path, vec, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me + character(kind=CDK,len=*),intent(in) :: path + integer(IK),dimension(:),allocatable,intent(out) :: vec + logical(LK),intent(out),optional :: found + integer(IK),dimension(:),intent(in),optional :: default !! default value if not found + + call json%get(me,path=to_unicode(path),vec=vec,found=found,default=default) + + end subroutine wrap_json_get_integer_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Get a real value from a [[json_value]]. + + subroutine json_get_real(json, me, value) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me + real(RK),intent(out) :: value + + logical(LK) :: status_ok !! for [[string_to_real]] + + value = 0.0_RK + if ( json%exception_thrown ) return + + if (me%var_type == json_real) then + value = me%dbl_value + else + if (json%strict_type_checking) then + if (allocated(me%name)) then + call json%throw_exception('Error in json_get_real:'//& + ' Unable to resolve value to real: '//me%name) + else + call json%throw_exception('Error in json_get_real:'//& + ' Unable to resolve value to real') + end if + else + !type conversions + select case (me%var_type) + case (json_integer) + value = real(me%int_value, RK) + case (json_logical) + if (me%log_value) then + value = 1.0_RK + else + value = 0.0_RK + end if + case (json_string) + call string_to_real(me%str_value,json%use_quiet_nan,value,status_ok) + if (.not. status_ok) then + value = 0.0_RK + if (allocated(me%name)) then + call json%throw_exception('Error in json_get_real:'//& + ' Unable to convert string value to real: '//& + me%name//' = '//trim(me%str_value)) + else + call json%throw_exception('Error in json_get_real:'//& + ' Unable to convert string value to real: '//& + trim(me%str_value)) + end if + end if + case (json_null) + if (ieee_support_nan(value) .and. json%null_to_real_mode/=1_IK) then + select case (json%null_to_real_mode) + case(2_IK) + if (json%use_quiet_nan) then + value = ieee_value(value,ieee_quiet_nan) + else + value = ieee_value(value,ieee_signaling_nan) + end if + case(3_IK) + value = 0.0_RK + end select + else + if (allocated(me%name)) then + call json%throw_exception('Error in json_get_real:'//& + ' Cannot convert null to NaN: '//me%name) + else + call json%throw_exception('Error in json_get_real:'//& + ' Cannot convert null to NaN') + end if + end if + case default + if (allocated(me%name)) then + call json%throw_exception('Error in json_get_real:'//& + ' Unable to resolve value to real: '//me%name) + else + call json%throw_exception('Error in json_get_real:'//& + ' Unable to resolve value to real') + end if + end select + end if + end if + + end subroutine json_get_real +!***************************************************************************************** + +!***************************************************************************************** +!> +! Get a real value from a [[json_value]], given the path. + + subroutine json_get_real_by_path(json, me, path, value, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me + character(kind=CK,len=*),intent(in) :: path + real(RK),intent(out) :: value + logical(LK),intent(out),optional :: found + real(RK),intent(in),optional :: default !! default value if not found + + real(RK),parameter :: default_if_not_specified = 0.0_RK + character(kind=CK,len=*),parameter :: routine = CK_'json_get_real_by_path' + +#include "json_get_scalar_by_path.inc" + + end subroutine json_get_real_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_real_by_path]], where "path" is kind=CDK + + subroutine wrap_json_get_real_by_path(json, me, path, value, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me + character(kind=CDK,len=*),intent(in) :: path + real(RK),intent(out) :: value + logical(LK),intent(out),optional :: found + real(RK),intent(in),optional :: default !! default value if not found + + call json%get(me,to_unicode(path),value,found,default) + + end subroutine wrap_json_get_real_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 5/14/2014 +! +! Get a real vector from a [[json_value]]. + + subroutine json_get_real_vec(json, me, vec) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me + real(RK),dimension(:),allocatable,intent(out) :: vec + + logical(LK) :: initialized + + if ( json%exception_thrown ) return + + ! check for 0-length arrays first: + select case (me%var_type) + case (json_array) + if (json%count(me)==0) then + allocate(vec(0)) + return + end if + end select + + initialized = .false. + + !the callback function is called for each element of the array: + call json%get(me, array_callback=get_real_from_array) + + if (json%exception_thrown .and. allocated(vec)) deallocate(vec) + + contains + + subroutine get_real_from_array(json, element, i, count) + + !! callback function for real + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: element + integer(IK),intent(in) :: i !! index + integer(IK),intent(in) :: count !! size of array + + !size the output array: + if (.not. initialized) then + allocate(vec(count)) + initialized = .true. + end if + + !populate the elements: + call json%get(element, value=vec(i)) + + end subroutine get_real_from_array + + end subroutine json_get_real_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Get a real vector from a [[json_value]], given the path. + + subroutine json_get_real_vec_by_path(json, me, path, vec, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=*),intent(in) :: path + real(RK),dimension(:),allocatable,intent(out) :: vec + logical(LK),intent(out),optional :: found + real(RK),dimension(:),intent(in),optional :: default !! default value if not found + + character(kind=CK,len=*),parameter :: routine = CK_'json_get_real_vec_by_path' + +#include "json_get_vec_by_path.inc" + + end subroutine json_get_real_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_real_vec_by_path]], where "path" is kind=CDK + + subroutine wrap_json_get_real_vec_by_path(json, me, path, vec, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me + character(kind=CDK,len=*),intent(in) :: path + real(RK),dimension(:),allocatable,intent(out) :: vec + logical(LK),intent(out),optional :: found + real(RK),dimension(:),intent(in),optional :: default !! default value if not found + + call json%get(me, to_unicode(path), vec, found, default) + + end subroutine wrap_json_get_real_vec_by_path +!***************************************************************************************** + +#ifndef REAL32 +!***************************************************************************************** +!> +! Alternate version of [[json_get_real]] where value=real32. + + subroutine json_get_real32(json, me, value) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me + real(real32),intent(out) :: value + + real(RK) :: tmp + + call json%get(me, tmp) + value = real(tmp,real32) + + end subroutine json_get_real32 +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_real_by_path]] where value=real32. + + subroutine json_get_real32_by_path(json, me, path, value, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me + character(kind=CK,len=*),intent(in) :: path + real(real32),intent(out) :: value + logical(LK),intent(out),optional :: found + real(real32),intent(in),optional :: default !! default value if not found + + real(RK) :: tmp + real(RK) :: tmp_default + + if (present(default)) then + tmp_default = real(default,RK) + call json%get(me, path, tmp, found, tmp_default) + else + call json%get(me, path, tmp, found) + end if + + value = real(tmp,real32) + + end subroutine json_get_real32_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_real32_by_path]], where "path" is kind=CDK + + subroutine wrap_json_get_real32_by_path(json, me, path, value, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me + character(kind=CDK,len=*),intent(in) :: path + real(real32),intent(out) :: value + logical(LK),intent(out),optional :: found + real(real32),intent(in),optional :: default !! default value if not found + + call json%get(me,to_unicode(path),value,found,default) + + end subroutine wrap_json_get_real32_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_real_vec]] where `vec` is `real32`. + + subroutine json_get_real32_vec(json, me, vec) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me + real(real32),dimension(:),allocatable,intent(out) :: vec + + real(RK),dimension(:),allocatable :: tmp + + call json%get(me, tmp) + if (allocated(tmp)) vec = real(tmp,real32) + + end subroutine json_get_real32_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_real_vec_by_path]] where `vec` is `real32`. + + subroutine json_get_real32_vec_by_path(json, me, path, vec, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=*),intent(in) :: path + real(real32),dimension(:),allocatable,intent(out) :: vec + logical(LK),intent(out),optional :: found + real(real32),dimension(:),intent(in),optional :: default !! default value if not found + + real(RK),dimension(:),allocatable :: tmp + real(RK),dimension(:),allocatable :: tmp_default + + if (present(default)) then + tmp_default = real(default,RK) + call json%get(me, path, tmp, found, tmp_default) + else + call json%get(me, path, tmp, found) + end if + + if (allocated(tmp)) vec = real(tmp,real32) + + end subroutine json_get_real32_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_real32_vec_by_path]], where "path" is kind=CDK + + subroutine wrap_json_get_real32_vec_by_path(json, me, path, vec, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me + character(kind=CDK,len=*),intent(in) :: path + real(real32),dimension(:),allocatable,intent(out) :: vec + logical(LK),intent(out),optional :: found + real(real32),dimension(:),intent(in),optional :: default !! default value if not found + + call json%get(me, to_unicode(path), vec, found, default) + + end subroutine wrap_json_get_real32_vec_by_path +!***************************************************************************************** +#endif + +#ifdef REAL128 +!***************************************************************************************** +!> +! Alternate version of [[json_get_real]] where `value` is `real64`. + + subroutine json_get_real64(json, me, value) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me + real(real64),intent(out) :: value + + real(RK) :: tmp + + call json%get(me, tmp) + value = real(tmp,real64) + + end subroutine json_get_real64 +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_real_by_path]] where `value` is `real64`. + + subroutine json_get_real64_by_path(json, me, path, value, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me + character(kind=CK,len=*),intent(in) :: path + real(real64),intent(out) :: value + logical(LK),intent(out),optional :: found + real(real64),intent(in),optional :: default !! default value if not found + + real(RK) :: tmp + + call json%get(me, path, tmp, found, default) + value = real(tmp,real64) + + end subroutine json_get_real64_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_real64_by_path]], where "path" is kind=CDK + + subroutine wrap_json_get_real64_by_path(json, me, path, value, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me + character(kind=CDK,len=*),intent(in) :: path + real(real64),intent(out) :: value + logical(LK),intent(out),optional :: found + real(real64),intent(in),optional :: default !! default value if not found + + call json%get(me,to_unicode(path),value,found, default) + + end subroutine wrap_json_get_real64_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_real_vec]] where `vec` is `real64`. + + subroutine json_get_real64_vec(json, me, vec) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me + real(real64),dimension(:),allocatable,intent(out) :: vec + + real(RK),dimension(:),allocatable :: tmp + + call json%get(me, tmp) + if (allocated(tmp)) vec = real(tmp,real64) + + end subroutine json_get_real64_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_real_vec_by_path]] where `vec` is `real64`. + + subroutine json_get_real64_vec_by_path(json, me, path, vec, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=*),intent(in) :: path + real(real64),dimension(:),allocatable,intent(out) :: vec + logical(LK),intent(out),optional :: found + real(real64),dimension(:),intent(in),optional :: default !! default value if not found + + real(RK),dimension(:),allocatable :: tmp + + call json%get(me, path, tmp, found, default) + if (allocated(tmp)) vec = real(tmp,real64) + + end subroutine json_get_real64_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_real64_vec_by_path]], where "path" is kind=CDK + + subroutine wrap_json_get_real64_vec_by_path(json, me, path, vec, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: me + character(kind=CDK,len=*),intent(in) :: path + real(real64),dimension(:),allocatable,intent(out) :: vec + logical(LK),intent(out),optional :: found + real(real64),dimension(:),intent(in),optional :: default !! default value if not found + + call json%get(me, to_unicode(path), vec, found, default) + + end subroutine wrap_json_get_real64_vec_by_path +!***************************************************************************************** +#endif + +!***************************************************************************************** +!> +! Get a logical value from a [[json_value]]. +! +!### Note +! If `strict_type_checking` is False, then the following assumptions are made: +! +! * For integers: a value > 0 is True +! * For reals: a value > 0 is True +! * For strings: 'true' is True, and everything else is false. [case sensitive match] + + subroutine json_get_logical(json, me, value) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + logical(LK),intent(out) :: value + + value = .false. + if ( json%exception_thrown ) return + + if (me%var_type == json_logical) then + value = me%log_value + else + if (json%strict_type_checking) then + if (allocated(me%name)) then + call json%throw_exception('Error in json_get_logical: '//& + 'Unable to resolve value to logical: '//& + me%name) + else + call json%throw_exception('Error in json_get_logical: '//& + 'Unable to resolve value to logical') + end if + else + !type conversions + select case (me%var_type) + case (json_integer) + value = (me%int_value > 0_IK) + case (json_real) + value = (me%dbl_value > 0.0_RK) + case (json_string) + value = (me%str_value == true_str) + case default + if (allocated(me%name)) then + call json%throw_exception('Error in json_get_logical: '//& + 'Unable to resolve value to logical: '//& + me%name) + else + call json%throw_exception('Error in json_get_logical: '//& + 'Unable to resolve value to logical') + end if + end select + end if + end if + + end subroutine json_get_logical +!***************************************************************************************** + +!***************************************************************************************** +!> +! Get a logical value from a [[json_value]], given the path. + + subroutine json_get_logical_by_path(json, me, path, value, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=*),intent(in) :: path + logical(LK),intent(out) :: value + logical(LK),intent(out),optional :: found + logical(LK),intent(in),optional :: default !! default value if not found + + logical(LK),parameter :: default_if_not_specified = .false. + character(kind=CK,len=*),parameter :: routine = CK_'json_get_logical_by_path' + +#include "json_get_scalar_by_path.inc" + + end subroutine json_get_logical_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_logical_by_path]], where "path" is kind=CDK + + subroutine wrap_json_get_logical_by_path(json, me, path, value, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CDK,len=*),intent(in) :: path + logical(LK),intent(out) :: value + logical(LK),intent(out),optional :: found + logical(LK),intent(in),optional :: default !! default value if not found + + call json%get(me,to_unicode(path),value,found,default) + + end subroutine wrap_json_get_logical_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 5/14/2014 +! +! Get a logical vector from [[json_value]]. + + subroutine json_get_logical_vec(json, me, vec) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + logical(LK),dimension(:),allocatable,intent(out) :: vec + + logical(LK) :: initialized + + if ( json%exception_thrown ) return + + ! check for 0-length arrays first: + select case (me%var_type) + case (json_array) + if (json%count(me)==0) then + allocate(vec(0)) + return + end if + end select + + initialized = .false. + + !the callback function is called for each element of the array: + call json%get(me, array_callback=get_logical_from_array) + + if (json%exception_thrown .and. allocated(vec)) deallocate(vec) + + contains + + subroutine get_logical_from_array(json, element, i, count) + + !! callback function for logical + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: element + integer(IK),intent(in) :: i !! index + integer(IK),intent(in) :: count !! size of array + + !size the output array: + if (.not. initialized) then + allocate(vec(count)) + initialized = .true. + end if + + !populate the elements: + call json%get(element, value=vec(i)) + + end subroutine get_logical_from_array + + end subroutine json_get_logical_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Get a logical vector from a [[json_value]], given the path. + + subroutine json_get_logical_vec_by_path(json, me, path, vec, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=*),intent(in) :: path + logical(LK),dimension(:),allocatable,intent(out) :: vec + logical(LK),intent(out),optional :: found + logical(LK),dimension(:),intent(in),optional :: default + + character(kind=CK,len=*),parameter :: routine = CK_'json_get_logical_vec_by_path' + +#include "json_get_vec_by_path.inc" + + end subroutine json_get_logical_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_logical_vec_by_path]], where "path" is kind=CDK + + subroutine wrap_json_get_logical_vec_by_path(json, me, path, vec, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CDK,len=*),intent(in) :: path + logical(LK),dimension(:),allocatable,intent(out) :: vec + logical(LK),intent(out),optional :: found + logical(LK),dimension(:),intent(in),optional :: default + + call json%get(me,to_unicode(path),vec,found,default) + + end subroutine wrap_json_get_logical_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Get a character string from a [[json_value]]. + + subroutine json_get_string(json, me, value) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=:),allocatable,intent(out) :: value + + value = CK_'' + if (.not. json%exception_thrown) then + + if (me%var_type == json_string) then + + if (allocated(me%str_value)) then + if (json%unescaped_strings) then + ! default: it is stored already unescaped: + value = me%str_value + else + ! return the escaped version: + call escape_string(me%str_value, value, json%escape_solidus) + end if + else + call json%throw_exception('Error in json_get_string: '//& + 'me%str_value not allocated') + end if + + else + + if (json%strict_type_checking) then + if (allocated(me%name)) then + call json%throw_exception('Error in json_get_string:'//& + ' Unable to resolve value to string: '//me%name) + else + call json%throw_exception('Error in json_get_string:'//& + ' Unable to resolve value to string') + end if + else + + select case (me%var_type) + + case (json_integer) + + if (allocated(me%int_value)) then + value = repeat(space, max_integer_str_len) + call integer_to_string(me%int_value,int_fmt,value) + value = trim(value) + else + call json%throw_exception('Error in json_get_string: '//& + 'me%int_value not allocated') + end if + + case (json_real) + + if (allocated(me%dbl_value)) then + value = repeat(space, max_numeric_str_len) + call real_to_string(me%dbl_value,json%real_fmt,& + json%non_normals_to_null,& + json%compact_real,value) + value = trim(value) + else + call json%throw_exception('Error in json_get_string: '//& + 'me%int_value not allocated') + end if + + case (json_logical) + + if (allocated(me%log_value)) then + if (me%log_value) then + value = true_str + else + value = false_str + end if + else + call json%throw_exception('Error in json_get_string: '//& + 'me%log_value not allocated') + end if + + case (json_null) + + value = null_str + + case default + if (allocated(me%name)) then + call json%throw_exception('Error in json_get_string: '//& + 'Unable to resolve value to characters: '//& + me%name) + else + call json%throw_exception('Error in json_get_string: '//& + 'Unable to resolve value to characters') + end if + end select + + end if + end if + + end if + + end subroutine json_get_string +!***************************************************************************************** + +!***************************************************************************************** +!> +! Get a character string from a [[json_value]], given the path. + + subroutine json_get_string_by_path(json, me, path, value, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=*),intent(in) :: path + character(kind=CK,len=:),allocatable,intent(out) :: value + logical(LK),intent(out),optional :: found + character(kind=CK,len=*),intent(in),optional :: default + + character(kind=CK,len=*),parameter :: default_if_not_specified = CK_'' + character(kind=CK,len=*),parameter :: routine = CK_'json_get_string_by_path' + +#include "json_get_scalar_by_path.inc" + + end subroutine json_get_string_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_string_by_path]], where "path" is kind=CDK + + subroutine wrap_json_get_string_by_path(json, me, path, value, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CDK,len=*),intent(in) :: path + character(kind=CK,len=:),allocatable,intent(out) :: value + logical(LK),intent(out),optional :: found + character(kind=CK,len=*),intent(in),optional :: default + + call json%get(me,to_unicode(path),value,found,default) + + end subroutine wrap_json_get_string_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 5/14/2014 +! +! Get a string vector from a [[json_value(type)]]. + + subroutine json_get_string_vec(json, me, vec) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=*),dimension(:),allocatable,intent(out) :: vec + + logical(LK) :: initialized + + if ( json%exception_thrown ) return + + ! check for 0-length arrays first: + select case (me%var_type) + case (json_array) + if (json%count(me)==0) then + allocate(vec(0)) + return + end if + end select + + initialized = .false. + + !the callback function is called for each element of the array: + call json%get(me, array_callback=get_chars_from_array) + + if (json%exception_thrown .and. allocated(vec)) deallocate(vec) + + contains + + subroutine get_chars_from_array(json, element, i, count) + + !! callback function for chars + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: element + integer(IK),intent(in) :: i !! index + integer(IK),intent(in) :: count !! size of array + + character(kind=CK,len=:),allocatable :: cval + + !size the output array: + if (.not. initialized) then + allocate(vec(count)) + initialized = .true. + end if + + !populate the elements: + call json%get(element, value=cval) + if (allocated(cval)) then + vec(i) = cval + deallocate(cval) + else + vec(i) = CK_'' + end if + + end subroutine get_chars_from_array + + end subroutine json_get_string_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Get a string vector from a [[json_value(type)]], given the path. + + subroutine json_get_string_vec_by_path(json, me, path, vec, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=*),intent(in) :: path + character(kind=CK,len=*),dimension(:),allocatable,intent(out) :: vec + logical(LK),intent(out),optional :: found + character(kind=CK,len=*),dimension(:),intent(in),optional :: default + + character(kind=CK,len=*),parameter :: routine = CK_'json_get_string_vec_by_path' + +#include "json_get_vec_by_path.inc" + + end subroutine json_get_string_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_string_vec_by_path]], where "path" is kind=CDK + + subroutine wrap_json_get_string_vec_by_path(json, me, path, vec, found, default) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CDK,len=*),intent(in) :: path + character(kind=CK,len=*),dimension(:),allocatable,intent(out) :: vec + logical(LK),intent(out),optional :: found + character(kind=CK,len=*),dimension(:),intent(in),optional :: default + + call json%get(me,to_unicode(path),vec,found,default) + + end subroutine wrap_json_get_string_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/16/2016 +! +! Get a string vector from a [[json_value(type)]]. This is an alternate +! version of [[json_get_string_vec]]. This one returns an allocatable +! length character (where the string length is the maximum length of +! any element in the array). It also returns an integer array of the +! actual sizes of the strings in the JSON structure. +! +!@note This is somewhat inefficient since it does +! cycle through the array twice. +! +!@warning The allocation of `vec` doesn't work with +! gfortran 4.9 or 5 due to compiler bugs + + subroutine json_get_alloc_string_vec(json, me, vec, ilen) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=:),dimension(:),allocatable,intent(out) :: vec + integer(IK),dimension(:),allocatable,intent(out) :: ilen !! the actual length + !! of each character + !! string in the array + + logical(LK) :: initialized !! if the output array has been sized + integer(IK) :: max_len !! the length of the longest string in the array + + if ( json%exception_thrown ) return + + ! check for 0-length arrays first: + select case (me%var_type) + case (json_array) + if (json%count(me)==0) then + allocate(character(kind=CK,len=0) :: vec(0)) + allocate(ilen(0)) + return + end if + end select + + initialized = .false. + + call json%string_info(me,ilen=ilen,max_str_len=max_len) + if (.not. json%exception_thrown) then + ! now get each string using the callback function: + call json%get(me, array_callback=get_chars_from_array) + end if + + if (json%exception_thrown) then + if (allocated(vec)) deallocate(vec) + if (allocated(ilen)) deallocate(ilen) + end if + + contains + + subroutine get_chars_from_array(json, element, i, count) + + !! callback function for chars + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: element + integer(IK),intent(in) :: i !! index + integer(IK),intent(in) :: count !! size of array + + character(kind=CK,len=:),allocatable :: cval !! for getting string + + !size the output array: + if (.not. initialized) then + ! string length long enough to hold the longest one + ! Note that this doesn't work with gfortran 4.9 or 5. + allocate( character(kind=CK,len=max_len) :: vec(count) ) + initialized = .true. + end if + + !populate the elements: + call json%get(element, value=cval) + if (allocated(cval)) then + vec(i) = cval + ilen(i) = len(cval) ! return the actual length + deallocate(cval) + else + vec(i) = CK_'' + ilen(i) = 0 + end if + + end subroutine get_chars_from_array + + end subroutine json_get_alloc_string_vec +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_alloc_string_vec]] where input is the path. +! +! This is an alternate version of [[json_get_string_vec_by_path]]. +! This one returns an allocatable length character (where the string +! length is the maximum length of any element in the array). It also +! returns an integer array of the actual sizes of the strings in the +! JSON structure. +! +!@note An alternative to using this routine is to use [[json_get_array]] with +! a callback function that gets the string from each element and populates +! a user-defined string type. +! +!@note If the `default` argument is used, and `default_ilen` is not present, +! then `ilen` will just be returned as the length of the `default` dummy +! argument (all elements with the same length). + + subroutine json_get_alloc_string_vec_by_path(json,me,path,vec,ilen,found,default,default_ilen) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=*),intent(in) :: path + character(kind=CK,len=:),dimension(:),allocatable,intent(out) :: vec + integer(IK),dimension(:),allocatable,intent(out) :: ilen !! the actual length + !! of each character + !! string in the array + logical(LK),intent(out),optional :: found + character(kind=CK,len=*),dimension(:),intent(in),optional :: default + integer(IK),dimension(:),intent(in),optional :: default_ilen !! the actual + !! length of `default` + + character(kind=CK,len=*),parameter :: routine = CK_'json_get_alloc_string_vec_by_path' + +#include "json_get_vec_by_path_alloc.inc" + + end subroutine json_get_alloc_string_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_alloc_string_vec_by_path]], where "path" is kind=CDK + + subroutine wrap_json_get_alloc_string_vec_by_path(json,me,path,vec,ilen,found,default,default_ilen) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CDK,len=*),intent(in) :: path + character(kind=CK,len=:),dimension(:),allocatable,intent(out) :: vec + integer(IK),dimension(:),allocatable,intent(out) :: ilen !! the actual length + !! of each character + !! string in the array + logical(LK),intent(out),optional :: found + character(kind=CK,len=*),dimension(:),intent(in),optional :: default + integer(IK),dimension(:),intent(in),optional :: default_ilen !! the actual + !! length of `default` + + call json%get(me,to_unicode(path),vec,ilen,found,default,default_ilen) + + end subroutine wrap_json_get_alloc_string_vec_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! This routine calls the user-supplied [[json_array_callback_func]] +! subroutine for each element in the array. +! +!@note For integer, real, logical, and character arrays, +! higher-level routines are provided (see `get` methods), so +! this routine does not have to be used for those cases. + + recursive subroutine json_get_array(json, me, array_callback) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + procedure(json_array_callback_func) :: array_callback + + type(json_value),pointer :: element !! temp variable for getting elements + integer(IK) :: i !! counter + integer(IK) :: count !! number of elements in the array + + if ( json%exception_thrown ) return + + select case (me%var_type) + case (json_array) + count = json%count(me) + element => me%children + do i = 1, count ! callback for each child + if (.not. associated(element)) then + call json%throw_exception('Error in json_get_array: '//& + 'Malformed JSON linked list') + return + end if + call array_callback(json, element, i, count) + if (json%exception_thrown) exit + element => element%next + end do + case default + call json%throw_exception('Error in json_get_array:'//& + ' Resolved value is not an array ') + end select + + end subroutine json_get_array +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 4/28/2016 +! +! Traverse a JSON structure. +! This routine calls the user-specified [[json_traverse_callback_func]] +! for each element of the structure. + + subroutine json_traverse(json,p,traverse_callback) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p + procedure(json_traverse_callback_func) :: traverse_callback + + logical(LK) :: finished !! can be used to stop the process + + if (.not. json%exception_thrown) call traverse(p) + + contains + + recursive subroutine traverse(p) + + !! recursive [[json_value]] traversal. + + implicit none + + type(json_value),pointer,intent(in) :: p + + type(json_value),pointer :: element !! a child element + integer(IK) :: i !! counter + integer(IK) :: icount !! number of children + + if (json%exception_thrown) return + call traverse_callback(json,p,finished) ! first call for this object + if (finished) return + + !for arrays and objects, have to also call for all children: + if (p%var_type==json_array .or. p%var_type==json_object) then + + icount = json%count(p) ! number of children + if (icount>0) then + element => p%children ! first one + do i = 1, icount ! call for each child + if (.not. associated(element)) then + call json%throw_exception('Error in json_traverse: '//& + 'Malformed JSON linked list') + return + end if + call traverse(element) + if (finished .or. json%exception_thrown) exit + element => element%next + end do + end if + nullify(element) + + end if + + end subroutine traverse + + end subroutine json_traverse +!***************************************************************************************** + +!***************************************************************************************** +!> +! This routine calls the user-supplied array_callback subroutine +! for each element in the array (specified by the path). + + recursive subroutine json_get_array_by_path(json, me, path, array_callback, found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=*),intent(in) :: path + procedure(json_array_callback_func) :: array_callback + logical(LK),intent(out),optional :: found + + type(json_value),pointer :: p + + if ( json%exception_thrown ) then + if ( present(found) ) found = .false. + return + end if + + nullify(p) + + ! resolve the path to the value + call json%get(me=me, path=path, p=p) + + if (.not. associated(p)) then + call json%throw_exception('Error in json_get_array:'//& + ' Unable to resolve path: '//trim(path),found) + else + call json%get(me=p,array_callback=array_callback) + nullify(p) + end if + if ( json%exception_thrown ) then + if ( present(found) ) then + found = .false. + call json%clear_exceptions() + end if + else + if ( present(found) ) found = .true. + end if + + end subroutine json_get_array_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_array_by_path]], where "path" is kind=CDK + + recursive subroutine wrap_json_get_array_by_path(json, me, path, array_callback, found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CDK,len=*),intent(in) :: path + procedure(json_array_callback_func) :: array_callback + logical(LK),intent(out),optional :: found + + call json%get(me, to_unicode(path), array_callback, found) + + end subroutine wrap_json_get_array_by_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Internal routine to be called before parsing JSON. +! Currently, all this does it allocate the `comment_char` if none was specified. + + subroutine json_prepare_parser(json) + + implicit none + + class(json_core),intent(inout) :: json + + if (json%allow_comments .and. .not. allocated(json%comment_char)) then + ! comments are enabled, but user hasn't set the comment char, + ! so in this case use the default: + json%comment_char = CK_'/!#' + end if + + end subroutine json_prepare_parser +!***************************************************************************************** + +!***************************************************************************************** +!> +! Parse the JSON file and populate the [[json_value]] tree. +! +!### Inputs +! +! The inputs can be: +! +! * `file` & `unit` : the specified unit is used to read JSON from file. +! [note if unit is already open, then the filename is ignored] +! * `file` : JSON is read from file using internal unit number +! +!### Example +! +!````fortran +! type(json_core) :: json +! type(json_value),pointer :: p +! call json%load(file='myfile.json', p=p) +!```` +! +!### History +! * Jacob Williams : 01/13/2015 : added read from string option. +! * Izaak Beekman : 03/08/2015 : moved read from string to separate +! subroutine, and error annotation to separate subroutine. +! +!@note When calling this routine, any exceptions thrown from previous +! calls will automatically be cleared. + + subroutine json_parse_file(json, file, p, unit) + + implicit none + + class(json_core),intent(inout) :: json + character(kind=CDK,len=*),intent(in) :: file !! JSON file name + type(json_value),pointer :: p !! output structure + integer(IK),intent(in),optional :: unit !! file unit number (/= 0) + + integer(IK) :: iunit !! file unit actually used + integer(IK) :: istat !! iostat flag + logical(LK) :: is_open !! if the file is already open + logical(LK) :: has_duplicate !! if checking for duplicate keys + character(kind=CK,len=:),allocatable :: path !! path to any duplicate key + + ! clear any exceptions and initialize: + call json%initialize() + call json%prepare_parser() + + if ( present(unit) ) then + + if (unit==0) then + call json%throw_exception('Error in json_parse_file: unit number must not be 0.') + return + end if + + iunit = unit + + ! check to see if the file is already open + ! if it is, then use it, otherwise open the file with the name given. + inquire(unit=iunit, opened=is_open, iostat=istat) + if (istat==0 .and. .not. is_open) then + ! open the file + open ( unit = iunit, & + file = file, & + status = 'OLD', & + action = 'READ', & + form = form_spec, & + access = access_spec, & + iostat = istat & + FILE_ENCODING ) + else + ! if the file is already open, then we need to make sure + ! that it is open with the correct form/access/etc... + end if + + else + + ! open the file with a new unit number: + open ( newunit = iunit, & + file = file, & + status = 'OLD', & + action = 'READ', & + form = form_spec, & + access = access_spec, & + iostat = istat & + FILE_ENCODING ) + + end if + + if (istat==0) then + + if (use_unformatted_stream) then + ! save the file size to be read: + inquire(unit=iunit, size=json%filesize, iostat=istat) + end if + + ! create the value and associate the pointer + call json_value_create(p) + + ! Note: the name of the root json_value doesn't really matter, + ! but we'll allocate something here just in case. + p%name = trim(file) !use the file name + + ! parse as a value + call json%parse_value(unit=iunit, str=CK_'', value=p) + call json%parse_end(unit=iunit, str=CK_'') + + ! check for errors: + if (json%exception_thrown) then + call json%annotate_invalid_json(iunit,CK_'') + else + if (.not. json%allow_duplicate_keys) then + call json%check_for_duplicate_keys(p,has_duplicate,path=path) + if (.not. json%exception_thrown) then + if (has_duplicate) then + call json%throw_exception('Error in json_parse_file: '//& + 'Duplicate key found: '//path) + end if + end if + end if + end if + + ! close the file: + close(unit=iunit, iostat=istat) + + else + + call json%throw_exception('Error in json_parse_file: Error opening file: '//trim(file)) + nullify(p) + + end if + + end subroutine json_parse_file +!***************************************************************************************** + +!***************************************************************************************** +!> +! Parse the JSON string and populate the [[json_value]] tree. +! +!### See also +! * [[json_parse_file]] + + subroutine json_parse_string(json, p, str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p !! output structure + character(kind=CK,len=*),intent(in) :: str !! string with JSON data + + integer(IK),parameter :: iunit = 0 !! indicates that json data will be read from buffer + + logical(LK) :: has_duplicate !! if checking for duplicate keys + character(kind=CK,len=:),allocatable :: path !! path to any duplicate key + + ! clear any exceptions and initialize: + call json%initialize() + call json%prepare_parser() + + ! create the value and associate the pointer + call json_value_create(p) + + ! Note: the name of the root json_value doesn't really matter, + ! but we'll allocate something here just in case. + p%name = CK_'' + + ! parse as a value + call json%parse_value(unit=iunit, str=str, value=p) + call json%parse_end(unit=iunit, str=str) + + if (json%exception_thrown) then + call json%annotate_invalid_json(iunit,str) + else + if (.not. json%allow_duplicate_keys) then + call json%check_for_duplicate_keys(p,has_duplicate,path=path) + if (.not. json%exception_thrown) then + if (has_duplicate) then + call json%throw_exception('Error in json_parse_string: '//& + 'Duplicate key found: '//path) + end if + end if + end if + end if + + end subroutine json_parse_string +!***************************************************************************************** + +!***************************************************************************************** +!> +! An error checking routine to call after a file (or string) has been parsed. +! It will throw an exception if there are any other non-whitespace characters +! in the file. + + subroutine json_parse_end(json, unit, str) + + implicit none + + class(json_core),intent(inout) :: json + integer(IK),intent(in) :: unit !! file unit number + character(kind=CK,len=*),intent(in) :: str !! string containing JSON + !! data (only used if `unit=0`) + + logical(LK) :: eof !! end-of-file flag + character(kind=CK,len=1) :: c !! character read from file + !! (or string) by [[pop_char]] + + ! first check for exceptions: + if (json%exception_thrown) return + + ! pop the next non whitespace character off the file + call json%pop_char(unit, str=str, eof=eof, skip_ws=.true., & + skip_comments=json%allow_comments, popped=c) + + if (.not. eof) then + call json%throw_exception('Error in json_parse_end:'//& + ' Unexpected character found after parsing value. "'//& + c//'"') + end if + + end subroutine json_parse_end +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_parse_string]], where `str` is kind=CDK. + + subroutine wrap_json_parse_string(json, p, str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p !! output structure + character(kind=CDK,len=*),intent(in) :: str !! string with JSON data + + call json%deserialize(p,to_unicode(str)) + + end subroutine wrap_json_parse_string +!***************************************************************************************** + +!***************************************************************************************** +!> +! Generate a warning message if there was an error parsing a JSON +! file or string. + + subroutine annotate_invalid_json(json,iunit,str) + + implicit none + + class(json_core),intent(inout) :: json + integer(IK),intent(in) :: iunit !! file unit number + character(kind=CK,len=*),intent(in) :: str !! string with JSON data + + character(kind=CK,len=:),allocatable :: line !! line containing the error + character(kind=CK,len=:),allocatable :: arrow_str !! arrow string that points + !! to the current character + character(kind=CK,len=max_integer_str_len) :: line_str !! current line number string + character(kind=CK,len=max_integer_str_len) :: char_str !! current character count string + integer(IK) :: i !! line number counter + integer(IK) :: i_nl_prev !! index of previous newline character + integer(IK) :: i_nl !! index of current newline character + + ! If there was an error reading the file, then + ! print the line where the error occurred: + if (json%exception_thrown) then + + !the counters for the current line and the last character read: + call integer_to_string(json%line_count, int_fmt, line_str) + call integer_to_string(json%char_count, int_fmt, char_str) + + !draw the arrow string that points to the current character: + arrow_str = repeat('-',max( 0_IK, json%char_count - 1_IK) )//'^' + + if (json%line_count>0 .and. json%char_count>0) then + + if (iunit/=0) then + + if (use_unformatted_stream) then + call json%get_current_line_from_file_stream(iunit,line) + else + call json%get_current_line_from_file_sequential(iunit,line) + end if + + else + + !get the current line from the string: + ! [this is done by counting the newline characters] + i_nl_prev = 0 !index of previous newline character + i_nl = 2 !just in case line_count = 0 + do i=1,json%line_count + i_nl = index(str(i_nl_prev+1:),newline) + if (i_nl==0) then !last line - no newline character + i_nl = len(str)+1 + exit + end if + i_nl = i_nl + i_nl_prev !index of current newline character + i_nl_prev = i_nl !update for next iteration + end do + line = str(i_nl_prev+1 : i_nl-1) !extract current line + + end if + + else + !in this case, it was an empty line or file + line = CK_'' + end if + + ! add a newline for the error display if necessary: + line = trim(line) + if (len(line)>0) then + i = len(line) + if (line(i:i)/=newline) line = line//newline + else + line = line//newline + end if + + !create the error message: + if (allocated(json%err_message)) then + json%err_message = json%err_message//newline + else + json%err_message = '' + end if + json%err_message = json%err_message//& + 'line: '//trim(adjustl(line_str))//', '//& + 'character: '//trim(adjustl(char_str))//newline//& + line//arrow_str + + if (allocated(line)) deallocate(line) + + end if + + end subroutine annotate_invalid_json +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Rewind the file to the beginning of the current line, and return this line. +! The file is assumed to be opened. +! This is the SEQUENTIAL version (see also [[get_current_line_from_file_stream]]). + + subroutine get_current_line_from_file_sequential(iunit,line) + + implicit none + + integer(IK),intent(in) :: iunit !! file unit number + character(kind=CK,len=:),allocatable,intent(out) :: line !! current line + + character(kind=CK,len=seq_chunk_size) :: chunk !! for reading line in chunks + integer(IK) :: istat !! iostat flag + integer(IK) :: isize !! number of characters read in read statement + + !initialize: + line = CK_'' + + !rewind to beginning of the current record: + backspace(iunit, iostat=istat) + + !loop to read in all the characters in the current record. + ![the line is read in chunks until the end of the line is reached] + if (istat==0) then + do + isize = 0 + read(iunit,fmt='(A)',advance='NO',size=isize,iostat=istat) chunk + if (istat==0) then + line = line//chunk + else + if (isize>0 .and. isize<=seq_chunk_size) line = line//chunk(1:isize) + exit + end if + end do + end if + + end subroutine get_current_line_from_file_sequential +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Rewind the file to the beginning of the current line, and return this line. +! The file is assumed to be opened. +! This is the STREAM version (see also [[get_current_line_from_file_sequential]]). + + subroutine get_current_line_from_file_stream(json,iunit,line) + + implicit none + + class(json_core),intent(inout) :: json + integer(IK),intent(in) :: iunit !! file unit number + character(kind=CK,len=:),allocatable,intent(out) :: line !! current line + + integer(IK) :: istart !! start position of current line + integer(IK) :: iend !! end position of current line + integer(IK) :: ios !! file read `iostat` code + character(kind=CK,len=1) :: c !! a character read from the file + logical :: done !! flag to exit the loop + + istart = json%ipos + do + if (istart<=1) then + istart = 1 + exit + end if + read(iunit,pos=istart,iostat=ios) c + done = ios /= 0_IK + if (.not. done) done = c==newline + if (done) then + if (istart/=1) istart = istart - 1 + exit + end if + istart = istart-1 !rewind until the beginning of the line + end do + iend = json%ipos + do + read(iunit,pos=iend,iostat=ios) c + if (IS_IOSTAT_END(ios)) then + ! account for end of file without linebreak + iend=iend-1 + exit + end if + if (c==newline .or. ios/=0) exit + iend=iend+1 + end do + allocate( character(kind=CK,len=iend-istart+1) :: line ) + read(iunit,pos=istart,iostat=ios) line + + end subroutine get_current_line_from_file_stream +!***************************************************************************************** + +!***************************************************************************************** +!> +! Core parsing routine. + + recursive subroutine parse_value(json, unit, str, value) + + implicit none + + class(json_core),intent(inout) :: json + integer(IK),intent(in) :: unit !! file unit number + character(kind=CK,len=*),intent(in) :: str !! string containing JSON + !! data (only used if `unit=0`) + type(json_value),pointer :: value !! JSON data that is extracted + + logical(LK) :: eof !! end-of-file flag + character(kind=CK,len=1) :: c !! character read from file + !! (or string) by [[pop_char]] +#if defined __GFORTRAN__ + character(kind=CK,len=:),allocatable :: tmp !! this is a work-around for a bug + !! in the gfortran 4.9 compiler. +#endif + + if (.not. json%exception_thrown) then + + !the routine is being called incorrectly. + if (.not. associated(value)) then + call json%throw_exception('Error in parse_value: value pointer not associated.') + return + end if + + ! pop the next non whitespace character off the file + call json%pop_char(unit, str=str, eof=eof, skip_ws=.true., & + skip_comments=json%allow_comments, popped=c) + + if (eof) then + return + else + + select case (c) + + case (start_object) + + ! start object + call json%to_object(value) !allocate class + call json%parse_object(unit, str, value) + + case (start_array) + + ! start array + call json%to_array(value) !allocate class + call json%parse_array(unit, str, value) + + case (end_array) + + ! end an empty array + call json%push_char(c) + if (associated(value)) then + deallocate(value) + nullify(value) + end if + + case (quotation_mark) + + ! string + call json%to_string(value) !allocate class + + select case (value%var_type) + case (json_string) +#if defined __GFORTRAN__ + ! write to a tmp variable because of + ! a bug in 4.9 gfortran compiler. + call json%parse_string(unit,str,tmp) + value%str_value = tmp + if (allocated(tmp)) deallocate(tmp) +#else + call json%parse_string(unit,str,value%str_value) +#endif + end select + + case (CK_'t') !true_str(1:1) gfortran bug work around + + !true + call json%parse_for_chars(unit, str, true_str(2:)) + !allocate class and set value: + if (.not. json%exception_thrown) call json%to_logical(value,.true.) + + case (CK_'f') !false_str(1:1) gfortran bug work around + + !false + call json%parse_for_chars(unit, str, false_str(2:)) + !allocate class and set value: + if (.not. json%exception_thrown) call json%to_logical(value,.false.) + + case (CK_'n') !null_str(1:1) gfortran bug work around + + !null + call json%parse_for_chars(unit, str, null_str(2:)) + if (.not. json%exception_thrown) call json%to_null(value) ! allocate class + + case(CK_'-', CK_'0': CK_'9', CK_'.', CK_'+') + + call json%push_char(c) + call json%parse_number(unit, str, value) + + case default + + call json%throw_exception('Error in parse_value:'//& + ' Unexpected character while parsing value. "'//& + c//'"') + + end select + end if + + end if + + end subroutine parse_value +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Allocate a [[json_value]] pointer and make it a logical(LK) variable. +! The pointer should not already be allocated. +! +!### Example +!````fortran +! type(json_value),pointer :: p +! type(json_core) :: json +! call json%create_logical(p,'value',.true.) +!```` + + subroutine json_value_create_logical(json,p,val,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + logical(LK),intent(in) :: val !! variable value + character(kind=CK,len=*),intent(in) :: name !! variable name + + call json_value_create(p) + call json%to_logical(p,val,name) + + end subroutine json_value_create_logical +!***************************************************************************************** + +!***************************************************************************************** +!> author: Izaak Beekman +! +! Wrapper for [[json_value_create_logical]] so `create_logical` method can +! be called with name of character kind 'DEFAULT' or 'ISO_10646' + + subroutine wrap_json_value_create_logical(json,p,val,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + logical(LK),intent(in) :: val + character(kind=CDK,len=*),intent(in) :: name + + call json%create_logical(p,val,to_unicode(name)) + + end subroutine wrap_json_value_create_logical +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Allocate a [[json_value]] pointer and make it an integer(IK) variable. +! The pointer should not already be allocated. +! +!### Example +!````fortran +! type(json_value),pointer :: p +! type(json_core) :: json +! call json%create_integer(p,'value',1) +!```` + + subroutine json_value_create_integer(json,p,val,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + integer(IK),intent(in) :: val + character(kind=CK,len=*),intent(in) :: name + + call json_value_create(p) + call json%to_integer(p,val,name) + + end subroutine json_value_create_integer +!***************************************************************************************** + +!***************************************************************************************** +!> author: Izaak Beekman +! +! A wrapper procedure for [[json_value_create_integer]] so that `create_integer` +! method may be called with either a 'DEFAULT' or 'ISO_10646' character kind +! `name` actual argument. + + subroutine wrap_json_value_create_integer(json,p,val,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + integer(IK),intent(in) :: val + character(kind=CDK,len=*),intent(in) :: name + + call json%create_integer(p,val,to_unicode(name)) + + end subroutine wrap_json_value_create_integer +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Allocate a [[json_value]] pointer and make it a real(RK) variable. +! The pointer should not already be allocated. +! +!### Example +!````fortran +! type(json_value),pointer :: p +! type(json_core) :: json +! call json%create_real(p,'value',1.0_RK) +!```` + + subroutine json_value_create_real(json,p,val,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + real(RK),intent(in) :: val + character(kind=CK,len=*),intent(in) :: name + + call json_value_create(p) + call json%to_real(p,val,name) + + end subroutine json_value_create_real +!***************************************************************************************** + +!***************************************************************************************** +!> author: Izaak Beekman +! +! A wrapper for [[json_value_create_real]] so that `create_real` method +! may be called with an actual argument corresponding to the dummy argument, +! `name` that may be of 'DEFAULT' or 'ISO_10646' character kind. + + subroutine wrap_json_value_create_real(json,p,val,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + real(RK),intent(in) :: val + character(kind=CDK,len=*),intent(in) :: name + + call json%create_real(p,val,to_unicode(name)) + + end subroutine wrap_json_value_create_real +!***************************************************************************************** + +#ifndef REAL32 +!***************************************************************************************** +!> +! Alternate version of [[json_value_create_real]] where val=real32. +! +!@note The value is converted into a `real(RK)` variable internally. + + subroutine json_value_create_real32(json,p,val,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + real(real32),intent(in) :: val + character(kind=CK,len=*),intent(in) :: name + + call json%create_real(p,real(val,RK),name) + + end subroutine json_value_create_real32 +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_create_real32]] where "name" is kind(CDK). + + subroutine wrap_json_value_create_real32(json,p,val,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + real(real32),intent(in) :: val + character(kind=CDK,len=*),intent(in) :: name + + call json%create_real(p,val,to_unicode(name)) + + end subroutine wrap_json_value_create_real32 +!***************************************************************************************** +#endif + +#ifdef REAL128 +!***************************************************************************************** +!> +! Alternate version of [[json_value_create_real]] where val=real64. +! +!@note The value is converted into a `real(RK)` variable internally. + + subroutine json_value_create_real64(json,p,val,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + real(real64),intent(in) :: val + character(kind=CK,len=*),intent(in) :: name + + call json%create_real(p,real(val,RK),name) + + end subroutine json_value_create_real64 +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_value_create_real64]] where "name" is kind(CDK). + + subroutine wrap_json_value_create_real64(json,p,val,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + real(real64),intent(in) :: val + character(kind=CDK,len=*),intent(in) :: name + + call json%create_real(p,val,to_unicode(name)) + + end subroutine wrap_json_value_create_real64 +!***************************************************************************************** +#endif + +!***************************************************************************************** +!> author: Jacob Williams +! +! Allocate a json_value pointer and make it a string variable. +! The pointer should not already be allocated. +! +!### Example +!````fortran +! type(json_value),pointer :: p +! type(json_core) :: json +! call json%create_string(p,'value','hello') +!```` + + subroutine json_value_create_string(json,p,val,name,trim_str,adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: val + character(kind=CK,len=*),intent(in) :: name + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + + call json_value_create(p) + call json%to_string(p,val,name,trim_str,adjustl_str) + + end subroutine json_value_create_string +!***************************************************************************************** + +!***************************************************************************************** +!> author: Izaak Beekman +! +! Wrap [[json_value_create_string]] so that `create_string` method may be called +! with actual character string arguments for `name` and `val` that are BOTH of +! 'DEFAULT' or 'ISO_10646' character kind. + + subroutine wrap_json_value_create_string(json,p,val,name,trim_str,adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: val + character(kind=CDK,len=*),intent(in) :: name + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + + call json%create_string(p,to_unicode(val),to_unicode(name),trim_str,adjustl_str) + + end subroutine wrap_json_value_create_string +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Allocate a json_value pointer and make it a null variable. +! The pointer should not already be allocated. +! +!### Example +!````fortran +! type(json_value),pointer :: p +! type(json_core) :: json +! call json%create_null(p,'value') +!```` + + subroutine json_value_create_null(json,p,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: name + + call json_value_create(p) + call json%to_null(p,name) + + end subroutine json_value_create_null +!***************************************************************************************** + +!***************************************************************************************** +!> author: Izaak Beekman +! +! Wrap [[json_value_create_null]] so that `create_null` method may be called with +! an actual argument corresponding to the dummy argument `name` that is either +! of 'DEFAULT' or 'ISO_10646' character kind. + + subroutine wrap_json_value_create_null(json,p,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name + + call json%create_null(p,to_unicode(name)) + + end subroutine wrap_json_value_create_null +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Allocate a [[json_value]] pointer and make it an object variable. +! The pointer should not already be allocated. +! +!### Example +!````fortran +! type(json_value),pointer :: p +! type(json_core) :: json +! call json%create_object(p,'objectname') +!```` +! +!@note The name is not significant for the root structure or an array element. +! In those cases, an empty string can be used. + + subroutine json_value_create_object(json,p,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: name + + call json_value_create(p) + call json%to_object(p,name) + + end subroutine json_value_create_object +!***************************************************************************************** + +!***************************************************************************************** +!> author: Izaak Beekman +! +! Wrap [[json_value_create_object]] so that `create_object` method may be called +! with an actual argument corresponding to the dummy argument `name` that is of +! either 'DEFAULT' or 'ISO_10646' character kind. + + subroutine wrap_json_value_create_object(json,p,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name + + call json%create_object(p,to_unicode(name)) + + end subroutine wrap_json_value_create_object +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Allocate a [[json_value]] pointer and make it an array variable. +! The pointer should not already be allocated. +! +!### Example +!````fortran +! type(json_value),pointer :: p +! type(json_core) :: json +! call json%create_array(p,'arrayname') +!```` + + subroutine json_value_create_array(json,p,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in) :: name + + call json_value_create(p) + call json%to_array(p,name) + + end subroutine json_value_create_array +!***************************************************************************************** + +!***************************************************************************************** +!> author: Izaak Beekman +! +! A wrapper for [[json_value_create_array]] so that `create_array` method may be +! called with an actual argument, corresponding to the dummy argument `name`, +! that is either of 'DEFAULT' or 'ISO_10646' character kind. + + subroutine wrap_json_value_create_array(json,p,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CDK,len=*),intent(in) :: name + + call json%create_array(p,to_unicode(name)) + + end subroutine wrap_json_value_create_array +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Change the [[json_value]] variable to a logical. + + subroutine to_logical(json,p,val,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + logical(LK),intent(in),optional :: val !! if the value is also to be set + !! (if not present, then .false. is used). + character(kind=CK,len=*),intent(in),optional :: name !! if the name is also to be changed. + + !set type and value: + call destroy_json_data(p) + p%var_type = json_logical + allocate(p%log_value) + if (present(val)) then + p%log_value = val + else + p%log_value = .false. !default value + end if + + !name: + if (present(name)) call json%rename(p,name) + + end subroutine to_logical +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Change the [[json_value]] variable to an integer. + + subroutine to_integer(json,p,val,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + integer(IK),intent(in),optional :: val !! if the value is also to be set + !! (if not present, then 0 is used). + character(kind=CK,len=*),intent(in),optional :: name !! if the name is also to be changed. + + !set type and value: + call destroy_json_data(p) + p%var_type = json_integer + allocate(p%int_value) + if (present(val)) then + p%int_value = val + else + p%int_value = 0_IK !default value + end if + + !name: + if (present(name)) call json%rename(p,name) + + end subroutine to_integer +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Change the [[json_value]] variable to a real. + + subroutine to_real(json,p,val,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + real(RK),intent(in),optional :: val !! if the value is also to be set + !! (if not present, then 0.0_rk is used). + character(kind=CK,len=*),intent(in),optional :: name !! if the name is also to be changed. + + !set type and value: + call destroy_json_data(p) + p%var_type = json_real + allocate(p%dbl_value) + if (present(val)) then + p%dbl_value = val + else + p%dbl_value = 0.0_RK !default value + end if + + !name: + if (present(name)) call json%rename(p,name) + + end subroutine to_real +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Change the [[json_value]] variable to a string. +! +!### Modified +! * Izaak Beekman : 02/24/2015 + + subroutine to_string(json,p,val,name,trim_str,adjustl_str) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in),optional :: val !! if the value is also to be set + !! (if not present, then '' is used). + character(kind=CK,len=*),intent(in),optional :: name !! if the name is also to be changed. + logical(LK),intent(in),optional :: trim_str !! if TRIM() should be called for the `val` + !! (only used if `val` is present) + logical(LK),intent(in),optional :: adjustl_str !! if ADJUSTL() should be called for the `val` + !! (only used if `val` is present) + !! (note that ADJUSTL is done before TRIM) + + character(kind=CK,len=:),allocatable :: str !! temp string for `trim()` and/or `adjustl()` + logical :: trim_string !! if the string is to be trimmed + logical :: adjustl_string !! if the string is to be adjusted left + + !set type and value: + call destroy_json_data(p) + p%var_type = json_string + if (present(val)) then + + if (present(trim_str)) then + trim_string = trim_str + else + trim_string = .false. + end if + if (present(adjustl_str)) then + adjustl_string = adjustl_str + else + adjustl_string = .false. + end if + + if (trim_string .or. adjustl_string) then + str = val + if (adjustl_string) str = adjustl(str) + if (trim_string) str = trim(str) + p%str_value = str + else + p%str_value = val + end if + + else + p%str_value = CK_'' ! default value + end if + + !name: + if (present(name)) call json%rename(p,name) + + end subroutine to_string +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Change the [[json_value]] variable to a null. + + subroutine to_null(json,p,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in),optional :: name !! if the name is also to be changed. + + !set type and value: + call destroy_json_data(p) + p%var_type = json_null + + !name: + if (present(name)) call json%rename(p,name) + + end subroutine to_null +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Change the [[json_value]] variable to an object. + + subroutine to_object(json,p,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in),optional :: name !! if the name is also to be changed. + + !set type and value: + call destroy_json_data(p) + p%var_type = json_object + + !name: + if (present(name)) call json%rename(p,name) + + end subroutine to_object +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Change the [[json_value]] variable to an array. + + subroutine to_array(json,p,name) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + character(kind=CK,len=*),intent(in),optional :: name !! if the name is also to be changed. + + !set type and value: + call destroy_json_data(p) + p%var_type = json_array + + !name: + if (present(name)) call json%rename(p,name) + + end subroutine to_array +!***************************************************************************************** + +!***************************************************************************************** +!> +! Core parsing routine. + + recursive subroutine parse_object(json, unit, str, parent) + + implicit none + + class(json_core),intent(inout) :: json + integer(IK),intent(in) :: unit !! file unit number (if parsing from a file) + character(kind=CK,len=*),intent(in) :: str !! JSON string (if parsing from a string) + type(json_value),pointer :: parent !! the parsed object will be added as a child of this + + type(json_value),pointer :: pair !! temp variable + logical(LK) :: eof !! end of file flag + character(kind=CK,len=1) :: c !! character returned by [[pop_char]] +#if defined __GFORTRAN__ + character(kind=CK,len=:),allocatable :: tmp !! this is a work-around for a bug + !! in the gfortran 4.9 compiler. +#endif + + if (.not. json%exception_thrown) then + + !the routine is being called incorrectly. + if (.not. associated(parent)) then + call json%throw_exception('Error in parse_object: parent pointer not associated.') + end if + + nullify(pair) !probably not necessary + + ! pair name + call json%pop_char(unit, str=str, eof=eof, skip_ws=.true., & + skip_comments=json%allow_comments, popped=c) + if (eof) then + call json%throw_exception('Error in parse_object:'//& + ' Unexpected end of file while parsing start of object.') + return + else if (end_object == c) then + ! end of an empty object + return + else if (quotation_mark == c) then + call json_value_create(pair) +#if defined __GFORTRAN__ + call json%parse_string(unit,str,tmp) ! write to a tmp variable because of + pair%name = tmp ! a bug in 4.9 gfortran compiler. + deallocate(tmp) +#else + call json%parse_string(unit,str,pair%name) +#endif + if (json%exception_thrown) then + call json%destroy(pair) + return + end if + else + call json%throw_exception('Error in parse_object: Expecting string: "'//c//'"') + return + end if + + ! pair value + call json%pop_char(unit, str=str, eof=eof, skip_ws=.true., & + skip_comments=json%allow_comments, popped=c) + if (eof) then + call json%destroy(pair) + call json%throw_exception('Error in parse_object:'//& + ' Unexpected end of file while parsing object member.') + return + else if (colon_char == c) then + ! parse the value + call json%parse_value(unit, str, pair) + if (json%exception_thrown) then + call json%destroy(pair) + return + else + call json%add(parent, pair) + end if + else + call json%destroy(pair) + call json%throw_exception('Error in parse_object:'//& + ' Expecting : and then a value: '//c) + return + end if + + ! another possible pair + call json%pop_char(unit, str=str, eof=eof, skip_ws=.true., & + skip_comments=json%allow_comments, popped=c) + if (eof) then + call json%throw_exception('Error in parse_object: '//& + 'End of file encountered when parsing an object') + return + else if (delimiter == c) then + ! read the next member + call json%parse_object(unit = unit, str=str, parent = parent) + else if (end_object == c) then + ! end of object + return + else + call json%throw_exception('Error in parse_object: Expecting end of object: '//c) + return + end if + + end if + + end subroutine parse_object +!***************************************************************************************** + +!***************************************************************************************** +!> +! Core parsing routine. + + recursive subroutine parse_array(json, unit, str, array) + + implicit none + + class(json_core),intent(inout) :: json + integer(IK),intent(in) :: unit !! file unit number (if parsing from a file) + character(kind=CK,len=*),intent(in) :: str !! JSON string (if parsing from a string) + type(json_value),pointer :: array + + type(json_value),pointer :: element !! temp variable for array element + logical(LK) :: eof !! end of file flag + character(kind=CK,len=1) :: c !! character returned by [[pop_char]] + + do + + if (json%exception_thrown) exit + + ! try to parse an element value + nullify(element) + call json_value_create(element) + call json%parse_value(unit, str, element) + if (json%exception_thrown) then + if (associated(element)) call json%destroy(element) + exit + end if + + ! parse value will deallocate an empty array value + if (associated(element)) call json%add(array, element) + + ! popped the next character + call json%pop_char(unit, str=str, eof=eof, skip_ws=.true., & + skip_comments=json%allow_comments, popped=c) + + if (eof) then + ! The file ended before array was finished: + call json%throw_exception('Error in parse_array: '//& + 'End of file encountered when parsing an array.') + exit + else if (delimiter == c) then + ! parse the next element + cycle + else if (end_array == c) then + ! end of array + exit + else + call json%throw_exception('Error in parse_array: '//& + 'Unexpected character encountered when parsing array.') + exit + end if + + end do + + end subroutine parse_array +!***************************************************************************************** + +!***************************************************************************************** +!> +! Parses a string while reading a JSON file. +! +!### History +! * Jacob Williams : 6/16/2014 : Added hex validation. +! * Jacob Williams : 12/3/2015 : Fixed some bugs. +! * Jacob Williams : 8/23/2015 : `string` is now returned unescaped. +! * Jacob Williams : 7/21/2018 : moved hex validate to [[unescape_string]]. + + subroutine parse_string(json, unit, str, string) + + implicit none + + class(json_core),intent(inout) :: json + integer(IK),intent(in) :: unit !! file unit number (if + !! parsing from a file) + character(kind=CK,len=*),intent(in) :: str !! JSON string (if parsing + !! from a string) + character(kind=CK,len=:),allocatable,intent(out) :: string !! the string (unescaped + !! if necessary) + + logical(LK) :: eof !! end of file flag + logical(LK) :: escape !! for escape string parsing + character(kind=CK,len=1) :: c !! character returned by [[pop_char]] + integer(IK) :: ip !! index to put next character, + !! to speed up by reducing the number + !! of character string reallocations. + character(kind=CK,len=:),allocatable :: error_message !! for string unescaping + + !at least return a blank string if there is a problem: + string = blank_chunk + + if (.not. json%exception_thrown) then + + !initialize: + escape = .false. + ip = 1 + + do + + !get the next character from the file: + call json%pop_char(unit, str=str, eof=eof, skip_ws=.false., popped=c) + + if (eof) then + + call json%throw_exception('Error in parse_string: Expecting end of string') + return + + else if (c==quotation_mark .and. .not. escape) then !end of string + + exit + + else + + !if the string is not big enough, then add another chunk: + if (ip>len(string)) string = string // blank_chunk + + !append to string: + string(ip:ip) = c + ip = ip + 1 + + ! check for escape character, so we don't + ! exit prematurely if escaping a quotation + ! character: + if (escape) then + escape = .false. + else + escape = (c==backslash) + end if + + end if + + end do + + !trim the string if necessary: + if (ip +! Core parsing routine. +! +! This is used to verify the strings `true`, `false`, and `null` during parsing. + + subroutine parse_for_chars(json, unit, str, chars) + + implicit none + + class(json_core),intent(inout) :: json + integer(IK),intent(in) :: unit !! file unit number (if parsing from a file) + character(kind=CK,len=*),intent(in) :: str !! JSON string (if parsing from a string) + character(kind=CK,len=*),intent(in) :: chars !! the string to check for. + + integer(IK) :: i !! counter + integer(IK) :: length !! trimmed length of `chars` + logical(LK) :: eof !! end of file flag + character(kind=CK,len=1) :: c !! character returned by [[pop_char]] + + if (.not. json%exception_thrown) then + + length = len_trim(chars) + + do i = 1, length + call json%pop_char(unit, str=str, eof=eof, skip_ws=.false., popped=c) + if (eof) then + call json%throw_exception('Error in parse_for_chars:'//& + ' Unexpected end of file while parsing.') + return + else if (c /= chars(i:i)) then + call json%throw_exception('Error in parse_for_chars:'//& + ' Unexpected character: "'//c//'" (expecting "'//& + chars(i:i)//'")') + return + end if + end do + + end if + + end subroutine parse_for_chars +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 1/20/2014 +! +! Read a numerical value from the file (or string). +! The routine will determine if it is an integer or a real, and +! allocate the type accordingly. +! +!@note Complete rewrite of the original FSON routine, which had some problems. + + subroutine parse_number(json, unit, str, value) + + implicit none + + class(json_core),intent(inout) :: json + integer(IK),intent(in) :: unit !! file unit number (if parsing from a file) + character(kind=CK,len=*),intent(in) :: str !! JSON string (if parsing from a string) + type(json_value),pointer :: value + + character(kind=CK,len=:),allocatable :: tmp !! temp string + character(kind=CK,len=:),allocatable :: saved_err_message !! temp error message for + !! string to int conversion + character(kind=CK,len=1) :: c !! character returned by [[pop_char]] + logical(LK) :: eof !! end of file flag + real(RK) :: rval !! real value + integer(IK) :: ival !! integer value + logical(LK) :: first !! first character + logical(LK) :: is_integer !! it is an integer + integer(IK) :: ip !! index to put next character + !! [to speed up by reducing the number + !! of character string reallocations] + + if (.not. json%exception_thrown) then + + tmp = blank_chunk + ip = 1 + first = .true. + is_integer = .true. !assume it may be an integer, unless otherwise determined + + !read one character at a time and accumulate the string: + do + + !get the next character: + call json%pop_char(unit, str=str, eof=eof, skip_ws=.true., popped=c) + + select case (c) + case(CK_'-',CK_'+') !note: allowing a '+' as the first character here. + + if (is_integer .and. (.not. first)) is_integer = .false. + + !add it to the string: + !tmp = tmp // c !...original + if (ip>len(tmp)) tmp = tmp // blank_chunk + tmp(ip:ip) = c + ip = ip + 1 + + case(CK_'.',CK_'E',CK_'e',CK_'D',CK_'d') !can be present in real numbers + + if (is_integer) is_integer = .false. + + !add it to the string: + !tmp = tmp // c !...original + if (ip>len(tmp)) tmp = tmp // blank_chunk + tmp(ip:ip) = c + ip = ip + 1 + + case(CK_'0':CK_'9') !valid characters for numbers + + !add it to the string: + !tmp = tmp // c !...original + if (ip>len(tmp)) tmp = tmp // blank_chunk + tmp(ip:ip) = c + ip = ip + 1 + + case default + + !push back the last character read: + call json%push_char(c) + + !string to value: + if (is_integer) then + ! it is an integer: + ival = json%string_to_int(tmp) + + if (json%exception_thrown .and. .not. json%strict_integer_type_checking) then + ! if it couldn't be converted to an integer, + ! then try to convert it to a real value and see if that works + + saved_err_message = json%err_message ! keep the original error message + call json%clear_exceptions() ! clear exceptions + rval = json%string_to_dble(tmp) + if (json%exception_thrown) then + ! restore original error message and continue + json%err_message = saved_err_message + call json%to_integer(value,ival) ! just so we have something + else + ! in this case, we return a real + call json%to_real(value,rval) + end if + + else + call json%to_integer(value,ival) + end if + + else + ! it is a real: + rval = json%string_to_dble(tmp) + call json%to_real(value,rval) + end if + + exit !finished + + end select + + if (first) first = .false. + + end do + + !cleanup: + if (allocated(tmp)) deallocate(tmp) + + end if + + end subroutine parse_number +!***************************************************************************************** + +!***************************************************************************************** +!> +! Get the next character from the file (or string). +! +!### See also +! * [[push_char]] +! +!@note This routine ignores non-printing ASCII characters +! (`iachar<=31`) that are in strings. + + subroutine pop_char(json,unit,str,skip_ws,skip_comments,eof,popped) + + implicit none + + class(json_core),intent(inout) :: json + integer(IK),intent(in) :: unit !! file unit number (if parsing + !! from a file) + character(kind=CK,len=*),intent(in) :: str !! JSON string (if parsing from a + !! string) -- only used if `unit=0` + logical(LK),intent(in),optional :: skip_ws !! to ignore whitespace [default False] + logical(LK),intent(in),optional :: skip_comments !! to ignore comment lines [default False] + logical(LK),intent(out) :: eof !! true if the end of the file has + !! been reached. + character(kind=CK,len=1),intent(out) :: popped !! the popped character returned + + integer(IK) :: ios !! `iostat` flag + integer(IK) :: str_len !! length of `str` + character(kind=CK,len=1) :: c !! a character read from the file (or string) + logical(LK) :: ignore !! if whitespace is to be ignored + logical(LK) :: ignore_comments !! if comment lines are to be ignored + logical(LK) :: parsing_comment !! if we are in the process + !! of parsing a comment line + + if (.not. json%exception_thrown) then + + eof = .false. + if (.not. present(skip_ws)) then + ignore = .false. + else + ignore = skip_ws + end if + parsing_comment = .false. + if (.not. present(skip_comments)) then + ignore_comments = .false. + else + ignore_comments = skip_comments + end if + + do + + if (json%pushed_index > 0) then + + ! there is a character pushed back on, most likely + ! from the number parsing. Note: this can only occur if + ! reading from a file when use_unformatted_stream=.false. + c = json%pushed_char(json%pushed_index:json%pushed_index) + json%pushed_index = json%pushed_index - 1 + + else + + if (unit/=0) then !read from the file + + !read the next character: + if (use_unformatted_stream) then + + ! in this case, we read the file in chunks. + ! if we already have the character we need, + ! then get it from the chunk. Otherwise, + ! read in another chunk. + if (json%ichunk<1) then + ! read in a chunk: + json%ichunk = 0 + if (json%filesizelen(json%chunk)) then + ! check this just in case + ios = IOSTAT_END + else + ! get the next character from the chunk: + c = json%chunk(json%ichunk:json%ichunk) + if (json%ichunk==len(json%chunk)) then + json%ichunk = 0 ! reset for next chunk + end if + end if + + else + ! a formatted read: + read(unit=unit,fmt='(A1)',advance='NO',iostat=ios) c + end if + json%ipos = json%ipos + 1 + + else !read from the string + + str_len = len(str) !length of the string + if (json%ipos<=str_len) then + c = str(json%ipos:json%ipos) + ios = 0 + else + ios = IOSTAT_END !end of the string + end if + json%ipos = json%ipos + 1 + + end if + + json%char_count = json%char_count + 1 !character count in the current line + + if (IS_IOSTAT_END(ios)) then !end of file + + ! no character to return + json%char_count = 0 + eof = .true. + popped = space ! just to set a value + exit + + else if (IS_IOSTAT_EOR(ios) .or. c==newline) then !end of record + + json%char_count = 0 + json%line_count = json%line_count + 1 + if (ignore_comments) parsing_comment = .false. ! done parsing this comment line + cycle + + end if + + end if + + if (ignore_comments .and. (parsing_comment .or. scan(c,json%comment_char,kind=IK)>0_IK) ) then + + ! skipping the comment + parsing_comment = .true. + cycle + + else if (any(c == control_chars)) then + + ! non printing ascii characters + cycle + + else if (ignore .and. c == space) then + + ! ignoring whitespace + cycle + + else + + ! return the character + popped = c + exit + + end if + + end do + + end if + + end subroutine pop_char +!***************************************************************************************** + +!***************************************************************************************** +!> +! Core routine. +! +!### See also +! * [[pop_char]] +! +!### History +! * Jacob Williams : 5/3/2015 : replaced original version of this routine. + + subroutine push_char(json,c) + + implicit none + + class(json_core),intent(inout) :: json + character(kind=CK,len=1),intent(in) :: c !! to character to push + + character(kind=CK,len=max_numeric_str_len) :: istr !! for error printing + + if (.not. json%exception_thrown) then + + if (use_unformatted_stream) then + + !in this case, c is ignored, and we just + !decrement the stream position counter: + json%ipos = json%ipos - 1 + json%ichunk = json%ichunk - 1 + + else + + json%pushed_index = json%pushed_index + 1 + + if (json%pushed_index>0 .and. json%pushed_index<=len(json%pushed_char)) then + json%pushed_char(json%pushed_index:json%pushed_index) = c + else + call integer_to_string(json%pushed_index,int_fmt,istr) + call json%throw_exception('Error in push_char: '//& + 'invalid valid of pushed_index: '//trim(istr)) + end if + + end if + + !character count in the current line + json%char_count = json%char_count - 1 + + end if + + end subroutine push_char +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! +! Print any error message, and then clear the exceptions. +! +!@note This routine is used by the unit tests. +! It was originally in json_example.f90, and was +! moved here 2/26/2015 by Izaak Beekman. + + subroutine json_print_error_message(json,io_unit) + + implicit none + + class(json_core),intent(inout) :: json + integer, intent(in), optional :: io_unit !! unit number for + !! printing error message + + character(kind=CK,len=:),allocatable :: error_msg !! error message + logical :: status_ok !! false if there were any errors thrown + + !get error message: + call json%check_for_errors(status_ok, error_msg) + + !print it if there is one: + if (.not. status_ok) then + if (present(io_unit)) then + write(io_unit,'(A)') error_msg + else + write(output_unit,'(A)') error_msg + end if + deallocate(error_msg) + call json%clear_exceptions() + end if + + end subroutine json_print_error_message +!***************************************************************************************** + +!***************************************************************************************** + end module json_value_module +!***************************************************************************************** diff --git a/Equipments/BopStack/ANNULAR.f90 b/Equipments/BopStack/ANNULAR.f90 new file mode 100644 index 0000000..3bad676 --- /dev/null +++ b/Equipments/BopStack/ANNULAR.f90 @@ -0,0 +1,427 @@ +SUBROUTINE ANNULAR + USE VARIABLES + USE CBopControlPanelVariables + USE PressureDisplayVARIABLES + USE CEquipmentsConstants + USE CBopStackVariables + + implicit none + + !write(*,*) 'checkpoint 1' +!===================================================================== +! ANNULAR PREVENTER- BOP CAMERON Type U 5000 +! START CONDITIONS FOR ANNULAR PREVENTER +!===================================================================== + + RAM(1)%SuccessionCounter = RAM(1)%SuccessionCounter + 1 + + if (AnnularValve == 1.0 .and. AnnularFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1) then + + if (AnnularCloseLedMine == LedOn) then + RETURN + end if + + + if ( RAM(1)%SuccessionCounter /= RAM(1)%SuccessionCounterOld+1 ) then + RAM(1)%SuccessionCounter = 0 ! also in starup + RAM(1)%SuccessionCounterOld = 0 ! also in starup + !return + else + RAM(1)%SuccessionCounterOld= RAM(1)%SuccessionCounter + endif + + + + if ( RAM(1)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then + !return + + RAM(1)%First_CloseTimecheck= 1 + + AnnularOpenLed = LedOff + AnnularOpenLedMine = LedOff + AnnularCloseLed = LedOn !LedBlinking + + RAM(1)%FourwayValve = 1 + + endif + + endif + + + if (RAM(1)%FourwayValve == 1 .and. p_acc>acc_MinPressure .and. Pannular_reg>AnnularMovingPressure) then ! 1: Open , 0: Close + + + RAM(1)%FourwayValve = 0 + + + + Annular_closed=0 + !Annular_closed_withPossibility= Annular_closed * TD_BOPConnectionPossibility(1) + RAM(1)%vdis_tot=0 + RAM(1)%vdis_bottles=0. + RAM(1)%fvr_air=0. + RAM(1)%vdis_elecp=0. + Qiter=7 + RAM(1)%Qzero=70 + RAM(1)%Q=RAM(1)%Qzero + RAM(1)%flow=70 + tolAnnular=0.0018 + if (finished_Annular==1) then + AnnularLeverOld=-1.0 + else + AnnularLeverOld=AnnularValve + endif + finished_Annular=0 + AnnularIsClosing = .true. + AnnularIsOpening = .false. + + RAM(2)%bop_type = 3 + !AbopAnnular=963.1 !(in^2) + AbopAnnular=(AnnularPreventerClose*231.)/((IDAnnularBase-ODDrillpipe_inAnnularBase)/2.) ! 231 in^3 = 1 gal + NeededVolumeAnnular=AbopAnnular*(IDAnnularBase-max(ODDrillpipe_inAnnular,ODDrillpipe_inAnnularBase))/(2.*231) !=17.98 galon for IDAnnularBase=13 5/8 , ODDrillpipe_inAnnularBase=5 + !WRITE(*,*) 'a)NeededVolumeAnnular=' , NeededVolumeAnnular + !write(*,*) 'close 1' + endif + + + if (AnnularValve == -1.0 .and. AnnularFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1 ) then + + if (AnnularOpenLedMine == LedOn) then + RETURN + end if + + !CasingPressure : PressureGauges(2) *****temp conditionssssss + + !note: (AnnularSealingPressure) is only for opening while well is pressurised + + + if ( RAM(1)%SuccessionCounter /= RAM(1)%SuccessionCounterOld+1 ) then + RAM(1)%SuccessionCounter = 0 ! also in starup + RAM(1)%SuccessionCounterOld = 0 ! also in starup + !return + else + RAM(1)%SuccessionCounterOld= RAM(1)%SuccessionCounter + endif + + + + if ( RAM(1)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then + !return + + RAM(1)%First_OpenTimecheck= 1 + + AnnularCloseLed = LedOff !new + AnnularCloseLedMine = LedOff !new + AnnularOpenLed = LedOn !LedBlinking + + RAM(1)%FourwayValve = 1 + + endif + + endif + + + + + + if (RAM(1)%FourwayValve == 1 .and. Pannular_reg>AnnularMovingPressure .and. p_acc>acc_MinPressure & + .and. (Annular_closed==0 .or. (Annular_closed==1 .and.PressureGauges(2) <=100.0) .or. (Annular_closed==1 .and.PressureGauges(2)>100.0 .and. Pannular_reg>=AnnularSealingPressure))) then ! 1: Open , 0: Close + !write(*,*) 'open 2' + + RAM(1)%FourwayValve = 0 + + + + Annular_closed=0 + !Annular_closed_withPossibility= Annular_closed * TD_BOPConnectionPossibility(1) + RAM(1)%vdis_tot=0 + RAM(1)%vdis_bottles=0. + RAM(1)%fvr_air=0. + RAM(1)%vdis_elecp=0. + Qiter=7 + RAM(1)%Qzero=70 + RAM(1)%Q=RAM(1)%Qzero + RAM(1)%flow=70 + tolAnnular=0.0018 + + + + if (finished_Annular==1) then + AnnularLeverOld=1.0 + else + AnnularLeverOld=AnnularValve + endif + finished_Annular=0 + AnnularIsOpening = .true. + AnnularIsClosing = .false. + + + !if (AnnularOpenLed == LedOn) then + ! RETURN + !end if + + + + RAM(1)%bop_type = 3 + !AbopAnnular=758.48 !(in^2) + AbopAnnular=(AnnularPreventerOpen*231)/((IDAnnularBase-max(ODDrillpipe_inAnnular,ODDrillpipe_inAnnularBase))/2.) + NeededVolumeAnnular=AbopAnnular*(IDAnnularBase-ODDrillpipe_inAnnular)/(2.*231) !=14.16 galon for IDAnnularBase=13 5/8 , ODDrillpipe_inAnnular=5 + !write(*,*) 'open 1' + + endif + +!===================================================================== + +if (AnnularIsOpening .or. AnnularIsClosing .or. RAM(1)%Bottles_Charged_MalfActive) then + CALL ANNULAR_SUB +end if + + + + + END SUBROUTINE ANNULAR + + + + + + + + + + + + + + +SUBROUTINE ANNULAR_SUB + USE VARIABLES + USE PressureDisplayVARIABLES + USE CBopControlPanelVariables + USE CEquipmentsConstants + USE CBopStackVariables + USE CSimulationVariables + + implicit none + + + FirstSet= 0 + RamsFirstSet= 0 + + + loop5: do while (finished_Annular==0) + + !write(*,*) 'checkpoint 2' + + + RAM(1)%SuccessionCounter = RAM(1)%SuccessionCounter + 1 + + ! CALL CPU_TIME(Annular_StartTime) + + if (AnnularValve == 1.0 .and. AnnularLeverOld == -1.0 .and. AnnularFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1) then + if ( RAM(1)%First_CloseTimecheck == 0 ) then + + + + if ( RAM(1)%SuccessionCounter /= RAM(1)%SuccessionCounterOld+1 ) then + RAM(1)%SuccessionCounter = 0 ! also in starup + RAM(1)%SuccessionCounterOld = 0 ! also in starup + !return + else + RAM(1)%SuccessionCounterOld= RAM(1)%SuccessionCounter + endif + + + + if ( RAM(1)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then + !return + + AnnularOpenLed = LedOff + AnnularOpenLedMine = LedOff + AnnularCloseLed = LedOn !LedBlinking + + RAM(1)%FourwayValve = 1 + + endif + + endif + !write(*,*) 'chekkk 1' + + endif + + + if (RAM(1)%FourwayValve == 1 .and. Pannular_reg>AnnularMovingPressure .and. p_acc>acc_MinPressure) then + !write(*,*) 'close 4' + + RAM(1)%FourwayValve = 0 + + + Annular_closed=0 + !Annular_closed_withPossibility= Annular_closed * TD_BOPConnectionPossibility(1) + p_annular=pa_annular + AnnularLeverOld = AnnularValve + + CALL OpenAnnular + Annular_Situation_forTD= 0 ! open - for TD code + RAM(1)%bop_type = 3 + !AbopAnnular=963.1 !(in^2) + AbopAnnular=(AnnularPreventerClose*231)/((IDAnnularBase-ODDrillpipe_inAnnularBase)/2.) + !write(*,*) 'NeededVolumeShearRams1=',NeededVolumeShearRams + NeededVolumeAnnular=AbopAnnular*(IDAnnular-max(ODDrillpipe_inAnnular,ODDrillpipe_inAnnularBase))/(2*231.) + ! write(*,*) 'NeededVolumeAnnular=',NeededVolumeAnnular + + RAM(1)%vdis_bottles=0. + RAM(1)%fvr_air=0. + RAM(1)%vdis_elecp=0. + AnnularIsClosing = .true. + AnnularIsOpening = .false. + !write(*,*) 'close 2' + + endif + + if (AnnularValve == -1.0 .and. AnnularLeverOld == 1.0 .and. p_acc>acc_MinPressure .and. AnnularFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1 ) then + + !CasingPressure : PressureGauges(2) *****temp conditionssssss + + !note: (AnnularSealingPressure) is only for opening while well is pressurised + + if ( RAM(1)%First_OpenTimecheck == 0 ) then + + if ( RAM(1)%SuccessionCounter /= RAM(1)%SuccessionCounterOld+1 ) then + RAM(1)%SuccessionCounter = 0 ! also in starup + RAM(1)%SuccessionCounterOld = 0 ! also in starup + !return + else + RAM(1)%SuccessionCounterOld= RAM(1)%SuccessionCounter + endif + + if ( RAM(1)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then + !return + + AnnularCloseLed = LedOff + AnnularCloseLedMine= LedOff + AnnularOpenLed = LedOn !LedBlinking + + RAM(1)%FourwayValve = 1 + + endif + + endif + !write(*,*) 'chekkk 2' + + endif + + + + if (RAM(1)%FourwayValve == 1 .and. Pannular_reg>AnnularMovingPressure & + .and. (Annular_closed==0 .or. (Annular_closed==1 .and.PressureGauges(2) <=100.0) .or. (Annular_closed==1 .and.PressureGauges(2)>100.0 .and. Pannular_reg>=AnnularSealingPressure))) then + !write(*,*) 'open 4' + + RAM(1)%FourwayValve = 0 + + + Annular_closed=0 + !Annular_closed_withPossibility= Annular_closed * TD_BOPConnectionPossibility(1) + p_annular=pa_annular + AnnularLeverOld = AnnularValve + + CALL OpenAnnular + Annular_Situation_forTD= 0 ! open - for TD code + RAM(1)%bop_type = 3 + !AbopAnnular=758.48 !(in^2) + AbopAnnular=(AnnularPreventerOpen*231)/((IDAnnularBase-ODDrillpipe_inAnnularBase)/2.) + NeededVolumeAnnular=AbopAnnular*(IDAnnularBase-IDAnnular)/(2*231.) + RAM(1)%vdis_bottles=0. + RAM(1)%fvr_air=0. + RAM(1)%vdis_elecp=0. + + AnnularIsOpening = .true. + AnnularIsClosing = .false. + + !write(*,*) 'open 2' + + endif + + + + RAM(1)%First_CloseTimecheck = 0 + RAM(1)%First_OpenTimecheck = 0 + + RAM(1)%time=RAM(1)%time+DeltaT_BOP !overal time (s) + + + + + +!=================================================== +! BOP +!=================================================== +if (Annular_closed==0) then !bop closing + !write(*,*) 'AnnularIsClosing,AnnularIsOpening' , AnnularIsClosing,AnnularIsOpening + call bop_codeAnnular(1) !ramtype=4 1=RNUMBER +endif !bop is closing +!================================================================ +if (Annular_closed==1) then + RAM(1)%Q=0 + !p_bop=pram_reg + p_annular=pa_annular +endif + +RAM(1)%timecounter_ram=RAM(1)%timecounter_ram+1 + + + + + +! MiddleRamsStatus = IDshearBop +! UpperRamsStatus = IDPipeRam1 +! LowerRamsStatus = IDPipeRam2 +! AnnularStatus = IDAnnular +! AccumulatorPressureGauge = p_acc +! ManifoldPressureGauge= pram_reg +! AnnularPressureGauge=Pannular_reg +! +! +! +! WRITE(60,60) RAM(1)%time,RAM(1)%Q,RAM(1)%vdis_tot,p_acc, & +! pram_reg,Pannular_reg,RAM(1)%p_bop,IDshearBop, & +! IDPipeRam1,IDPipeRam2,IDAnnular +!60 FORMAT(11(f18.5)) + + + call sleepqq(100) + + + !CALL CPU_TIME(Annular_EndTime) + ! + ! + !PUMP(1)%INT_CPU_TIME=IDINT((Annular_EndTime-Annular_StartTime)*1000.) + !PUMP(1)%Dt_ref=IDINT(DeltaT_BOP*1000.) + ! + !call sleepqq(PUMP(1)%Dt_ref-PUMP(1)%INT_CPU_TIME) + + + + + +if (Annular_closed==1) then + ! if ((MiddleRamsValve==1. .and. MiddleRamsFailureMalf==0) .or. (MiddleRamsValve==-1.0 .and. MiddleRamsFailureMalf==0) .or. (LowerRamsValve==1. .and. LowerRamsFailureMalf==0) .or. (LowerRamsValve==-1.0 .and. LowerRamsFailureMalf==0) .or. (UpperRamsValve==1. .and. UpperRamsFailureMalf==0) .or. (UpperRamsValve==-1.0 .and. UpperRamsFailureMalf==0) .or. ChokeLineValve==1. .or. ChokeLineValve==-1.0 .or. KillLineValve==1. .or. KillLineValve==-1.0) then + finished_Annular=1 + ! endif +endif + + if (IsStopped == .true.) return + + + end do loop5 !while finished_Annular==0 + + + + + + if ( finished_Annular==1 .and. RAM(1)%Bottles_Charged_MalfActive==.true.) then + call bop_codeAnnular(1) !ramtype=4 1=RNUMBER + call sleepqq(100) + endif + +END SUBROUTINE ANNULAR_SUB \ No newline at end of file diff --git a/Equipments/BopStack/AnnularMain.f90 b/Equipments/BopStack/AnnularMain.f90 new file mode 100644 index 0000000..892730f --- /dev/null +++ b/Equipments/BopStack/AnnularMain.f90 @@ -0,0 +1,65 @@ +module AnnularMain + implicit none + public + contains + + subroutine Annular_Setup() + use CSimulationVariables + implicit none + call OnSimulationInitialization%Add(Annular_Init) + call OnSimulationStop%Add(Annular_Init) + call OnAnnularStep%Add(Annular_Step) + call OnAnnularOutput%Add(Annular_Output) + call OnAnnularMain%Add(AnnularMainBody) + end subroutine + + subroutine Annular_Init + implicit none + end subroutine Annular_Init + + subroutine Annular_Step + CALL ANNULAR + end subroutine Annular_Step + + subroutine Annular_Output + implicit none + end subroutine Annular_Output + + subroutine AnnularMainBody + USE ifport + USE ifmt + USE CSimulationVariables + ! USE BOP + implicit none + + INTEGER :: AnnularDuration + integer,dimension(8) :: AnnularStartTime , AnnularEndTime + + ! CALL BOP_StartUp() + loop1: DO + CALL DATE_AND_TIME(values=AnnularStartTime) + + CALL ANNULAR + + CALL DATE_AND_TIME(values=AnnularEndTime) + + AnnularDuration = 3600000 * (AnnularEndTime(5) - AnnularStartTime(5)) + 60000 * (AnnularEndTime(6) - AnnularStartTime(6)) + 1000 * (AnnularEndTime(7) - AnnularStartTime(7)) + (AnnularEndTime(8) - AnnularStartTime(8)) + + if (AnnularDuration < 100) then + call sleepqq(100 - AnnularDuration) + ELSE + WRITE (*,*) 'Annular BOP run duration exceeded 100 ms and =', AnnularDuration + end if + + IF (IsStopped==.true.) THEN + EXIT loop1 + ENDIF + + + ENDDO loop1 + + + ! CALL DEALLOCATE_ARRAYS() + end subroutine AnnularMainBody + +end module AnnularMain \ No newline at end of file diff --git a/Equipments/BopStack/BOP.f90 b/Equipments/BopStack/BOP.f90 new file mode 100644 index 0000000..e7c5d52 --- /dev/null +++ b/Equipments/BopStack/BOP.f90 @@ -0,0 +1,299 @@ +module BOP + contains + + subroutine BopStack_Step + USE VARIABLES + USE CBopControlPanelVariables + USE TD_GeneralData + ! USE CEquipmentsConstants + use CSounds + implicit none + + + BOP_timeCounter= BOP_timeCounter + 1 + + write(*,*) 'BOP_timeCounter=' , BOP_timeCounter + + AirSupplyPressureGauge= (1 - AirSupplyPressureGaugeMalf)* (1 - RigAirMalf) *120. !psi + + + if (pram_reg < 2300.) then + ShearIsNotAllowed= 1 + else + ShearIsNotAllowed= 0 + endif + + !write(*,*) 'ShearIsNotAllowed=' , ShearIsNotAllowed + + + !TD_AnnularFillingFinal ! (0.0 to 1.0) percentage filled by tool joint + + + !====================================================================== + ! MAIN BODY OF PROGRAM + ! PURPOSE: BOP Control + !====================================================================== + + + !=== Instantaneous Pipe Diameters in Each Ram (Input from TD Module):== + ODDrillpipe_inAnnular= TD_AnnularPreventerDiam * 12.0 ! ft to inch + ODDrillpipe_inPipeRam1= TD_UpperRamDiam * 12.0 + ODDrillpipe_inShearRam= TD_BlindRamDiam * 12.0 + ODDrillpipe_inPipeRam2= TD_LowerRamDiam * 12.0 + + + + !IDshearBopFinal + !IDPipeRam1Final + !IDPipeRam2Final + !IDAnnularFinal + + OpenArea_shearBop= PI*(IDshearBopFinal**2-ODDrillpipe_inShearRam**2)/4.0d0 !D(in), AREA(in^2) + OpenArea_PipeRam1= PI*(IDPipeRam1Final**2-ODDrillpipe_inPipeRam1**2)/4.0d0 !D(in), AREA(in^2) + OpenArea_PipeRam2= PI*(IDPipeRam2Final**2-ODDrillpipe_inPipeRam2**2)/4.0d0 !D(in), AREA(in^2) + OpenArea_Annular= PI*(IDAnnularFinal**2-ODDrillpipe_inAnnular**2)/4.0d0 !D(in), AREA(in^2) + + MinimumOpenArea_InBOP= min(OpenArea_shearBop,OpenArea_PipeRam1,OpenArea_PipeRam2,OpenArea_Annular) + + !TD_BOPConnectionPossibility(j) = 0 or 1 + + !!!AnnularPreventerDiam = TD_BOPConnectionPossibility(1) >> used in Annular code + !!!UpperRamDiam = TD_BOPConnectionPossibility(2) >> used in PipeRam1 code + !!!BlindRamDiam = TD_BOPConnectionPossibility(3) >> used in ShearRam code + !!!LowerRamDiam = TD_BOPConnectionPossibility(4) >> used in PipeRam2 code + + !===================================================================== + !============SEALING PRESSURES TO BE SET IN ANNULAR REGULATOR========== + WellBorePressure=5000. + if (ODDrillpipe_inAnnular>0.) then + if (ODDrillpipe_inAnnular>0. .and. ODDrillpipe_inAnnular<=1.99) then + acoef=-0.2673 + bcoef=994.3 + const=77 + elseif (ODDrillpipe_inAnnular>1.99 .and. ODDrillpipe_inAnnular<=2.375) then + acoef=-0.2539 + bcoef=994.3 + const=73.15 + elseif (ODDrillpipe_inAnnular>2.375 .and. ODDrillpipe_inAnnular<=2.875) then + acoef=-0.2005 + bcoef=745.9 + const=57.75 + elseif (ODDrillpipe_inAnnular>2.875 .and. ODDrillpipe_inAnnular<=3.5) then + acoef=-0.1871 + bcoef=696.1 + const=53.9 + elseif (ODDrillpipe_inAnnular>3.5 .and. ODDrillpipe_inAnnular<=5) then + acoef=-0.1733 + bcoef=647 + const=50 + elseif (ODDrillpipe_inAnnular>5 .and. ODDrillpipe_inAnnular<=10) then + acoef=-0.1604 + bcoef=596.7 + const=46.2 + endif + AnnularSealingPressure= max((acoef*WellBorePressure+bcoef), const) !(psi) + else !CSO(COMPLETE SHUT OFF) ODDrillpipe_inAnnular=0 + AnnularSealingPressure= 1150. !(psi) + endif + + !===================================================================== + ! BYPASS POSITION + !===================================================================== + if(ByePassValve == -1.0 .and. AirMasterValve==1) then + ByPassOld= -1.0 + !write(*,*) 'ByePassValve to -1' ,ByePassValve + elseif(ByePassValve == 1.0 .and. AirMasterValve==1) then + ByPassOld= 1.0 + !write(*,*) 'ByePassValve to 1=' ,ByePassValve + endif + !write(*,*) 'ByePassValve,ByPassOld=' ,ByePassValve,ByPassOld + !===================================================================== + !WRITE(*,*) 'AnnularRegulatorSetControl====' , AnnularRegulatorSetControl + Pannular_regset=min(AnnularRegulatorSetControl,1700.) ! for changing its set conditions instantaneously + if (Annular_closed==1) then + if (FirstSet==1) then ! code start + Pannular_reg= Pannular_regset + endif + + if (FirstSet==0) then ! durig run, but annular is not closing or opening + Pannular_reg= min(p_acc,Pannular_regset) + endif + endif + + !=================================================================== + ! Annular Preventer Pressure Rise On Tooljoint + !=================================================================== + if ( Annular_Situation_forTD == 1 .and. TD_AnnularFillingFinal==0.0 ) then ! Annular_Situation_forTD= 1 ! closed - for TD code + AnnPressureRise= .true. + elseif ( Annular_Situation_forTD == 0 ) then + AnnPressureRise= .false. + endif + + if (AnnPressureRise == .true.) then + Pannular_reg= Pannular_reg + 200. * TD_AnnularFillingFinal ! 200 psi pressure rise when 100% of AnnPreventer is filled by tool joint + !TD_AnnularFillingFinal ! (0.0 to 1.0) percentage filled by tool joint + endif + !=================================================================== + if (FirstSet== 1) then + !new= (1 - AnnularPressureGaugeMalf) * min(AnnularRegulatorSetControl,1700.) + CALL Pannular_regDelay%AddToFirst( (1 - AnnularPressureGaugeMalf) * min(AnnularRegulatorSetControl,1700.) ) + CALL Pannular_regDelay%Remove(Pannular_regDelay%Length()) + AnnularPressureGauge= Pannular_regDelay%Last() + !AnnularPressureGauge= (1 - AnnularPressureGaugeMalf) * min(AnnularRegulatorSetControl,1700.) + !write(*,*) 'set 1' , AnnularPressureGauge + else !FirstSet== 0 + !new= (1 - AnnularPressureGaugeMalf) * Pannular_reg + + CALL Pannular_regDelay%AddToFirst( (1 - AnnularPressureGaugeMalf) * Pannular_reg) + CALL Pannular_regDelay%Remove(Pannular_regDelay%Length()) + AnnularPressureGauge= Pannular_regDelay%Last() + !AnnularPressureGauge= (1 - AnnularPressureGaugeMalf) * Pannular_reg + !write(*,*) 'set 0' , AnnularPressureGauge + endif + + !=================================================== + ! AIR OPERATED PUMP CODE- START + !=================================================== + if (p_accAIR_PUMPOFF .and. airp_switch==1) then + airp_switch=0 + call SetSoundKoomeyAirPump(airp_switch) + endif + + if (p_accELECTRIC_PUMPOFF .and. elecp_switch==1) then + elecp_switch=0 + endif + + !write(*,*) 'airp_switch,elecp_switch=' , airp_switch,elecp_switch + !================CHARGING BOTTLES======================= + if (airp_switch==1 .or. elecp_switch==1) then + if (Annular_closed==1 .and. ShearBop_closed==1 .and. PipeRam1_closed==1 .and. PipeRam2_closed==1 .and. ChokeLine_closed==1 .and. KillLine_closed==1) then + call pumps_charge_bottle() + ! increases volume and pressure in the bottles + if (p_acc>acc_ChargedPressure) then + p_acc=acc_ChargedPressure + if (AnnularLeakMalf== 0) then + !finished_Annular=1 + RAM(1)%Bottles_Charged_MalfActive= .false. + else + finished_Annular=0 + RAM(1)%Bottles_Charged_MalfActive= .true. + !fvr=fvr-2.5 + endif + if (UpperRamsLeakMalf== 0) then + !finished_pipe1=1 + RAM(2)%Bottles_Charged_MalfActive= .false. + else + finished_pipe1=0 + RAM(2)%Bottles_Charged_MalfActive= .true. + !fvr=fvr-2.5 + endif + + if (LowerRamsLeakMalf== 0) then + !finished_pipe2=1 + RAM(3)%Bottles_Charged_MalfActive= .false. + else + finished_pipe2=0 + RAM(3)%Bottles_Charged_MalfActive= .true. + !fvr=fvr-2.5 + endif + if (MiddleRamsLeakMalf== 0) then + !finished_shear=1 + RAM(4)%Bottles_Charged_MalfActive= .false. + else + finished_shear=0 + RAM(4)%Bottles_Charged_MalfActive= .true. + !fvr=fvr-2.5 + endif + + finished_KillLine=1 + finished_ChokeLine=1 + + + if (AnnularLeakMalf== 0 .and. UpperRamsLeakMalf== 0 .and. LowerRamsLeakMalf== 0 .and. MiddleRamsLeakMalf== 0) then + elecp_switch=0 + airp_switch=0 + endif + endif + endif + endif + + !======================================================= + if (elecp_switch==1 .and. AccPupmsFailMalf==0) then !on position + deltav_elecp=QELECTRIC_PUMP*DeltaT_BOP/60. !QELECTRIC_PUMP(gpm), deltav_elecp(gal), DeltaT_BOP(0.1 sec) + SoundKoomeyElectricPump= .True. + else + deltav_elecp=0 + SoundKoomeyElectricPump= .false. + endif + + !call SetSoundKoomeyElectricPump(SoundKoomeyElectricPump) + if (airp_switch==1 .and. AccPupmsFailMalf==0) then !on position + call airpump_code() !ramtype=2 + end if ! if (airp_switch==1) then !on position + + + !===============AIR OPERATED PUMP CODE- END================ + if (ShearBop_closed==1 .and. PipeRam1_closed==1 .and. PipeRam2_closed==1 .and. ChokeLine_closed==1 .and. KillLine_closed==1) then + + !write(*,*) ' All Rams are closed' + + if(ByPassOld== -1.0) then ! (OPEN POSITION) + !old=pram_reg + !new=p_acc- MAXVAL(RAM%loss_before) + !difference= new-old + PressureDifference= p_acc- MAXVAL(RAM%loss_before) - pram_reg + if (ABS(PressureDifference) > BaseDifferenceP) then !BaseDifferenceP= 300. psi + pram_reg= pram_reg + (PressureDifference/PressureDifferenceSteps) ! PressureDifferenceSteps = 20. + else + pram_reg= p_acc- MAXVAL(RAM%loss_before) ! mishe khate paeen ye shart gozasht ke pacc=3000 shod, in adad dige kam nashe + endif + + elseif (ByPassOld== 1.0) then ! (CLOSE POSITION) + !pram_reg= prams_regset + !if (RamsFirstSet==1) then + !write(*,*) 'bypass CLOSE POSITION' + !old=pram_reg + !new=prams_regset + !difference= new-old + PressureDifference= prams_regset - pram_reg + !write(*,*) 'PressureDifference, prams_regset , pram_reg=' , PressureDifference, prams_regset , pram_reg + + if (ABS(PressureDifference) > BaseDifferenceP) then !BaseDifferenceP= 200. ! psi in starup + pram_reg= pram_reg + (PressureDifference/PressureDifferenceSteps) ! PressureDifferenceSteps = 20. in startup + else + pram_reg= prams_regset + endif + !write(*,*) 'pram_reg=' , pram_reg + + !endif ! if (RamsFirstSet==1) then + endif + + + endif + + MiddleRamsStatus = IDshearBop + UpperRamsStatus = IDPipeRam1 + LowerRamsStatus = IDPipeRam2 + AnnularStatus = IDAnnular + AccumulatorPressureGauge = (1 - AccumulatorPressureGaugeMalf) * p_acc + ManifoldPressureGauge= (1 - ManifoldPressureGaugeMalf) * pram_reg + !AnnularPressureGauge=Pannular_reg + ! + ! WRITE(60,60) RAM(2)%time,RAM(2)%Q,RAM(2)%vdis_tot,p_acc, & + ! pram_reg,Pannular_reg,RAM(2)%p_bop,IDshearBop, & + ! IDPipeRam1,IDPipeRam2,IDAnnular + !60 FORMAT(11(f18.5)) + !WRITE(*,*) 'IDAnnular=' , IDAnnular + !write(*,*) 'elecp_switch=' , elecp_switch + !call sleepqq(100) + end subroutine BopStack_Step + +end module BOP \ No newline at end of file diff --git a/Equipments/BopStack/BOPstartup.f90 b/Equipments/BopStack/BOPstartup.f90 new file mode 100644 index 0000000..f95c4e1 --- /dev/null +++ b/Equipments/BopStack/BOPstartup.f90 @@ -0,0 +1,324 @@ + +SUBROUTINE BOP_StartUp() +USE VARIABLES +USE CAccumulatorVariables +USE CBopStackVariables +USE CBopControlPanelVariables +USE CEquipmentsConstants +implicit none + +integer i + + +!UpperRamsFailureMalf=0 +!AnnularFailureMalf=0 +!LowerRamsFailureMalf=0 +!MiddleRamsFailureMalf=0 +!UpperRamsLeakMalf=0 +!LowerRamsLeakMalf=0 +!MiddleRamsLeakMalf=0 +!AnnularLeakMalf=0 +!AccPupmsFailMalf=0 +!AirSupplyPressureGauge=0 +!======================= SETTING VARIABLES + +BOP_timeCounter= 0 + +!============== FOR MANIFOLD VALVES CODE===================== +CALL OpenAnnular +CALL OpenUpperRams +CALL OpenMiddleRams +CALL CloseKillLine +CALL CloseChokeLine +CALL OpenLowerRams + +Annular_Situation_forTD= 0 ! open - for TD code +ShearBop_Situation_forTD= 0 ! open - for TD code +PipeRam1_Situation_forTD= 0 ! open - for TD code +PipeRam2_Situation_forTD= 0 ! open - for TD code +!====================================================================== + +CALL LOSS_INPUTS() +! +!OPEN(50,FILE='AIRPUMP_OUTPUTS.DAT') +!OPEN(60,FILE='RAMS_OUTPUTS.DAT') +!====================================================================== +! GET INPUTS +!====================================================================== + +RAM%SuccessionCounter = 0 +RAM%SuccessionCounterOld = 0 + +RAM%First_CloseTimecheck= 0 +RAM%First_OpenTimecheck= 0 + + + +Cumulative_AirVolume= 0.0 + + +bottle_capacity=10 !(GALON) +nobottles=NumberOfBottels + + + + + + + +!fvr_tot=40 !(GALON) IN CHARGED POSITION +prams_regset=1500 !RamsReglatorSet !=1500 DEFAULT regulator set pressure (PSI) +acc_ChargedPressure=3000 !charged(PSI) +acc_MinPressure=AccumulatorMinimumOperatingPressure !1200 !discharged(PSI) +!acc_precharge=1000 + + +fvr_tot=(-2451*(acc_ChargedPressure**(-0.8202))+8.435)*nobottles ! IT IS WRRITEN FOR PRECHARGE 1000 PSI FROM ITS CURVE + +!write(*,*) 'fvr_tot=',fvr_tot + +!ELECTRIC_PUMPON=2800 +ELECTRIC_PUMPON=StartPressure +!ELECTRIC_PUMPOFF=acc_ChargedPressure !=3000 psi +ELECTRIC_PUMPOFF=StopPressure +!QELECTRIC_PUMP=12 !(gpm) +QELECTRIC_PUMP=ElectricPumpOutput + + + +!AIR_PUMPON=2600 +AIR_PUMPON=StartPressure2 +!AIR_PUMPOFF=2900 +AIR_PUMPOFF=StopPressure2 + + + +RAM%tol=0.0037 !%=(2700-2600)/2700 +RAM%tolzero=RAM%tol + +tolAnnular=0.0018 !=(2900-2895)/2900 +tolzeroAnnular=tolAnnular +!======================OTHER INPUTS(CONSTANTS)=========================== +pa=300 !(PSI) +p_shear=1200 !(PSI) +!p_shear=2423.1 !(PSI) +pb=p_shear-pa +pa_annular=100 !(psi) + + + + +IDAnnularBase=13.625 !(inch) +IDAnnular=IDAnnularBase +ODDrillpipe_inAnnularBase=5. ! so 18 gal is for complete closing of annular +ODDrillpipe_inAnnular=5. ! initial +AnnularMovingPressure=360. !(psi) +IDAnnularFinal= IDAnnular + + +IDshearBopBase=13.625 !(inch) +IDshearBop=IDshearBopBase +ODDrillpipe_inShearRamBase=5 !initial +ODDrillpipe_inShearRam=5 !initial +IDshearBopFinal= IDshearBop + +IDPipeRamBase=13.625 !(inch) +IDPipeRam1=IDPipeRamBase +ODDrillpipe_inPipeRam1Base=5 !initial +ODDrillpipe_inPipeRam1=5 !initial +IDPipeRam1Final= IDPipeRam1 + + +IDPipeRam2=IDPipeRamBase !(inch) +ODDrillpipe_inPipeRam2Base=5 !initial +ODDrillpipe_inPipeRam2=5 !initial +IDPipeRam2Final= IDPipeRam2 + +IDChokeLineBase=8.6 !(inch) +IDChokeLine=IDChokeLineBase +ODDrillpipe_inChokeLineBase=5 +ODDrillpipe_inChokeLine=5 + +IDKillLineBase=8.6 !(inch) +IDKillLine=IDKillLineBase +ODDrillpipe_inKillLineBase=5 +ODDrillpipe_inKillLine=5 + + +!va=4 !(liter) +!vb=8 !(liter) + +!cv=2; !flow coefficinet of regulator + +RAM_COURSE=320.2 !milimeter +H_REGRAM=0 !(m)<<<<<<<<<<<<<<<<<<<<<<<< +H_ShearRamBop=(GroundLevel-BlindRamHeight)*0.3048 ! foot to meter +H_PipeRam1Bop=(GroundLevel-UpperRamHeight)*0.3048 ! foot to meter +H_PipeRam2Bop=(GroundLevel-LowerRamHeight)*0.3048 ! foot to meter +H_AnnularBop=(GroundLevel-AnnularPreventerHeight)*0.3048 ! foot to meter +H_ChokeLineBop=(GroundLevel-KillHeight)*0.3048 ! foot to meter +H_KillLineBop=(GroundLevel-KillHeight)*0.3048 ! foot to meter + + +p_acc=acc_ChargedPressure +RAM%vdis_bottles=0 !initial discharged volume +fvr=fvr_tot +RAMS%minloss=0. + +!======================AIRPUMP INPUTS(CONSTANTS)=========================== + +RAM%FVR_AIR=0 +P_AIRP=0 + +ba1=1003; ba2=.03375; ba3=4.014; ba4=.2458 +bba1 =31.8; bba2 =-725.7 ; bba3 =4154 + +Qiter=7 !(gpm) + +! Q=0.0003585; true + + +DeltaT_BOP=0.1 !second +tol_air=.08 + +alpha_Qair=0 +alpha_timeair=0 +alpha_paccair=p_acc +alpha_pairp=p_acc +alpha_diffpair=0 +alpha_lossesair=0 +alpha_fvrair=0 + +counter_airp=1 + +!======================BOP INPUTS(CONSTANTS)=========================== + + if (PrechargePressure == 1400.) then + b1=1396; b2=0.17; b3=3.873; b4=1.101 + elseif (PrechargePressure == 2000.) then + b1=1980; b2=0.1237; b3=15.69; b4=1.029 + elseif (PrechargePressure == 600.) then + b1=591.9; b2=0.1968; b3=2.887; b4=0.9757 + else !(PrechargePressure == 1000.) then ! this is for precharge=1000 psi + b1=993.7; b2=0.164; b3=5.492; b4=0.9796 + endif + +ByPassOld= 1.0 + +RAM%p_bop=pa +p_annular=pa_annular +!Q=0.0055; !initial flow rate (m^3/s) +RAM%flow=60 !(gpm) initial value +RAM%Qzero=70 !for DP code, increasing Q after shear +RAM%vdis_tot=0 +airp_switch=0 !off position +elecp_switch=0 !off position +ShearBop_closed=1 +PipeRam1_closed=1 +PipeRam2_closed=1 +ChokeLine_closed=1 +KillLine_closed=1 +Annular_closed=1 +finished_Shear=0 +finished_pipe1=0 +finished_pipe2=0 +finished_ChokeLine=0 +finished_KillLine=0 +finished_Annular=0 +deltav_elecp=0 +RAM%vdis_elecp=0 +!================================================================== +RAM%timecounter_ram=0 +RAM%Q=0 +pram_reg=prams_regset !psi !RamsReglatorSet +Pannular_reg=min(AnnularRegulatorSetControl,1700.) + + + + +MiddleRamsStatus= IDshearBop +UpperRamsStatus= IDPipeRam1 +LowerRamsStatus= IDPipeRam2 +AnnularStatus = IDAnnular + + +AccumulatorPressureGauge = p_acc + + +RAM%time=0 + +! WRITE(60,10) ' Overal Time','Q Ram Line','Vdis Ram Line','P Accumulator','Preg Ram Line','Preg Annular',' P BOP','ID Shear Ram', & +! 'ID Pipe Ram1','ID Pipe Ram2','ID Annular' +!10 FORMAT(11(A18)) +! +! +! +! WRITE(60,60) RAM(2)%time,RAM(2)%Q,RAM(2)%vdis_tot,p_acc, & +! pram_reg,Pannular_reg,RAM(2)%p_bop,IDshearBop, & +! IDPipeRam1,IDPipeRam2,IDAnnular +!60 FORMAT(11(f18.5)) + + + MiddleRamsOpenLED = LedOn + MiddleRamsOpenLEDMine = LedOn + MiddleRamsCloseLED = LedOff + MiddleRamsCloseLEDMine = LedOff + ShearRamIsOpening = .false. + ShearRamIsClosing = .false. + + UpperRamsOpenLED = LedOn + UpperRamsOpenLEDMine = LedOn + UpperRamsCloseLED = LedOff + UpperRamsCloseLEDMine = LedOff + PipeRam1IsOpening = .false. + PipeRam1IsClosing = .false. + + LowerRamsOpenLED = LedOn + LowerRamsOpenLEDMine = LedOn + LowerRamsCloseLED = LedOff + LowerRamsCloseLEDMine = LedOff + PipeRam2IsOpening = .false. + PipeRam2IsClosing = .false. + + ChokeLineOpenLED = LedOff + ChokeLineOpenLEDMine = LedOff + ChokeLineCloseLED = LedOn + ChokeLineCloseLEDMine = LedOn + ChokeLineIsOpening = .false. + ChokeLineIsClosing = .false. + + + KillLineOpenLed = LedOff + KillLineOpenLedMine = LedOff + KillLineCloseLed = LedOn + KillLineCloseLedMine = LedOn + KillLineIsOpening = .false. + KillLineIsClosing = .false. + + + AnnularOpenLed = LedOn + AnnularOpenLedMine = LedOn + + AnnularCloseLed = LedOff + AnnularCloseLedMine = LedOff + + AnnularIsOpening = .false. + AnnularIsClosing = .false. + + + FirstSet=1 + RamsFirstSet=1 + ManifoldPressureGauge=prams_regset !RamsReglatorSet + AnnularPressureGauge= (1 - AnnularPressureGaugeMalf) * min(AnnularRegulatorSetControl,1700.) + + +PannularTimeStepDelay = int(1./DeltaT_BOP) ! 1/0.1 : for 1 sec delay in AnnRegulator shot time + + DO i = 1 , PannularTimeStepDelay + CALL Pannular_regDelay%AddToFirst(AnnularPressureGauge) + END DO + + + + end + \ No newline at end of file diff --git a/Equipments/BopStack/BlindRamsMain.f90 b/Equipments/BopStack/BlindRamsMain.f90 new file mode 100644 index 0000000..a8fd144 --- /dev/null +++ b/Equipments/BopStack/BlindRamsMain.f90 @@ -0,0 +1,68 @@ +module BlindRamsMain + implicit none + public + contains + + subroutine BlindRams_Setup() + use CSimulationVariables + implicit none + call OnSimulationInitialization%Add(BlindRams_Init) + call OnSimulationStop%Add(BlindRams_Init) + call OnBlindRamsStep%Add(BlindRams_Step) + call OnBlindRamsOutput%Add(BlindRams_Output) + call OnBlindRamsMain%Add(BlindRamsMainBody) + end subroutine + + subroutine BlindRams_Init + implicit none + end subroutine BlindRams_Init + + subroutine BlindRams_Step + CALL SHEAR_RAMS + end subroutine BlindRams_Step + + subroutine BlindRams_Output + implicit none + end subroutine BlindRams_Output + + subroutine BlindRamsMainBody + USE ifport + USE ifmt + USE CSimulationVariables + ! USE BOP + + implicit none + + INTEGER :: ShearRamDuration + integer,dimension(8) :: ShearRamStartTime , ShearRamEndTime + + + ! CALL BOP_StartUp() + loop1: DO + + CALL DATE_AND_TIME(values=ShearRamStartTime) + + + CALL SHEAR_RAMS + + CALL DATE_AND_TIME(values=ShearRamEndTime) + + ShearRamDuration = 3600000 * (ShearRamEndTime(5) - ShearRamStartTime(5)) + 60000 * (ShearRamEndTime(6) - ShearRamStartTime(6)) + 1000 * (ShearRamEndTime(7) - ShearRamStartTime(7)) + (ShearRamEndTime(8) - ShearRamStartTime(8)) + + if (ShearRamDuration < 100) then + call sleepqq(100 - ShearRamDuration) + ELSE + WRITE (*,*) 'ShearRam BOP run duration exceeded 100 ms and =', ShearRamDuration + end if + + + IF (IsStopped==.true.) THEN + EXIT loop1 + ENDIF + + + ENDDO loop1 + + end subroutine BlindRamsMainBody + +end module BlindRamsMain \ No newline at end of file diff --git a/Equipments/BopStack/BopStackMain.f90 b/Equipments/BopStack/BopStackMain.f90 new file mode 100644 index 0000000..07e1dc7 --- /dev/null +++ b/Equipments/BopStack/BopStackMain.f90 @@ -0,0 +1,10 @@ +module BopStackMain + use BOP + implicit none + public +contains + subroutine BopStack_Step + + CALL BOP_MainBody + end subroutine BopStack_Step +END MODULE BopStackMain \ No newline at end of file diff --git a/Equipments/BopStack/CHOKE_LINE.f90 b/Equipments/BopStack/CHOKE_LINE.f90 new file mode 100644 index 0000000..340f58f --- /dev/null +++ b/Equipments/BopStack/CHOKE_LINE.f90 @@ -0,0 +1,309 @@ + + +SUBROUTINE CHOKE_LINE + USE VARIABLES + USE CAccumulatorVariables + USE CBopStackVariables + USE CBopControlPanelVariables + USE CEquipmentsConstants + + implicit none + + +!===================================================================== +! CHOKE LINE 1- BOP CAMERON Type U 5000 +! START CONDITIONS FOR CHOKE LINE 1 +!===================================================================== + + RAM(5)%SuccessionCounter = RAM(5)%SuccessionCounter + 1 + + + if (ChokeLineValve == -1.0 .and. RigAirMalf==0 .and. AirMasterValve==1 .and. p_acc>acc_MinPressure) then + + if ( RAM(5)%SuccessionCounter /= RAM(5)%SuccessionCounterOld+1 ) then + RAM(5)%SuccessionCounter = 0 ! also in starup + RAM(5)%SuccessionCounterOld = 0 ! also in starup + return + else + RAM(5)%SuccessionCounterOld= RAM(5)%SuccessionCounter + endif + + + if ( RAM(5)%SuccessionCounter < int(2.5/DeltaT_BOP) ) then + return + endif + + RAM(5)%First_CloseTimecheck= 1 + + + + + if (ChokeLineOpenLEDMine == LedOn) then + RETURN + end if + ChokeLine_closed=0 + RAM(5)%vdis_tot=0 + RAM(5)%vdis_bottles=0. + RAM(5)%fvr_air=0. + RAM(5)%vdis_elecp=0. + Qiter=7 + RAM(5)%Qzero=70 + RAM(5)%Q=RAM(5)%Qzero + RAM(5)%flow=70 + RAM(5)%tol=0.0037 + if (finished_ChokeLine==1) then + ChokeLineLeverOld= 1.0 + else + ChokeLineLeverOld=ChokeLineValve + endif + finished_ChokeLine=0 + ChokeLineIsOpening = .true. + ChokeLineCloseLED = LedOff + ChokeLineCloseLEDMine = LedOff + ChokeLineOpenLED = LedOn !LedBlinking + RAM(5)%bop_type = 3 + !AbopChokeLine=196.67 + AbopChokeLine=(ChokeClose*231)/((IDChokeLineBase-ODDrillpipe_inChokeLineBase)/2.) + NeededVolumeChokeLine=AbopChokeLine*(IDChokeLineBase-max(ODDrillpipe_inChokeLine,ODDrillpipe_inChokeLineBase))/(2.*231) !1.5 galon for each BOP + endif + + if (ChokeLineValve == 1.0 .and. RigAirMalf==0 .and. AirMasterValve==1 .and. p_acc>acc_MinPressure) then + + + if ( RAM(5)%SuccessionCounter /= RAM(5)%SuccessionCounterOld+1 ) then + RAM(5)%SuccessionCounter = 0 ! also in starup + RAM(5)%SuccessionCounterOld = 0 ! also in starup + return + else + RAM(5)%SuccessionCounterOld= RAM(5)%SuccessionCounter + endif + + + if ( RAM(5)%SuccessionCounter < int(2.5/DeltaT_BOP) ) then + return + endif + + RAM(5)%First_OpenTimecheck= 1 + + + + if (ChokeLineCloseLEDMine == LedOn) then + RETURN + end if + ChokeLine_closed=0 + RAM(5)%vdis_tot=0 + RAM(5)%vdis_bottles=0. + RAM(5)%fvr_air=0. + RAM(5)%vdis_elecp=0. + Qiter=7 + RAM(5)%Qzero=70 + RAM(5)%Q=RAM(5)%Qzero + RAM(5)%flow=70 + RAM(5)%tol=0.0037 + + + + if (finished_ChokeLine==1) then + ChokeLineLeverOld= -1.0 + else + ChokeLineLeverOld=ChokeLineValve + endif + finished_ChokeLine=0 + ChokeLineIsClosing = .true. + + + !if (ChokeLineCloseLED == LedOn) then + ! RETURN + !end if + + ChokeLineCloseLed = LedOff !new + ChokeLineCloseLedMine = LedOff !new + + + ChokeLineCloseLED = LedOn !LedBlinking + RAM(5)%bop_type = 3 + !AbopChokeLine=196.67 + AbopChokeLine=(ChokeOpen*231)/((IDChokeLineBase-ODDrillpipe_inChokeLineBase)/2.) + NeededVolumeChokeLine=AbopChokeLine*(IDChokeLineBase-max(ODDrillpipe_inChokeLine,ODDrillpipe_inChokeLineBase))/(2.*231) !1.5 galon for each BOP + endif + + +!===================================================================== + +if (ChokeLineIsOpening .or. ChokeLineIsClosing) then + CALL CHOKE_LINE_SUB +end if + + + END SUBROUTINE CHOKE_LINE + + + + + + + + + + + + +SUBROUTINE CHOKE_LINE_SUB + + USE VARIABLES + USE CAccumulatorVariables + USE CBopStackVariables + USE CBopControlPanelVariables + USE CEquipmentsConstants + USE CSimulationVariables + implicit none + + + FirstSet= 0 + RamsFirstSet= 0 + + loop5: do while (finished_ChokeLine==0) + + + RAM(5)%SuccessionCounter = RAM(5)%SuccessionCounter + 1 + + + if (ChokeLineValve == 1.0 .and. ChokeLineLeverOld == -1.0 .and. RigAirMalf==0 .and. AirMasterValve==1 .and. p_acc>acc_MinPressure) then + + if ( RAM(5)%First_CloseTimecheck == 0 ) then + + + if ( RAM(5)%SuccessionCounter /= RAM(5)%SuccessionCounterOld+1 ) then + RAM(5)%SuccessionCounter = 0 ! also in starup + RAM(5)%SuccessionCounterOld = 0 ! also in starup + return + else + RAM(5)%SuccessionCounterOld= RAM(5)%SuccessionCounter + endif + + + + if ( RAM(5)%SuccessionCounter < int(2.5/DeltaT_BOP) ) then + return + endif + + endif + + + + ChokeLine_closed=0 + RAM(5)%p_bop=pa + ChokeLineLeverOld = ChokeLineValve + ChokeLineOpenLED = LedOff + ChokeLineOpenLEDMine = LedOff + ChokeLineCloseLED = LedOn !LedBlinking + CALL OpenChokeLine + RAM(5)%bop_type = 3 + !AbopChokeLine=196.67 + AbopChokeLine=(ChokeClose*231)/((IDChokeLineBase-ODDrillpipe_inChokeLineBase)/2.) + NeededVolumeChokeLine=AbopChokeLine*(IDChokeLine-max(ODDrillpipe_inChokeLine,ODDrillpipe_inChokeLineBase))/(2.*231) + + RAM(5)%vdis_bottles=0. + RAM(5)%fvr_air=0. + RAM(5)%vdis_elecp=0. + ChokeLineIsClosing = .true. + ChokeLineIsOpening = .false. + endif + + if (ChokeLineValve == -1.0 .and. ChokeLineLeverOld == 1.0 .and. p_acc>acc_MinPressure .and. RigAirMalf==0 .and. AirMasterValve==1) then + + if ( RAM(5)%First_OpenTimecheck == 0 ) then + + if ( RAM(5)%SuccessionCounter /= RAM(5)%SuccessionCounterOld+1 ) then + RAM(5)%SuccessionCounter = 0 ! also in starup + RAM(5)%SuccessionCounterOld = 0 ! also in starup + return + else + RAM(5)%SuccessionCounterOld= RAM(5)%SuccessionCounter + endif + + if ( RAM(5)%SuccessionCounter < int(2.5/DeltaT_BOP) ) then + return + endif + + endif + + + + ChokeLine_closed=0 + RAM(5)%p_bop=pa + ChokeLineLeverOld = ChokeLineValve + ChokeLineCloseLED = LedOff + ChokeLineCloseLEDMine = LedOff + ChokeLineOpenLED = LedOn !LedBlinking + CALL OpenChokeLine + RAM(5)%bop_type = 3 + !AbopChokeLine=196.67 + AbopChokeLine=(ChokeOpen*231)/((IDChokeLineBase-ODDrillpipe_inChokeLineBase)/2.) + NeededVolumeChokeLine=AbopChokeLine*(IDChokeLineBase-IDChokeLine)/(2.*231) + RAM(5)%vdis_bottles=0. + RAM(5)%fvr_air=0. + RAM(5)%vdis_elecp=0. + + ChokeLineIsOpening = .true. + ChokeLineIsClosing = .false. + endif + + + RAM(5)%First_CloseTimecheck = 0 + RAM(5)%First_OpenTimecheck = 0 + + + RAM(5)%time=RAM(5)%time+DeltaT_BOP !overal time (s) + + + +!=================================================== +! BOP +!=================================================== +if (ChokeLine_closed==0) then !bop closing + call bop_code(4,H_ChokeLineBop,5) !ramtype=4 5=RNUMBER +endif !bop is closing +!================================================================ +if (ChokeLine_closed==1) then + RAM(5)%Q=0 + !p_bop=pram_reg + RAM(5)%p_bop=pa + RAMS%minloss(5,17)=0. !RNUMBER=5 +endif + +RAM(5)%timecounter_ram=RAM(5)%timecounter_ram+1 + + + + + +! MiddleRamsStatus = IDshearBop +! UpperRamsStatus = IDPipeRam1 +! LowerRamsStatus = IDPipeRam2 +! AnnularStatus = IDAnnular +! AccumulatorPressureGauge = p_acc +! ManifoldPressureGauge= pram_reg +! AnnularPressureGauge=Pannular_reg +! +! +! +! WRITE(60,60) RAM(5)%time,RAM(5)%Q,RAM(5)%vdis_tot,p_acc, & +! pram_reg,Pannular_reg,RAM(5)%p_bop,IDshearBop, & +! IDPipeRam1,IDPipeRam2,IDAnnular +!60 FORMAT(11(f18.5)) + + + call sleepqq(100) + +if (ChokeLine_closed==1) then + ! if ((UpperRamsValve==1. .and. UpperRamsFailureMalf==0) .or. (UpperRamsValve==-1.0 .and. UpperRamsFailureMalf==0) .or. (MiddleRamsValve==1. .and. MiddleRamsFailureMalf==0) .or. (MiddleRamsValve==-1.0 .and. MiddleRamsFailureMalf==0) .or. (LowerRamsValve==1. .and. LowerRamsFailureMalf==0) .or. (LowerRamsValve==-1.0 .and. LowerRamsFailureMalf==0) .or. (AnnularValve==1. .and. AnnularFailureMalf==0) .or. (AnnularValve==-1.0 .and. AnnularFailureMalf==0) .or. KillLineValve==1. .or. KillLineValve==-1.0) then + finished_ChokeLine=1 + ! endif +endif + + if (IsStopped == .true.) return + + end do loop5 !while finished_ChokeLine==0 + +END SUBROUTINE CHOKE_LINE_SUB \ No newline at end of file diff --git a/Equipments/BopStack/ChokeLineMain.f90 b/Equipments/BopStack/ChokeLineMain.f90 new file mode 100644 index 0000000..3616ee3 --- /dev/null +++ b/Equipments/BopStack/ChokeLineMain.f90 @@ -0,0 +1,69 @@ +module ChokeLineMain + implicit none + public + contains + + subroutine ChokeLine_Setup() + use CSimulationVariables + implicit none + call OnSimulationInitialization%Add(ChokeLine_Init) + call OnSimulationStop%Add(ChokeLine_Init) + call OnChokeLineStep%Add(ChokeLine_Step) + call OnChokeLineOutput%Add(ChokeLine_Output) + call OnChokeLineMain%Add(ChokeLineMainBody) + end subroutine + + subroutine ChokeLine_Init + implicit none + end subroutine ChokeLine_Init + + subroutine ChokeLine_Step + CALL CHOKE_LINE + end subroutine ChokeLine_Step + + subroutine ChokeLine_Output + implicit none + end subroutine ChokeLine_Output + + subroutine ChokeLineMainBody + USE ifport + USE ifmt + USE CSimulationVariables + ! USE BOP + + implicit none + + INTEGER :: ChokeLineDuration + integer,dimension(8) :: ChokeLineStartTime , ChokeLineEndTime + + ! CALL BOP_StartUp() + loop1: DO + + CALL DATE_AND_TIME(values=ChokeLineStartTime) + + + CALL CHOKE_LINE + + CALL DATE_AND_TIME(values=chokeLineEndTime) + + chokeLineDuration = 3600000 * (chokeLineEndTime(5) - chokeLineStartTime(5)) + 60000 * (chokeLineEndTime(6) - chokeLineStartTime(6)) + 1000 * (chokeLineEndTime(7) - chokeLineStartTime(7)) + (chokeLineEndTime(8) - chokeLineStartTime(8)) + + if (chokeLineDuration < 100) then + call sleepqq(100 - chokeLineDuration) + ELSE + WRITE (*,*) 'chokeLine BOP run duration exceeded 100 ms and =', chokeLineDuration + end if + + IF (IsStopped==.true.) THEN + EXIT loop1 + ENDIF + + + ENDDO loop1 + + + ! CALL DEALLOCATE_ARRAYS() + + end subroutine ChokeLineMainBody + +end module ChokeLineMain \ No newline at end of file diff --git a/Equipments/BopStack/KILL_LINE.f90 b/Equipments/BopStack/KILL_LINE.f90 new file mode 100644 index 0000000..78446cd --- /dev/null +++ b/Equipments/BopStack/KILL_LINE.f90 @@ -0,0 +1,308 @@ + + +SUBROUTINE KILL_LINE + USE VARIABLES + USE CAccumulatorVariables + USE CBopStackVariables + USE CBopControlPanelVariables + USE CEquipmentsConstants + USE CSimulationVariables + + implicit none + + +!===================================================================== +! KILL LINE 1- BOP CAMERON Type U 5000 +! START CONDITIONS FOR KILL LINE 1 +!===================================================================== + + RAM(6)%SuccessionCounter = RAM(6)%SuccessionCounter + 1 + + + if (KillLineValve == -1.0 .and. RigAirMalf==0 .and. AirMasterValve==1 .and. p_acc>acc_MinPressure) then + + if ( RAM(6)%SuccessionCounter /= RAM(6)%SuccessionCounterOld+1 ) then + RAM(6)%SuccessionCounter = 0 ! also in starup + RAM(6)%SuccessionCounterOld = 0 ! also in starup + return + else + RAM(6)%SuccessionCounterOld= RAM(6)%SuccessionCounter + endif + + + if ( RAM(6)%SuccessionCounter < int(2.5/DeltaT_BOP) ) then + return + endif + + RAM(6)%First_CloseTimecheck= 1 + + + + if (KillLineOpenLedMine == LedOn) then + RETURN + end if + KillLine_closed=0 + RAM(6)%vdis_tot=0 + RAM(6)%vdis_bottles=0. + RAM(6)%fvr_air=0. + RAM(6)%vdis_elecp=0. + Qiter=7 + RAM(6)%Qzero=70 + RAM(6)%Q=RAM(6)%Qzero + RAM(6)%flow=70 + RAM(6)%tol=0.0037 + if (finished_KillLine==1) then + KillLineLeverOld= 1.0 + else + KillLineLeverOld=KillLineValve + endif + finished_KillLine=0 + KillLineIsOpening = .true. + KillLineCloseLed = LedOff + KillLineCloseLedMine = LedOff + KillLineOpenLed = LedOn !LedBlinking + RAM(6)%bop_type = 3 + !AbopKillLine=196.67 + AbopKillLine=(KillClose*231)/((IDKillLineBase-ODDrillpipe_inKillLineBase)/2.) + NeededVolumeKillLine=AbopKillLine*(IDKillLineBase-max(ODDrillpipe_inKillLine,ODDrillpipe_inKillLineBase))/(2.*231) !1.5 galon for each BOP + endif + + if (KillLineValve == 1.0 .and. RigAirMalf==0 .and. AirMasterValve==1 .and. p_acc>acc_MinPressure) then + + + if ( RAM(6)%SuccessionCounter /= RAM(6)%SuccessionCounterOld+1 ) then + RAM(6)%SuccessionCounter = 0 ! also in starup + RAM(6)%SuccessionCounterOld = 0 ! also in starup + return + else + RAM(6)%SuccessionCounterOld= RAM(6)%SuccessionCounter + endif + + + if ( RAM(6)%SuccessionCounter < int(2.5/DeltaT_BOP) ) then + return + endif + + RAM(6)%First_OpenTimecheck= 1 + + + + if (KillLineCloseLedMine == LedOn) then + RETURN + end if + KillLine_closed=0 + RAM(6)%vdis_tot=0 + RAM(6)%vdis_bottles=0. + RAM(6)%fvr_air=0. + RAM(6)%vdis_elecp=0. + Qiter=7 + RAM(6)%Qzero=70 + RAM(6)%Q=RAM(6)%Qzero + RAM(6)%flow=70 + RAM(6)%tol=0.0037 + + + + if (finished_KillLine==1) then + KillLineLeverOld= -1.0 + else + KillLineLeverOld=KillLineValve + endif + finished_KillLine=0 + KillLineIsClosing = .true. + + + !if (KillLineCloseLed == LedOn) then + ! RETURN + !end if + + KillLineCloseLed = LedOff !new + KillLineCloseLedMine = LedOff !new + + KillLineCloseLed = LedOn !LedBlinking + RAM(6)%bop_type = 3 + !AbopKillLine=196.67 + AbopKillLine=(KillOpen*231)/((IDKillLineBase-ODDrillpipe_inKillLineBase)/2.) + NeededVolumeKillLine=AbopKillLine*(IDKillLineBase-max(ODDrillpipe_inKillLine,ODDrillpipe_inKillLineBase))/(2.*231) !1.5 galon for each BOP + endif + +!========================================================================== + +if (KillLineIsOpening .or. KillLineIsClosing) then + CALL KILL_LINE_SUB +end if + + + END SUBROUTINE KILL_LINE + + + + + + + + + + + +SUBROUTINE KILL_LINE_SUB + + USE VARIABLES + USE CAccumulatorVariables + USE CBopStackVariables + USE CBopControlPanelVariables + USE CEquipmentsConstants + USE CSimulationVariables + + implicit none + + + FirstSet= 0 + RamsFirstSet= 0 + + loop6: do while (finished_KillLine==0) + + + RAM(6)%SuccessionCounter = RAM(6)%SuccessionCounter + 1 + + + + if (KillLineValve == 1.0 .and. KillLineLeverOld == -1.0 .and. RigAirMalf==0 .and. AirMasterValve==1 .and. p_acc>acc_MinPressure) then + + if ( RAM(6)%First_CloseTimecheck == 0 ) then + + + if ( RAM(6)%SuccessionCounter /= RAM(6)%SuccessionCounterOld+1 ) then + RAM(6)%SuccessionCounter = 0 ! also in starup + RAM(6)%SuccessionCounterOld = 0 ! also in starup + return + else + RAM(6)%SuccessionCounterOld= RAM(6)%SuccessionCounter + endif + + + + if ( RAM(6)%SuccessionCounter < int(2.5/DeltaT_BOP) ) then + return + endif + + endif + + + + KillLine_closed=0 + RAM(6)%p_bop=pa + KillLineLeverOld = KillLineValve + KillLineOpenLed = LedOff + KillLineOpenLedMine = LedOff + KillLineCloseLed = LedOn !LedBlinking + CALL OpenKillLine + RAM(6)%bop_type = 3 + !AbopKillLine=196.67 + AbopKillLine=(KillClose*231)/((IDKillLineBase-ODDrillpipe_inKillLineBase)/2.) + NeededVolumeKillLine=AbopKillLine*(IDKillLine-max(ODDrillpipe_inKillLine,ODDrillpipe_inKillLineBase))/(2.*231) + + RAM(6)%vdis_bottles=0. + RAM(6)%fvr_air=0. + RAM(6)%vdis_elecp=0. + KillLineIsClosing = .true. + KillLineIsOpening = .false. + endif + + if (KillLineValve == -1.0 .and. KillLineLeverOld == 1.0 .and. p_acc>acc_MinPressure .and. RigAirMalf==0 .and. AirMasterValve==1) then + + + if ( RAM(6)%First_OpenTimecheck == 0 ) then + + if ( RAM(6)%SuccessionCounter /= RAM(6)%SuccessionCounterOld+1 ) then + RAM(6)%SuccessionCounter = 0 ! also in starup + RAM(6)%SuccessionCounterOld = 0 ! also in starup + return + else + RAM(6)%SuccessionCounterOld= RAM(6)%SuccessionCounter + endif + + if ( RAM(6)%SuccessionCounter < int(2.5/DeltaT_BOP) ) then + return + endif + + endif + + + KillLine_closed=0 + RAM(6)%p_bop=pa + KillLineLeverOld = KillLineValve + KillLineCloseLed = LedOff + KillLineCloseLedMine = LedOff + KillLineOpenLed = LedOn !LedBlinking + CALL OpenKillLine + RAM(6)%bop_type = 3 + !AbopKillLine=196.67 + AbopKillLine=(KillOpen*231)/((IDKillLineBase-ODDrillpipe_inKillLineBase)/2.) + NeededVolumeKillLine=AbopKillLine*(IDKillLineBase-IDKillLine)/(2.*231) + RAM(6)%vdis_bottles=0. + RAM(6)%fvr_air=0. + RAM(6)%vdis_elecp=0. + + KillLineIsOpening = .true. + KillLineIsClosing = .false. + endif + + + RAM(6)%First_CloseTimecheck = 0 + RAM(6)%First_OpenTimecheck = 0 + + + RAM(6)%time=RAM(6)%time+DeltaT_BOP !overal time (s) + + + +!=================================================== +! BOP +!=================================================== +if (KillLine_closed==0) then !bop closing + call bop_code(5,H_KillLineBop,6) !ramtype=5 6=RNUMBER +endif !bop is closing +!================================================================ +if (KillLine_closed==1) then + RAM(6)%Q=0 + !p_bop=pram_reg + RAM(6)%p_bop=pa + RAMS%minloss(6,17)=0. !RNUMBER=6 +endif + +RAM(6)%timecounter_ram=RAM(6)%timecounter_ram+1 + + + + + +! MiddleRamsStatus = IDshearBop +! UpperRamsStatus = IDPipeRam1 +! LowerRamsStatus = IDPipeRam2 +! AnnularStatus = IDAnnular +! AccumulatorPressureGauge = p_acc +! ManifoldPressureGauge= pram_reg +! AnnularPressureGauge=Pannular_reg +! +! +! +! WRITE(60,60) RAM(6)%time,RAM(6)%Q,RAM(6)%vdis_tot,p_acc, & +! pram_reg,Pannular_reg,RAM(6)%p_bop,IDshearBop, & +! IDPipeRam1,IDPipeRam2,IDAnnular +!60 FORMAT(11(f18.5)) + + + call sleepqq(100) + +if (KillLine_closed==1) then + ! if ((UpperRamsValve==1. .and. UpperRamsFailureMalf==0) .or. (UpperRamsValve==-1.0 .and. UpperRamsFailureMalf==0) .or. (MiddleRamsValve==1. .and. MiddleRamsFailureMalf==0) .or. (MiddleRamsValve==-1.0 .and. MiddleRamsFailureMalf==0) .or. (LowerRamsValve==1. .and. LowerRamsFailureMalf==0) .or. (LowerRamsValve==-1.0 .and. LowerRamsFailureMalf==0) .or. (AnnularValve==1. .and. AnnularFailureMalf==0) .or. (AnnularValve==-1.0 .and. AnnularFailureMalf==0) .or. ChokeLineValve==1. .or. ChokeLineValve==-1.0) then + finished_KillLine=1 + ! endif +endif + + if (IsStopped == .true.) return + + end do loop6 !while finished_KillLine==0 + +END SUBROUTINE KILL_LINE_SUB \ No newline at end of file diff --git a/Equipments/BopStack/KillLineMain.f90 b/Equipments/BopStack/KillLineMain.f90 new file mode 100644 index 0000000..60ba858 --- /dev/null +++ b/Equipments/BopStack/KillLineMain.f90 @@ -0,0 +1,68 @@ +module KillLineMain + implicit none + public + contains + + subroutine KillLine_Setup() + use CSimulationVariables + implicit none + call OnSimulationInitialization%Add(KillLine_Init) + call OnSimulationStop%Add(KillLine_Init) + call OnKillLineStep%Add(KillLine_Step) + call OnKillLineOutput%Add(KillLine_Output) + call OnKillLineMain%Add(KillLineMainBody) + end subroutine + + subroutine KillLine_Init + implicit none + end subroutine KillLine_Init + + subroutine KillLine_Step + CALL KILL_LINE + end subroutine KillLine_Step + + subroutine KillLine_Output + implicit none + end subroutine KillLine_Output + + subroutine KillLineMainBody + USE ifport + USE ifmt + USE CSimulationVariables + ! USE BOP + implicit none + + INTEGER :: KillLineDuration + integer,dimension(8) :: KillLineStartTime , KillLineEndTime + + ! CALL BOP_StartUp() + loop1: DO + + CALL DATE_AND_TIME(values=KillLineStartTime) + + CALL KILL_LINE + + CALL DATE_AND_TIME(values=KillLineEndTime) + + KillLineDuration = 3600000 * (KillLineEndTime(5) - KillLineStartTime(5)) + 60000 * (KillLineEndTime(6) - KillLineStartTime(6)) + 1000 * (KillLineEndTime(7) - KillLineStartTime(7)) + (KillLineEndTime(8) - KillLineStartTime(8)) + + if (KillLineDuration < 100) then + call sleepqq(100 - KillLineDuration) + ELSE + WRITE (*,*) 'KillLine BOP run duration exceeded 100 ms and =', KillLineDuration + end if + + + IF (IsStopped==.true.) THEN + EXIT loop1 + ENDIF + + + ENDDO loop1 + + + ! CALL DEALLOCATE_ARRAYS() + + end subroutine KillLineMainBody + +end module KillLineMain \ No newline at end of file diff --git a/Equipments/BopStack/LOSS_INPUTS.f90 b/Equipments/BopStack/LOSS_INPUTS.f90 new file mode 100644 index 0000000..8100d2c --- /dev/null +++ b/Equipments/BopStack/LOSS_INPUTS.f90 @@ -0,0 +1,1269 @@ + SUBROUTINE DEALLOCATE_ARRAYS() +USE VARIABLES +implicit none +!=========================================================================== +! RAMLINE MINOR LOSSES INPUT +!=========================================================================== + DEALLOCATE (MINORS1,MINORDIAMETER_RAMLINE,AREAMINOR_RAMLINE & + ,LF_RAMLINE,CV_RAMLINE,NOTE_RAMLINE,RAMS%minlosspa,RAMS%minloss) +!=========================================================================== +! RAMLINE PIPNING LOSSES INPUT +!=========================================================================== + DEALLOCATE (PIPINGS_RAMLINE,DIAM_RAMLINE_INCH, & + AREA_RAMLINE,LENGT_RAMLINE,ROUGHNESS_RAMLINE,RELROUGH_RAMLINE & + ,RAMS%Re_ramline,RAMS%fric,RAMS%fricloss) +!=========================================================================== +! ANNULAR MINOR LOSSES INPUT +!=========================================================================== + DEALLOCATE (MINORS_ANNULAR,MINORDIAMETER_ANNULARLINE,AREAMINOR_ANNULARLINE & + ,LF_ANNULARLINE,CV_ANNULARLINE,NOTE_ANNULARLINE,minlosspa_ANNULAR,minloss_ANNULAR) +!=========================================================================== +! ANNULAR PIPNING LOSSES INPUT +!=========================================================================== + DEALLOCATE (PIPINGS_ANNULAR,DIAM_ANNULARLINE_INCH,AREA_ANNULARLINE, & + LENGT_ANNULARLINE,ROUGHNESS_ANNULARLINE,RELROUGH_ANNULARLINE & + ,Re_ANNULARline,fricANNULAR,friclossANNULAR) +!=========================================================================== +! AIR PUMP LOSSES INPUT +!=========================================================================== +DEALLOCATE (PIPINGS_AIRPUMP,DIAM_AIR_INCH, & + Re_air,AREA_AIR,LENGT_AIR,ROUGHNESS_AIRPLINE,REL_ROUGHAIR, & + fric_air,fricloss_air) + !================================================================ +DEALLOCATE (MINORS_AIRPUMP,MINORDIAM_AIR_INCH, & + MINORAREA_AIR,LF_AIR,CV_AIR,NOTE_AIR & + ,minlosspa_air,minloss_air) + +!=========================================================================== +! DELAY ARRAYS +!=========================================================================== +call Pannular_regDelay%Empty() + + + + END + + + + + + + + + + + +SUBROUTINE LOSS_INPUTS() +USE VARIABLES +implicit none +INTEGER I + +!=========================================================================== +! RAMLINE MINOR LOSSES INPUT +!=========================================================================== +NO_MINORSRAMLINE=34 + +ALLOCATE (MINORS1(NO_MINORSRAMLINE,4)) + + ! ID(INCH) LF CV NOTE(BAR) DESCRIPTION +MINORS1(1,1:4)= (/2., 2., 0., 0./) !Acc.tee +MINORS1(2,1:4)= (/2., 0.9, 0., 0./) !Avg.acc.tee +MINORS1(3,1:4)= (/2., 0.9, 0., 0./) !Avg.acc.tee +MINORS1(4,1:4)= (/2., 0.9, 0., 0./) !Avg.acc.tee +MINORS1(5,1:4)= (/2., 0.9, 0., 0./) !tee +MINORS1(6,1:4)= (/2., 2., 0., 0./) !tee +MINORS1(7,1:4)= (/2., 0., 105., 0./) !valve +MINORS1(8,1:4)= (/2., 0.9, 0., 0./) !tee +MINORS1(9,1:4)= (/2., 0., 105., 0./) !valve +MINORS1(10,1:4)= (/2., 0.42, 0., 0./) !elbow +MINORS1(11,1:4)= (/2., 0.42, 0., 0./) !elbow +MINORS1(12,1:4)= (/2., 0.8, 0., 0./) !unionA +MINORS1(13,1:4)= (/2., 0.8, 0., 0./) !unionA +MINORS1(14,1:4)= (/2., 1.5, 0., 0./) !elbow +MINORS1(15,1:4)= (/2., 0., 425., 0./) !valve +MINORS1(16,1:4)= (/2., 2., 0., 0./) !tee +MINORS1(17,1:4)= (/0.75, 0., 1.5, 0./) !REGULATOR +MINORS1(18,1:4)= (/1., 2., 0., 0./) !tee +MINORS1(19,1:4)= (/1., 1.5, 0., 0./) !elbow +MINORS1(20,1:4)= (/1., 0.42, 0., 0./) !elbow +MINORS1(21,1:4)= (/1., 0.42, 0., 0./) !elbow +MINORS1(22,1:4)= (/1., 1.5, 0., 0./) !elbow +MINORS1(23,1:4)= (/1., 0., 105., 0./) !valve +MINORS1(24,1:4)= (/1., 0.9, 0., 0./) !tee +MINORS1(25,1:4)= (/1., 0., 0., 0.5/) !FT +MINORS1(26,1:4)= (/1., 0., 0., 3.4/) !filter +MINORS1(27,1:4)= (/1., 0., 105., 0./) !valve +MINORS1(28,1:4)= (/1., 0.9, 0., 0./) !tee +MINORS1(29,1:4)= (/1., 1.5, 0., 0./) !elbow +MINORS1(30,1:4)= (/1., 1.5, 0., 0./) !elbow +MINORS1(31,1:4)= (/1., 0., 9.2, 0./) !valve +MINORS1(32,1:4)= (/1., 0.8, 0., 0./) !unionA +MINORS1(33,1:4)= (/1., 0.8, 0., 0./) !unionA +MINORS1(34,1:4)= (/0.75, 0.35, 0., 0./) !contraction + + +ALLOCATE (MINORDIAMETER_RAMLINE(NO_MINORSRAMLINE),AREAMINOR_RAMLINE(NO_MINORSRAMLINE),LF_RAMLINE(NO_MINORSRAMLINE),CV_RAMLINE(NO_MINORSRAMLINE) & + ,NOTE_RAMLINE(NO_MINORSRAMLINE),RAMS%minlosspa(6,NO_MINORSRAMLINE),RAMS%minloss(6,NO_MINORSRAMLINE)) + + + +DO I=1,NO_MINORSRAMLINE + MINORDIAMETER_RAMLINE(I)=MINORS1(I,1) + LF_RAMLINE(I)=MINORS1(I,2) + CV_RAMLINE(I)=MINORS1(I,3) + NOTE_RAMLINE(I)=MINORS1(I,4) + + + AREAMINOR_RAMLINE(I)=PI*(MINORDIAMETER_RAMLINE(I)*0.0254)**2/4. !D(in), AREA(m) +ENDDO + + +!=========================================================================== +! RAMLINE PIPNING LOSSES INPUT +!=========================================================================== +NO_PIPINGSRAMLINE=15 + +ALLOCATE (PIPINGS_RAMLINE(NO_PIPINGSRAMLINE,3)) + + ! ID(INCH) L(MM) ROUGHNESS(MM)=e DESCRIPTION +PIPINGS_RAMLINE(1,1:3)= (/2., 1035., 0.03/) !Avg.acc.distance +PIPINGS_RAMLINE(2,1:3)= (/2., 730., 0.03/) !Acc.end.horizontal +PIPINGS_RAMLINE(3,1:3)= (/2., 2000., 0.03/) !Acc.end.vertical +PIPINGS_RAMLINE(4,1:3)= (/2., 6000., 0.05/) !Hyd.hose +PIPINGS_RAMLINE(5,1:3)= (/2., 2370., 0.03/) !Corner.vertical1 +PIPINGS_RAMLINE(6,1:3)= (/2., 210., 0.03/) !Add.from.bend +PIPINGS_RAMLINE(7,1:3)= (/1., 780., 0.03/) !Corner.horizontal1 +PIPINGS_RAMLINE(8,1:3)= (/1., 780., 0.03/) !Corner.horizontal2 +PIPINGS_RAMLINE(9,1:3)= (/1., 750., 0.03/) !Extra.length.back +PIPINGS_RAMLINE(10,1:3)= (/1., 800., 0.03/) !Corner.horizontal3 +PIPINGS_RAMLINE(11,1:3)= (/1., 1650., 0.03/) !Corner.vertical2 +PIPINGS_RAMLINE(12,1:3)= (/1., 340., 0.03/) !12.Valves.horizontal +PIPINGS_RAMLINE(13,1:3)= (/1., 1650., 0.03/) !Valves.vertical +PIPINGS_RAMLINE(14,1:3)= (/1., 31000., 10./) !Hyd.hose +PIPINGS_RAMLINE(15,1:3)= (/1., 526., 0.03/) !Add.from.bend + + + + ALLOCATE (DIAM_RAMLINE_INCH(NO_PIPINGSRAMLINE), & + AREA_RAMLINE(NO_PIPINGSRAMLINE),LENGT_RAMLINE(NO_PIPINGSRAMLINE),ROUGHNESS_RAMLINE(NO_PIPINGSRAMLINE),RELROUGH_RAMLINE(NO_PIPINGSRAMLINE) & + ,RAMS%Re_ramline(6,NO_PIPINGSRAMLINE),RAMS%fric(6,NO_PIPINGSRAMLINE),RAMS%fricloss(6,NO_PIPINGSRAMLINE)) + +DO I=1,NO_PIPINGSRAMLINE + DIAM_RAMLINE_INCH(I)=PIPINGS_RAMLINE(I,1) + LENGT_RAMLINE(I)=PIPINGS_RAMLINE(I,2) + ROUGHNESS_RAMLINE(I)=PIPINGS_RAMLINE(I,3) + + + + AREA_RAMLINE(I)=PI*(DIAM_RAMLINE_INCH(I)*0.0254)**2/4 !D(in), AREA(m) + RELROUGH_RAMLINE(I)=ROUGHNESS_RAMLINE(I)/(DIAM_RAMLINE_INCH(I)*25.4) !e/D + !DIAM_RAMLINE_MM(I)=DIAM_RAMLINE_MM(I)*.001 ! (m) + LENGT_RAMLINE(I)=LENGT_RAMLINE(I)*.001 ! (m) +ENDDO + + + +!=========================================================================== +! ANNULAR PREVENTER MINOR LOSSES INPUT +!=========================================================================== +NO_MinorsAnnularLine=29 + +ALLOCATE (MINORS_ANNULAR(NO_MinorsAnnularLine,4)) + + ! ID(INCH) LF CV NOTE(BAR) DESCRIPTION +MINORS_ANNULAR(1,1:4)= (/2., 2., 0., 0./) !Acc.tee +MINORS_ANNULAR(2,1:4)= (/2., 0.9, 0., 0./) !Avg.acc.tee +MINORS_ANNULAR(3,1:4)= (/2., 0.9, 0., 0./) !Avg.acc.tee +MINORS_ANNULAR(4,1:4)= (/2., 0.9, 0., 0./) !Avg.acc.tee +MINORS_ANNULAR(5,1:4)= (/2., 0.9, 0., 0./) !tee +MINORS_ANNULAR(6,1:4)= (/2., 2., 0., 0./) !tee +MINORS_ANNULAR(7,1:4)= (/2., 0., 105., 0./) !valve +MINORS_ANNULAR(8,1:4)= (/2., 0.9, 0., 0./) !tee +MINORS_ANNULAR(9,1:4)= (/2., 0., 105., 0./) !valve +MINORS_ANNULAR(10,1:4)= (/2., 0.42, 0., 0./) !elbow +MINORS_ANNULAR(11,1:4)= (/2., 0.42, 0., 0./) !elbow +MINORS_ANNULAR(12,1:4)= (/2., 0.8, 0., 0./) !unionA +MINORS_ANNULAR(13,1:4)= (/2., 0.8, 0., 0./) !unionA +MINORS_ANNULAR(14,1:4)= (/2., 1.5, 0., 0./) !elbow +MINORS_ANNULAR(15,1:4)= (/2., 0., 425., 0./) !valve +MINORS_ANNULAR(16,1:4)= (/2., 2., 0., 0./) !tee +MINORS_ANNULAR(17,1:4)= (/0.75, 0., 1.5, 0./) !REGULATOR +MINORS_ANNULAR(18,1:4)= (/1., 2., 0., 0./) !tee +MINORS_ANNULAR(19,1:4)= (/1., 1.5, 0., 0./) !elbow +MINORS_ANNULAR(20,1:4)= (/1., 0.42, 0., 0./) !elbow +MINORS_ANNULAR(21,1:4)= (/1., 0.42, 0., 0./) !elbow +MINORS_ANNULAR(22,1:4)= (/1., 1.5, 0., 0./) !elbow +MINORS_ANNULAR(23,1:4)= (/1., 0., 3.2, 0./) !valve +MINORS_ANNULAR(24,1:4)= (/1., 2., 0., 0./) !tee +MINORS_ANNULAR(25,1:4)= (/1., 1.5, 0., 0./) !elbow +MINORS_ANNULAR(26,1:4)= (/1., 0.42, 0., 0./) !elbow +MINORS_ANNULAR(27,1:4)= (/1., 0.42, 0., 0./) !elbow +MINORS_ANNULAR(28,1:4)= (/1., 1.5, 0., 0./) !elbow +MINORS_ANNULAR(29,1:4)= (/1., 0., 3.2, 0./) !valve + + + + ALLOCATE (MINORDIAMETER_ANNULARLINE(NO_MinorsAnnularLine),AREAMINOR_ANNULARLINE(NO_MinorsAnnularLine),LF_ANNULARLINE(NO_MinorsAnnularLine) & + ,CV_ANNULARLINE(NO_MinorsAnnularLine),NOTE_ANNULARLINE(NO_MinorsAnnularLine),minlosspa_ANNULAR(NO_MinorsAnnularLine),minloss_ANNULAR(NO_MinorsAnnularLine)) + + + +DO I=1,NO_MinorsAnnularLine + MINORDIAMETER_ANNULARLINE(I)=MINORS_ANNULAR(I,1) + LF_ANNULARLINE(I)=MINORS_ANNULAR(I,2) + CV_ANNULARLINE(I)=MINORS_ANNULAR(I,3) + NOTE_ANNULARLINE(I)=MINORS_ANNULAR(I,4) + + AREAMINOR_ANNULARLINE(I)=PI*(MINORDIAMETER_ANNULARLINE(I)*0.0254)**2/4. !D(in), AREA(m) +ENDDO + + +!=========================================================================== +! ANNULAR PREVENTER PIPNING LOSSES INPUT +!=========================================================================== +NO_PipingsAnnularLine=10 + +ALLOCATE (PIPINGS_ANNULAR(NO_PipingsAnnularLine,3)) + + ! ID(INCH) L(MM) ROUGHNESS(MM)=e DESCRIPTION +PIPINGS_ANNULAR(1,1:3)= (/2., 1035., 0.03/) !Avg.acc.distance +PIPINGS_ANNULAR(2,1:3)= (/2., 730., 0.03/) !Acc.endhorizontal +PIPINGS_ANNULAR(3,1:3)= (/2., 2000., 0.03/) !Acc.endvertical +PIPINGS_ANNULAR(4,1:3)= (/2., 6000., 0.03/) !Hyd.hose +PIPINGS_ANNULAR(5,1:3)= (/2., 2370., 0.03/) !Corner.vertical1 +PIPINGS_ANNULAR(6,1:3)= (/2., 210., 0.03/) !Add.frombend +PIPINGS_ANNULAR(7,1:3)= (/2., 1000., 0.03/) !manifold +PIPINGS_ANNULAR(8,1:3)= (/1., 46000., 0.03/) !pipe +PIPINGS_ANNULAR(9,1:3)= (/2., 1000., 0.03/) !manifold +PIPINGS_ANNULAR(10,1:3)= (/1., 46000., 0.03/) !pipe + + + + + ALLOCATE (DIAM_ANNULARLINE_INCH(NO_PipingsAnnularLine),AREA_ANNULARLINE(NO_PipingsAnnularLine),LENGT_ANNULARLINE(NO_PipingsAnnularLine) & + ,ROUGHNESS_ANNULARLINE(NO_PipingsAnnularLine),RELROUGH_ANNULARLINE(NO_PipingsAnnularLine) & + ,Re_ANNULARline(NO_PipingsAnnularLine),fricANNULAR(NO_PipingsAnnularLine),friclossANNULAR(NO_PipingsAnnularLine)) + + +DO I=1,NO_PipingsAnnularLine + DIAM_ANNULARLINE_INCH(I)=PIPINGS_ANNULAR(I,1) + LENGT_ANNULARLINE(I)=PIPINGS_ANNULAR(I,2) + ROUGHNESS_ANNULARLINE(I)=PIPINGS_ANNULAR(I,3) + + + AREA_ANNULARLINE(I)=PI*(DIAM_ANNULARLINE_INCH(I)*0.0254)**2/4. !D(in), AREA(m) + RELROUGH_ANNULARLINE(I)=ROUGHNESS_ANNULARLINE(I)/(DIAM_ANNULARLINE_INCH(I)*25.4) + !DIAM_ANNULARLINE_MM(I)=DIAM_ANNULARLINE_MM(I)*.001 ! (m) + LENGT_ANNULARLINE(I)=LENGT_ANNULARLINE(I)*.001 ! (m) + ENDDO + + +!=========================================================================== +! AIR PUMP LOSSES INPUT +!=========================================================================== +NO_PIPINGS_AIRPLINE=1 + +ALLOCATE (PIPINGS_AIRPUMP(NO_PIPINGS_AIRPLINE,3)) + + ! ID(INCH) L(MM) ROUGHNESS(MM)=e DESCRIPTION +PIPINGS_AIRPUMP(1,1:3)= (/2., 10000., 0.03/) !Avg.acc.distance + + + + + ALLOCATE (DIAM_AIR_INCH(NO_PIPINGS_AIRPLINE),Re_air(NO_PIPINGS_AIRPLINE),AREA_AIR(NO_PIPINGS_AIRPLINE), & + LENGT_AIR(NO_PIPINGS_AIRPLINE),ROUGHNESS_AIRPLINE(NO_PIPINGS_AIRPLINE),REL_ROUGHAIR(NO_PIPINGS_AIRPLINE), & + fric_air(NO_PIPINGS_AIRPLINE),fricloss_air(NO_PIPINGS_AIRPLINE)) + + + +DO I=1,NO_PIPINGS_AIRPLINE + DIAM_AIR_INCH(I)=PIPINGS_AIRPUMP(I,1) + LENGT_AIR(I)=PIPINGS_AIRPUMP(I,2) + ROUGHNESS_AIRPLINE(I)=PIPINGS_AIRPUMP(I,3) + + + AREA_AIR(I)=PI*(DIAM_AIR_INCH(I)*0.0254)**2/4 !D(in), AREA(m) + REL_ROUGHAIR(I)=ROUGHNESS_AIRPLINE(I)/(DIAM_AIR_INCH(I)*25.4) + !DIAM_RAMLINE_MM(I)=DIAM_RAMLINE_MM(I)*.001 ! (m) + LENGT_AIR(I)=LENGT_AIR(I)*.001 ! (m) + ENDDO + + + + !================================================================ +NO_MINORS_AIRPLINE=6 + +ALLOCATE (MINORS_AIRPUMP(NO_MINORS_AIRPLINE,4)) + + ! ID(INCH) LF CV NOTE(BAR) DESCRIPTION +MINORS_AIRPUMP(1,1:4)= (/2., 10., 0., 0./) !Acc.tee +MINORS_AIRPUMP(2,1:4)= (/2., 11., 0., 0./) !elbow +MINORS_AIRPUMP(3,1:4)= (/1., 0., 0., 3.4/) !filter +MINORS_AIRPUMP(4,1:4)= (/2., 0., 105., 0./) !valve +MINORS_AIRPUMP(5,1:4)= (/1., 0., 9.2, 0./) !valve +MINORS_AIRPUMP(6,1:4)= (/2., 6.4, 0., 0./) !unionA + + + + ALLOCATE (MINORDIAM_AIR_INCH(NO_MINORS_AIRPLINE),MINORAREA_AIR(NO_MINORS_AIRPLINE), & + LF_AIR(NO_MINORS_AIRPLINE),CV_AIR(NO_MINORS_AIRPLINE),NOTE_AIR(NO_MINORS_AIRPLINE) & + ,minlosspa_air(NO_MINORS_AIRPLINE),minloss_air(NO_MINORS_AIRPLINE)) + + + +DO I=1,NO_MINORS_AIRPLINE + MINORDIAM_AIR_INCH(I)=MINORS_AIRPUMP(I,1) + LF_AIR(I)=MINORS_AIRPUMP(I,2) + CV_AIR(I)=MINORS_AIRPUMP(I,3) + NOTE_AIR(I)=MINORS_AIRPUMP(I,4) + + + MINORAREA_AIR(I)=PI*(MINORDIAM_AIR_INCH(I)*0.0254)**2/4. !D(in), AREA(m) +ENDDO + + + + END + +SUBROUTINE pumps_charge_bottle() +USE VARIABLES +USE CAccumulatorVariables +USE CBopStackVariables +USE CBopControlPanelVariables +USE CEquipmentsConstants +USE CSimulationVariables +implicit none + + !Pannular_regset=min(AnnularRegulatorSetControl,1700.) ! for changing its set conditions instantaneously +!write(*,*) 'pumps_charge_bottle' + + if(ByePassValve == -1.0) then + ByPassOld= -1.0 + elseif(ByePassValve == 1.0) then + ByPassOld= 1.0 + endif + + +!===================================================================== +! ACCUMULATOR +!=====for a 10 gal bottle,precharge=1000psig curve BOSCH-isotherm===== +!for charging bottles by the pump +!((((((((IN OUTER LOOP)))))) +! ba1=1003; ba2=.03375; ba3=4.014; ba4=.2458; +if (airp_switch==0) deltav_air=0 +fvr=fvr+deltav_air+deltav_elecp + +pacc_before=p_acc +p_acc=b1*exp(b2*fvr/nobottles)+b3*exp(b4*fvr/nobottles) ! adiabatic(psig)<<<< 8=no. of bottles + +!===================================================================== + + + if(ByPassOld == 1.0) then + + if (pram_reg BaseDifferenceP) then + pram_reg= pram_reg + (PressureDifference/PressureDifferenceSteps) ! PressureDifferenceSteps = 20. + else + + if (pram_reg BaseDifferenceP) then + pram_reg= pram_reg + (PressureDifference/PressureDifferenceSteps) ! PressureDifferenceSteps = 20. + else + pram_reg= p_acc- MAXVAL(RAM%loss_before) + endif + + endif + + + !Pannular_reg= min(p_acc,Pannular_regset) + + + end + + +SUBROUTINE airpump_code() +USE VARIABLES +use CSounds +implicit none +INTEGER I + + + +QAIR_PUMP=Qiter+.1 !(gpm) maximum flow for the start +diffp_air=-10 +losses_air=10 + +!=================================================================== +! AIR OPERATED PUMP +!=================for air consumption at 8 bar====================== +do while (diffp_air<0) + QAIR_PUMP=QAIR_PUMP-.1 +! Qup=QAIR_PUMP; +! bba1 =31.8; bba2 =-725.7 ; bba3 =4154; + p_airp=bba1*QAIR_PUMP**2+bba2*QAIR_PUMP+bba3 !(psig) + kinetic_air=sg*wdens*(QAIR_PUMP*6.30902e-5/((1/4.)*pi*(2*0.254e-1)**2))**2/(2*6895) !(psi) + + + diffp_air=p_airp+kinetic_air-p_acc + +end do !returns Qup + + + do while (abs((diffp_air-losses_air)/diffp_air)>tol_air) !finding correct QAIR_pump for 1 timecounter_ram + +if (diffp_air-losses_air>0) then + QAIR_PUMP=QAIR_PUMP+.01 +else + QAIR_PUMP=QAIR_PUMP-.01 +endif + +!=================================================================== +! AIR OPERATED PUMP +! Maximator - Model: GX (35) +!=================for air consumption at 8 bar====================== + + p_airp=bba1*QAIR_PUMP**2+bba2*QAIR_PUMP+bba3 !(psig) + kinetic_air=sg*wdens*(QAIR_PUMP*6.30902e-005/((1/4.)*pi*(2*0.254e-1)**2))**2/(2*6895) !(psi) + + diffp_air=p_airp+kinetic_air-p_acc + + +!===========================LOSSES==================================== + do i=1,NO_PIPINGS_AIRPLINE +Re_air(i)=QAIR_PUMP*6.30902e-005*DIAM_AIR_INCH(I)*0.0254/(area_air(i)*nu) +enddo + +do i=1,NO_PIPINGS_AIRPLINE + if (Re_air(i)NeededVolumeShearRams) then + + ShearBop_closed=1 + !ShearBop_closed_withPossibility= ShearBop_closed * TD_BOPConnectionPossibility(3) + + pram_reg=pram_reg+RAMS%minloss(RNUMBER,17) + p_acc= RAM(RNUMBER)%p_acccheck + + if (ShearRamIsClosing) then + IDshearBop=0. + ShearIsNotAllowed*ODDrillpipe_inShearRam + MiddleRamsCloseLED = LedOn + MiddleRamsCloseLEDMine = LedOn + MiddleRamsOpenLED = LedOff + MiddleRamsOpenLEDMine = LedOff + if (TD_BOPConnectionPossibility(3) == 1 .and. ShearIsNotAllowed==0) then + CALL CloseMiddleRams + ShearBop_Situation_forTD= 1 ! closed - for TD code + endif + endif + + if (ShearRamIsOpening) then + IDshearBop=IDshearBopBase + MiddleRamsOpenLED = LedOn + MiddleRamsOpenLEDMine = LedOn + MiddleRamsCloseLED = LedOff + MiddleRamsCloseLEDMine = LedOff + CALL OpenMiddleRams + ShearBop_Situation_forTD= 0 ! open - for TD code + endif + + endif + + IDshearBopFinal= IDshearBop ! for output data + +endif + +if (ramtype==2) then !for pipe ram1 + if (PipeRam1IsClosing) then + IDPipeRam1=(2.*(NeededVolumePipeRams1- RAM(RNUMBER)%vdis_tot)*231./AbopPipeRam)+max(ODDrillpipe_inPipeRam1,ODDrillpipe_inPipeRam1Base) + endif + + if (PipeRam1IsOpening) then + IDPipeRam1=IDPipeRamBase-2.*(NeededVolumePipeRams1- RAM(RNUMBER)%vdis_tot)*231./AbopPipeRam + endif + + if ( RAM(RNUMBER)%vdis_tot>NeededVolumePipeRams1) then + + PipeRam1_closed=1 + !PipeRam1_Situation_forTD= PipeRam1_closed * TD_BOPConnectionPossibility(2) + pram_reg=pram_reg+RAMS%minloss(RNUMBER,17) + p_acc= RAM(RNUMBER)%p_acccheck + + if (PipeRam1IsClosing) then + IDPipeRam1=max(ODDrillpipe_inPipeRam1,ODDrillpipe_inPipeRam1Base) + UpperRamsCloseLED = LedOn + UpperRamsCloseLEDMine = LedOn + UpperRamsOpenLED = LedOff + UpperRamsOpenLEDMine = LedOff + if (TD_BOPConnectionPossibility(2) == 1) then + CALL CloseUpperRams ! for C code + call Set_BlowoutFromAnnular(.true.) + + + PipeRam1_Situation_forTD= 1 ! closed - for TD code + endif + endif + + if (PipeRam1IsOpening) then + IDPipeRam1=IDPipeRamBase + UpperRamsOpenLED = LedOn + UpperRamsOpenLEDMine = LedOn + UpperRamsCloseLED = LedOff + UpperRamsCloseLEDMine = LedOff + Call OpenUpperRams ! for C code + PipeRam1_Situation_forTD= 0 ! open - for TD code + endif + + endif + + IDPipeRam1Final= IDPipeRam1 ! for output data + +endif + + +if (ramtype==3) then !for pipe ram2 + if (PipeRam2IsClosing) then + IDPipeRam2=(2.*(NeededVolumePipeRams2- RAM(RNUMBER)%vdis_tot)*231./AbopPipeRam)+max(ODDrillpipe_inPipeRam2,ODDrillpipe_inPipeRam1Base) + endif + + if (PipeRam2IsOpening) then + IDPipeRam2=IDPipeRamBase-2.*(NeededVolumePipeRams2- RAM(RNUMBER)%vdis_tot)*231./AbopPipeRam + endif + + if ( RAM(RNUMBER)%vdis_tot>NeededVolumePipeRams2) then + + PipeRam2_closed=1 + !PipeRam2_closed_withPossibility= PipeRam2_closed * TD_BOPConnectionPossibility(4) + pram_reg=pram_reg+RAMS%minloss(RNUMBER,17) + p_acc= RAM(RNUMBER)%p_acccheck + + if (PipeRam2IsClosing) then + IDPipeRam2=max(ODDrillpipe_inPipeRam2,ODDrillpipe_inPipeRam1Base) + LowerRamsCloseLED = LedOn + LowerRamsCloseLEDMine = LedOn + LowerRamsOpenLED = LedOff + LowerRamsOpenLEDMine = LedOff + if (TD_BOPConnectionPossibility(4) == 1) then + CALL CloseLowerRams + PipeRam2_Situation_forTD= 1 ! closed - for TD code + endif + endif + + if (PipeRam2IsOpening) then + IDPipeRam2=IDPipeRamBase + LowerRamsOpenLED = LedOn + LowerRamsOpenLEDMine = LedOn + LowerRamsCloseLED = LedOff + LowerRamsCloseLEDMine = LedOff + CALL OpenLowerRams + PipeRam2_Situation_forTD= 0 ! open - for TD code + endif + + endif + + IDPipeRam2Final= IDPipeRam2 ! for output data + +endif + + +if (ramtype==4) then !for Choke Line + if (ChokeLineIsClosing) then + IDChokeLine=(2.*(NeededVolumeChokeLine- RAM(RNUMBER)%vdis_tot)*231./AbopChokeLine)+max(ODDrillpipe_inChokeLine,ODDrillpipe_inChokeLineBase) + endif + + if (ChokeLineIsOpening) then + IDChokeLine=IDChokeLineBase-2.*(NeededVolumeChokeLine- RAM(RNUMBER)%vdis_tot)*231./AbopChokeLine + endif + + if ( RAM(RNUMBER)%vdis_tot>NeededVolumeChokeLine) then + + ChokeLine_closed=1 + pram_reg=pram_reg+RAMS%minloss(RNUMBER,17) + p_acc= RAM(RNUMBER)%p_acccheck + + if (ChokeLineIsClosing) then + IDChokeLine=max(ODDrillpipe_inChokeLine,ODDrillpipe_inChokeLineBase) + ChokeLineCloseLED = LedOn + ChokeLineCloseLEDMine = LedOn + ChokeLineOpenLED = LedOff + ChokeLineOpenLEDMine = LedOff + CALL CloseChokeLine + endif + + if (ChokeLineIsOpening) then + IDChokeLine=IDChokeLineBase + ChokeLineOpenLED = LedOn + ChokeLineOpenLEDMine = LedOn + ChokeLineCloseLED = LedOff + ChokeLineCloseLEDMine = LedOff + CALL OpenChokeLine + endif + + endif + +endif + + + +if (ramtype==5) then !for Kill Line + if (KillLineIsClosing) then + IDKillLine=(2.*(NeededVolumeKillLine- RAM(RNUMBER)%vdis_tot)*231./AbopKillLine)+max(ODDrillpipe_inKillLine,ODDrillpipe_inKillLineBase) + endif + + if (KillLineIsOpening) then + IDKillLine=IDKillLineBase-2.*(NeededVolumeKillLine- RAM(RNUMBER)%vdis_tot)*231./AbopKillLine + endif + + if ( RAM(RNUMBER)%vdis_tot>NeededVolumeKillLine) then + + KillLine_closed=1 + pram_reg=pram_reg+RAMS%minloss(RNUMBER,17) + p_acc= RAM(RNUMBER)%p_acccheck + + if (KillLineIsClosing) then + IDKillLine=max(ODDrillpipe_inKillLine,ODDrillpipe_inKillLineBase) + KillLineCloseLed = LedOn + KillLineCloseLedMine = LedOn + KillLineOpenLed = LedOff + KillLineOpenLedMine = LedOff + CALL CloseKillLine + endif + + if (KillLineIsOpening) then + IDKillLine=IDKillLineBase + KillLineOpenLed = LedOn + KillLineOpenLedMine = LedOn + KillLineCloseLed = LedOff + KillLineCloseLedMine = LedOff + CALL OpenKillLine + endif + + endif + +endif + + + + +!if (ramtype==4) then !for annular +! if (AnnularIsClosing) then +! IDAnnular=((NeededVolumeAnnular-vdis_tot)*231./AbopAnnular)+ODDrillpipe_inAnnular +! endif +! +! if (AnnularIsOpening) then +! IDAnnular=IDAnnularBase-(NeededVolumeAnnular-vdis_tot)*231./AbopAnnular +! endif +! +! if (vdis_tot>NeededVolumeAnnular) then +! +! Annular_closed=1 +! p_acc= RAM(RNUMBER)%p_acccheck +! +! if (AnnularIsClosing) then +! IDAnnular=ODDrillpipe_inAnnular +! AnnularCloseLed = LedOn +! AnnularOpenLed = LedOff +! endif +! +! if (AnnularIsOpening) then +! IDAnnular=IDAnnularBase +! AnnularOpenLed = LedOn +! AnnularCloseLed = LedOff +! endif +! +! endif +! +!endif + + + end + + + + SUBROUTINE bop_codeAnnular(RNUMBER) + + USE VARIABLES + USE CBopControlPanelVariables + USE CEquipmentsConstants + USE TD_GeneralData +implicit none +INTEGER RNUMBER, I + + + !Pannular_regset=min(AnnularRegulatorSetControl,1700.) ! for changing its set conditions instantaneously + +!==================================================== +! BOP back pressure without DP +!==================================================== +!if (bop_type==3) then + !p_annular=510.725-(30.145*IDAnnular) + p_annular=448-(19.7*IDAnnular) +! Q=flow +! endif + + + + RAM(RNUMBER)%clock=0 +!======================Losses============================ + RAM(RNUMBER)%loss_after=0 !initial value + RAM(RNUMBER)%diffp_ram=1000 !initial value + RAM(RNUMBER)%loss_before=0 + +!Q=0.0055; %initial flow rate (m^3/s) + + RAM(RNUMBER)%Q=RAM(RNUMBER)%flow + +!write(*,*) 'Q1=' , Q +!write(*,*) 'tol=' , tol +do while (abs( RAM(RNUMBER)%diffp_ram- RAM(RNUMBER)%loss_after)/ RAM(RNUMBER)%diffp_ram>tolAnnular) + if (RAM(RNUMBER)%Bottles_Charged_MalfActive==.true.) exit +! while abs( RAM(RNUMBER)%diffp_ram- RAM(RNUMBER)%loss_after)>10 + RAM(RNUMBER)%clock= RAM(RNUMBER)%clock+1 + +if ( RAM(RNUMBER)%clock>20) then +! tclock=clock + tolAnnular=tolzeroAnnular+(floor( RAM(RNUMBER)%clock/10)-1)*.001 +endif + ! if (clock==1) continue + + if ( RAM(RNUMBER)%clock/=1 .and. RAM(RNUMBER)%loss_after> RAM(RNUMBER)%diffp_ram) then + RAM(RNUMBER)%Q=RAM(RNUMBER)%Q-.1 + elseif ( RAM(RNUMBER)%clock/=1 .and. RAM(RNUMBER)%loss_after<= RAM(RNUMBER)%diffp_ram) then + RAM(RNUMBER)%Q=RAM(RNUMBER)%Q+.01 + + endif + +!====================Before Regulator========================= +do i=1,NO_PipingsAnnularLine +Re_ANNULARline(i)=RAM(RNUMBER)%Q*6.30902e-5*DIAM_ANNULARLINE_INCH(i)*0.0254/(AREA_ANNULARLINE(i)*nu) + +enddo + + + +do i=1,NO_PipingsAnnularLine + if (Re_ANNULARline(i)= int(2.5/DeltaT_BOP) ) then + !return + + RAM(2)%First_OpenTimecheck= 1 + + UpperRamsCloseLed = LedOff !new + UpperRamsCloseLedMine = LedOff !new + UpperRamsOpenLED = LedOn !LedBlinking + + RAM(2)%FourwayValve = 1 + + endif + + endif + + if (RAM(2)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then ! 1: Open , 0: Close + !write(*,*) 'open 2' + + RAM(2)%FourwayValve = 0 + + + PipeRam1_closed=0 + !PipeRam1_closed_withPossibility= PipeRam1_closed * TD_BOPConnectionPossibility(2) + RAM(2)%vdis_tot=0 + RAM(2)%vdis_bottles=0. + RAM(2)%fvr_air=0. + RAM(2)%vdis_elecp=0. + Qiter=7 + RAM(2)%Qzero=70 + RAM(2)%Q=RAM(2)%Qzero + RAM(2)%flow=70 + RAM(2)%tol=0.0037 + + + + if (finished_pipe1==1) then + PipeRams1LeverOld=1.0 + else + PipeRams1LeverOld=UpperRamsValve + endif + finished_pipe1=0 + PipeRam1IsOpening = .true. + PipeRam1IsClosing = .false. + + + !if (UpperRamsOpenLED == LedOn) then + ! RETURN + !end if + + + + RAM(2)%bop_type = 3 + !AbopPipeRam=186.5 + AbopPipeRam=(UpperRamOpen*231)/((IDPipeRamBase-ODDrillpipe_inPipeRam1Base)/2.) + NeededVolumePipeRams1=AbopPipeRam*(IDPipeRamBase-max(ODDrillpipe_inPipeRam1,ODDrillpipe_inPipeRam1Base))/(2.*231) !3.48 galon for each BOP + endif + +!===================================================================== + +if (PipeRam1IsOpening .or. PipeRam1IsClosing .or. RAM(2)%Bottles_Charged_MalfActive) then + CALL PIPE_RAMS1_SUB +end if + + + END SUBROUTINE PIPE_RAMS1 + + + + + + + + + + + +SUBROUTINE PIPE_RAMS1_SUB + + USE VARIABLES + USE CBopStackVariables + USE CBopControlPanelVariables + USE CEquipmentsConstants + USE CSimulationVariables + implicit none + + + FirstSet= 0 + RamsFirstSet= 0 + + loop3: do while (finished_pipe1==0) + + + RAM(2)%SuccessionCounter = RAM(2)%SuccessionCounter + 1 + + + if (UpperRamsValve == 1.0 .and. PipeRams1LeverOld == -1.0 .and. UpperRamsFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1) then + + + + if ( RAM(2)%First_CloseTimecheck == 0 ) then + + + if ( RAM(2)%SuccessionCounter /= RAM(2)%SuccessionCounterOld+1 ) then + RAM(2)%SuccessionCounter = 0 ! also in starup + RAM(2)%SuccessionCounterOld = 0 ! also in starup + !return + else + RAM(2)%SuccessionCounterOld= RAM(2)%SuccessionCounter + endif + + + + if ( RAM(2)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then + !return + + UpperRamsOpenLED = LedOff + UpperRamsOpenLEDMine = LedOff + UpperRamsCloseLED = LedOn !LedBlinking + + RAM(2)%FourwayValve = 1 + + endif + + endif + + endif + + if (RAM(2)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then + !write(*,*) 'close 4' + + RAM(2)%FourwayValve = 0 + + + PipeRam1_closed=0 + !PipeRam1_closed_withPossibility= PipeRam1_closed * TD_BOPConnectionPossibility(2) ! for TD code + CALL OpenUpperRams ! for C code + PipeRam1_Situation_forTD= 0 ! open - for TD code + RAM(2)%p_bop=pa + PipeRams1LeverOld = UpperRamsValve + + + RAM(2)%bop_type = 3 + !AbopPipeRam=196.67 + AbopPipeRam=(UpperRamClose*231)/((IDPipeRamBase-ODDrillpipe_inPipeRam1Base)/2.) + !write(*,*) 'NeededVolumeShearRams1=',NeededVolumeShearRams + NeededVolumePipeRams1=AbopPipeRam*(IDPipeRam1-max(ODDrillpipe_inPipeRam1,ODDrillpipe_inPipeRam1Base))/(2.*231) + ! write(*,*) 'NeededVolumeShearRams2=',NeededVolumeShearRams + + RAM(2)%vdis_bottles=0. + RAM(2)%fvr_air=0. + RAM(2)%vdis_elecp=0. + PipeRam1IsClosing = .true. + PipeRam1IsOpening = .false. + endif + + if (UpperRamsValve == -1.0 .and. PipeRams1LeverOld == 1.0 .and. UpperRamsFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1) then + + + if ( RAM(2)%First_OpenTimecheck == 0 ) then + + if ( RAM(2)%SuccessionCounter /= RAM(2)%SuccessionCounterOld+1 ) then + RAM(2)%SuccessionCounter = 0 ! also in starup + RAM(2)%SuccessionCounterOld = 0 ! also in starup + !return + else + RAM(2)%SuccessionCounterOld= RAM(2)%SuccessionCounter + endif + + if ( RAM(2)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then + !return + + UpperRamsCloseLED = LedOff + UpperRamsCloseLEDMine = LedOff + UpperRamsOpenLED = LedOn !LedBlinking + + RAM(2)%FourwayValve = 1 + + + endif + + endif + + endif + + if (RAM(2)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then + !write(*,*) 'open 4' + + RAM(2)%FourwayValve = 0 + + + + PipeRam1_closed=0 + !PipeRam1_closed_withPossibility= PipeRam1_closed * TD_BOPConnectionPossibility(2) + CALL OpenUpperRams + PipeRam1_Situation_forTD= 0 ! open - for TD code + RAM(2)%p_bop=pa + PipeRams1LeverOld = UpperRamsValve + + RAM(2)%bop_type = 3 + !AbopPipeRam=186.5 + AbopPipeRam=(UpperRamOpen*231)/((IDPipeRamBase-ODDrillpipe_inPipeRam1Base)/2.) + NeededVolumePipeRams1=AbopPipeRam*(IDPipeRamBase-IDPipeRam1)/(2.*231) + RAM(2)%vdis_bottles=0. + RAM(2)%fvr_air=0. + RAM(2)%vdis_elecp=0. + + PipeRam1IsOpening = .true. + PipeRam1IsClosing = .false. + endif + + + RAM(2)%First_CloseTimecheck = 0 + RAM(2)%First_OpenTimecheck = 0 + + + RAM(2)%time=RAM(2)%time+DeltaT_BOP !overal time (s) + + + +!=================================================== +! BOP +!=================================================== +if (PipeRam1_closed==0) then !bop closing + call bop_code(2,H_PipeRam1Bop,2) !ramtype=2 2=RNUMBER +endif !bop is closing +!================================================================ +if (PipeRam1_closed==1) then + RAM(2)%Q=0 + !p_bop=pram_reg + RAM(2)%p_bop=pa + RAMS%minloss(2,17)=0. !RNUMBER=2 +endif + +RAM(2)%timecounter_ram=RAM(2)%timecounter_ram+1 + + + + + +! MiddleRamsStatus = IDshearBop +! UpperRamsStatus = IDPipeRam1 +! LowerRamsStatus = IDPipeRam2 +! AnnularStatus = IDAnnular +! AccumulatorPressureGauge = p_acc +! ManifoldPressureGauge= pram_reg +! AnnularPressureGauge=Pannular_reg +! +! +! +! WRITE(60,60) RAM(2)%time,RAM(2)%Q,RAM(2)%vdis_tot,p_acc, & +! pram_reg,Pannular_reg,RAM(2)%p_bop,IDshearBop, & +! IDPipeRam1,IDPipeRam2,IDAnnular +!60 FORMAT(11(f18.5)) + + + call sleepqq(100) + +if (PipeRam1_closed==1) then + ! if ((MiddleRamsValve==1. .and. MiddleRamsFailureMalf==0) .or. (MiddleRamsValve==-1.0 .and. MiddleRamsFailureMalf==0) .or. (LowerRamsValve==1. .and. LowerRamsFailureMalf==0) .or. (LowerRamsValve==-1.0 .and. LowerRamsFailureMalf==0) .or. (AnnularValve==1. .and. AnnularFailureMalf==0) .or. (AnnularValve==-1.0 .and. AnnularFailureMalf==0) .or. ChokeLineValve==1. .or. ChokeLineValve==-1.0 .or. KillLineValve==1. .or. KillLineValve==-1.0) then + finished_pipe1=1 + ! endif +endif + + if (IsStopped == .true.) return + + end do loop3 !while finished_pipe1==0 + + + + + + + if ( finished_pipe1==1 .and. RAM(2)%Bottles_Charged_MalfActive==.true.) then + call bop_code(2,H_PipeRam1Bop,2) !ramtype=2 2=RNUMBER + call sleepqq(100) + endif + + + + + + +END SUBROUTINE PIPE_RAMS1_SUB \ No newline at end of file diff --git a/Equipments/BopStack/PIPE_RAM2.f90 b/Equipments/BopStack/PIPE_RAM2.f90 new file mode 100644 index 0000000..c26b1f4 --- /dev/null +++ b/Equipments/BopStack/PIPE_RAM2.f90 @@ -0,0 +1,397 @@ + + +SUBROUTINE PIPE_RAMS2 + USE VARIABLES + USE CBopStackVariables + USE CBopControlPanelVariables + USE CEquipmentsConstants + ! USE CSimulationVariables + implicit none + + + !write(*,*) 'checkpoint 1' + +!===================================================================== +! PIPE RAMS 2- BOP CAMERON Type U 5000 +! START CONDITIONS FOR PIPE RAMS 2 +!===================================================================== + RAM(3)%SuccessionCounter = RAM(3)%SuccessionCounter + 1 + + + if (LowerRamsValve == 1.0 .and. LowerRamsFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1) then + !write(*,*) 'close 1' + + + if (LowerRamsCloseLEDMine == LedOn) then + RETURN + end if + + + if ( RAM(3)%SuccessionCounter /= RAM(3)%SuccessionCounterOld+1 ) then + RAM(3)%SuccessionCounter = 0 ! also in starup + RAM(3)%SuccessionCounterOld = 0 ! also in starup + !return + else + RAM(3)%SuccessionCounterOld= RAM(3)%SuccessionCounter + endif + + + if ( RAM(3)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then + !return + + RAM(3)%First_CloseTimecheck= 1 + + LowerRamsOpenLED = LedOff + LowerRamsOpenLEDMine = LedOff + LowerRamsCloseLED = LedOn !LedBlinking + + RAM(3)%FourwayValve = 1 + + endif + + + endif + + + + if (RAM(3)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then ! 1: Open , 0: Close + !write(*,*) 'close 2' + + + + RAM(3)%FourwayValve = 0 + + PipeRam2_closed=0 + !PipeRam2_closed_withPossibility= PipeRam2_closed * TD_BOPConnectionPossibility(4) + RAM(3)%vdis_tot=0 + RAM(3)%vdis_bottles=0. + RAM(3)%fvr_air=0. + RAM(3)%vdis_elecp=0. + Qiter=7 + RAM(3)%Qzero=70 + RAM(3)%Q=RAM(3)%Qzero + RAM(3)%flow=70 + RAM(3)%tol=0.0037 + if (finished_pipe2==1) then + PipeRams2LeverOld=-1.0 + else + PipeRams2LeverOld=LowerRamsValve + endif + finished_pipe2=0 + PipeRam2IsClosing = .true. + PipeRam2IsOpening = .false. + + + RAM(3)%bop_type = 3 + !AbopPipeRam=196.67 + AbopPipeRam=(LowerRamClose*231)/((IDPipeRamBase-ODDrillpipe_inPipeRam1Base)/2.) + NeededVolumePipeRams2=AbopPipeRam*(IDPipeRamBase-max(ODDrillpipe_inPipeRam2,ODDrillpipe_inPipeRam1Base))/(2.*231) !galon for each BOP + !write(*,*) 'close 1' + endif + + if (LowerRamsValve == -1.0 .and. LowerRamsFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1) then + !write(*,*) 'open 1' + + if (LowerRamsOpenLEDMine == LedOn) then + RETURN + end if + + + if ( RAM(3)%SuccessionCounter /= RAM(3)%SuccessionCounterOld+1 ) then + RAM(3)%SuccessionCounter = 0 ! also in starup + RAM(3)%SuccessionCounterOld = 0 ! also in starup + !return + else + RAM(3)%SuccessionCounterOld= RAM(3)%SuccessionCounter + endif + + + if ( RAM(3)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then + !return + + RAM(3)%First_OpenTimecheck= 1 + + LowerRamsCloseLed = LedOff !new + LowerRamsCloseLedMine = LedOff !new + LowerRamsOpenLED = LedOn !LedBlinking + + RAM(3)%FourwayValve = 1 + + endif + + + endif + + + if (RAM(3)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then ! 1: Open , 0: Close + !write(*,*) 'open 2' + + RAM(3)%FourwayValve = 0 + + PipeRam2_closed=0 + !PipeRam2_closed_withPossibility= PipeRam2_closed * TD_BOPConnectionPossibility(4) + RAM(3)%vdis_tot=0 + RAM(3)%vdis_bottles=0. + RAM(3)%fvr_air=0. + RAM(3)%vdis_elecp=0. + Qiter=7 + RAM(3)%Qzero=70 + RAM(3)%Q=RAM(3)%Qzero + RAM(3)%flow=70 + RAM(3)%tol=0.0037 + + if (finished_pipe2==1) then + PipeRams2LeverOld=1.0 + else + PipeRams2LeverOld=LowerRamsValve + endif + finished_pipe2=0 + PipeRam2IsOpening = .true. + PipeRam2IsClosing = .false. + + + !if (LowerRamsOpenLED == LedOn) then + ! RETURN + !end if + + + RAM(3)%bop_type = 3 + !AbopPipeRam=186.5 + AbopPipeRam=(LowerRamOpen*231)/((IDPipeRamBase-ODDrillpipe_inPipeRam1Base)/2.) + NeededVolumePipeRams2=AbopPipeRam*(IDPipeRamBase-max(ODDrillpipe_inPipeRam2,ODDrillpipe_inPipeRam1Base))/(2.*231) !galon for each BOP + !write(*,*) 'open 1' + + endif + + +!===================================================================== + + +if (PipeRam2IsOpening .or. PipeRam2IsClosing .or. RAM(3)%Bottles_Charged_MalfActive) then + + CALL PIPE_RAMS2_SUB +end if + + + END SUBROUTINE PIPE_RAMS2 + + + + + + + + + + + + +SUBROUTINE PIPE_RAMS2_SUB + + USE VARIABLES + USE CBopStackVariables + USE CBopControlPanelVariables + USE CEquipmentsConstants + USE CSimulationVariables + implicit none + + + FirstSet= 0 + RamsFirstSet= 0 + + loop4: do while (finished_pipe2==0) + + !write(*,*) 'checkpoint 2' + + + RAM(3)%SuccessionCounter = RAM(3)%SuccessionCounter + 1 + + + if (LowerRamsValve == 1.0 .and. PipeRams2LeverOld == -1.0 .and. LowerRamsFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1) then + + !write(*,*) 'close 3' + + if ( RAM(3)%First_CloseTimecheck == 0 ) then + + + if ( RAM(3)%SuccessionCounter /= RAM(3)%SuccessionCounterOld+1 ) then + RAM(3)%SuccessionCounter = 0 ! also in starup + RAM(3)%SuccessionCounterOld = 0 ! also in starup + !return + else + RAM(3)%SuccessionCounterOld= RAM(3)%SuccessionCounter + endif + + + + if ( RAM(3)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then + !return + + LowerRamsOpenLED = LedOff + LowerRamsOpenLEDMine = LedOff + LowerRamsCloseLED = LedOn !LedBlinking + + RAM(3)%FourwayValve = 1 + + endif + + endif + + + + + endif + + if (RAM(3)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then + !write(*,*) 'close 4' + + RAM(3)%FourwayValve = 0 + + + PipeRam2_closed=0 + !PipeRam2_closed_withPossibility= PipeRam2_closed * TD_BOPConnectionPossibility(4) + RAM(3)%p_bop=pa + PipeRams2LeverOld = LowerRamsValve + + CALL OpenLowerRams + PipeRam2_Situation_forTD= 0 ! open - for TD code + RAM(3)%bop_type = 3 + !AbopPipeRam=196.67 + AbopPipeRam=(LowerRamClose*231)/((IDPipeRamBase-ODDrillpipe_inPipeRam1Base)/2.) + NeededVolumePipeRams2=AbopPipeRam*(IDPipeRam2-max(ODDrillpipe_inPipeRam2,ODDrillpipe_inPipeRam1Base))/(2.*231) + + RAM(3)%vdis_bottles=0. + RAM(3)%fvr_air=0. + RAM(3)%vdis_elecp=0. + PipeRam2IsClosing = .true. + PipeRam2IsOpening = .false. + !write(*,*) 'close 2' + + endif + + if (LowerRamsValve == -1.0 .and. PipeRams2LeverOld == 1.0 .and. LowerRamsFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1) then + !write(*,*) 'open 3' + + + if ( RAM(3)%First_OpenTimecheck == 0 ) then + + if ( RAM(3)%SuccessionCounter /= RAM(3)%SuccessionCounterOld+1 ) then + RAM(3)%SuccessionCounter = 0 ! also in starup + RAM(3)%SuccessionCounterOld = 0 ! also in starup + !return + else + RAM(3)%SuccessionCounterOld= RAM(3)%SuccessionCounter + endif + + if ( RAM(3)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then + !return + + LowerRamsCloseLED = LedOff + LowerRamsCloseLEDMine = LedOff + LowerRamsOpenLED = LedOn !LedBlinking + + RAM(3)%FourwayValve = 1 + + endif + + endif + + + endif + + + if (RAM(3)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then + !write(*,*) 'open 4' + + RAM(3)%FourwayValve = 0 + + PipeRam2_closed=0 + !PipeRam2_closed_withPossibility= PipeRam2_closed * TD_BOPConnectionPossibility(4) + RAM(3)%p_bop=pa + PipeRams2LeverOld = LowerRamsValve + + CALL OpenLowerRams + PipeRam2_Situation_forTD= 0 ! open - for TD code + RAM(3)%bop_type = 3 + !AbopPipeRam=186.5 + AbopPipeRam=(LowerRamOpen*231)/((IDPipeRamBase-ODDrillpipe_inPipeRam1Base)/2.) + NeededVolumePipeRams2=AbopPipeRam*(IDPipeRamBase-IDPipeRam2)/(2.*231) + RAM(3)%vdis_bottles=0. + RAM(3)%fvr_air=0. + RAM(3)%vdis_elecp=0. + + PipeRam2IsOpening = .true. + PipeRam2IsClosing = .false. + !write(*,*) 'open 2' + + endif + + + RAM(3)%First_CloseTimecheck = 0 + RAM(3)%First_OpenTimecheck = 0 + + + RAM(3)%time=RAM(3)%time+DeltaT_BOP !overal time (s) + + + +!=================================================== +! BOP +!=================================================== +if (PipeRam2_closed==0) then !bop closing +!write(*,*) 'BOP code is called' + call bop_code(3,H_PipeRam2Bop,3) !ramtype=3 3=RNUMBER +endif !bop is closing +!================================================================ +if (PipeRam2_closed==1) then + RAM(3)%Q=0 + !p_bop=pram_reg + RAM(3)%p_bop=pa + RAMS%minloss(3,17)=0. !RNUMBER=3 +endif + +RAM(3)%timecounter_ram=RAM(3)%timecounter_ram+1 + + + + + +! MiddleRamsStatus = IDshearBop +! UpperRamsStatus = IDPipeRam1 +! LowerRamsStatus = IDPipeRam2 +! AnnularStatus = IDAnnular +! AccumulatorPressureGauge = p_acc +! ManifoldPressureGauge= pram_reg +! AnnularPressureGauge=Pannular_reg +! +! +! +! WRITE(60,60) RAM(3)%time,RAM(3)%Q,RAM(3)%vdis_tot,p_acc, & +! pram_reg,Pannular_reg,RAM(3)%p_bop,IDshearBop, & +! IDPipeRam1,IDPipeRam2,IDAnnular +!60 FORMAT(11(f18.5)) + + + call sleepqq(100) + +if (PipeRam2_closed==1) then + +! if ((MiddleRamsValve==1. .and. MiddleRamsFailureMalf==0) .or. (MiddleRamsValve==-1.0 .and. MiddleRamsFailureMalf==0) .or. (UpperRamsValve==1. .and. UpperRamsFailureMalf==0) .or. (UpperRamsValve==-1.0 .and. UpperRamsFailureMalf==0) .or. (AnnularValve==1. .and. AnnularFailureMalf==0) .or. (AnnularValve==-1.0 .and. AnnularFailureMalf==0) .or. ChokeLineValve==1. .or. ChokeLineValve==-1.0 .or. KillLineValve==1. .or. KillLineValve==-1.0) then + finished_pipe2=1 +! endif +endif + + if (IsStopped == .true.) return + + + end do loop4 !while finished_pipe2==0 + + if ( finished_pipe2==1 .and. RAM(3)%Bottles_Charged_MalfActive==.true.) then + call bop_code(3,H_PipeRam2Bop,3) !ramtype=3 3=RNUMBER + call sleepqq(100) + endif + + + + +END SUBROUTINE PIPE_RAMS2_SUB \ No newline at end of file diff --git a/Equipments/BopStack/PipeRams1Main.f90 b/Equipments/BopStack/PipeRams1Main.f90 new file mode 100644 index 0000000..474bfa4 --- /dev/null +++ b/Equipments/BopStack/PipeRams1Main.f90 @@ -0,0 +1,68 @@ +module PipeRams1Main + implicit none + public + contains + + subroutine PipeRams1_Setup() + use CSimulationVariables + implicit none + call OnSimulationInitialization%Add(PipeRams1_Init) + call OnSimulationStop%Add(PipeRams1_Init) + call OnPipeRams1Step%Add(PipeRams1_Step) + call OnPipeRams1Output%Add(PipeRams1_Output) + call OnPipeRams1Main%Add(PipeRams1MainBody) + end subroutine + + subroutine PipeRams1_Init + implicit none + end subroutine PipeRams1_Init + + subroutine PipeRams1_Step + CALL PIPE_RAMS1 + end subroutine PipeRams1_Step + + subroutine PipeRams1_Output + + end subroutine PipeRams1_Output + + subroutine PipeRams1MainBody + + USE ifport + USE ifmt + USE CSimulationVariables + ! USE BOP + + implicit none + + INTEGER :: PipeRam1Duration + integer,dimension(8) :: PipeRam1StartTime , PipeRam1EndTime + + ! CALL BOP_StartUp() + loop1: DO + + CALL DATE_AND_TIME(values=PipeRam1StartTime) + CALL PIPE_RAMS1 + CALL DATE_AND_TIME(values=PipeRam1EndTime) + + PipeRam1Duration = 3600000 * (PipeRam1EndTime(5) - PipeRam1StartTime(5)) + 60000 * (PipeRam1EndTime(6) - PipeRam1StartTime(6)) + 1000 * (PipeRam1EndTime(7) - PipeRam1StartTime(7)) + (PipeRam1EndTime(8) - PipeRam1StartTime(8)) + + if (PipeRam1Duration < 100) then + call sleepqq(100 - PipeRam1Duration) + ELSE + WRITE (*,*) 'PipeRam1 BOP run duration exceeded 100 ms and =', PipeRam1Duration + end if + + + IF (IsStopped==.true.) THEN + EXIT loop1 + ENDIF + + + ENDDO loop1 + + + ! CALL DEALLOCATE_ARRAYS() + + end subroutine PipeRams1MainBody + +end module PipeRams1Main \ No newline at end of file diff --git a/Equipments/BopStack/PipeRams2Main.f90 b/Equipments/BopStack/PipeRams2Main.f90 new file mode 100644 index 0000000..6056832 --- /dev/null +++ b/Equipments/BopStack/PipeRams2Main.f90 @@ -0,0 +1,68 @@ + + module PipeRams2Main + implicit none + public + contains + + subroutine PipeRams2_Setup() + use CSimulationVariables + implicit none + call OnSimulationInitialization%Add(PipeRams2_Init) + call OnSimulationStop%Add(PipeRams2_Init) + call OnPipeRams2Step%Add(PipeRams2_Step) + call OnPipeRams2Output%Add(PipeRams2_Output) + call OnPipeRams2Main%Add(PipeRams2MainBody) + end subroutine + + subroutine PipeRams2_Init + implicit none + end subroutine PipeRams2_Init + + subroutine PipeRams2_Step + CALL PIPE_RAMS2 + end subroutine PipeRams2_Step + + subroutine PipeRams2_Output + implicit none + end subroutine PipeRams2_Output + + subroutine PipeRams2MainBody + USE ifport + USE ifmt + USE CSimulationVariables + ! USE BOP + implicit none + + INTEGER :: PipeRam2Duration + integer,dimension(8) :: PipeRam2StartTime , PipeRam2EndTime + + ! CALL BOP_StartUp() + loop1: DO + + CALL DATE_AND_TIME(values=PipeRam2StartTime) + + + CALL PIPE_RAMS2 + + CALL DATE_AND_TIME(values=PipeRam2EndTime) + + PipeRam2Duration = 3600000 * (PipeRam2EndTime(5) - PipeRam2StartTime(5)) + 60000 * (PipeRam2EndTime(6) - PipeRam2StartTime(6)) + 1000 * (PipeRam2EndTime(7) - PipeRam2StartTime(7)) + (PipeRam2EndTime(8) - PipeRam2StartTime(8)) + + if (PipeRam2Duration < 100) then + call sleepqq(100 - PipeRam2Duration) + ELSE + WRITE (*,*) 'PipeRam2 BOP run duration exceeded 100 ms and =', PipeRam2Duration + end if + + IF (IsStopped==.true.) THEN + EXIT loop1 + ENDIF + + + ENDDO loop1 + + + ! CALL DEALLOCATE_ARRAYS() + end subroutine PipeRams2MainBody + +end module PipeRams2Main \ No newline at end of file diff --git a/Equipments/BopStack/SHEAR_RAM.f90 b/Equipments/BopStack/SHEAR_RAM.f90 new file mode 100644 index 0000000..418f3cc --- /dev/null +++ b/Equipments/BopStack/SHEAR_RAM.f90 @@ -0,0 +1,396 @@ + +SUBROUTINE SHEAR_RAMS + USE VARIABLES + USE CBopStackVariables + USE CBopControlPanelVariables + USE CEquipmentsConstants + USE CSimulationVariables + implicit none + + + +!===================================================================== +! SHEAR RAMS- BOP CAMERON Type U 5000 +! START CONDITIONS FOR SHEAR RAMS +!===================================================================== + + RAM(4)%SuccessionCounter = RAM(4)%SuccessionCounter + 1 + + + if (MiddleRamsValve == 1.0 .and. MiddleRamsFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1) then + + if (MiddleRamsCloseLEDMine == LedOn) then + RETURN + end if + + + if ( RAM(4)%SuccessionCounter /= RAM(4)%SuccessionCounterOld+1 ) then + RAM(4)%SuccessionCounter = 0 ! also in starup + RAM(4)%SuccessionCounterOld = 0 ! also in starup + !return + else + RAM(4)%SuccessionCounterOld= RAM(4)%SuccessionCounter + endif + + + if ( RAM(4)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then + !return + + RAM(4)%First_CloseTimecheck= 1 + + MiddleRamsOpenLED = LedOff + MiddleRamsOpenLEDMine = LedOff + MiddleRamsCloseLED = LedOn !LedBlinking + + RAM(4)%FourwayValve = 1 + + endif + + endif + + + if (RAM(4)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then ! 1: Open , 0: Close + !write(*,*) 'close 2' + + RAM(4)%FourwayValve = 0 + + + ShearBop_closed=0 + !ShearBop_closed_withPossibility= ShearBop_closed * TD_BOPConnectionPossibility(3) + RAM(4)%vdis_tot=0 + RAM(4)%vdis_bottles=0. + RAM(4)%fvr_air=0. + RAM(4)%vdis_elecp=0. + Qiter=7 + RAM(4)%Qzero=70 + RAM(4)%Q=RAM(4)%Qzero + RAM(4)%flow=70 + RAM(4)%tol=0.0037 + + + if (finished_shear==1) then + ShearRamsLeverOld=-1.0 + else + ShearRamsLeverOld=MiddleRamsValve + endif + finished_shear=0 + ShearRamIsClosing = .true. + ShearRamIsOpening = .false. + + RAM(4)%bop_type = 2 + !NeededVolumeShearRams=5.8 !galon for each BOP + !AbopShearRam=196.67 !(in^2) + AbopShearRam=(BlindRamClose*231)/(IDshearBopBase/2.) + !NeededVolumeShearRams=BlindRamClose !galon for each BOP **changed + NeededVolumeShearRams=AbopShearRam*(IDshearBopBase-ShearIsNotAllowed*ODDrillpipe_inShearRam)/(2.*231) !3.67 galon for each BOP ! **changed + va=AbopShearRam*(IDshearBopBase-ODDrillpipe_inShearRam)/(2.*231) + vb=NeededVolumeShearRams + endif + + if (MiddleRamsValve == -1.0 .and. MiddleRamsFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1) then + + if (MiddleRamsOpenLEDMine == LedOn) then + RETURN + end if + + if ( RAM(4)%SuccessionCounter /= RAM(4)%SuccessionCounterOld+1 ) then + RAM(4)%SuccessionCounter = 0 ! also in starup + RAM(4)%SuccessionCounterOld = 0 ! also in starup + !return + else + RAM(4)%SuccessionCounterOld= RAM(4)%SuccessionCounter + endif + + + if ( RAM(4)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then + !return + + RAM(4)%First_OpenTimecheck= 1 + + MiddleRamsCloseLed = LedOff !new + MiddleRamsCloseLedMine = LedOff !new + MiddleRamsOpenLED = LedOn !LedBlinking + + endif + + endif + + + if (RAM(4)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then ! 1: Open , 0: Close + !write(*,*) 'open 2' + + RAM(4)%FourwayValve = 0 + + + + ShearBop_closed=0 + !ShearBop_closed_withPossibility= ShearBop_closed * TD_BOPConnectionPossibility(3) + RAM(4)%vdis_tot=0 + RAM(4)%vdis_bottles=0. + RAM(4)%fvr_air=0. + RAM(4)%vdis_elecp=0. + Qiter=7 + RAM(4)%Qzero=70 + RAM(4)%Q=RAM(4)%Qzero + RAM(4)%flow=70 + RAM(4)%tol=0.0037 + + + if (finished_shear==1) then + ShearRamsLeverOld=1.0 + else + ShearRamsLeverOld=MiddleRamsValve + endif + finished_shear=0 + ShearRamIsOpening = .true. + ShearRamIsClosing = .false. + + + !if (MiddleRamsOpenLED == LedOn) then + ! RETURN + !end if + + + + RAM(4)%bop_type = 3 + !AbopShearRam=186.5 !(in^2) + AbopShearRam=(BlindRamOpen*231)/(IDshearBopBase/2.) + !NeededVolumeShearRams=5.5 !galon for each BOP + !NeededVolumeShearRams=BlindRamOpen ! **changed + NeededVolumeShearRams=AbopShearRam*(IDshearBopBase-ShearIsNotAllowed*ODDrillpipe_inShearRam)/(2.*231) !3.67 galon for each BOP ! **changed + !va=AbopShearRam*(IDshearBopBase-ODDrillpipe_inShearRam)/(2.*231) + !vb=NeededVolumeShearRams + endif + + +!===================================================================== + + +if (ShearRamIsOpening .or. ShearRamIsClosing .or. RAM(4)%Bottles_Charged_MalfActive) then + CALL SHEAR_RAMS_SUB +end if + + + END SUBROUTINE SHEAR_RAMS + + + + + +SUBROUTINE SHEAR_RAMS_SUB + USE VARIABLES + USE CBopStackVariables + USE CBopControlPanelVariables + USE CEquipmentsConstants + USE CSimulationVariables + implicit none + + + FirstSet= 0 + RamsFirstSet= 0 + + loop2: do while (finished_shear==0) + + RAM(4)%SuccessionCounter = RAM(4)%SuccessionCounter + 1 + + + + if (MiddleRamsValve == 1.0 .and. ShearRamsLeverOld == -1.0 .and. MiddleRamsFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1) then + + + if ( RAM(4)%First_CloseTimecheck == 0 ) then + + + if ( RAM(4)%SuccessionCounter /= RAM(4)%SuccessionCounterOld+1 ) then + RAM(4)%SuccessionCounter = 0 ! also in starup + RAM(4)%SuccessionCounterOld = 0 ! also in starup + !return + else + RAM(4)%SuccessionCounterOld= RAM(4)%SuccessionCounter + endif + + + + if ( RAM(4)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then + !return + + MiddleRamsOpenLED = LedOff + MiddleRamsOpenLEDMine = LedOff + MiddleRamsCloseLED = LedOn !LedBlinking + + RAM(4)%FourwayValve = 1 + + endif + + endif + + endif + + + if (RAM(4)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then + !write(*,*) 'close 4' + + RAM(4)%FourwayValve = 0 + + + + + ShearBop_closed=0 + !ShearBop_closed_withPossibility= ShearBop_closed * TD_BOPConnectionPossibility(3) + RAM(4)%p_bop=pa + ShearRamsLeverOld = MiddleRamsValve + + CALL OpenMiddleRams ! for C code + ShearBop_Situation_forTD= 0 ! open - for TD code + + RAM(4)%bop_type = 2 + !AbopShearRam=196.67 + AbopShearRam=(BlindRamClose*231)/(IDshearBopBase/2.) + !NeededVolumeShearRams=AbopShearRam*IDshearBop/(2.*231) ! **changed + NeededVolumeShearRams=AbopShearRam*(IDshearBop-ShearIsNotAllowed*ODDrillpipe_inShearRam)/(2.*231) ! **changed + + + RAM(4)%vdis_bottles=0. + RAM(4)%fvr_air=0. + RAM(4)%vdis_elecp=0. + ShearRamIsClosing = .true. + ShearRamIsOpening = .false. + endif + + if (MiddleRamsValve == -1.0 .and. ShearRamsLeverOld == 1.0 .and. MiddleRamsFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1) then + + + if ( RAM(4)%First_OpenTimecheck == 0 ) then + + if ( RAM(4)%SuccessionCounter /= RAM(4)%SuccessionCounterOld+1 ) then + RAM(4)%SuccessionCounter = 0 ! also in starup + RAM(4)%SuccessionCounterOld = 0 ! also in starup + !return + else + RAM(4)%SuccessionCounterOld= RAM(4)%SuccessionCounter + endif + + if ( RAM(4)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then + !return + + MiddleRamsCloseLED = LedOff + MiddleRamsCloseLEDMine = LedOff + MiddleRamsOpenLED = LedOn !LedBlinking + + RAM(4)%FourwayValve = 1 + + endif + + endif + + endif + + if (RAM(4)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then + !write(*,*) 'open 4' + + RAM(4)%FourwayValve = 0 + + + ShearBop_closed=0 + !ShearBop_closed_withPossibility= ShearBop_closed * TD_BOPConnectionPossibility(3) + RAM(4)%p_bop=pa + ShearRamsLeverOld = MiddleRamsValve + + CALL OpenMiddleRams + ShearBop_Situation_forTD= 0 ! open - for TD code + RAM(4)%bop_type = 3 + !AbopShearRam=186.5 + NeededVolumeShearRams=AbopShearRam*(IDshearBopBase-IDshearBop)/(2.*231) + RAM(4)%vdis_bottles=0. + RAM(4)%fvr_air=0. + RAM(4)%vdis_elecp=0. + + ShearRamIsOpening = .true. + ShearRamIsClosing = .false. + endif + + + RAM(4)%First_CloseTimecheck = 0 + RAM(4)%First_OpenTimecheck = 0 + + + RAM(4)%time=RAM(4)%time+DeltaT_BOP !overal time (s) + + + + +!=================================================== +! BOP +!=================================================== +if (ShearBop_closed==0) then !bop closing + call bop_code(1,H_ShearRamBop,4) !ramtype=1 4=RNUMBER +endif !bop is closing +!================================================================ +if (ShearBop_closed==1) then + RAM(4)%Q=0 + ! p_bop=pram_reg + RAM(4)%p_bop=pa + RAMS%minloss(4,17)=0. !RNUMBER=4 +endif + + + + +RAM(4)%timecounter_ram=RAM(4)%timecounter_ram+1 + + + + +! MiddleRamsStatus = IDshearBop +! UpperRamsStatus = IDPipeRam1 +! LowerRamsStatus = IDPipeRam2 +! AnnularStatus = IDAnnular +! AccumulatorPressureGauge = p_acc +! ManifoldPressureGauge= pram_reg +! AnnularPressureGauge=Pannular_reg +! +! +! +! WRITE(60,60) RAM(4)%time,RAM(4)%Q,RAM(4)%vdis_tot,p_acc & +! ,pram_reg,Pannular_reg,RAM(4)%p_bop,IDshearBop, & +! IDPipeRam1,IDPipeRam2,IDAnnular +!60 FORMAT(11(f18.5)) + +! + + call sleepqq(100) + +if (ShearBop_closed==1) then +! if ((UpperRamsValve==1. .and. UpperRamsFailureMalf==0) .or. (UpperRamsValve==-1.0 .and. UpperRamsFailureMalf==0) .or. (LowerRamsValve==1. .and. LowerRamsFailureMalf==0) .or. (LowerRamsValve==-1.0 .and. LowerRamsFailureMalf==0) .or. (AnnularValve==1. .and. AnnularFailureMalf==0) .or. (AnnularValve==-1.0 .and. AnnularFailureMalf==0) .or. ChokeLineValve==1. .or. ChokeLineValve==-1.0 .or. KillLineValve==1. .or. KillLineValve==-1.0) then + finished_shear=1 +! endif +endif + + if (IsStopped == .true.) return + + + end do loop2 !while finished_shear==0 + + + if ( finished_shear==1 .and. RAM(4)%Bottles_Charged_MalfActive==.true.) then + call bop_code(1,H_ShearRamBop,4) !ramtype=1 4=RNUMBER + call sleepqq(100) + endif + + + +END SUBROUTINE SHEAR_RAMS_SUB + + + + + + + + + + + + + + \ No newline at end of file diff --git a/Equipments/BopStack/VARIABLES.f90 b/Equipments/BopStack/VARIABLES.f90 new file mode 100644 index 0000000..bf10456 --- /dev/null +++ b/Equipments/BopStack/VARIABLES.f90 @@ -0,0 +1,212 @@ +MODULE VARIABLES + use DynamicDoubleArray + IMPLICIT NONE + + + + +!=========================================================================== +! INPUT VARIABLES +!=========================================================================== +REAL,ALLOCATABLE:: MINORS1(:,:),PIPINGS_RAMLINE(:,:),MINORS_ANNULAR(:,:),PIPINGS_ANNULAR(:,:),PIPINGS_AIRPUMP(:,:),MINORS_AIRPUMP(:,:) + +integer AnnularOpenLedMine,AnnularCloseLedMine,UpperRamsCloseLEDMine,UpperRamsOpenLEDMine,LowerRamsOpenLEDMine,LowerRamsCloseLEDMine +integer MiddleRamsOpenLEDMine,MiddleRamsCloseLEDMine,KillLineOpenLedMine,KillLineCloseLedMine,ChokeLineOpenLEDMine,ChokeLineCloseLEDMine +integer BOP_timeCounter +!=========================================================================== +! ACC. VARIABLES +!=========================================================================== +REAL,PARAMETER :: PI=3.141593 ,PressureDifferenceSteps = 20. ,BaseDifferenceP= 200. ! psi +REAL FVR_TOT,BOTTLE_CAPACITY,PRAMS_REGSET,acc_ChargedPressure,acc_MinPressure,ACC_PRECHARGE,ByPassOld +REAL pram_reg,test1,test2,test3,test4,test5,test6,test7,test8,test9,ax,bx +integer NOBOTTLES,AccPupmsFailMalf,AirSupplyPressureGaugeMalf,ManifoldPressureGaugeMalf,AccumulatorPressureGaugeMalf,RigAirMalf +real Cumulative_AirVolume, PressureDifference +integer SoundKoomeyAirPump +!=========================================================================== +! RAM LINE COMPUTATIONAL VARIABLES +!=========================================================================== +logical ShearRamIsClosing,ShearRamIsOpening +REAL ShearRamsLeverOld,NoActiveRmas +!REAL checkp,p_acccheck +REAL P_ACC,FVR,DeltaT_BOP +REAL diffp_air,losses_air,Qup,kinetic_air,pipe_loss1air,minor_loss1air,static_loss1air!,pipe_loss1_before,minor_loss1,static_loss1,kinetic_loss1,pipe_loss1 +!REAL loss_before,pipe_loss2,minor_loss2,deltah,static_loss2,kinetic_loss2,loss_after +integer AIRP_SWITCH,ELECP_SWITCH,ShearBop_closed,FINISHED_shear,EOF,NO_MINORSRAMLINE,NO_PIPINGSRAMLINE,NO_PIPINGS_AIRPLINE,NO_MINORS_AIRPLINE +integer counter,iteration,ShearBop_Situation_forTD +real BA1,BA2,BA3,BA4,BBA1,BBA2,BBA3,BBA4 +REAL B1,B2,B3,B4 +REAL,ALLOCATABLE:: Re_air(:),DIAM_AIR_MM(:),DIAM_AIR_INCH(:),AREA_AIR(:),REL_ROUGHAIR(:),LENGT_AIR(:),LF_AIR(:),CV_AIR(:),NOTE_AIR(:) +REAL,ALLOCATABLE:: fric_air(:),fricloss_air(:),minlosspa_air(:),minloss_air(:) +REAL,ALLOCATABLE:: MINORDIAM_AIR_INCH(:),MINORAREA_AIR(:) +REAL,ALLOCATABLE:: DIAM_RAMLINE_INCH(:),DIAM_RAMLINE_MM(:),AREA_RAMLINE(:),ROUGHNESS_AIRPLINE(:),ROUGHNESS_RAMLINE(:),RELROUGH_RAMLINE(:),LENGT_RAMLINE(:),LF_RAMLINE(:),CV_RAMLINE(:),NOTE_RAMLINE(:),AREAMINOR_RAMLINE(:) +!REAL,ALLOCATABLE:: Re_ramline(:),fric(:),fricloss(:) +REAL,ALLOCATABLE:: MINORDIAMETER_RAMLINE(:) +INTEGER,ALLOCATABLE:: ITEM(:),ITEM_PIPING(:),ITEM_PIPINGAIR(:),ITEM_MINORAIR(:) +CHARACTER,ALLOCATABLE:: DECRIPTION(:),DECRIPTION2(:),DECRIPTION_RAM(:),DESCRIPTION_AIR1(:),DESCRIPTION_AIR2(:) +real:: counter_airp,pacc_before +integer Annular_active,ShearBop_active,PipeRam1_active,PipeRam2_active,ChokeLine_active,KillLine_active +!=========================================================================== +! ANNULAR PREVENTER COMPUTATIONAL VARIABLES +!=========================================================================== + +integer PannularTimeStepDelay +type(DynamicDoubleArrayType) :: Pannular_regDelay + + +logical AnnPressureRise +integer NO_MinorsAnnularLine,NO_PipingsAnnularLine,RamsFirstSet +REAL pa_annular,p_annular +REAL,ALLOCATABLE:: MINORDIAMETER_ANNULARLINE(:),AREAMINOR_ANNULARLINE(:) +!REAL,ALLOCATABLE:: REAL_PregAnnular(:),real_IDAnnular(:),real_pAnnular(:) +REAL REAL_PregAnnular,real_IDAnnular,real_pAnnular +REAL,ALLOCATABLE:: LF_ANNULARLINE(:),CV_ANNULARLINE(:),NOTE_ANNULARLINE(:),minlosspa_ANNULAR(:),minloss_ANNULAR(:) +REAL,ALLOCATABLE:: DIAM_ANNULARLINE_INCH(:),DIAM_ANNULARLINE_MM(:),AREA_ANNULARLINE(:) +REAL,ALLOCATABLE:: LENGT_ANNULARLINE(:),ROUGHNESS_ANNULARLINE(:),RELROUGH_ANNULARLINE(:),Re_ANNULARline(:),fricANNULAR(:),friclossANNULAR(:) +INTEGER,ALLOCATABLE:: ITEMANNULAR(:),ITEM_PIPINGANNULAR(:) +CHARACTER,ALLOCATABLE:: DECRIPTIONANNULAR(:),DECRIPTION2ANNULAR(:),DECRIPTION_ANNULAR(:) +REAL WellBorePressure,acoef,Bcoef,const,AnnularSealingPressure,AnnularMovingPressure +!=========================================================================== +! ANNULAR PREVENTER VARIABLES +!=========================================================================== +REAL (8) Pannular_reg +real Pannular_regset +logical AnnularIsClosing,AnnularIsOpening +REAL tolAnnular,tolzeroAnnular +integer Annular_closed,finished_Annular,FirstSet,AnnularFailureMalf,AnnularLeakMalf,AnnularPressureGaugeMalf,Annular_Situation_forTD +REAL AnnularLeverOld,H_AnnularBop,IDAnnular,AbopAnnular,ODDrillpipe_inAnnular,IDAnnularBase,ODDrillpipe_inAnnularBase +REAL NeededVolumeAnnular +!=========================================================================== +! PIPE RAMS 1 VARIABLES +!=========================================================================== +logical PipeRam1IsClosing,PipeRam1IsOpening +REAL PipeRams1LeverOld,H_PipeRam1Bop +REAL NeededVolumePipeRams1,AbopPipeRam,IDPipeRamBase,IDPipeRam1,ODDrillpipe_inPipeRam1,ODDrillpipe_inPipeRam1Base +integer PipeRam1_closed,finished_pipe1,UpperRamsFailureMalf,UpperRamsLeakMalf,PipeRam1_Situation_forTD +REAL real_IDPipeRam1 + +!============================================================================ +! SHEAR RAM BOP VARIABLES +!============================================================================ +REAL PA,PB,P_SHEAR,VA,VB,RAM_COURSE,H_REGRAM,H_ShearRamBop +REAL,ALLOCATABLE:: ALPHA_QRAM(:),ALPHA_VDISRAM(:),ALPHA_PACC(:),ALPHA_PREGRAM(:),ALPHA_PBOP(:) +!REAL,ALLOCATABLE:: REAL_TIME(:),REAL_QRAM(:),REAL_VDISRAM(:),REAL_PACC(:),REAL_PREGRAM(:),REAL_PBOP(:),real_IDshearBop(:) +REAL REAL_TIME,REAL_QRAM,REAL_VDISRAM,REAL_PACC,REAL_PREGRAM,REAL_PBOP,real_IDshearBop +REAL IDshearBopBase,IDshearBop,ODDrillpipe_inShearRam,AbopShearRam,NeededVolumeShearRams,ODDrillpipe_inShearRamBase +Real IDshearBopFinal,IDPipeRam1Final,IDPipeRam2Final,IDAnnularFinal,OpenArea_shearBop,OpenArea_PipeRam1,OpenArea_PipeRam2,OpenArea_Annular +Real MinimumOpenArea_InBOP +integer MiddleRamsFailureMalf,MiddleRamsLeakMalf,ShearIsNotAllowed + +!=========================================================================== +! PIPE RAMS 2 VARIABLES +!=========================================================================== +logical PipeRam2IsClosing,PipeRam2IsOpening +REAL PipeRams2LeverOld,H_PipeRam2Bop +REAL NeededVolumePipeRams2,IDPipeRam2,ODDrillpipe_inPipeRam2,ODDrillpipe_inPipeRam2Base +integer PipeRam2_closed,finished_pipe2,LowerRamsFailureMalf,LowerRamsLeakMalf,PipeRam2_Situation_forTD +!REAL,ALLOCATABLE:: real_IDPipeRam2(:) +REAL real_IDPipeRam2 + +!=========================================================================== +! CHOKE LINE VARIABLES +!=========================================================================== +logical ChokeLineIsClosing,ChokeLineIsOpening +REAL ChokeLineLeverOld,H_ChokeLineBop +REAL NeededVolumeChokeLine,AbopChokeLine,IDChokeLine,ODDrillpipe_inChokeLine,IDChokeLineBase,ODDrillpipe_inChokeLineBase +integer ChokeLine_closed,finished_ChokeLine +!REAL,ALLOCATABLE:: real_IDPipeRam1(:) +REAL real_IDChokeLine + +!=========================================================================== +! KILL LINE VARIABLES +!=========================================================================== +logical KillLineIsClosing,KillLineIsOpening +REAL KillLineLeverOld,H_KillLineBop +REAL NeededVolumeKillLine,AbopKillLine,IDKillLine,ODDrillpipe_inKillLine,IDKillLineBase,ODDrillpipe_inKillLineBase +integer KillLine_closed,finished_KillLine +!REAL,ALLOCATABLE:: real_IDPipeRam1(:) +REAL real_IDKillLine + +!============================================================================ +! OIL & ENVIRONMENT VARIABLES +!============================================================================ +REAL:: SG=1.12,WDENS=1000,GRAVITY=9.81,RE_CR=2000,NU=9e-6 +!specific gravity of liquid +!water density(kg/m^3) +!============================================================================ +! PUMP VARIABLES +!============================================================================ +REAL P_AIRP,DELTAV_AIR,TOL_AIR,DELTAV_ELECP,Qiter +REAL ELECTRIC_PUMPON,ELECTRIC_PUMPOFF,AIR_PUMPON,AIR_PUMPOFF,QAIR_PUMP,QELECTRIC_PUMP +!REAL,ALLOCATABLE:: alpha_Qair(:),alpha_timeair(:),alpha_paccair(:),alpha_pairp(:),alpha_diffpair(:),alpha_lossesair(:),alpha_fvrair(:) +REAL alpha_Qair,alpha_timeair,alpha_paccair,alpha_pairp,alpha_diffpair,alpha_lossesair,alpha_fvrair +logical SoundKoomeyElectricPump + + + +!================================================================================= + + TYPE, PUBLIC :: BOP_TypeVars + + + + + REAL vdis_tot,vdis_bottles,deltav_bottles,fvr_air,vdis_elecp,Qzero,Q,flow,tol,TIME,timecounter_ram,clock + integer bop_type, SuccessionCounter, SuccessionCounterOld,First_CloseTimecheck,First_OpenTimecheck,FourwayValve ! FourwayValve 1: Open , 0: Close + REAL loss_before,pipe_loss2,minor_loss2,deltah,static_loss2,kinetic_loss2,loss_after,TOLZERO,diffp_ram + REAL checkp,p_acccheck,P_BOP,minor_loss1,static_loss1,kinetic_loss1,pipe_loss1 + Logical Bottles_Charged_MalfActive + + + + END TYPE BOP_TypeVars + + TYPE(BOP_TypeVars), DIMENSION(1:6) :: RAM + + + + + + + TYPE, PUBLIC :: BOP_TypeVars2D + + + REAL, ALLOCATABLE:: minlosspa(:,:),minloss(:,:) + REAL,ALLOCATABLE:: Re_ramline(:,:),fric(:,:),fricloss(:,:) + + + END TYPE BOP_TypeVars2D + + TYPE(BOP_TypeVars2D) :: RAMS + + + + + + ! 1 : Annular (RNUMBER) + ! 2 : PipeRam1 (RNUMBER) + ! 3 : PipeRam2 (RNUMBER) + ! 4 : ShearRam (RNUMBER) + ! 5 : ChokeLine (RNUMBER) + ! 6 : KillLine (RNUMBER) + + + + + + + + + + + + + + + + +END MODULE + + + + + diff --git a/Equipments/BopStack/bopstackmain.mod b/Equipments/BopStack/bopstackmain.mod new file mode 100644 index 0000000..0d49faf Binary files /dev/null and b/Equipments/BopStack/bopstackmain.mod differ diff --git a/Equipments/ChokeControl/AirPump_Choke_Subs.f90 b/Equipments/ChokeControl/AirPump_Choke_Subs.f90 new file mode 100644 index 0000000..28b8579 --- /dev/null +++ b/Equipments/ChokeControl/AirPump_Choke_Subs.f90 @@ -0,0 +1,454 @@ + + SUBROUTINE DEALLOCATE_ARRAYS_CHOKE() +USE CHOKEVARIABLES +implicit none +write(*,*) 'deallocateeeeeeeeeeeee' +!=========================================================================== +! AIR PUMP LOSSES INPUT +!=========================================================================== +!if(allocated(PIPINGS_AIRPUMP)) deallocate(PIPINGS_AIRPUMP) + +DEALLOCATE (PIPINGS_AIRPUMP,DIAM_AIR_INCH, & + Re_air,AREA_AIR,LENGT_AIR,ROUGHNESS_AIRPLINE,REL_ROUGHAIR, & + fric_air,fricloss_air) + !================================================================ +DEALLOCATE (MINORS_AIRPUMP,MINORDIAM_AIR_INCH, & + MINORAREA_AIR,LF_AIR,CV_AIR,NOTE_AIR & + ,minlosspa_air,minloss_air) + + END + + + + + + + SUBROUTINE LOSS_INPUTS_CHOKE() +USE CHOKEVARIABLES +implicit none + Integer I + + +!=========================================================================== +! AIR PUMP LOSSES INPUT +!=========================================================================== +NO_PIPINGS_AIRPLINE=1 + +ALLOCATE (PIPINGS_AIRPUMP(NO_PIPINGS_AIRPLINE,3)) + ! ID(INCH) L(MM) ROUGHNESS(MM)=e DESCRIPTION +PIPINGS_AIRPUMP(1,1:3)= (/0.5, 60960., 0.03/) !Avg.acc.distance + +!60960= 200 ft + + + ALLOCATE (DIAM_AIR_INCH(NO_PIPINGS_AIRPLINE),Re_air(NO_PIPINGS_AIRPLINE),AREA_AIR(NO_PIPINGS_AIRPLINE), & + LENGT_AIR(NO_PIPINGS_AIRPLINE),ROUGHNESS_AIRPLINE(NO_PIPINGS_AIRPLINE),REL_ROUGHAIR(NO_PIPINGS_AIRPLINE), & + fric_air(NO_PIPINGS_AIRPLINE),fricloss_air(NO_PIPINGS_AIRPLINE)) + + + +DO I=1,NO_PIPINGS_AIRPLINE + DIAM_AIR_INCH(I)=PIPINGS_AIRPUMP(I,1) + LENGT_AIR(I)=PIPINGS_AIRPUMP(I,2) + ROUGHNESS_AIRPLINE(I)=PIPINGS_AIRPUMP(I,3) + + + AREA_AIR(I)=PI*(DIAM_AIR_INCH(I)*0.0254)**2/4 !D(in), AREA(m) + REL_ROUGHAIR(I)=ROUGHNESS_AIRPLINE(I)/(DIAM_AIR_INCH(I)*25.4) + !DIAM_RAMLINE_MM(I)=DIAM_RAMLINE_MM(I)*.001 ! (m) + LENGT_AIR(I)=LENGT_AIR(I)*.001 ! (m) + ENDDO + + + !================================================================ +NO_MINORS_AIRPLINE=6 + +ALLOCATE (MINORS_AIRPUMP(NO_MINORS_AIRPLINE,4)) + + ! ID(INCH) LF CV NOTE(BAR) DESCRIPTION +MINORS_AIRPUMP(1,1:4)= (/2., 10., 0., 0./) !Acc.tee +MINORS_AIRPUMP(2,1:4)= (/2., 11., 0., 0./) !elbow +MINORS_AIRPUMP(3,1:4)= (/1., 0., 0., 3.4/) !filter +MINORS_AIRPUMP(4,1:4)= (/2., 0., 105., 0./) !valve +MINORS_AIRPUMP(5,1:4)= (/1., 0., 9.2, 0./) !valve +MINORS_AIRPUMP(6,1:4)= (/2., 6.4, 0., 0./) !unionA + + + + ALLOCATE (MINORDIAM_AIR_INCH(NO_MINORS_AIRPLINE),MINORAREA_AIR(NO_MINORS_AIRPLINE), & + LF_AIR(NO_MINORS_AIRPLINE),CV_AIR(NO_MINORS_AIRPLINE),NOTE_AIR(NO_MINORS_AIRPLINE) & + ,minlosspa_air(NO_MINORS_AIRPLINE),minloss_air(NO_MINORS_AIRPLINE)) + + + +DO I=1,NO_MINORS_AIRPLINE + MINORDIAM_AIR_INCH(I)=MINORS_AIRPUMP(I,1) + LF_AIR(I)=MINORS_AIRPUMP(I,2) + CV_AIR(I)=MINORS_AIRPUMP(I,3) + NOTE_AIR(I)=MINORS_AIRPUMP(I,4) + + + MINORAREA_AIR(I)=PI*(MINORDIAM_AIR_INCH(I)*0.0254)**2/4. !D(in), AREA(m) +ENDDO + + + END + + + + + +SUBROUTINE PIPE_RAMS_CHOKE(CHNUMBER) + USE CHOKEVARIABLES + implicit none + INTEGER CHNUMBER + Integer I + + + loop3: do while (ABS(ChokeControlLever)==1.0 .AND. ChokePanelRigAirSwitch == 1 .AND. CHOOKE(CHNUMBER)%FailMalf==0 .AND. ChokeAirFail==0) + if (ChokeControlLever == 1.0) then + CHOOKE(CHNUMBER)%ChokeIsClosing = .true. + CHOOKE(CHNUMBER)%ChokeIsOpening = .false. + endif + + if (ChokeControlLever == -1.0) then + CHOOKE(CHNUMBER)%ChokeIsOpening = .true. + CHOOKE(CHNUMBER)%ChokeIsClosing = .false. + endif + + + + time=time+DeltaT_Choke !overal time (s) + + + +!==================================================== +! ******************************** + call airpump_code_CHOKE(CHNUMBER) +! ************************* +!==================================================== + + call sleepqq(100) + + + if (IsStopped == .true.) return + + end do loop3 !while finished_Choke==0 + + end + + + + + + + SUBROUTINE airpump_code_CHOKE(CHNUMBER) +USE CHOKEVARIABLES +USE CChokeManifoldVariables +use CSounds +USE CChokeProblemsVariables +implicit none + Integer I + +INTEGER CHNUMBER + + +QAIR_PUMP=Qiter+.1 !(gpm) maximum flow for the start +diffp_air=-10 +losses_air=10 + +!=================================================================== +! AIR OPERATED PUMP +! MODEL 10-6000W030 RATIO 55:1 +!=================for air consumption at 100 psig=================== +do while (diffp_air<0) + QAIR_PUMP=QAIR_PUMP-.1 +! Qup=QAIR_PUMP; + !cc1 = 1354; cc2 = -2066; cc3 = -2109; cc4 = -513.6; cc5 = 5935 FOR OUTPUT IN GPM + p_airp=cc1*(QAIR_PUMP**4) + cc2*(QAIR_PUMP**3) + cc3*(QAIR_PUMP**2) + cc4*QAIR_PUMP + cc5 !(psig) +! kinetic_air=sg*wdens*(QAIR_PUMP*6.30902e-5/((1/4.)*pi*(2*0.254e-1)**2))**2/(2*6895) !(psi) + + diffp_air= p_airp - Pdownstrem + +end do !returns Qup + + + + do while (abs((diffp_air-losses_air)/diffp_air)>tol_air) !finding correct QAIR_pump for 1 timecounter_ram + +if (diffp_air-losses_air>0) then + QAIR_PUMP=QAIR_PUMP+.005 +else + QAIR_PUMP=QAIR_PUMP-.005 +endif + +!=================================================================== +! AIR OPERATED PUMP +! MODEL 10-6000W030 RATIO 55:1 +!=================for air consumption at 100 psig=================== + + p_airp=cc1*(QAIR_PUMP**4) + cc2*(QAIR_PUMP**3) + cc3*(QAIR_PUMP**2) + cc4*QAIR_PUMP + cc5 !(psig) + !kinetic_air=sg*wdens*(QAIR_PUMP*6.30902e-005/((1/4.)*pi*(2*0.254e-1)**2))**2/(2*6895) !(psi) + + diffp_air= p_airp - Pdownstrem + + +!===========================LOSSES==================================== + do i=1,NO_PIPINGS_AIRPLINE +Re_air(i)=QAIR_PUMP*6.30902e-005*DIAM_AIR_INCH(I)*0.0254/(area_air(i)*nu) +enddo + + +do i=1,NO_PIPINGS_AIRPLINE + if (Re_air(i) 1.0 ) then + SoundChokePump= 60 + Cumulative_AirVolume_Choke= Cumulative_AirVolume_Choke - 1.0 + else + SoundChokePump= 0.0 + endif + + !SoundChokePump= int (QAIR_PUMP/ (1.5*0.004329004)*DeltaT_Choke/60.0) ! 1.5: Volume per stroke (in^3) , 0.004329004: in^3 to gal , 60:seconds + + + +deltav_air=QAIR_PUMP*DeltaT_Choke/60 !(galon) delta_t=1sec , Q(gpm) + +if (CHOOKE(CHNUMBER)%ChokeIsClosing) CHOOKE(CHNUMBER)%PassedCourse=CHOOKE(CHNUMBER)%PassedCourse + (deltav_air*3785.412/Acylinder)!*(ChokeRateControlKnob/10.) ! 3785.412 : GALON TO CM^3 + + +if (CHOOKE(CHNUMBER)%ChokeIsOpening) CHOOKE(CHNUMBER)%PassedCourse=CHOOKE(CHNUMBER)%PassedCourse - (deltav_air*3785.412/Acylinder)!*(ChokeRateControlKnob/10.) + + + +!DeltaT_Choke= 1sec or 2sec + + +!((((((((IN OUTER LOOP)))))) + +!===============AIR PUMP OUTPUTS========================= +alpha_timeair=time ! overal time (s) +alpha_Pdownstrem=Pdownstrem +alpha_pairp=p_airp +alpha_Qair=QAIR_PUMP +!write(*,*) 'diffp_air=',diffp_air +!pause +alpha_diffpair=diffp_air + +alpha_lossesair=losses_air +!======================================================== +!OPEN(150,FILE='CHOKE_AIRPUMP_OUTPUTS.DAT') + + + if (CHOOKE(CHNUMBER)%ChokeIsClosing .AND. CHOOKE(CHNUMBER)%PassedCourse>CourseBase) then + CHOOKE(CHNUMBER)%PassedCourse=CourseBase + SoundChokePump= 0.0 + endif + + if (CHOOKE(CHNUMBER)%ChokeIsOpening .AND. CHOOKE(CHNUMBER)%PassedCourse<0.) then + CHOOKE(CHNUMBER)%PassedCourse=0. + SoundChokePump= 0.0 + endif + + + call SetSoundChokePump(SoundChokePump) + + CHOOKE(CHNUMBER)%PercentClose= CHOOKE(CHNUMBER)%PassedCourse/CourseBase + + + IF (Choke1LED==1) THEN + ChokePosition= (1 - GaugeChokePositionMailf) * CHOOKE(1)%PercentClose*10 + ELSE ! Choke2LED==1 + ChokePosition= (1 - GaugeChokePositionMailf) * CHOOKE(2)%PercentClose*10 + ENDIF + + !CALL SetHydraulicChock1(nint(MIN(CHOOKE(1)%PercentClose / 0.91 , 1.0)*100)) + ! CALL SetHydraulicChock2(nint(MIN(CHOOKE(2)%PercentClose / 0.91 , 1.0)*100)) + + ! .91 >> 9 percent clearance + +! =================== calculating Area + + ! AreaChoke=0.5 + ! .91 >> 9 percent clearance + + CHOOKE(1)%AreaChoke=0.01334635-(0.01334635* MIN(CHOOKE(1)%PercentClose / 0.91 , 1.0)) !ft^2 0.01334635 is ChokeAreaFullyOpen (ft^2) + CHOOKE(2)%AreaChoke=0.01334635-(0.01334635* MIN(CHOOKE(2)%PercentClose/ 0.91 , 1.0)) !ft^2 + + !write(*,*) 'CHOOKE(1)%AreaChoke= ' , CHOOKE(1)%AreaChoke + + + + + HydraulicChoke1WashoutCoef= HydraulicChoke1WashoutCoef * CHOOKE(1)%WashoutMalf + HydraulicChoke1WashoutCoef= MIN( 0.5 , HydraulicChoke1WashoutCoef+ CHOOKE(1)%WashoutMalf*(0.5/(60.0/DeltaT_Choke)) ) ! 0.5=maximum washout coef , 60.0 sec= 1min duration time + + HydraulicChoke2WashoutCoef= HydraulicChoke2WashoutCoef * CHOOKE(2)%WashoutMalf + HydraulicChoke2WashoutCoef= MIN( 0.5 , HydraulicChoke2WashoutCoef+ CHOOKE(2)%WashoutMalf*(0.5/(60.0/DeltaT_Choke)) ) ! 0.5=maximum washout coef , 60.0 sec= 1min duration time + + + !write(*,*) 'HydraulicChoke1WashoutCoef=' , HydraulicChoke1WashoutCoef + + IF (CHOOKE(1)%PlugMalf == 1) THEN + + Present_HydraulicChoke1Plug= Present_HydraulicChoke1Plug * CHOOKE(1)%PlugMalf + ! integer: HydraulicChoke1PluggedPercent,HydraulicChoke1PluggedPercent_Old,PlugTimeCounter,ChokePlugTimeDelay + ! real: Present_HydraulicChoke1Plug,DeltaPlug1Percent + + !write(*,*) 'HydraulicChoke1PluggedPercent=' , HydraulicChoke1PluggedPercent + + if ( (HydraulicChoke1PluggedPercent - HydraulicChoke1PluggedPercent_Old) /= 0) then + DeltaPlug1Percent = (REAL(HydraulicChoke1PluggedPercent)/100.) - Present_HydraulicChoke1Plug + Plug1TimeCounter = 0 + !write(*,*) 'DeltaPlug1Percent, Present_HydraulicChoke1Plug = ' ,DeltaPlug1Percent , Present_HydraulicChoke1Plug + endif + + + Plug1TimeCounter= Plug1TimeCounter + 1 + + HydraulicChoke1PluggedPercent_Old= HydraulicChoke1PluggedPercent + + if (Plug1TimeCounter <= ChokePlugTimeDelay) then !ChokePlugTimeDelay=600 + + Present_HydraulicChoke1Plug = Present_HydraulicChoke1Plug + CHOOKE(1)%PlugMalf* ((DeltaPlug1Percent / real(ChokePlugTimeDelay))) ! real(ChokePlugTimeDelay)= 600.0 + + endif + + !write(*,*) 'Present_HydraulicChoke1Plug=' , Present_HydraulicChoke1Plug + + ENDIF + + + + + + + IF (CHOOKE(2)%PlugMalf == 1) THEN + + Present_HydraulicChoke2Plug= Present_HydraulicChoke2Plug * CHOOKE(2)%PlugMalf + ! integer: HydraulicChoke2PluggedPercent,HydraulicChoke2PluggedPercent_Old,PlugTimeCounter,ChokePlugTimeDelay + ! real: Present_HydraulicChoke2Plug,DeltaPlug2Percent + + + if ( (HydraulicChoke2PluggedPercent - HydraulicChoke2PluggedPercent_Old) /= 0 ) then + DeltaPlug2Percent = (REAL(HydraulicChoke2PluggedPercent)/100.) - Present_HydraulicChoke2Plug + Plug2TimeCounter = 0 + endif + + Plug2TimeCounter= Plug2TimeCounter + 1 + + HydraulicChoke2PluggedPercent_Old= HydraulicChoke2PluggedPercent + + if (Plug2TimeCounter <= ChokePlugTimeDelay) then !ChokePlugTimeDelay=600 + + Present_HydraulicChoke2Plug = Present_HydraulicChoke2Plug + CHOOKE(2)%PlugMalf *((DeltaPlug2Percent / real(ChokePlugTimeDelay))) ! real(ChokePlugTimeDelay)= 600.0 + + endif + + ENDIF + + + + + + + + ! fully open area is 123/64 in^2 = 0.01334635 ft^2 + CHOOKE(1)%AreaChoke=CHOOKE(1)%AreaChoke+(CHOOKE(1)%WashoutMalf*HydraulicChoke1WashoutCoef*ChokeAreaFullyOpen/144.0) ! Initialised in Choke Startup + + !write(*,*) 'CHOOKE(1)%WashoutMalf , CHOOKE(1)%AreaChoke=' ,CHOOKE(1)%WashoutMalf , CHOOKE(1)%AreaChoke + + CHOOKE(1)%AreaChoke=CHOOKE(1)%AreaChoke-(CHOOKE(1)%PlugMalf* Present_HydraulicChoke1Plug *CHOOKE(1)%AreaChoke) ! Initialised in Choke Startup + + CHOOKE(2)%AreaChoke=CHOOKE(2)%AreaChoke+(CHOOKE(2)%WashoutMalf*HydraulicChoke2WashoutCoef*ChokeAreaFullyOpen/144.0) ! Initialised in Choke Startup + CHOOKE(2)%AreaChoke=CHOOKE(2)%AreaChoke-(CHOOKE(2)%PlugMalf* Present_HydraulicChoke2Plug *CHOOKE(2)%AreaChoke) ! Initialised in Choke Startup + !write(*,*) 'CHOOKE(2)%WashoutMalf , CHOOKE(2)%AreaChoke=' ,CHOOKE(2)%WashoutMalf , CHOOKE(2)%AreaChoke + + + CHOOKE(1)%AreaChokeFinal= CHOOKE(1)%AreaChoke + CHOOKE(2)%AreaChokeFinal= CHOOKE(2)%AreaChoke + + ! 144: ft^2 to in^2 + CALL SetHydraulicChock1(100 - nint((CHOOKE(1)%AreaChokeFinal/(ChokeAreaFullyOpen/144.))*100)) ! for manifold valve + CALL SetHydraulicChock2(100 - nint((CHOOKE(2)%AreaChokeFinal/(ChokeAreaFullyOpen/144.))*100)) ! for manifold valve + + + !write(*,*) 'CHOOKE(1)%PercentClose=' , CHOOKE(1)%PercentClose ! close percent 0 to 100 + !write(*,*) 'ChokePosition=' , ChokePosition ! close position 0 to 10 for display + !write(*,*) 'CHOOKE(1)%AreaChokeFinal=' , CHOOKE(1)%AreaChokeFinal ! Open Area (in^2) with clearance + !write(*,*) '(ChokeAreaFullyOpen/144.)=' , (ChokeAreaFullyOpen/144.) + !write(*,*) 'valve value=' , 100 - nint((CHOOKE(1)%AreaChokeFinal/(ChokeAreaFullyOpen/144.))*100) ! percent close 0 to 100 with clearance + !write(*,*) 'Valve(33)%Status=' , Valve(33)%Status ! T : open , F: close + + + + + +! =================== calculating Area + + + + !write(*,*) 'CHOOKE(1)%AreaChoke= ' , CHOOKE(1)%AreaChoke + + + +! WRITE(150,50) alpha_timeair,alpha_Qair,alpha_pairp, & +! alpha_Pdownstrem,alpha_diffpair,alpha_lossesair,CHOOKE(CHNUMBER)%PassedCourse +!50 FORMAT(7(f15.5)) + + +!======================================================================================== +!======================================================================================== + + ! write(*,*) PassedCourse + + + + end diff --git a/Equipments/ChokeControl/CHOKE.f90 b/Equipments/ChokeControl/CHOKE.f90 new file mode 100644 index 0000000..bac2dc7 --- /dev/null +++ b/Equipments/ChokeControl/CHOKE.f90 @@ -0,0 +1,207 @@ + + +module choke + + USE CHOKEVARIABLES + !USE CDataDisplayConsoleVariables, CasingPressureDataDisplay=>CasingPressure!, StandPipePressureDataDisplay=>StandPipePressure + USE CChokeProblemsVariables + !use CChokeControlPanelVariables, StandPipePressureChoke=>StandPipePressure + use MudSystemVARIABLES + USE CChokeManifoldVariables + + contains + + subroutine CHOKE_MainBody + + implicit none + Integer I + + INTEGER CHNUMBER + + + ! time2=time2+0.1 + + +!=========================================================================== + + !StandPipePressureChoke= STGauge_Pressure ! from module mud system + ! CasingPressure = CasingPressureDataDisplay + + + + +!=========================================================================== +! +! HYDRAULIC CHOKE CONTROL +! +!=========================================================================== + + + IF(ChokeSelectorSwitch== 1) THEN + Choke1LED=1 + Choke2LED=0 + CHNUMBER=1 + ELSE + Choke2LED=1 + Choke1LED=0 + CHNUMBER=2 + ENDIF + + + + + if (ABS(ChokeControlLever)==1.0 .AND. ChokePanelRigAirSwitch == 1 .AND. (CHOOKE(1)%FailMalf==0 .OR. CHOOKE(2)%FailMalf==0)) then + CALL PIPE_RAMS_CHOKE(CHNUMBER) + end if + + + + + + IF (Choke1LED==1) THEN + ChokePosition= (1 - GaugeChokePositionMailf) * CHOOKE(1)%PercentClose*10 ! display monitor + ELSE ! Choke2LED==1 + ChokePosition= (1 - GaugeChokePositionMailf) * CHOOKE(2)%PercentClose*10 ! display monitor + ENDIF + + + +! =================== calculating Area + + ! AreaChoke=0.5 + ! .91 >> 9 percent clearance + + CHOOKE(1)%AreaChoke=0.01334635-(0.01334635* MIN(CHOOKE(1)%PercentClose / 0.91 , 1.0)) !ft^2 0.01334635 is ChokeAreaFullyOpen (ft^2) + CHOOKE(2)%AreaChoke=0.01334635-(0.01334635* MIN(CHOOKE(2)%PercentClose/ 0.91 , 1.0)) !ft^2 + + !write(*,*) 'CHOOKE(1)%AreaChoke= ' , CHOOKE(1)%AreaChoke + + + + + HydraulicChoke1WashoutCoef= HydraulicChoke1WashoutCoef * CHOOKE(1)%WashoutMalf + HydraulicChoke1WashoutCoef= MIN( 0.5 , HydraulicChoke1WashoutCoef+ CHOOKE(1)%WashoutMalf*(0.5/(180.0/DeltaT_Choke)) ) ! 0.5 = maximum washout coef , 180.0 sec = 3 min duration time + + HydraulicChoke2WashoutCoef= HydraulicChoke2WashoutCoef * CHOOKE(2)%WashoutMalf + HydraulicChoke2WashoutCoef= MIN( 0.5 , HydraulicChoke2WashoutCoef+ CHOOKE(2)%WashoutMalf*(0.5/(180.0/DeltaT_Choke)) ) ! 0.5 = maximum washout coef , 180.0 sec = 3 min duration time + + + !write(*,*) 'HydraulicChoke1WashoutCoef=' , HydraulicChoke1WashoutCoef + + IF (CHOOKE(1)%PlugMalf == 1) THEN + + Present_HydraulicChoke1Plug= Present_HydraulicChoke1Plug * CHOOKE(1)%PlugMalf + ! integer: HydraulicChoke1PluggedPercent,HydraulicChoke1PluggedPercent_Old,PlugTimeCounter,ChokePlugTimeDelay + ! real: Present_HydraulicChoke1Plug,DeltaPlug1Percent + + !write(*,*) 'HydraulicChoke1PluggedPercent=' , HydraulicChoke1PluggedPercent + + if ( (HydraulicChoke1PluggedPercent - HydraulicChoke1PluggedPercent_Old) /= 0) then + DeltaPlug1Percent = (REAL(HydraulicChoke1PluggedPercent)/100.) - Present_HydraulicChoke1Plug + Plug1TimeCounter = 0 + !write(*,*) 'DeltaPlug1Percent, Present_HydraulicChoke1Plug = ' ,DeltaPlug1Percent , Present_HydraulicChoke1Plug + endif + + + Plug1TimeCounter= Plug1TimeCounter + 1 + + HydraulicChoke1PluggedPercent_Old= HydraulicChoke1PluggedPercent + + if (Plug1TimeCounter <= ChokePlugTimeDelay) then !ChokePlugTimeDelay=1800 + + Present_HydraulicChoke1Plug = Present_HydraulicChoke1Plug + CHOOKE(1)%PlugMalf* ((DeltaPlug1Percent / real(ChokePlugTimeDelay))) ! real(ChokePlugTimeDelay)= 600.0 + + endif + + !write(*,*) 'Present_HydraulicChoke1Plug=' , Present_HydraulicChoke1Plug + + ENDIF + + + + + + + IF (CHOOKE(2)%PlugMalf == 1) THEN + + Present_HydraulicChoke2Plug= Present_HydraulicChoke2Plug * CHOOKE(2)%PlugMalf + ! integer: HydraulicChoke2PluggedPercent,HydraulicChoke2PluggedPercent_Old,PlugTimeCounter,ChokePlugTimeDelay + ! real: Present_HydraulicChoke2Plug,DeltaPlug2Percent + + + if ( (HydraulicChoke2PluggedPercent - HydraulicChoke2PluggedPercent_Old) /= 0 ) then + DeltaPlug2Percent = (REAL(HydraulicChoke2PluggedPercent)/100.) - Present_HydraulicChoke2Plug + Plug2TimeCounter = 0 + endif + + Plug2TimeCounter= Plug2TimeCounter + 1 + + HydraulicChoke2PluggedPercent_Old= HydraulicChoke2PluggedPercent + + if (Plug2TimeCounter <= ChokePlugTimeDelay) then !ChokePlugTimeDelay=1800 + + Present_HydraulicChoke2Plug = Present_HydraulicChoke2Plug + CHOOKE(2)%PlugMalf *((DeltaPlug2Percent / real(ChokePlugTimeDelay))) ! real(ChokePlugTimeDelay)= 1800.0 + + endif + + ENDIF + + + + + + + + ! fully open area is 123/64 in^2 = 0.01334635 ft^2 + CHOOKE(1)%AreaChoke=CHOOKE(1)%AreaChoke+(CHOOKE(1)%WashoutMalf*HydraulicChoke1WashoutCoef*ChokeAreaFullyOpen/144.0) ! Initialised in Choke Startup + + !write(*,*) 'CHOOKE(1)%WashoutMalf , CHOOKE(1)%AreaChoke=' ,CHOOKE(1)%WashoutMalf , CHOOKE(1)%AreaChoke + + CHOOKE(1)%AreaChoke=CHOOKE(1)%AreaChoke-(CHOOKE(1)%PlugMalf* Present_HydraulicChoke1Plug *CHOOKE(1)%AreaChoke) ! Initialised in Choke Startup + + CHOOKE(2)%AreaChoke=CHOOKE(2)%AreaChoke+(CHOOKE(2)%WashoutMalf*HydraulicChoke2WashoutCoef*ChokeAreaFullyOpen/144.0) ! Initialised in Choke Startup + CHOOKE(2)%AreaChoke=CHOOKE(2)%AreaChoke-(CHOOKE(2)%PlugMalf* Present_HydraulicChoke2Plug *CHOOKE(2)%AreaChoke) ! Initialised in Choke Startup + !write(*,*) 'CHOOKE(2)%WashoutMalf , CHOOKE(2)%AreaChoke=' ,CHOOKE(2)%WashoutMalf , CHOOKE(2)%AreaChoke + + + CHOOKE(1)%AreaChokeFinal= CHOOKE(1)%AreaChoke + CHOOKE(2)%AreaChokeFinal= CHOOKE(2)%AreaChoke + + ! 144: ft^2 to in^2 + CALL SetHydraulicChock1(100 - nint((CHOOKE(1)%AreaChokeFinal/(ChokeAreaFullyOpen/144.))*100)) ! for manifold valve + CALL SetHydraulicChock2(100 - nint((CHOOKE(2)%AreaChokeFinal/(ChokeAreaFullyOpen/144.))*100)) ! for manifold valve + + + !write(*,*) 'CHOOKE(1)%PercentClose=' , CHOOKE(1)%PercentClose ! close percent 0 to 100 + !write(*,*) 'ChokePosition=' , ChokePosition ! close position 0 to 10 for display + !write(*,*) 'CHOOKE(1)%AreaChokeFinal=' , CHOOKE(1)%AreaChokeFinal ! Open Area (in^2) with clearance + !write(*,*) '(ChokeAreaFullyOpen/144.)=' , (ChokeAreaFullyOpen/144.) + !write(*,*) 'valve value=' , 100 - nint((CHOOKE(1)%AreaChokeFinal/(ChokeAreaFullyOpen/144.))*100) ! percent close 0 to 100 with clearance + !write(*,*) 'Valve(33)%Status=' , Valve(33)%Status ! T : open , F: close + + + + + +! =================== calculating Area + + !AreaChoke= CHOOKE(1)%AreaChoke !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< badan moteghayer 1 ya 2 shavad + +! write(*,*) 'AreaChoke:',AreaChoke + +!=========================================================================== +! MUD PUMP STROKES +! & TOTAL STROKE- CHOKE CONTROL PANEL +!=========================================================================== + +!************************* IN MUD SYSTEM MODULE************************* + + + + end subroutine CHOKE_MainBody + + + + + +end module CHOKE \ No newline at end of file diff --git a/Equipments/ChokeControl/CHOKE_VARIABLES.f90 b/Equipments/ChokeControl/CHOKE_VARIABLES.f90 new file mode 100644 index 0000000..6ea4819 --- /dev/null +++ b/Equipments/ChokeControl/CHOKE_VARIABLES.f90 @@ -0,0 +1,106 @@ +MODULE CHOKEVARIABLES +!IMPLICIT DOUBLEPRECISION(A-H,O-Z) +use CBopControlPanelVariables +use CEquipmentsConstants +use CSimulationVariables +use CAccumulatorVariables +use CBopStackVariables +use CChokeControlPanelVariables + +IMPLICIT NONE + +!=========================================================================== +! CHOKE VARIABLES +!=========================================================================== +REAL Ycritical,Cp,Cv,CL,kRatio,nPolytripic,x1,SGliquid,WaterDensity,LiquidDensity,VL,VG1 +REAL epsilon_step,epsilon_abs,step_size,Ycritical_a,Ycritical_b,Ycritical_c +REAL G2,Cdrag,Pwh,MixDens2,Yratio_a,Yratio_b,Yratio_c,Yratio,Yratio_low,Yratio_high +REAL FlowRate,Patm,MassFlux,LiquidPPG,time2,AreaChoke +REAL eps_step,eps_abs,Yratiomat(100),Yrario_actual,Yrario +REAL :: DegreeOpen,GRAVITY1=9.81!,PercentClose +REAL ChokedMassFlux,ChokedFlowRate,PwhChoked +REAL TotalStrokes1,TotalStrokes2 +!INTEGER WashoutMalf,PlugMalf,failMalf +INTEGER GaugeChokePositionMailf,SoundChokePump +Real Cumulative_AirVolume_Choke +Real HydraulicChoke1WashoutCoef,HydraulicChoke2WashoutCoef + +Real Present_HydraulicChoke1Plug, Present_HydraulicChoke2Plug,DeltaPlug1Percent,DeltaPlug2Percent +Integer HydraulicChoke1PluggedPercent_Old,HydraulicChoke2PluggedPercent_Old,Plug1TimeCounter,Plug2TimeCounter,ChokePlugTimeDelay +Real ChokeAreaFullyOpen +!=========================================================================== +! AIR DRIVEN PUMP VARIABLES +!=========================================================================== +REAL QAIR_PUMP,cc1,cc2,cc3,cc4,cc5 +PARAMETER PI=3.141593 +INTEGER ChokeAirFail +!============================================================================ +! OIL & ENVIRONMENT VARIABLES +!============================================================================ +REAL:: SG=1.12,WDENS=1000,GRAVITY=9.81,RE_CR=2000,NU=9e-6 +!specific gravity of liquid +!water density(kg/m^3) + + +!=========================================================================== +! AIR PUMP LINE COMPUTATIONAL VARIABLES +!=========================================================================== +!logical ChokeIsClosing,ChokeIsOpening +REAL ChokeControlLeverOld +REAL P_AIRP,QITER,DELTAV_AIR,TIME,DeltaT_Choke,TOL_AIR +REAL diffp_air,losses_air,pipe_loss1air,minor_loss1air,static_loss1air +integer NO_PIPINGS_AIRPLINE,NO_MINORS_AIRPLINE +REAL,ALLOCATABLE:: Re_air(:),DIAM_AIR_MM(:),DIAM_AIR_INCH(:),AREA_AIR(:),REL_ROUGHAIR(:),LENGT_AIR(:),LF_AIR(:),CV_AIR(:),NOTE_AIR(:) +REAL,ALLOCATABLE:: fric_air(:),fricloss_air(:),minlosspa_air(:),minloss_air(:),MINORS_AIRPUMP(:,:) +REAL,ALLOCATABLE:: MINORDIAM_AIR_INCH(:),MINORAREA_AIR(:) +REAL,ALLOCATABLE:: ROUGHNESS_AIRPLINE(:),PIPINGS_AIRPUMP(:,:) +REAL Acylinder,CourseBase!,PassedCourse +REAL alpha_Qair,alpha_timeair,alpha_pairp,alpha_diffpair,alpha_lossesair,alpha_Pdownstrem,Pdownstrem + + + +!================================================================================= + + TYPE, PUBLIC :: CHOKE_TypeVars + + + + + INTEGER WashoutMalf,PlugMalf,failMalf + REAL PercentClose,PassedCourse,AreaChoke,AreaChokeFinal + logical ChokeIsClosing,ChokeIsOpening + + + + END TYPE CHOKE_TypeVars + + TYPE(CHOKE_TypeVars), DIMENSION(1:2) :: CHOOKE + + + + + + + !TYPE, PUBLIC :: BOP_TypeVars2D + !REAL, ALLOCATABLE:: minlosspa(:,:),minloss(:,:) + !REAL,ALLOCATABLE:: Re_ramline(:,:),fric(:,:),fricloss(:,:) + ! + ! + !END TYPE BOP_TypeVars2D + ! + !TYPE(BOP_TypeVars2D) :: RAMS + + + + ! 1 : CHOKE1 + ! 2 : CHOKE2 + + + + +END MODULE + + + + + diff --git a/Equipments/ChokeControl/ChokeControlMain.f90 b/Equipments/ChokeControl/ChokeControlMain.f90 new file mode 100644 index 0000000..900c7c6 --- /dev/null +++ b/Equipments/ChokeControl/ChokeControlMain.f90 @@ -0,0 +1,60 @@ +module ChokeControlMain + implicit none + public + contains + + subroutine ChokeControl_Setup() + use CSimulationVariables + implicit none + call OnSimulationInitialization%Add(ChokeControl_Init) + call OnSimulationStop%Add(ChokeControl_Init) + call OnChokeControlStep%Add(ChokeControl_Step) + call OnChokeControlOutput%Add(ChokeControl_Output) + call OnChokeControlMain%Add(ChokeControlMainBody) + end subroutine + + subroutine ChokeControl_Init + implicit none + end subroutine ChokeControl_Init + + subroutine ChokeControl_Step + implicit none + end subroutine ChokeControl_Step + + subroutine ChokeControl_Output + implicit none + end subroutine ChokeControl_Output + + subroutine ChokeControlMainBody + use CRigSizeVariables + use CHOKE + implicit none + + CALL Choke_StartUp() + loop1: DO + CALL CHOKE_MainBody + call sleepqq(100) + !IF (IsStopped==.true.) THEN + ! EXIT loop1 + !ENDIF + !write(*,*) '1111111111111' + if(IsStopped) then +!write(*,*) '22222222222222' + + CALL DEALLOCATE_ARRAYS_CHOKE() +!write(*,*) '333333333' + + call Quit() + end if + + + + ENDDO loop1 + + CLOSE(150) + + !CALL DEALLOCATE_ARRAYS_CHOKE() + + end subroutine ChokeControlMainBody + +end module ChokeControlMain \ No newline at end of file diff --git a/Equipments/ChokeControl/ChokeStartup.f90 b/Equipments/ChokeControl/ChokeStartup.f90 new file mode 100644 index 0000000..783f94f --- /dev/null +++ b/Equipments/ChokeControl/ChokeStartup.f90 @@ -0,0 +1,137 @@ + SUBROUTINE Choke_StartUp() + + USE CHOKEVARIABLES + USE CChokeProblemsVariables + implicit none + + CALL LOSS_INPUTS_CHOKE() + + !OPEN(150,FILE='CHOKE_AIRPUMP_OUTPUTS.DAT') + + + !CHOOKE(1)%WashoutMalf=1 + !CHOOKE(1)%PlugMalf=0 + !CHOOKE(1)%FailMalf=0 + ! + !CHOOKE(2)%WashoutMalf=1 + !CHOOKE(2)%PlugMalf=0 + !CHOOKE(2)%FailMalf=0 + ! + ! + !ChokeAirFail=0 + ! + !GaugeChokePositionMailf=0 + + + + + + + + kRatio=1.4 +Cp=0.24 +CL=0.8 + +x1=0.5 + +LiquidPPG=9. +LiquidDensity=LiquidPPG*7.48 !lbm/ft**3 + +VL=1.0/LiquidDensity !SpecificVolume of Liquid + +Cv=Cp/kRatio + +nPolytripic=1+(x1*(Cp-Cv)/(x1*Cv+(1-x1)*CL)) + +VG1=1./0.748 !lbm/ft**3 Specific Volume of Air, Upstream + +Cdrag=0.8 +Pwh=1400. !psi + + +Patm=14.7 +MixDens2=x1*VG1 !lbm/ft**3 + + + +epsilon_abs= 1e-5 +epsilon_step= 1e-5 + + +!ChokeDiameter= 32/64. !in + +CHOOKE%PercentClose= 0.0 + !AreaChoke=0.01334635 + + ! CHOOKE(1)%AreaChoke=0.01334635 +!ChokeAreaFullyOpen = 123.d0 / 64.d0 ! fully open area is 123/64 in^2 = 0.01334635 ft^2 + +DeltaT_Choke=0.1 +!TotalStrokes1=0. +!TotalStrokes2=0. + +HydraulicChoke1WashoutCoef= 0.0 +HydraulicChoke2WashoutCoef= 0.0 + + + +ChokePlugTimeDelay = int(180./DeltaT_Choke) ! =1800 = 180/0.1 : for 3 min delay + +Present_HydraulicChoke1Plug = REAL(HydraulicChoke1PluggedPercent)/100. +HydraulicChoke1PluggedPercent_Old= HydraulicChoke1PluggedPercent +Plug1TimeCounter= 0 +DeltaPlug1Percent = 0.0 + +Present_HydraulicChoke2Plug = REAL(HydraulicChoke2PluggedPercent)/100. +HydraulicChoke2PluggedPercent_Old= HydraulicChoke2PluggedPercent +Plug2TimeCounter= 0 +DeltaPlug2Percent = 0.0 + + + + + + +!======================AIRPUMP INPUTS(CONSTANTS)=========================== + CourseBase= 24. !cm + CHOOKE%PassedCourse= 0. + ChokePosition=0. + + Acylinder= PI*(8.**2)/4. ! (CM^2), 8=DIAMETER, 24=course , 3785.412: cm^3 to galon + + + CHOOKE%ChokeIsOpening = .false. + CHOOKE%ChokeIsClosing = .false. + + + P_AIRP=0 + + cc1 = 0.1354; cc2 = -2.066; cc3 = -21.09; cc4 = -51.36; cc5 = 5935 ! FOR OUTPUT IN GPM + ! cc1 = 4.754e-07; cc2 = -0.0001676; cc3 = -0.03953; cc4 = -2.223; cc5 = 5935 FOR OUTPUT IN IN^3/MIN + + +Pdownstrem= 4950 !+0.01*Pchoke (psi) <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +Qiter=5. !(gpm) + +! Q=0.0003585; true +time=0 +tol_air=0.05 + +alpha_Qair=0 +alpha_timeair=0 +alpha_Pdownstrem=Pdownstrem +alpha_diffpair=0 +alpha_lossesair=0 + + + + + + + + + + + + + end \ No newline at end of file diff --git a/Equipments/Drawworks/DWBrakeSound.f90 b/Equipments/Drawworks/DWBrakeSound.f90 new file mode 100644 index 0000000..2818ffa --- /dev/null +++ b/Equipments/Drawworks/DWBrakeSound.f90 @@ -0,0 +1,91 @@ +subroutine DWBrakeSound + + ! Use Drawworks_VARIABLES + ! Use CSounds + ! + !IMPLICIT NONE + ! + ! Real :: DW_MainBrakeTorque , DW_DrumRPM + ! + ! + ! + ! DW_MainBrakeTorque = ((Drawworks%Diameter/2.0d0)*Drawworks%BreakLoad)*(Drawworks%ManualBreak/100.0d0) ![N.m] + ! DW_MainBrakeTorque = DW_MainBrakeTorque/800.d0 ! Scaling: 0<=DW_MainBrakeTorque=<100 + ! !print*, 'DW_MainBrakeTorque0=' , DW_MainBrakeTorque + ! if ( DW_MainBrakeTorque>100. ) then + ! DW_MainBrakeTorque = 100.d0 + ! end if + ! + ! + ! + ! DW_DrumRPM = Drawworks%w_drum + ! DW_DrumRPM = DW_DrumRPM*10.d0+(Drawworks%ManualBreak/100.0d0) ! Scaling: 0<=DW_DrumRPM=<1000 + ! !print*, 'DW_DrumRPM0=' , DW_DrumRPM + ! !if ( DW_DrumRPM>=0. .and. DW_DrumRPM<=1. ) then + ! ! DW_DrumRPM = 1.0 + ! !end if + ! if ( DW_DrumRPM>1000.d0 ) then + ! DW_DrumRPM = 1000.d0 + ! end if + ! + ! + ! Drawworks%SoundDwBrake = INT((DW_MainBrakeTorque*DW_DrumRPM)) ! 0<=SoundDWBrake=<100000 + ! Call SetSoundDwBrake( Drawworks%SoundDwBrake ) + ! + ! + ! !print*, 'Drawworks%SoundDwBrake=' , Drawworks%SoundDwBrake + ! !print*, 'DW_DrumRPM=' , DW_DrumRPM + ! !print*, 'DW_MainBrakeTorque=' , DW_MainBrakeTorque + ! !print*, 'Drawworks%ManualBreak=' , Drawworks%ManualBreak + + + + + + Use Drawworks_VARIABLES + Use CSounds + Use TD_StringConnectionData + + IMPLICIT NONE + + Real :: DW_MainBrakeTorque , DW_DrumRPM + + + + !DW_MainBrakeTorque = ((Drawworks%Diameter/2.0d0)*Drawworks%BreakLoad)*(Drawworks%ManualBreak/100.0d0) ![N.m] + !DW_MainBrakeTorque = DW_MainBrakeTorque/800.d0 ! Scaling: 0<=DW_MainBrakeTorque=<100 + !print*, 'DW_MainBrakeTorque0=' , DW_MainBrakeTorque + !if ( DW_MainBrakeTorque>100. ) then + ! DW_MainBrakeTorque = 100.d0 + !end if + + + + DW_DrumRPM = Drawworks%w_drum + !DW_DrumRPM = DW_DrumRPM*10.d0+(Drawworks%ManualBreak/100.0d0) ! Scaling: 0<=DW_DrumRPM=<1000 + !print*, 'DW_DrumRPM0=' , DW_DrumRPM + !!if ( DW_DrumRPM>=0. .and. DW_DrumRPM<=1. ) then + !! DW_DrumRPM = 1.0 + !!end if + !if ( DW_DrumRPM>1000.d0 ) then + ! DW_DrumRPM = 1000.d0 + !end if + + + !Drawworks%SoundDwBrake = INT((DW_MainBrakeTorque*DW_DrumRPM)) ! 0<=SoundDWBrake=<100000 + Drawworks%SoundDwBrake = INT((TD_DrawworksLoadInput/20000.)*DW_DrumRPM) + if ( Drawworks%ManualBreak==0. ) then + Drawworks%SoundDwBrake = 0 + end if + Drawworks%SoundDwBrake = Drawworks%SoundDwBrake*10 + Call SetSoundDwBrake( Drawworks%SoundDwBrake ) + + + !print*, 'Drawworks%SoundDwBrake=' , Drawworks%SoundDwBrake + !print*, 'DW_DrumRPM=' , DW_DrumRPM + !print*, 'TD_DrawworksLoadInput=' , TD_DrawworksLoadInput + !print*, 'Drawworks%ManualBreak=' , Drawworks%ManualBreak + + + +END subroutine \ No newline at end of file diff --git a/Equipments/Drawworks/DWFixModeMotion.f90 b/Equipments/Drawworks/DWFixModeMotion.f90 new file mode 100644 index 0000000..e01a795 --- /dev/null +++ b/Equipments/Drawworks/DWFixModeMotion.f90 @@ -0,0 +1,28 @@ +subroutine DWFixModeMotion + + Use Drawworks_VARIABLES + Use CHookVariables + + IMPLICIT NONE + + + + Drawworks%Hook_Height_final = Drawworks%Hook_Height_final ![ft] + Call Set_HookHeight(real(Drawworks%Hook_Height_final)) + Drawworks%Hook_Height= Drawworks%Hook_Height_final/3.280839895 ![m] + Drawworks%w_drum = 0. + Drawworks%w_old_drum = 0. + Drawworks%w = 0. + Drawworks%w_old = 0. + !Drawworks%ia = 0. ?????????? + !Drawworks%ia_old = 0. ?????????? + !Drawworks%x = 0. ?????????? + !Drawworks%x_old = 0. ?????????? + !Drawworks%y = 0. ?????????? + !Drawworks%y_old = 0. ?????????? + Drawworks%motion = 0 + + + + +END subroutine \ No newline at end of file diff --git a/Equipments/Drawworks/DWMalfunction_ClutchDisengage.f90 b/Equipments/Drawworks/DWMalfunction_ClutchDisengage.f90 new file mode 100644 index 0000000..d21dbf0 --- /dev/null +++ b/Equipments/Drawworks/DWMalfunction_ClutchDisengage.f90 @@ -0,0 +1,19 @@ +subroutine DWMalfunction_ClutchDisengage + + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CHoistingVariables + use Drawworks_VARIABLES + + IMPLICIT NONE + + !! Drawworks Malfunction ----> Clutch Disengage + !if ( Drawworks%ClutchDisengageMalf==1 ) then + ! Drawworks%ClutchMode=0 + ! return + !end if + + + + +END subroutine \ No newline at end of file diff --git a/Equipments/Drawworks/DWMalfunction_ClutchEngage.f90 b/Equipments/Drawworks/DWMalfunction_ClutchEngage.f90 new file mode 100644 index 0000000..9399564 --- /dev/null +++ b/Equipments/Drawworks/DWMalfunction_ClutchEngage.f90 @@ -0,0 +1,55 @@ +subroutine DWMalfunction_ClutchEngage + + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CHoistingVariables + use Drawworks_VARIABLES + use CSounds + use CLog4 + IMPLICIT NONE + + + + + + ! Sound Generation + if ( Drawworks%SoundClutch) then + Drawworks%SoundClutch = .false. + Call SetSoundDwClutch(Drawworks%SoundClutch) + end if + if ( DW_OldClutchMode/=0 .and. DWClutchLever==0 ) then + Drawworks%SoundClutch = .true. + Call SetSoundDwClutch(Drawworks%SoundClutch) + end if + DW_OldClutchMode = DWClutchLever + + + + + ! Drawworks Malfunction ----> Clutch Engage + if ( Drawworks%ClutchEngageMalf==1 ) then + if ( Drawworks%ClutchMode==1 .or. Drawworks%ClutchMode==-1 ) then + Drawworks%ClutchMode = Drawworks%ClutchMode + else if ( Drawworks%ClutchMode==0 ) then + Drawworks%ClutchMode = -1 + end if + return + end if + + + + + ! Drawworks Malfunction ----> Clutch Disengage + if ( Drawworks%ClutchDisengageMalf==1 ) then + Drawworks%ClutchMode = 0 + return + end if + + + Drawworks%ClutchMode = DWClutchLever + + + + + +end subroutine \ No newline at end of file diff --git a/Equipments/Drawworks/DWMalfunction_MotorFailure.f90 b/Equipments/Drawworks/DWMalfunction_MotorFailure.f90 new file mode 100644 index 0000000..013856f --- /dev/null +++ b/Equipments/Drawworks/DWMalfunction_MotorFailure.f90 @@ -0,0 +1,20 @@ +subroutine DWMalfunction_MotorFailure + + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CHoistingVariables + use Drawworks_VARIABLES + + IMPLICIT NONE + + + + + if (Drawworks%MotorFaileMalf==1) then + Drawworks%Conv_Ratio = 1.0D0 + end if + + + + +END subroutine \ No newline at end of file diff --git a/Equipments/Drawworks/DrawworksMain.f90 b/Equipments/Drawworks/DrawworksMain.f90 new file mode 100644 index 0000000..bdf0b49 --- /dev/null +++ b/Equipments/Drawworks/DrawworksMain.f90 @@ -0,0 +1,171 @@ +module DrawworksMain + implicit none + public + contains + + subroutine Drawworks_Setup() + use CSimulationVariables + implicit none + call OnSimulationInitialization%Add(Drawworks_Init) + call OnSimulationStop%Add(Drawworks_Init) + call OnDrawworksStep%Add(Drawworks_Step) + call OnDrawworksOutput%Add(Drawworks_Output) + call OnDrawworksMain%Add(DrawworksMainBody) + end subroutine + + subroutine Drawworks_Init + implicit none + end subroutine Drawworks_Init + + subroutine Drawworks_Step + implicit none + end subroutine Drawworks_Step + + subroutine Drawworks_Output + implicit none + end subroutine Drawworks_Output + + subroutine DrawworksMainBody + + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CHoistingVariables + use CSimulationVariables + use Drawworks_VARIABLES + use CHookVariables + use CWarningsVariables + use CSounds + + + implicit none + + integer,dimension(8) :: DW_START_TIME, DW_END_TIME + INTEGER :: DW_SolDuration + + + + + Call Drawworks_StartUp + loopdrawsim : do + + CALL DATE_AND_TIME(values=DW_START_TIME) + if (IsPortable) then + Drawworks%AssignmentSwitch = 1 + else + Drawworks%AssignmentSwitch = AssignmentSwitch + end if + if((any(Drawworks%AssignmentSwitch==(/1,2,3,4,5,7,8,9,10,11/))) .and. (DWSwitch==-1) .and. (DWThrottle==0.)) then + + + Drawworks%SoundBlower = .true. + Call SetSoundBlowerDW(Drawworks%SoundBlower) + DWBLWR = 1 + + loopDrawworks1 : do + + CALL DATE_AND_TIME(values=DW_START_TIME) + if (IsPortable) then + Drawworks%AssignmentSwitch = 1 + else + Drawworks%AssignmentSwitch = AssignmentSwitch + end if + if(any(Drawworks%AssignmentSwitch==(/1,2,5,7,8,9,10,11/))) then + Drawworks%NumberOfTracMotor = 2.0d0 + else if (any(Drawworks%AssignmentSwitch==(/3,4/))) then + Drawworks%NumberOfTracMotor = 1.0d0 + end if + + Call Drawworks_Solver + DW_TDHookHeight = Drawworks%Hook_Height_final + if ( Drawworks%motion==+1 ) then + Drawworks%SoundRev = 0 ![rpm] , Integer + Call SetSoundDwRev( Drawworks%SoundRev ) + Drawworks%SoundFw = INT(Drawworks%w_drum) ![rpm] , Integer + Call SetSoundDwFw(Drawworks%SoundFw) + Call DWBrakeSound + else + Drawworks%SoundFw = 0 ![rpm] , Integer + Call SetSoundDwFw(Drawworks%SoundFw) + Drawworks%SoundRev = INT(Drawworks%w_drum) ![rpm] , Integer + Call SetSoundDwRev( Drawworks%SoundRev ) + Call DWBrakeSound + end if + DW_OldTransMode = DWTransmisionLever + + if (IsPortable) then + Drawworks%AssignmentSwitch = 1 + else + Drawworks%AssignmentSwitch = AssignmentSwitch + end if + if ((any(Drawworks%AssignmentSwitch==(/6,12/))) .or. (any(DWSwitch==(/0,1/))) .or. (IsStopped == .true.)) then + Drawworks%SoundBlower = .false. + Call SetSoundBlowerDW(Drawworks%SoundBlower) + DWBLWR = 0 + !Call Drawworks_Solver_FreeTractionMotor + exit loopDrawworks1 + end if + + CALL DATE_AND_TIME(values=DW_END_TIME) + DW_SolDuration = 100-(DW_END_TIME(5)*3600000+DW_END_TIME(6)*60000+DW_END_TIME(7)*1000+DW_END_TIME(8)-DW_START_TIME(5)*3600000-DW_START_TIME(6)*60000-DW_START_TIME(7)*1000-DW_START_TIME(8)) + if(DW_SolDuration > 0.0d0) then + CALL sleepqq(DW_SolDuration) + end if + + end do loopDrawworks1 + + + else + + + if (IsPortable) then + Drawworks%AssignmentSwitch = 1 + else + Drawworks%AssignmentSwitch = AssignmentSwitch + end if + if((any(Drawworks%AssignmentSwitch==(/1,2,3,4,5,7,8,9,10,11/))) .and. (DWSwitch==-1)) then + Drawworks%SoundBlower = .true. + Call SetSoundBlowerDW(Drawworks%SoundBlower) + DWBLWR = 1 + else + Drawworks%SoundBlower = .false. + Call SetSoundBlowerDW(Drawworks%SoundBlower) + DWBLWR = 0 + end if + + Call Drawworks_Solver_FreeTractionMotor + DW_TDHookHeight = Drawworks%Hook_Height_final + if ( Drawworks%motion==+1 ) then + Drawworks%SoundRev = 0 ![rpm] , Integer + Call SetSoundDwRev( Drawworks%SoundRev ) + Drawworks%SoundFw = INT(Drawworks%w_drum) ![rpm] , Integer + Call SetSoundDwFw(Drawworks%SoundFw) + Call DWBrakeSound + else + Drawworks%SoundFw = 0 ![rpm] , Integer + Call SetSoundDwFw(Drawworks%SoundFw) + Drawworks%SoundRev = INT(Drawworks%w_drum) ![rpm] , Integer + Call SetSoundDwRev( Drawworks%SoundRev ) + Call DWBrakeSound + end if + DW_OldTransMode = DWTransmisionLever + + + end if + + if (IsStopped == .true.) then + exit loopdrawsim + end if + + + CALL DATE_AND_TIME(values=DW_END_TIME) + DW_SolDuration = 100-(DW_END_TIME(5)*3600000+DW_END_TIME(6)*60000+DW_END_TIME(7)*1000+DW_END_TIME(8)-DW_START_TIME(5)*3600000-DW_START_TIME(6)*60000-DW_START_TIME(7)*1000-DW_START_TIME(8)) + !print*, 'time=', DW_SolDuration + if(DW_SolDuration > 0.0d0) then + CALL sleepqq(DW_SolDuration) + end if + + end do loopdrawsim + + end subroutine DrawworksMainBody + +end module DrawworksMain \ No newline at end of file diff --git a/Equipments/Drawworks/Drawworks_Diff_Equations.f90 b/Equipments/Drawworks/Drawworks_Diff_Equations.f90 new file mode 100644 index 0000000..1b3e25e --- /dev/null +++ b/Equipments/Drawworks/Drawworks_Diff_Equations.f90 @@ -0,0 +1,218 @@ +!---------------------------------------------- +! subroutine dia +!---------------------------------------------- + +subroutine dia(x1,x2,x3,x5,x6,x7) !dia(t ia w fii x y) + + Use Drawworks_VARIABLES + + IMPLICIT NONE + REAL :: x1,x2,x3,x5,x6,x7 + + !Drawworks%Vt = x6+Kpi*(Kpn*((30.*Drawworks%w_ref/pi)-(30.*x3/pi))-x2) + Drawworks%ia_ref = x7+Kpn*((30.0d0*Drawworks%w_ref/pi)-(30.0d0*x3/pi)) + if ( Drawworks%ia_ref>1400. ) then + Drawworks%ia_ref = 1400. + end if + + Drawworks%Vt = x6+(Kpi*(Drawworks%ia_ref-x2)) + IF (Drawworks%Vt>810.0d0) THEN + Drawworks%Vt = 810.0d0 + ELSE IF (Drawworks%Vt<0.0d0) THEN + Drawworks%Vt = 0.0d0 + END IF + + IF (x2<=1150.0d0) THEN + x5 = 6.3304d-3*x2 + ELSE IF (x2>1150.0d0) THEN + x5 = (2.8571d-7)*(x2-1150.0d0)+7.280d0 + END IF + + Drawworks%Ea = x5*x3 + Drawworks%dia = (Drawworks%Vt-(Ra+Rf)*x2-Drawworks%Ea)/(La+Lf) + + end subroutine + + + + + + + +!---------------------------------------------- +! subroutine dw +!---------------------------------------------- + +subroutine dw(x1,x2,x3,x4,x5) !x1=t, x2=ia, x3=w, x4=fii, x5=TL + + Use Drawworks_VARIABLES + + IMPLICIT NONE + REAL :: x1,x2,x3,x4,x5 + + IF (x2<=1150.) THEN + x4 = 6.3304d-3*x2 + ELSE IF (x2>1150.0d0) THEN + x4 = 2.8571d-7*(x2-1150.0d0)+7.280d0 + END IF + + Drawworks%Te = x4*x2 + IF (Drawworks%Conv_Ratio==1.) THEN + Drawworks%Te = 0.0d0 + END IF + + Drawworks%EddyTorque = (1.039d5*exp(4.343d-4*(30.0d0*(x3/Drawworks%Conv_Ratio)/pi)))+(-1.036d5*exp(-.047920d0*(30.0d0*(x3/Drawworks%Conv_Ratio)/pi))) ![Lbf.ft] + !IF (Drawworks%EddyTorque>115000.0d0) THEN + ! Drawworks%EddyTorque = 115000.0d0 + !END IF + Drawworks%EddyTorque = 1.3558179480d0*Drawworks%EddyTorque ![N.m] + + Drawworks%TL = ((Drawworks%F_fastline*(Drawworks%Diameter/2.0d0))+(Drawworks%EddyTorque*(Drawworks%EddyBreak/100.0d0))+(((Drawworks%Diameter/2.0d0)*Drawworks%BreakLoad)*(Drawworks%ManualBreak/100.0d0)))/Drawworks%Conv_Ratio + Drawworks%TL = Drawworks%TL/Drawworks%NumberOfTracMotor + + Drawworks%dw = (Drawworks%Te-Drawworks%TL)/Drawworks%J_coef + +end subroutine + + + + + + + +!---------------------------------------------- +! subroutine dx +!---------------------------------------------- + +subroutine dx(x1,x2,x3,x4,x5) + + Use Drawworks_VARIABLES + + IMPLICIT NONE + REAL :: x1,x2,x3,x4,x5 + + Drawworks%ia_ref = x5+Kpn*((30.0d0*Drawworks%w_ref/pi)-(30.0d0*x3/pi)) + if ( Drawworks%ia_ref>1400. ) then + Drawworks%ia_ref = 1400. + end if + + Drawworks%dx = Kii*(Drawworks%ia_ref-x2) + +end subroutine + + + + + + + +!---------------------------------------------- +! subroutine dy +!---------------------------------------------- + +subroutine dy(x1,x2,x3,x4,x5) + + Use Drawworks_VARIABLES + + IMPLICIT NONE + REAL :: x1,x2,x3,x4,x5 + + Drawworks%dy = Kin*((30.0d0*Drawworks%w_ref/pi)-(30.0d0*x3/pi)) + +end subroutine + + + + + + + + +!---------------------------------------------- +! subroutine dw_freeTrac_Dmotion +!---------------------------------------------- + +subroutine dw_freeTrac_Dmotion(x1,x2) !x1=t , x2=w + + Use Drawworks_VARIABLES + + IMPLICIT NONE + REAL :: x1, x2 + + Drawworks%EddyTorque = (1.039d5*exp(4.343d-4*(30.0d0*(x2)/pi)))+(-1.036d5*exp(-.047920d0*(30.0d0*(x2)/pi))) ![Lbf.ft] + IF (Drawworks%EddyTorque>115000.0d0) THEN + Drawworks%EddyTorque = 115000.0d0 + END IF + Drawworks%EddyTorque = 1.3558179480d0*Drawworks%EddyTorque ![N.m] + + Drawworks%dw_freeTrac_Dmotion = ((Drawworks%F_fastline*(Drawworks%Diameter/2.0d0))-(Drawworks%EddyTorque*(Drawworks%EddyBreak/100.0d0))-(((Drawworks%Diameter/2.0d0)*Drawworks%BreakLoad)*(Drawworks%ManualBreak/100.0d0)))/Drawworks%J_coef + +end subroutine + + + + + + + + + +!---------------------------------------------- +! subroutine dw_freeTrac +!---------------------------------------------- +subroutine dw_freeTrac(x1,x2) !x1=t, x2=w + + Use Drawworks_VARIABLES + + IMPLICIT NONE + REAL :: x1, x2 + + Drawworks%EddyTorque = (1.039d5*exp(4.343d-4*(30.0d0*(x2)/pi)))+(-1.036d5*exp(-.047920d0*(30.0d0*(x2)/pi))) ![Lbf.ft] + IF (Drawworks%EddyTorque>115000.0d0) THEN + Drawworks%EddyTorque = 115000.0d0 + END IF + Drawworks%EddyTorque = 1.3558179480d0*Drawworks%EddyTorque ![N.m] + + Drawworks%dw_freeTrac = (-(Drawworks%F_fastline*(Drawworks%Diameter/2.0d0))-(Drawworks%EddyTorque*(Drawworks%EddyBreak/100.0d0))-(((Drawworks%Diameter/2.0d0)*Drawworks%BreakLoad)*(Drawworks%ManualBreak/100.0d0)))/Drawworks%J_coef + +end subroutine + + + + + + + + + +!---------------------------------------------- +! subroutine dw_DawnMotion +!---------------------------------------------- + +subroutine dw_DawnMotion(x1,x2,x3,x4,x5) !x1=t, x2=ia, x3=w, x4=fii, x5=TL + + Use Drawworks_VARIABLES + + IMPLICIT NONE + REAL :: x1,x2,x3,x4,x5 + + IF (x2<=1150.0d0) THEN + x4 = 6.3304d-3*x2 + ELSE IF (x2>1150.0d0) THEN + x4 = 2.8571d-7*(x2-1150.0d0)+7.280d0 + END IF + + Drawworks%Te = x4*x2 + + Drawworks%EddyTorque = (1.039d5*exp(4.343d-4*(30.0d0*(x3/Drawworks%Conv_Ratio)/pi)))+(-1.036d5*exp(-.047920d0*(30.0d0*(x3/Drawworks%Conv_Ratio)/pi))) ![Lbf.ft] + IF (Drawworks%EddyTorque>115000.0d0) THEN + Drawworks%EddyTorque = 115000.0d0 + END IF + Drawworks%EddyTorque = 1.3558179480d0*Drawworks%EddyTorque ![N.m] + + Drawworks%TL = ((Drawworks%F_fastline*(Drawworks%Diameter/2.0d0))-(Drawworks%EddyTorque*(Drawworks%EddyBreak/100.0d0))-(((Drawworks%Diameter/2.0d0)*Drawworks%BreakLoad)*(Drawworks%ManualBreak/100.0d0)))/Drawworks%Conv_Ratio + Drawworks%TL = Drawworks%TL/Drawworks%NumberOfTracMotor + + Drawworks%dw_DawnMotion = (Drawworks%TL-Drawworks%Te)/Drawworks%J_coef + +end subroutine \ No newline at end of file diff --git a/Equipments/Drawworks/Drawworks_Direction.f90 b/Equipments/Drawworks/Drawworks_Direction.f90 new file mode 100644 index 0000000..7399789 --- /dev/null +++ b/Equipments/Drawworks/Drawworks_Direction.f90 @@ -0,0 +1,119 @@ +subroutine Drawworks_Direction + + Use CDrillingConsoleVariables + Use CDataDisplayConsoleVariables + Use Drawworks_VARIABLES + + IMPLICIT NONE + + + + + + if (Drawworks%Conv_Ratio==1.d0) then + + + IF (Drawworks%motion==+1) THEN + Call Drawworks_Free_Traction_motor_Dir + if (Drawworks%w_drum_Dir<=0.) then + Drawworks%motion = 0 + else + Drawworks%motion = +1 + Call Drawworks_Free_Traction_motor + Drawworks%w = Drawworks%w_drum*Drawworks%Conv_Ratio + Drawworks%w_old = Drawworks%w_old_drum*Drawworks%Conv_Ratio + end if + ELSE + if (((Drawworks%F_fastline*(Drawworks%Diameter/2.0d0))-(((Drawworks%Diameter/2.0d0)*Drawworks%BreakLoad)*(Drawworks%ManualBreak/100.0d0)))<=0.) then + Drawworks%motion = 0 + Drawworks%w_drum = 0.0d0 + Drawworks%w_old_drum = 0.0d0 + Drawworks%w = Drawworks%w_drum*Drawworks%Conv_Ratio + Drawworks%w_old = Drawworks%w_old_drum*Drawworks%Conv_Ratio + Drawworks%Hook_Height = Drawworks%Hook_Height + + Drawworks%ia = 0. + Drawworks%ia_old = 0. + Drawworks%x = 0. + Drawworks%x_old = 0. + Drawworks%y = 0. + Drawworks%y_old = 0. + else + Drawworks%motion = -1 + Call Drawworks_Free_Traction_motor_dawn_motion + Drawworks%w = Drawworks%w_drum*Drawworks%Conv_Ratio + Drawworks%w_old = Drawworks%w_old_drum*Drawworks%Conv_Ratio + end if + + END IF + + + else + + IF (Drawworks%motion==-1) THEN + Drawworks%w = -Drawworks%w + Drawworks%w_old = -Drawworks%w_old + Drawworks%w_drum = -Drawworks%w_drum + Drawworks%w_old_drum = -Drawworks%w_old_drum + END IF + Call Drawworks_Traction_motor_ClutchMode_Dir + IF (Drawworks%w_Dir>0.) then + + Drawworks%motion = +1 + Call Drawworks_Traction_motor_ClutchMode + Drawworks%w_drum = Drawworks%w/Drawworks%Conv_Ratio + Drawworks%w_old_drum = Drawworks%w_old/Drawworks%Conv_Ratio + ELSE + Drawworks%EddyTorque = (1.039d5*exp(4.343d-4*(30.0d0*(Drawworks%w/Drawworks%Conv_Ratio)/pi)))+(-1.036d5*exp(-.047920d0*(30.0d0*(Drawworks%w/Drawworks%Conv_Ratio)/pi))) !Lbf.ft + if (Drawworks%EddyTorque>115000.) then + Drawworks%EddyTorque = 115000.0d0 + end if + Drawworks%EddyTorque = 1.355817948*Drawworks%EddyTorque ![N.m] + if ((Drawworks%F_fastline*(Drawworks%Diameter/2.0d0))>((((Drawworks%Diameter/2.0d0)*Drawworks%BreakLoad)*(Drawworks%ManualBreak/100.0d0))+(Drawworks%EddyTorque*(Drawworks%EddyBreak/100.0d0)))) then + Drawworks%motion = -1 + + IF (Drawworks%w_drum<0.) THEN + Drawworks%w = -Drawworks%w + Drawworks%w_old = -Drawworks%w_old + !Drawworks%w = 0. !??????????????? + !Drawworks%w_old = 0. !??????????????? + Drawworks%w_drum = -Drawworks%w_drum + Drawworks%w_old_drum = -Drawworks%w_old_drum + END IF + + Drawworks%Conv_Ratio = 1. + Call Drawworks_Free_Traction_motor_dawn_motion + Drawworks%w = Drawworks%w_drum*Drawworks%Conv_Ratio + Drawworks%w_old = Drawworks%w_old_drum*Drawworks%Conv_Ratio + !Drawworks%w_drum = Drawworks%w/Drawworks%Conv_Ratio + !Drawworks%w_old_drum = Drawworks%w_old/Drawworks%Conv_Ratio + else + Drawworks%motion = 0 + Drawworks%w_drum = 0.0d0 + Drawworks%w_old_drum = 0.0d0 + Drawworks%w = Drawworks%w_drum*Drawworks%Conv_Ratio + Drawworks%w_old = Drawworks%w_old_drum*Drawworks%Conv_Ratio + Drawworks%Hook_Height = Drawworks%Hook_Height + + Drawworks%ia = 0. + Drawworks%ia_old = 0. + Drawworks%x = 0. + Drawworks%x_old = 0. + Drawworks%y = 0. + Drawworks%y_old = 0. + end if + + END IF + + end if + + + + Call DWBrakeSound + + !print* , 'Drawworks%ia_new=' , Drawworks%ia_new + !print* , 'Drawworks%ia_ref=' , Drawworks%ia_ref + !print* , 'Drawworks%Vt=' , Drawworks%Vt + !print* , 'Drawworks%w_new=' , Drawworks%w_new + +end subroutine Drawworks_Direction \ No newline at end of file diff --git a/Equipments/Drawworks/Drawworks_Free_Traction_motor.f90 b/Equipments/Drawworks/Drawworks_Free_Traction_motor.f90 new file mode 100644 index 0000000..9b97ec6 --- /dev/null +++ b/Equipments/Drawworks/Drawworks_Free_Traction_motor.f90 @@ -0,0 +1,86 @@ +subroutine Drawworks_Free_Traction_motor + + + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use Drawworks_VARIABLES + + IMPLICIT NONE + + + REAL, allocatable, dimension(:) :: w_array + Integer :: jj, kk + REAL :: sigma_w + + + + + + !Drawworks%w_drum = Drawworks%w/Drawworks%Conv_Ratio + + Drawworks%time = Drawworks%time_step + Drawworks%dt = 1.d-5 + Drawworks%error = .001 + +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + Drawworks%n = Drawworks%time/Drawworks%dt + + if (allocated(w_array)) deallocate(w_array) + allocate(w_array(0:Drawworks%n)) + w_array(0) = Drawworks%w_drum + + Drawworks%i = 1 + +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + DO WHILE (Drawworks%i<=Drawworks%n) + + + !>>>>>>>>>>>> Runge-Kutta Method (2nd order) <<<<<<<<<<<<<< + + call dw_freeTrac((Drawworks%i*Drawworks%dt),Drawworks%w_drum) + Drawworks%K1w = Drawworks%dt*Drawworks%dw_freeTrac + + call dw_freeTrac((Drawworks%i*Drawworks%dt)+(Drawworks%dt),Drawworks%w_drum+(Drawworks%K1w)) + Drawworks%K2w = Drawworks%dt*Drawworks%dw_freeTrac + + Drawworks%w_new_drum = Drawworks%w_old_drum+((Drawworks%K1w+Drawworks%K2w)/2.) + + Drawworks%w_old_drum = Drawworks%w_new_drum + Drawworks%w_drum = Drawworks%w_new_drum + + w_array(Drawworks%i) = Drawworks%w_new_drum + + Drawworks%i = Drawworks%i+1 + + + END DO +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + + + + + +!>>>>>>>>> Hook Height Calculation <<<<<<<<<<< + !>>>>>>>>>>>> Simpson1/3 Method <<<<<<<<<<<<<< + sigma_w = w_array(0)+w_array(Drawworks%n) + + do jj = 1,Drawworks%n-1,2 + sigma_w = sigma_w+(4.0d0*w_array(jj)) + end do + + do kk = 2,Drawworks%n-2,2 + sigma_w = sigma_w+(2.0d0*w_array(kk)) + end do + + Drawworks%Hook_Height = Drawworks%Hook_Height+(((Drawworks%Diameter/2.0d0)*(Drawworks%dt*sigma_w/3.0d0))/Drawworks%NumberOfLine) + + + + + + + + +END subroutine Drawworks_Free_Traction_motor \ No newline at end of file diff --git a/Equipments/Drawworks/Drawworks_Free_Traction_motor_Dir.f90 b/Equipments/Drawworks/Drawworks_Free_Traction_motor_Dir.f90 new file mode 100644 index 0000000..071238b --- /dev/null +++ b/Equipments/Drawworks/Drawworks_Free_Traction_motor_Dir.f90 @@ -0,0 +1,61 @@ +subroutine Drawworks_Free_Traction_motor_Dir + + + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use Drawworks_VARIABLES + + IMPLICIT NONE + + + Integer :: jj, kk + REAL, allocatable, dimension(:) :: w_array + REAL :: sigma_w + + + + + + !Drawworks%w_drum = Drawworks%w/Drawworks%Conv_Ratio + + Drawworks%time = Drawworks%time_step + Drawworks%dt = 1.d-5 + Drawworks%error = .001 + + Drawworks%w_drum_Dir = Drawworks%w_drum + Drawworks%w_old_drum_Dir = Drawworks%w_old_drum + +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + Drawworks%n = Drawworks%time/Drawworks%dt + + Drawworks%i = 1 + +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + DO WHILE (Drawworks%i<=Drawworks%n) + + + !>>>>>>>>>>>> Runge-Kutta Method (2nd order) <<<<<<<<<<<<<< + + call dw_freeTrac((Drawworks%i*Drawworks%dt),Drawworks%w_drum_Dir) + Drawworks%K1w = Drawworks%dt*Drawworks%dw_freeTrac + + call dw_freeTrac((Drawworks%i*Drawworks%dt)+(Drawworks%dt),Drawworks%w_drum_Dir+(Drawworks%K1w)) + Drawworks%K2w = Drawworks%dt*Drawworks%dw_freeTrac + + Drawworks%w_new_drum_Dir = Drawworks%w_old_drum_Dir+((Drawworks%K1w+Drawworks%K2w)/2.0d0) + + Drawworks%w_old_drum_Dir = Drawworks%w_new_drum_Dir + Drawworks%w_drum_Dir = Drawworks%w_new_drum_Dir + + Drawworks%i = Drawworks%i+1 + + + END DO +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + + + + +END subroutine Drawworks_Free_Traction_motor_Dir \ No newline at end of file diff --git a/Equipments/Drawworks/Drawworks_Free_Traction_motor_dawn_motion.f90 b/Equipments/Drawworks/Drawworks_Free_Traction_motor_dawn_motion.f90 new file mode 100644 index 0000000..56bb467 --- /dev/null +++ b/Equipments/Drawworks/Drawworks_Free_Traction_motor_dawn_motion.f90 @@ -0,0 +1,86 @@ +subroutine Drawworks_Free_Traction_motor_dawn_motion + + + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use Drawworks_VARIABLES + + IMPLICIT NONE + + + REAL, allocatable, dimension(:) :: w_array + Integer :: jj, kk + REAL :: sigma_w + + + + + + !Drawworks%w_drum = Drawworks%w/Drawworks%Conv_Ratio + + Drawworks%time = Drawworks%time_step + Drawworks%dt = 1.d-5 + Drawworks%error = .001 + +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + Drawworks%n = Drawworks%time/Drawworks%dt + + if (allocated(w_array)) deallocate(w_array) + allocate(w_array(0:Drawworks%n)) + w_array(0) = Drawworks%w_drum + + Drawworks%i = 1 + +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + DO WHILE (Drawworks%i<=Drawworks%n) + + + !>>>>>>>>>>>> Runge-Kutta Method (2nd order) <<<<<<<<<<<<<< + + call dw_freeTrac_Dmotion((Drawworks%i*Drawworks%dt),Drawworks%w_drum) + Drawworks%K1w = Drawworks%dt*Drawworks%dw_freeTrac_Dmotion + + call dw_freeTrac_Dmotion((Drawworks%i*Drawworks%dt)+(Drawworks%dt),Drawworks%w_drum+(Drawworks%K1w)) + Drawworks%K2w = Drawworks%dt*Drawworks%dw_freeTrac_Dmotion + + Drawworks%w_new_drum = Drawworks%w_old_drum+((Drawworks%K1w+Drawworks%K2w)/2.) + + Drawworks%w_old_drum = Drawworks%w_new_drum + Drawworks%w_drum = Drawworks%w_new_drum + + w_array(Drawworks%i) = Drawworks%w_new_drum + + Drawworks%i = Drawworks%i+1 + + + END DO +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !print* , 'Drawworksdir555=',Drawworks%F_fastline , (Drawworks%F_fastline*(Drawworks%Diameter/2.0d0)) , (Drawworks%EddyTorque*(Drawworks%EddyBreak/100.0d0)) , (((Drawworks%Diameter/2.0d0)*Drawworks%BreakLoad)*(Drawworks%ManualBreak/100.0d0)) , Drawworks%ManualBreak + + + + + + +!>>>>>>>>> Hook Height Calculation <<<<<<<<<<< + !>>>>>>>>>>>> Simpson1/3 Method <<<<<<<<<<<<<< + sigma_w = w_array(0)+w_array(Drawworks%n) + + do jj=1,Drawworks%n-1,2 + sigma_w = sigma_w+(4.0d0*w_array(jj)) + end do + + do kk=2,Drawworks%n-2,2 + sigma_w = sigma_w+(2.0d0*w_array(kk)) + end do + + Drawworks%Hook_Height = Drawworks%Hook_Height-(((Drawworks%Diameter/2.0d0)*(Drawworks%dt*sigma_w/3.0d0))/Drawworks%NumberOfLine) + + !deallocate(w_array) + + + + + +END subroutine Drawworks_Free_Traction_motor_dawn_motion \ No newline at end of file diff --git a/Equipments/Drawworks/Drawworks_INPUTS.f90 b/Equipments/Drawworks/Drawworks_INPUTS.f90 new file mode 100644 index 0000000..2f82d70 --- /dev/null +++ b/Equipments/Drawworks/Drawworks_INPUTS.f90 @@ -0,0 +1,250 @@ +subroutine Drawworks_INPUTS + + Use CDrillingConsoleVariables + Use CDataDisplayConsoleVariables + Use CHoistingVariables + Use CSimulationVariables + Use CSlipsEnumVariables + Use CKellyConnectionEnumVariables + Use CElevatorConnectionEnumVariables + Use COperationConditionEnumVariables + Use COperationScenariosVariables + Use CSwingEnumVariables + Use CUnityInputs + Use CTdsConnectionModesEnumVariables + Use CTdsElevatorModesEnumVariables + Use CTdsSwingEnumVariables + Use VARIABLES + Use Drawworks_VARIABLES + Use TD_StringConnectionData + Use TD_DrillStemComponents + + IMPLICIT NONE + + + + Call DWMalfunction_ClutchEngage + + + + Drawworks%TransMode = DWTransmisionLever + Drawworks%Direction_Var = DWSwitch + + + if (IsPortable) then + if (Drawworks%Direction_Var==-1 .and. Clutch==1) then !in FWD mode + Drawworks%Conv_Ratio = Drawworks%FWD_Conv_Ratio(Drawworks%ClutchMode,Drawworks%TransMode) + else + Drawworks%Conv_Ratio = 1.d0 + end if + else + if (Drawworks%Direction_Var==-1) then !in FWD mode + Drawworks%Conv_Ratio = Drawworks%FWD_Conv_Ratio(Drawworks%ClutchMode,Drawworks%TransMode) + else if (Drawworks%Direction_Var==+1) then !in REV mode + Drawworks%Conv_Ratio = 1.d0 + else if (Drawworks%Direction_Var==0) then !in OFF mode + Drawworks%Conv_Ratio = 1.d0 + end if + end if + + + + !===> Main Brake and Eddy Brake + Drawworks%EddyBreak = EddyBreakLever*0.5 !0 Brake Load (Main Brake) + Drawworks%BreakLoad = DrillingLineBreakingLoad ![Lbf] + Drawworks%BreakLoad = 4.448221619*Drawworks%BreakLoad ![N] + + + + !===> F_fastline + Drawworks%F_fastline = real(TD_DrawworksLoadInput) ![Lbf] + Drawworks%F_fastline = 4.448221619*Drawworks%F_fastline ![N] + + + + !===> min&max Hook Height + if ( DriveType==1 .and. Get_OperationCondition()==OPERATION_DRILL ) then + if ( Get_Swing()==SWING_WELL_END .and. Get_KellyConnection()==KELLY_CONNECTION_NOTHING ) then + DW_DrillModeCond = 1 + Drawworks%min_Hook_Height = TD_TopJointHeight+HKL-RE ![ft] HKL=63.76=Kelly Ass. Height , RE=Release + Drawworks%max_Hook_Height = 120.d0 ![ft] + else if ( Get_Swing()==SWING_WELL_END .and. Get_KellyConnection()==KELLY_CONNECTION_SINGLE ) then + DW_DrillModeCond = 2 + Drawworks%min_Hook_Height = TD_TopJointHeight+HKL+PL-RE ![ft] PL=30=Pipe Lenght + Drawworks%max_Hook_Height = 120.d0 ![ft] + else if ( Get_Swing()==SWING_WELL_END .and. Get_KellyConnection() == KELLY_CONNECTION_STRING ) then + DW_DrillModeCond = 3 + Drawworks%min_Hook_Height = 21.44d0-RE ![ft] ?????????? check 21.44=(TD_KellyConst-TD_KellyElementConst) + Drawworks%max_Hook_Height = 120.d0 ![ft] + else if ( Get_Swing()==SWING_MOUSE_HOLE_END .and. Get_KellyConnection()==KELLY_CONNECTION_NOTHING ) then + DW_DrillModeCond = 4 + Drawworks%min_Hook_Height = 66.d0-RE ![ft] + Drawworks%max_Hook_Height = 120.d0 ![ft] + else if ( Get_Swing()==SWING_MOUSE_HOLE_END .and. Get_KellyConnection()==KELLY_CONNECTION_SINGLE ) then + DW_DrillModeCond = 5 + Drawworks%min_Hook_Height = 65.1d0-RE ![ft] + Drawworks%max_Hook_Height = 120.d0 ![ft] + else if ( Get_Swing()==SWING_RAT_HOLE_END ) then + DW_DrillModeCond = 6 + Drawworks%min_Hook_Height = 66.d0-RE ![ft] + Drawworks%max_Hook_Height = 120.d0 ![ft] + end if + else if ( DriveType==1 .and. Get_OperationCondition()==OPERATION_TRIP ) then + if ( Get_Swing()==SWING_WELL_END .and. Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING ) then + DW_DrillModeCond = 7 + Drawworks%min_Hook_Height = 18.38d0 ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_Swing()==SWING_WELL_END .and. Get_ElevatorConnection() == ELEVATOR_CONNECTION_STAND ) then + DW_DrillModeCond = 8 + Drawworks%min_Hook_Height = TD_TopJointHeight+HL+SL-(3.d0*RE) ![ft] HL=17.81=Hook Assy , SL=90=Stand Length , 3: chon meghdari az toole loole(tool joint) dakhele elevator gharar migirad + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_Swing()==SWING_WELL_END .and. Get_ElevatorConnection() == ELEVATOR_CONNECTION_SINGLE ) then + DW_DrillModeCond = 9 + Drawworks%min_Hook_Height = TD_TopJointHeight+HL+PL-(3.d0*RE) ![ft] 3: chon meghdari az toole loole(tool joint) balaye elevator mimanad + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_Swing()==SWING_WELL_END .and. Get_ElevatorConnection() == ELEVATOR_CONNECTION_STRING ) then + DW_DrillModeCond = 10 + Drawworks%min_Hook_Height = 18.5d0-RE ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_Swing()==SWING_MOUSE_HOLE_END .and. Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING ) then + DW_DrillModeCond = 11 + Drawworks%min_Hook_Height = 19.38d0-RE ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_Swing()==SWING_MOUSE_HOLE_END .and. Get_ElevatorConnection() == ELEVATOR_CONNECTION_SINGLE ) then + DW_DrillModeCond = 12 + Drawworks%min_Hook_Height = 17.73d0-RE ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_Swing()==SWING_RAT_HOLE_END ) then + DW_DrillModeCond = 13 + Drawworks%min_Hook_Height = 27.41d0-RE ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_Swing()==SWING_WELL_END .and. Get_ElevatorConnection() == ELEVATOR_LATCH_STRING ) then + DW_DrillModeCond = 14 + Drawworks%min_Hook_Height = 18.38d0 ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_Swing()==SWING_WELL_END .and. Get_ElevatorConnection() == ELEVATOR_LATCH_SINGLE ) then + DW_DrillModeCond = 25 !warning & collision + Drawworks%min_Hook_Height = 18.38d0 !????????????????? ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_Swing()==SWING_MOUSE_HOLE_END .and. Get_ElevatorConnection() == ELEVATOR_LATCH_SINGLE ) then + DW_DrillModeCond = 26 + Drawworks%min_Hook_Height = 10.38d0 !????????????????? ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_Swing()==SWING_WELL_END .and. Get_ElevatorConnection() == ELEVATOR_LATCH_STAND ) then + DW_DrillModeCond = 27 + Drawworks%min_Hook_Height = 18.38d0 !????????????????? ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + end if + else if ( DriveType==0 ) then + if ( Get_TdsSwing()==TDS_SWING_TILT_END ) then + if ( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_LATCH_SINGLE ) then + DW_DrillModeCond = 15 + Drawworks%min_Hook_Height = 15.0d0 ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_CONNECTION_SINGLE ) then + DW_DrillModeCond = 16 + Drawworks%min_Hook_Height = 15.0d0 ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_CONNECTION_NOTHING ) then + DW_DrillModeCond = 17 + Drawworks%min_Hook_Height = 15.0d0 ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + end if + else if ( Get_TdsSwing()==TDS_SWING_OFF_END ) then + if ( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_LATCH_STRING ) then + DW_DrillModeCond = 18 + Drawworks%min_Hook_Height = max(16.0d0,TD_TopJointHeight) ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_CONNECTION_STRING ) then + DW_DrillModeCond = 19 + Drawworks%min_Hook_Height = TD_TopJointHeight ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_TdsConnectionModes()==TDS_CONNECTION_STRING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_CONNECTION_NOTHING ) then + DW_DrillModeCond = 20 + Drawworks%min_Hook_Height = TD_TopJointHeight ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_CONNECTION_NOTHING ) then + DW_DrillModeCond = 21 + Drawworks%min_Hook_Height = max(16.0d0,TD_TopJointHeight) ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_LATCH_STAND ) then + DW_DrillModeCond = 22 + Drawworks%min_Hook_Height = max(16.0d0,TD_TopJointHeight) ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_CONNECTION_STAND ) then + DW_DrillModeCond = 23 + Drawworks%min_Hook_Height = max(16.0d0,TD_TopJointHeight) ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + else if ( Get_TdsConnectionModes()==TDS_CONNECTION_SPINE .and. Get_TdsElevatorModes()==TDS_ELEVATOR_CONNECTION_NOTHING ) then + DW_DrillModeCond = 24 + Drawworks%min_Hook_Height = TD_TopJointHeight ![ft] + Drawworks%max_Hook_Height = 140.d0 ![ft] + end if + end if + end if + + + + !print* , 'DW_DrillModeCond=' , DW_DrillModeCond + !!print* , 'Drawworks%min_Hook_Height=' , Drawworks%min_Hook_Height + !!print* , 'Drawworks%max_Hook_Height=' , Drawworks%max_Hook_Height + !print* , 'Drawworks%Hook_Height_final=' , Drawworks%Hook_Height_final + !print*, 'TD_DrillStemComponentsNumbs2=' , TD_DrillStemComponentsNumbs + !print*, 'TD_TopJointHeight2=' , TD_TopJointHeight + !print*, 'TD_DrillStemTotalLength2=', TD_DrillStemTotalLength + + + + + !===> SLIPS SET , No Motion + if ( DriveType==1 .and. Get_Slips() == SLIPS_SET_END .and. Get_KellyConnection() == KELLY_CONNECTION_STRING ) then + Drawworks%ManualBreak = 100.d0 + Drawworks%N_ref = 0.d0 + end if + + if ( DriveType==0 .and. Get_Slips() == SLIPS_SET_END .and. (Get_TdsConnectionModes()==TDS_CONNECTION_SPINE .or. Get_TdsConnectionModes()==TDS_CONNECTION_STRING) ) then + Drawworks%ManualBreak = 100.d0 + Drawworks%N_ref = 0.d0 + end if + + !if ( Get_Slips() == SLIPS_SET_END .and. Get_ElevatorConnection() == ELEVATOR_CONNECTION_STRING .and. Drawworks%motion==+1 ) then + ! Drawworks%ManualBreak = 100.d0 + ! Drawworks%N_ref = 0.d0 + !!else if ( Get_Slips() == SLIPS_SET_END .and. Get_ElevatorConnection() == ELEVATOR_CONNECTION_STRING .and. Drawworks%motion/=+1 ) then + !! Drawworks%N_ref = 0.d0 + !! !Call DWFixModeMotion + !! !print*, 'ELEVATOR_CONNECTION_STRING' + !end if + + + + !===> Closed BOP Rams , No Motion + !if ( PipeRam1_Situation_forTD==1 .or. PipeRam2_Situation_forTD==1 .or. ShearBop_Situation_forTD==1 ) then + if ( ShearBop_Situation_forTD==1 .and. (any(DW_DrillModeCond==(/3,10,19,20,24/))) ) then + Drawworks%ManualBreak = 100.d0 + Drawworks%N_ref = 0.d0 + end if + + + + + +end subroutine Drawworks_INPUTS \ No newline at end of file diff --git a/Equipments/Drawworks/Drawworks_Solver.f90 b/Equipments/Drawworks/Drawworks_Solver.f90 new file mode 100644 index 0000000..f1d2482 --- /dev/null +++ b/Equipments/Drawworks/Drawworks_Solver.f90 @@ -0,0 +1,379 @@ +subroutine Drawworks_Solver + + Use CDrillingConsoleVariables + Use CDataDisplayConsoleVariables + Use CHoistingVariables + Use CUnityInputs + Use Drawworks_VARIABLES + Use CHookVariables + Use CWarningsVariables + Use COperationConditionEnumVariables + Use CSlipsEnumVariables + Use CElevatorConnectionEnumVariables + Use CTdsConnectionModesEnumVariables + Use CTdsElevatorModesEnumVariables + Use TD_DrillStemComponents + Use TD_WellGeometry + Use CWarningsVariables + Use TD_GeneralData + Use CSounds + + IMPLICIT NONE + + + Integer :: j + Integer :: CrownCollision_Status , FloorCollision_Status , CrownWarning_Status , FloorWarning_Status + real :: time + + + + + +!>>>>>>>>>>>>>>>>>>>> N_Ref <<<<<<<<<<<<<<<<<<<<<<<< + + Drawworks%N_Throtle = DWThrottle ![rpm] + Drawworks%N_Accelarator = (DWAcceleretor/100.0)*965.0 ![rpm] + !print* , 'Drawworks%N_Throtle=' , Drawworks%N_Throtle + !print* , 'DWAcceleretor=' , DWAcceleretor + !print* , 'Drawworks%N_Accelarator=' , Drawworks%N_Accelarator + IF (Drawworks%N_Throtle>Drawworks%N_Accelarator) THEN + Drawworks%N_new = Drawworks%N_Throtle + !print* , 'Drawworks%N_Throtle' + ELSE + Drawworks%N_new = Drawworks%N_Accelarator + !print* , 'Drawworks%N_Accelarator' + END IF + if (((Drawworks%N_new-Drawworks%N_old)/Drawworks%time_step)>193.) then + Drawworks%N_ref = (193.*Drawworks%time_step)+Drawworks%N_old + else if (((Drawworks%N_old-Drawworks%N_new)/Drawworks%time_step)>193.) then + Drawworks%N_ref = (-193.*Drawworks%time_step)+Drawworks%N_old + else + Drawworks%N_ref = Drawworks%N_new + end if + Drawworks%N_old = Drawworks%N_ref + !print* , 'Drawworks%N_ref=' , Drawworks%N_ref + + + + + Call Drawworks_INPUTS + + + ! Drawworks Malfunction ----> Drive Motor Failure + Call DWMalfunction_MotorFailure + + + + + !=====> Drawworks Gears Abuse + if ( DW_OldTransMode==0 .and. Drawworks%TransMode/=0 .and. Drawworks%w_drum/=0. .and. Drawworks%ClutchMode/=0 ) then + Call Activate_DrawworksGearsAbuse() + Drawworks%SoundGearCrash = .true. + Call SetSoundDwGearCrash(Drawworks%SoundGearCrash) + Drawworks%ManualBreak = 100. + !Drawworks%N_ref = 0. + Call DWFixModeMotion + Drawworks%SoundRev = INT(Drawworks%w_drum) ![rpm] , Integer + Call SetSoundDwRev( Drawworks%SoundRev ) + return + else + Drawworks%SoundGearCrash = .false. + Call SetSoundDwGearCrash(Drawworks%SoundGearCrash) + end if + if ( DrawworksGearsAbuse==1 ) then + return + end if + + + + + + Call Drawworks_Direction + + + + + +!==================================================== +! Collision & Warning +!==================================================== + if ( CrownCollision == .false. ) then + CrownCollision_Status = 0 + end if + if ( FloorCollision == .false. ) then + FloorCollision_Status = 0 + end if + + !if ( CrownWarning == .false. ) then + ! CrownWarning_Status = 0 + !end if + !if ( FloorWarning == .false. ) then + ! FloorWarning_Status = 0 + !end if + + + + + + + + !==================================================== + ! Crown Collision (Max_Hook_Height) + !==================================================== + if ( ((3.280839895*Drawworks%Hook_Height)>=Drawworks%max_Hook_Height) .and. (any(DW_DrillModeCond==(/3,4,7,10,11,12,14/))) ) then + if ( CrownCollision_Status==0 .and. Drawworks%motion==1 ) then + Call Activate_CrownCollision() + CrownCollision_Status = 1 + Drawworks%SoundCrownCollision = .true. + Call SetSoundCrownCollision(Drawworks%SoundCrownCollision) + else + Drawworks%SoundCrownCollision = .false. + Call SetSoundCrownCollision(Drawworks%SoundCrownCollision) + end if + do While ( CrownCollision==1 ) + Call DWFixModeMotion + end do + if ( Drawworks%motion==-1 ) then + Drawworks%Hook_Height_final = 3.280839895*Drawworks%Hook_Height ![ft] + Call Set_HookHeight(real(Drawworks%Hook_Height_final)) + else + Call DWFixModeMotion + end if + return + end if + + + + + + + + !==================================================== + ! Floor Collision (Min_Hook_Height) + !==================================================== + if ( ((3.280839895*Drawworks%Hook_Height)<=Drawworks%min_Hook_Height) .and. (any(DW_DrillModeCond==(/3,4,7,10,11,12,14/))) ) then + if ( FloorCollision_Status==0 .and. Drawworks%motion==-1 ) then + Call Activate_FloorCollision() + Drawworks%SoundFloorCollision = .true. + Call SetSoundFloorCollision(Drawworks%SoundFloorCollision) + FloorCollision_Status = 1 + else + Drawworks%SoundFloorCollision = .false. + Call SetSoundFloorCollision(Drawworks%SoundFloorCollision) + end if + Do While ( FloorCollision ==1 ) + Call DWFixModeMotion + End Do + if ( Drawworks%motion==1 ) then + Drawworks%Hook_Height_final = 3.280839895*Drawworks%Hook_Height ![ft] + Call Set_HookHeight(real(Drawworks%Hook_Height_final)) + else + Call DWFixModeMotion + end if + return + end if + + + + + + + + + !==================================================== + ! Crown Warning + !==================================================== + if ( ((3.280839895*Drawworks%Hook_Height)>=Drawworks%max_Hook_Height) .and. (any(DW_DrillModeCond==(/1,2,5,6,8,9,13/))) ) then + !if ( crownwarning_Status==0 .and. Drawworks%motion==1 ) then ?????????? + ! Call Activate_crownwarning() ?????????? + !Drawworks%SoundCrownCollision = .true. + !Call SetSoundCrownCollision(Drawworks%SoundCrownCollision) + ! CrownWarning_Status = 1 ?????????? + !else + ! Drawworks%SoundCrownCollision = .false. + !Call SetSoundCrownCollision(Drawworks%SoundCrownCollision) + !end if ?????????? + if ( Drawworks%motion==-1 ) then + Drawworks%Hook_Height_final = 3.280839895*Drawworks%Hook_Height ![ft] + Call Set_HookHeight(real(Drawworks%Hook_Height_final)) + else + Call DWFixModeMotion + end if + return + end if + + + + + + + + !==================================================== + ! Floor Warning + !==================================================== + if ( ((3.280839895*Drawworks%Hook_Height)<=Drawworks%min_Hook_Height) .and. (any(DW_DrillModeCond==(/1,2,5,6,8,9,13/))) ) then + !if ( floorwarning_Status==0 .and. Drawworks%motion==-1 ) then ?????????? + ! Call Activate_floorwarning() ?????????? + !Drawworks%SoundCrownCollision = .true. + !Call SetSoundCrownCollision(Drawworks%SoundCrownCollision) + ! floorwarning_Status = 1 ?????????? + !else + !Drawworks%SoundCrownCollision = .false. + !Call SetSoundCrownCollision(Drawworks%SoundCrownCollision) + !end if ?????????? + if ( Drawworks%motion==1 ) then + Drawworks%Hook_Height_final = 3.280839895*Drawworks%Hook_Height ![ft] + Call Set_HookHeight(real(Drawworks%Hook_Height_final)) + else + Call DWFixModeMotion + end if + return + end if + + + + + + + + + + + !==================================================== + ! ELEVATOR CONNECTION STRING (SLIPS SET , No Motion) + !==================================================== + if ( DriveType==1 .and. Get_Slips() == SLIPS_SET_END .and. Get_ElevatorConnection() == ELEVATOR_CONNECTION_STRING .and. Drawworks%motion/=-1 ) then + !if ( Drawworks%motion/=-1 ) then + Call DWFixModeMotion + return + !end if + end if + + if ( DriveType==0 .and. Get_Slips() == SLIPS_SET_END .and. (Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_CONNECTION_STRING) .and. Drawworks%motion/=-1 ) then + !if ( Drawworks%motion/=-1 ) then + Call DWFixModeMotion + return + !end if + end if + + + + + + + + + + + + !==================================================== + ! RAM & ToolJoint Collision (Top of RAM) + !==================================================== + Do j = 2,4 !startup problem ??????? + if ( TD_BOPElementNo(j)/=0 ) then + if ( ((TD_BOPHeight(j)-TD_BOPThickness)<=(TD_DrillStems(TD_BOPElementNo(j))%TopDepth+TD_DrillStems(TD_BOPElementNo(j))%ToolJointRange)) .and. ((TD_BOPHeight(j)-TD_BOPThickness)>TD_DrillStems(TD_BOPElementNo(j))%TopDepth) .and. (TD_BOPRamDiam(j)<(2.d0*12.d0*TD_DrillStems(TD_BOPElementNo(j))%RtoolJoint)) ) then + if ( Drawworks%motion==1 ) then + Drawworks%Hook_Height_final = 3.280839895*Drawworks%Hook_Height ![ft] + Call Set_HookHeight(real(Drawworks%Hook_Height_final)) + else + Call DWFixModeMotion + end if + return + end if + end if + End Do + + + + + + + + + + !==================================================== + ! RAM & ToolJoint Collision (Bottom of RAM) + !==================================================== + Do j = 2,4 + if ( TD_BOPElementNo(j)/=0 ) then + if ( ((TD_BOPHeight(j)+TD_BOPThickness)>=(TD_DrillStems(TD_BOPElementNo(j))%DownDepth-TD_DrillStems(TD_BOPElementNo(j))%ToolJointRange)) .and. ((TD_BOPHeight(j)+TD_BOPThickness) 0.0) call FillingWell_By_BellNipple ! Filling Well Through BellNipple ( Path j11 ) + !if (MUD(10)%Q > 0.0) call FillingWell_By_Pumps ! Filling Well Through Pumps ( Path j19 ) + + !write(*,*) 'TD_RemoveVolume,Get_JointConnectionPossible=' , TD_RemoveVolume,Get_JointConnectionPossible() + + if (TD_RemoveVolume > 0.) call DisconnectingPipe !! .and. Get_JointConnectionPossible() == .false.) call DisconnectingPipe + + + IF (KickFlux .AND. NOT(KickOffBottom)) THEN + call Kick_Influx + endif + + + + + IF ( NewInfluxNumber > 0 ) THEN + !write(*,*) 'KickOffBottom , ROP=' , KickOffBottom , Rate_of_Penetration + call Kick_Migration + endif + +! ============================ must be after migration ============================== + + DO KickNumber= NewInfluxNumber-NoGasPocket+1 , NewInfluxNumber + ! FINDING NEW KICK LOCATIONS: + Ann_KickLoc= 0 + Op_KickLoc= 0 + ChokeLine_KickLoc= 0 + + do i = 1, Ann_MudOrKick%Length () + if (Ann_MudOrKick%Array(i) == KickNumber) then + Ann_KickLoc = i + exit + endif + end do + + do i = 1, Op_MudOrKick%Length () + if (Op_MudOrKick%Array(i) == KickNumber) then + Op_KickLoc = i + exit + endif + end do + + do i = 1, ChokeLine_MudOrKick%Length () + if (ChokeLine_MudOrKick%Array(i) == KickNumber) then + ChokeLine_KickLoc = i + exit + endif + end do + +! ============================ must be after migration-end =========================== + + IF (ALLOCATED(GasPocketWeight%Array) .and. KickNumber == NewInfluxNumber .AND. NOT(KickOffBottom) .AND. WellHeadIsOpen) THEN + + cycle + + ELSE IF (ALLOCATED(GasPocketWeight%Array)) THEN + + if (((GasPocketDeltaVol%Array(NewInfluxNumber - KickNumber + 1) > 0.0 .AND. WellHeadIsOpen) .or. KickExpansion_DueToMudLost) ) call Kick_Expansion + + if ((GasPocketDeltaVol%Array(NewInfluxNumber - KickNumber + 1) < 0.0 ) .OR. WellHeadIsOpen == .FALSE.) CALL Kick_Contraction + + ENDIF + + + ENDDO + + + + + LostInTripOutIsDone= .false. + + if( DeltaVolumeOp >= 0.0 .and. Get_KellyConnection()==KELLY_CONNECTION_STRING) then + !write(*,*) 'DeltaVolumeOp=' , DeltaVolumeOp + call Pump_and_TripIn + elseif (DeltaVolumeOp < 0.0) then + ! when we have Utube and tripping out simultaneously, it uses "TripOut_and_Pump" subroutine, and then Utube code is done + ! "Utube" and "Pump_and_TripIn" subroutines, not to be used simultaneously because "Utube" code supports trip in + call TripOut_and_Pump + endif + + WellOutletDensity= Ann_Density%Last() ! (ppg) used in MudSystem + + + + if (MUD(4)%Q > 0.) then ! ( j4 > 0 ) ! THIS CIRCULATION CODE IS JUST FOR LINE J4, AND NOT NEEDED FOR LINE J18 + call ChokeLineMud + endif + + + call Choke_GasSound + + !WRITE(*,*) 'CIRCU-Ann_Saved_MudDischarged_Volume' , Ann_Saved_MudDischarged_Volume + +! ****Utube is called in Plot Subroutine**** + + Call Instructor_CirculationMud_Edit + + + + call PlotFinalMudElements + + MudChecked= .true. + UtubePossibility= .true. + + + !WRITE(*,*) '***********************************************************************' + + + + +end subroutine CirculationCodeSelect \ No newline at end of file diff --git a/Equipments/MudSystem/Deallocate_Normal_Circulation.f90 b/Equipments/MudSystem/Deallocate_Normal_Circulation.f90 new file mode 100644 index 0000000..442e8f4 --- /dev/null +++ b/Equipments/MudSystem/Deallocate_Normal_Circulation.f90 @@ -0,0 +1,189 @@ +subroutine DEALLOCATE_ARRAYS_NormalCirculation() ! is called in module FluidFlowMain + USE MudSystemVARIABLES + implicit none + + +if(allocated(Xstart_PipeSection)) deallocate(Xstart_PipeSection) +if(allocated(Xend_PipeSection)) deallocate(Xend_PipeSection) +if(allocated(PipeSection_VolumeCapacity)) deallocate(PipeSection_VolumeCapacity) +if(allocated(Area_PipeSectionFt)) deallocate(Area_PipeSectionFt) +if(allocated(OD_PipeSectionInch)) deallocate(OD_PipeSectionInch) +if(allocated(ID_PipeSectionInch)) deallocate(ID_PipeSectionInch) +if(allocated(Xstart_OpSection)) deallocate(Xstart_OpSection) +if(allocated(Xend_OpSection)) deallocate(Xend_OpSection) +if(allocated(Area_OpSectionFt)) deallocate(Area_OpSectionFt) +if(allocated(OD_OpSectionInch)) deallocate(OD_OpSectionInch) +if(allocated(ID_OpSectionInch)) deallocate(ID_OpSectionInch) +if(allocated(OpSection_VolumeCapacity)) deallocate(OpSection_VolumeCapacity) +if(allocated(GeoTypeOp)) deallocate(GeoTypeOp) +if(allocated(GeoType)) deallocate(GeoType) + + + call Hz_MudDischarged_Volume%Empty() + call Hz_Mud_Backhead_X%Empty() + call Hz_Mud_Backhead_section%Empty() + call Hz_Mud_Forehead_X%Empty() + call Hz_Mud_Forehead_section%Empty() + call Hz_Density%Empty() + call Hz_RemainedVolume_in_LastSection%Empty() + call Hz_EmptyVolume_inBackheadLocation%Empty() + call Hz_MudOrKick%Empty() + + + call St_MudDischarged_Volume%Empty() + call St_Mud_Backhead_X%Empty() + call St_Mud_Backhead_section%Empty() + call St_Mud_Forehead_X%Empty() + call St_Mud_Forehead_section%Empty() + call St_Density%Empty() + call St_RemainedVolume_in_LastSection%Empty() + call St_EmptyVolume_inBackheadLocation%Empty() + call St_MudOrKick%Empty() + + + call Ann_MudDischarged_Volume%Empty() + call Ann_Mud_Backhead_X%Empty() + call Ann_Mud_Backhead_section%Empty() + call Ann_Mud_Forehead_X%Empty() + call Ann_Mud_Forehead_section%Empty() + call Ann_Density%Empty() + call Ann_RemainedVolume_in_LastSection%Empty() + call Ann_EmptyVolume_inBackheadLocation%Empty() + call Ann_MudOrKick%Empty() + call Ann_CuttingMud%Empty() + + + call Op_MudDischarged_Volume%Empty() + call Op_Mud_Backhead_X%Empty() + call Op_Mud_Backhead_section%Empty() + call Op_Mud_Forehead_X%Empty() + call Op_Mud_Forehead_section%Empty() + call Op_Density%Empty() + call Op_RemainedVolume_in_LastSection%Empty() + call Op_EmptyVolume_inBackheadLocation%Empty() + call Op_MudOrKick%Empty() + + + call ChokeLine_MudDischarged_Volume%Empty() + call ChokeLine_Mud_Backhead_X%Empty() + call ChokeLine_Mud_Backhead_section%Empty() + call ChokeLine_Mud_Forehead_X%Empty() + call ChokeLine_Mud_Forehead_section%Empty() + call ChokeLine_Density%Empty() + call ChokeLine_RemainedVolume_in_LastSection%Empty() + call ChokeLine_EmptyVolume_inBackheadLocation%Empty() + call ChokeLine_MudOrKick%Empty() + + + call Xend_MudElement%Empty() + call Xstart_MudElement%Empty() + call TVDend_MudElement%Empty() + call TVDstart_MudElement%Empty() + call Density_MudElement%Empty() + call MudGeoType%Empty() + call PipeID_MudElement%Empty() + call PipeOD_MudElement%Empty() + call MudType_MudElement%Empty() + + call Xend_OpMudElement%Empty() + call Xstart_OpMudElement%Empty() + call TVDend_OpMudElement%Empty() + call TVDstart_OPMudElement%Empty() + call Density_OpMudElement%Empty() + call PipeID_OpMudElement%Empty() + call PipeOD_OpMudElement%Empty() + call MudTypeOp_MudElement%Empty() + + + + end subroutine + + + +subroutine RemoveAnnulusMudArrays(ilocal) + USE MudSystemVARIABLES + implicit none + + INTEGER :: ilocal + + + call Ann_MudDischarged_Volume%Remove (ilocal) + call Ann_Mud_Backhead_X%Remove (ilocal) + call Ann_Mud_Backhead_section%Remove (ilocal) + call Ann_Mud_Forehead_X%Remove (ilocal) + call Ann_Mud_Forehead_section%Remove (ilocal) + call Ann_Density%Remove (ilocal) + call Ann_RemainedVolume_in_LastSection%Remove (ilocal) + call Ann_EmptyVolume_inBackheadLocation%Remove (ilocal) + call Ann_MudOrKick%Remove (ilocal) + call Ann_CuttingMud%Remove (ilocal) + + + + end subroutine + + +subroutine RemoveStringMudArrays(ilocal) + USE MudSystemVARIABLES + implicit none + + INTEGER :: ilocal + + + call St_MudDischarged_Volume%Remove (ilocal) + call St_Mud_Backhead_X%Remove (ilocal) + call St_Mud_Backhead_section%Remove (ilocal) + call St_Mud_Forehead_X%Remove (ilocal) + call St_Mud_Forehead_section%Remove (ilocal) + call St_Density%Remove (ilocal) + call St_RemainedVolume_in_LastSection%Remove (ilocal) + call St_EmptyVolume_inBackheadLocation%Remove (ilocal) + call St_MudOrKick%Remove (ilocal) + + + + end subroutine + + +subroutine RemoveOpMudArrays(ilocal) + USE MudSystemVARIABLES + implicit none + + INTEGER :: ilocal + + + call Op_MudDischarged_Volume%Remove (ilocal) + call Op_Mud_Backhead_X%Remove (ilocal) + call Op_Mud_Backhead_section%Remove (ilocal) + call Op_Mud_Forehead_X%Remove (ilocal) + call Op_Mud_Forehead_section%Remove (ilocal) + call Op_Density%Remove (ilocal) + call Op_RemainedVolume_in_LastSection%Remove (ilocal) + call Op_EmptyVolume_inBackheadLocation%Remove (ilocal) + call Op_MudOrKick%Remove (ilocal) + + + + end subroutine + +subroutine RemoveHzMudArrays(ilocal) + USE MudSystemVARIABLES + implicit none + + INTEGER :: ilocal + + + call Hz_MudDischarged_Volume%Remove (ilocal) + call Hz_Mud_Backhead_X%Remove (ilocal) + call Hz_Mud_Backhead_section%Remove (ilocal) + call Hz_Mud_Forehead_X%Remove (ilocal) + call Hz_Mud_Forehead_section%Remove (ilocal) + call Hz_Density%Remove (ilocal) + call Hz_RemainedVolume_in_LastSection%Remove (ilocal) + call Hz_EmptyVolume_inBackheadLocation%Remove (ilocal) + call Hz_MudOrKick%Remove (ilocal) + + + + end subroutine + \ No newline at end of file diff --git a/Equipments/MudSystem/Disconnecting_Pipe.f90 b/Equipments/MudSystem/Disconnecting_Pipe.f90 new file mode 100644 index 0000000..5bf5661 --- /dev/null +++ b/Equipments/MudSystem/Disconnecting_Pipe.f90 @@ -0,0 +1,108 @@ +subroutine DisconnectingPipe ! is called in subroutine CirculationCodeSelect + + Use GeoElements_FluidModule + USE CMudPropertiesVariables + USE MudSystemVARIABLES + USE Pump_VARIABLES + use CDrillWatchVariables + use CTanksVariables, TripTankVolume2 => TripTankVolume, TripTankDensity2 => TripTankDensity + USE sROP_Other_Variables + USE sROP_Variables + Use KickVariables + USE TD_DrillStemComponents + Use CKellyConnectionEnumVariables + Use CUnityOutputs + USE CManifolds + + implicit none + + Real(8) ExcessMudVolume, ExcessMudVolume_Remained + write(*,*) 'DisconnectingPipe' + + !TD_RemoveVolume= TD_RemoveVolume* 7.48051948 ! ft^3 to gal + + ExcessMudVolume= sum(St_MudDischarged_Volume%Array(:)) - sum(PipeSection_VolumeCapacity(2:F_StringIntervalCounts)) + + + ! ======if(ExcessMudVolume <= 0.) No Modification Needed Because Removed Pipe was Empty===== + + if (Get_KellyConnection() == KELLY_CONNECTION_NOTHING .and. Valve(56)%Status == .False.) ExcessMudVolume= 0.d0 !Valve(56)%Status == .False. :: safety valve installed + + if (ExcessMudVolume > 0.) then + + if ( Valve(53)%Status == .true. ) then + MudBucketVolume= ExcessMudVolume + else + MudBucketVolume= 0.0 + endif + + + + + +!========================Flow Disconnect Unity Input Signals================= + + !if ( Get_JointConnectionPossible() == .false. ) then + if (Get_KellyConnection() == KELLY_CONNECTION_NOTHING) then + Call Set_FlowKellyDisconnect(.true.) + else + Call Set_FlowPipeDisconnect(.true.) + endif + !endif + + + +!====================Flow Disconnect Unity Input Signals-End================= + + + + +!========================Disconnecting Pipe from the String================= + + ExcessMudVolume_Remained= ExcessMudVolume ! ft^3 to gal + + + imud=1 + + Do + + if(St_MudDischarged_Volume%Array(imud) < ExcessMudVolume_Remained) then + ExcessMudVolume_Remained= ExcessMudVolume_Remained- St_MudDischarged_Volume%Array(imud) + call St_MudDischarged_Volume%Remove (imud) + call St_Mud_Backhead_X%Remove (imud) + call St_Mud_Backhead_section%Remove (imud) + call St_Mud_Forehead_X%Remove (imud) + call St_Mud_Forehead_section%Remove (imud) + call St_Density%Remove (imud) + call St_RemainedVolume_in_LastSection%Remove (imud) + call St_EmptyVolume_inBackheadLocation%Remove (imud) + call St_MudOrKick%Remove (imud) + + elseif(St_MudDischarged_Volume%Array(imud) > ExcessMudVolume_Remained) then + St_MudDischarged_Volume%Array(imud)= St_MudDischarged_Volume%Array(imud)- ExcessMudVolume_Remained + exit + + else !(St_MudDischarged_Volume%Array(imud) == ExcessMudVolume_Remained) + call St_MudDischarged_Volume%Remove (imud) + call St_Mud_Backhead_X%Remove (imud) + call St_Mud_Backhead_section%Remove (imud) + call St_Mud_Forehead_X%Remove (imud) + call St_Mud_Forehead_section%Remove (imud) + call St_Density%Remove (imud) + call St_RemainedVolume_in_LastSection%Remove (imud) + call St_EmptyVolume_inBackheadLocation%Remove (imud) + call St_MudOrKick%Remove (imud) + exit + + endif + + enddo + + + + +!=================Disconnecting Pipe from the String - End=================== + endif + + + end subroutine DisconnectingPipe \ No newline at end of file diff --git a/Equipments/MudSystem/Elements_Creation.f90 b/Equipments/MudSystem/Elements_Creation.f90 new file mode 100644 index 0000000..316e127 --- /dev/null +++ b/Equipments/MudSystem/Elements_Creation.f90 @@ -0,0 +1,274 @@ +subroutine ElementsCreation ! is called in subroutine Fluid_Flow_Solver + + Use GeoElements_FluidModule + USE CMudPropertiesVariables + USE MudSystemVARIABLES + USE Pump_VARIABLES + !USE CHOKEVARIABLES + !USE CDataDisplayConsoleVariables , StandPipePressureDataDisplay=>StandPipePressure + !use CManifolds + use CDrillWatchVariables + !use CHOKEVARIABLES + !use CChokeManifoldVariables + use CTanksVariables, TripTankVolume2 => TripTankVolume, TripTankDensity2 => TripTankDensity + USE sROP_Other_Variables + USE sROP_Variables + Use KickVariables + + + implicit none + + integer jelement, jmud, jsection,ielement,i + integer jopelement,jopmud,jopsection + +!===========================================================WELL============================================================ +!===========================================================WELL============================================================ + + if(allocated(Xstart_PipeSection)) deallocate(Xstart_PipeSection) + if(allocated(Xend_PipeSection)) deallocate(Xend_PipeSection) + if(allocated(PipeSection_VolumeCapacity)) deallocate(PipeSection_VolumeCapacity) + if(allocated(Area_PipeSectionFt)) deallocate(Area_PipeSectionFt) + if(allocated(GeoType)) deallocate(GeoType) + if(allocated(OD_PipeSectionInch)) deallocate(OD_PipeSectionInch) + if(allocated(ID_PipeSectionInch)) deallocate(ID_PipeSectionInch) + if(allocated(Angle_PipeSection)) deallocate(Angle_PipeSection) + + if(allocated(Xstart_OpSection)) deallocate(Xstart_OpSection) + if(allocated(Xend_OpSection)) deallocate(Xend_OpSection) + if(allocated(OpSection_VolumeCapacity)) deallocate(OpSection_VolumeCapacity) + if(allocated(Area_OpSectionFt)) deallocate(Area_OpSectionFt) + if(allocated(GeoTypeOp)) deallocate(GeoTypeOp) + if(allocated(OD_OpSectionInch)) deallocate(OD_OpSectionInch) + if(allocated(ID_OpSectionInch)) deallocate(ID_OpSectionInch) + if(allocated(Angle_OpSection)) deallocate(Angle_OpSection) + + + +ALLOCATE (Xstart_PipeSection(F_StringIntervalCounts+F_AnnulusIntervalCounts),Xend_PipeSection(F_StringIntervalCounts+F_AnnulusIntervalCounts) & + ,PipeSection_VolumeCapacity(F_StringIntervalCounts+F_AnnulusIntervalCounts),Area_PipeSectionFt(F_StringIntervalCounts+F_AnnulusIntervalCounts), & + GeoType(F_StringIntervalCounts+F_AnnulusIntervalCounts),OD_PipeSectionInch(F_StringIntervalCounts+F_AnnulusIntervalCounts),ID_PipeSectionInch(F_StringIntervalCounts+F_AnnulusIntervalCounts)) + + +ALLOCATE (Xstart_OpSection(F_BottomHoleIntervalCounts),Xend_OpSection(F_BottomHoleIntervalCounts) & + ,OpSection_VolumeCapacity(F_BottomHoleIntervalCounts),Area_OpSectionFt(F_BottomHoleIntervalCounts), & + GeoTypeOp(F_BottomHoleIntervalCounts),OD_OpSectionInch(F_BottomHoleIntervalCounts),ID_OpSectionInch(F_BottomHoleIntervalCounts)) + + OpSection=0 + isection=0 + + + DO iisection=1, F_IntervalsTotalCounts + IF (F_Interval(iisection)%GeoType == 1) THEN + OpSection= OpSection+1 + Xstart_OpSection(OpSection)= (F_Interval(iisection)%StartDepth) + Xend_OpSection(OpSection)= (F_Interval(iisection)%EndDepth) + Area_OpSectionFt(OpSection)= PII*((F_Interval(iisection)%OD/12.0d0)**2-(F_Interval(iisection)%ID/12.0d0)**2)/4.0d0 !D(in), AREA(ft^2) + OD_OpSectionInch(OpSection)= (F_Interval(iisection)%OD) + ID_OpSectionInch(OpSection)= (F_Interval(iisection)%ID) !REAL(F_Interval(iisection)%Volume) + GeoTypeOp(OpSection)= F_Interval(iisection)%GeoType ! niaz nist ehtemalan + !Angle_OpSection(OpSection)= F_Interval(iisection)%Angle + !write(*,*) 'iisection=' , iisection + !write(*,*) 'StartDepth=' , F_Interval(iisection)%StartDepth + !write(*,*) 'EndDepth=' , F_Interval(iisection)%EndDepth + !write(*,*) 'OD=' , F_Interval(iisection)%OD + !write(*,*) 'ID=' , F_Interval(iisection)%ID + ELSE + isection= isection+1 + Xstart_PipeSection(isection)= (F_Interval(iisection)%StartDepth) + !write(*,*) 'F_Interval(iisection)%StartDepth=' , F_Interval(iisection)%StartDepth + Xend_PipeSection(isection)= (F_Interval(iisection)%EndDepth) + !write(*,*) 'F_Interval(iisection)%EndDepth=' , F_Interval(iisection)%EndDepth + + OD_PipeSectionInch(isection)= (F_Interval(iisection)%OD) + Area_PipeSectionFt(isection)= PII*((F_Interval(iisection)%OD/12.0d0)**2-(F_Interval(iisection)%ID/12.0d0)**2)/4.0d0 !D(in), AREA(ft^2) + ID_PipeSectionInch(isection)= (F_Interval(iisection)%ID) + !PipeSection_VolumeCapacity(isection)= Area_PipeSectionFt(isection)* ABS(Xend_PipeSection(isection)-Xstart_PipeSection(isection))* 7.48051948 !REAL(F_Interval(iisection)%Volume) ! (gal) + GeoType(isection)= F_Interval(iisection)%GeoType + !Angle_PipeSection(isection)= F_Interval(iisection)%Angle + ENDIF + + ENDDO + + + + call Xstart_MudElement%Empty() + call Xstart_MudElement%Add(Xstart_PipeSection(1)) + + + call Xstart_OpMudElement%Empty() + call Xstart_OpMudElement%Add(Xstart_OpSection(1)) + + + call TVDstart_MudElement%Empty() + call TVD_Calculator(Xstart_PipeSection(1),MudCircVerticalDepth) + call TVDstart_MudElement%Add(MudCircVerticalDepth) + + + call TVDstart_OPMudElement%Empty() + call TVD_Calculator(Xstart_OpSection(1),MudCircVerticalDepth) + call TVDstart_OPMudElement%Add(MudCircVerticalDepth) + + + + NoPipeSections= isection ! sections in string and annulus(GeoType 0 & 2) + + + DO OpSection= 1,F_BottomHoleIntervalCounts + OpSection_VolumeCapacity(OpSection)= Area_OpSectionFt(OpSection)* ABS(Xend_OpSection(OpSection)-Xstart_OpSection(OpSection))* 7.48051948d0 !REAL(F_Interval(iisection)%Volume) + ENDDO + + DO isection= 1,NoPipeSections + PipeSection_VolumeCapacity(isection)= Area_PipeSectionFt(isection)* ABS(Xend_PipeSection(isection)-Xstart_PipeSection(isection))* 7.48051948d0 !REAL(F_Interval(iisection)%Volume) ! (gal) + ENDDO + + + + + !types: Mud= 0 Kick=1 + +!=========================================== + if (FirstMudSet==0) then + call Hz_MudDischarged_Volume%AddToFirst(PipeSection_VolumeCapacity(1)) !startup initial + call Hz_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(1)) + call Hz_Mud_Backhead_section%AddToFirst (1) + call Hz_Mud_Forehead_X%AddToFirst (Xend_PipeSection(1)) + call Hz_Mud_Forehead_section%AddToFirst (1) + call Hz_Density%AddToFirst (ActiveDensity) ! initial(ppg) + call Hz_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Hz_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Hz_MudOrKick%AddToFirst (0) + + + call St_MudDischarged_Volume%AddToFirst(sum(PipeSection_VolumeCapacity(2:F_StringIntervalCounts))) !startup initial + call St_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(2)) + call St_Mud_Backhead_section%AddToFirst (2) + call St_Mud_Forehead_X%AddToFirst (Xend_PipeSection(F_StringIntervalCounts)) + call St_Mud_Forehead_section%AddToFirst (F_StringIntervalCounts) + call St_Density%AddToFirst (ActiveDensity) ! initial(ppg) + call St_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call St_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call St_MudOrKick%AddToFirst (0) + + + call Ann_MudDischarged_Volume%AddToFirst(sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections))) + call Ann_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) + call Ann_Mud_Backhead_section%AddToFirst (F_StringIntervalCounts+1) + call Ann_Mud_Forehead_X%AddToFirst (Xend_PipeSection(NoPipeSections)) + call Ann_Mud_Forehead_section%AddToFirst (NoPipeSections) + call Ann_Density%AddToFirst (ActiveDensity) ! initial(ppg) + call Ann_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Ann_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Ann_MudOrKick%AddToFirst (0) + call Ann_CuttingMud%AddToFirst (0) + + OldPosition= Xend_PipeSection(F_StringIntervalCounts) + + OldAnnulusCapacity= sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + + + call ChokeLine_MudDischarged_Volume%AddToFirst(ChokeLine_VolumeCapacity) + call ChokeLine_Mud_Backhead_X%AddToFirst (0.0d0) + call ChokeLine_Mud_Backhead_section%AddToFirst (1) + call ChokeLine_Mud_Forehead_X%AddToFirst (ChokeLineLength) + call ChokeLine_Mud_Forehead_section%AddToFirst (1) + call ChokeLine_Density%AddToFirst (ActiveDensity) ! initial(ppg) + call ChokeLine_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call ChokeLine_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call ChokeLine_MudOrKick%AddToFirst (0) + + + call Op_MudDischarged_Volume%AddToFirst (sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts))) + call Op_Mud_Backhead_X%AddToFirst (Xstart_OpSection(1)) + call Op_Mud_Backhead_section%AddToFirst (1) + call Op_Mud_Forehead_X%AddToFirst (Xend_OpSection(F_BottomHoleIntervalCounts)) + call Op_Mud_Forehead_section%AddToFirst (F_BottomHoleIntervalCounts) + call Op_Density%AddToFirst (ActiveDensity) + call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Op_MudOrKick%AddToFirst (0) + + !F_StringIntervalCountsOld= F_StringIntervalCounts ! is used for adding new pipe to string + F_StringIntervalCounts_Old= F_StringIntervalCounts ! is used for adding new pipe to string + + + FirstMudSet= 1 + endif + + +!===================== Trip Detection ================ + + !DeltaVolumeOp > 0 : Trip in + !DeltaVolumeOp < 0 : Trip out + + + DeltaVolumeOp= ((Xend_PipeSection(F_StringIntervalCounts)-OldPosition)*PII*((OD_PipeSectionInch(F_StringIntervalCounts+1)/12.0d0)**2)/4.0d0)* 7.48051948d0! ft^3 to gal ! D(in) + DeltaVolumeOp = INT(DeltaVolumeOp * 100000.d0) / 100000.d0 + + DeltaVolumePipe= ((Xend_PipeSection(F_StringIntervalCounts)-OldPosition)*PII*((ID_PipeSectionInch(F_StringIntervalCounts+F_AnnulusIntervalCounts)/12.0d0)**2)/4.0d0)* 7.48051948d0! ft^3 to gal + DeltaVolumePipe = INT(DeltaVolumePipe * 100000.d0) / 100000.d0 + + !DeltaVolumeAnnulusCapacity= ((Xend_PipeSection(F_StringIntervalCounts)-OldPosition))*Area_PipeSectionFt(NoPipeSections)* 7.48051948d0! ft^3 to gal + DrillStringSpeed = (Xend_PipeSection(F_StringIntervalCounts)-OldPosition) / 0.1 + + DeltaVolumeAnnulusCapacity= sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) - OldAnnulusCapacity + + + !write(*,*) 'DeltaVolumeAnnulusCapacity= ' , DeltaVolumeAnnulusCapacity + + !write(*,*) 'DeltaVolumePipe=' , DeltaVolumePipe + !write(*,*) 'DeltaVolumeOp=' , DeltaVolumeOp + ! + ! + !write(*,*) 'Bit here=' , Xend_PipeSection(F_StringIntervalCounts) + + + + + OldAnnulusCapacity= sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + + OldPosition= Xend_PipeSection(F_StringIntervalCounts) + + ! Needed for trip in or out: + if (Hz_Mud_Backhead_X%Length() == 0) then + + CALL ErrorStop('Hz_Mud_Backhead_X Length is 0') + endif + + + Hz_Mud_Backhead_X%Array(1)= Xstart_PipeSection(1) + Hz_Mud_Backhead_section%Array(1)= 1 + + AddedElementsToString = F_StringIntervalCounts - F_StringIntervalCounts_Old + St_Mud_Backhead_X%Array(1)= Xstart_PipeSection(2) + St_Mud_Backhead_section%Array(1)= 2 + Ann_Mud_Backhead_X%Array(1)= Xstart_PipeSection(F_StringIntervalCounts+1) + Ann_Mud_Backhead_section%Array(1)= F_StringIntervalCounts+1 + Op_Mud_Backhead_X%Array(1)= Xstart_OpSection(1) + Op_Mud_Backhead_section%Array(1)= 1 + ChokeLine_Mud_Backhead_X%Array(1)= 0. + ChokeLine_Mud_Backhead_section%Array(1)= 1 + + + F_StringIntervalCounts_Old= F_StringIntervalCounts +!write(*,*) 'Xstart_PipeSection(2)' , Xstart_PipeSection(2) +!write(*,*) 'Xend_PipeSection(1)' , Xend_PipeSection(1) + + +!=================================================== + + ! + !DeltaWellCap= sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) - WellCapOld + !WellCapOld= sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) + !write(*,*) 'DeltaWellCap=' , DeltaWellCap + ! + ! + ! + !DeltaAnnCap= sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) - AnnCapOld + !AnnCapOld= sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + !write(*,*) 'DeltaAnnCap=' , DeltaAnnCap + + end subroutine ElementsCreation + + + + diff --git a/Equipments/MudSystem/FillingWell_By_BellNipple.f90 b/Equipments/MudSystem/FillingWell_By_BellNipple.f90 new file mode 100644 index 0000000..cfa5af7 --- /dev/null +++ b/Equipments/MudSystem/FillingWell_By_BellNipple.f90 @@ -0,0 +1,215 @@ +subroutine FillingWell_By_BellNipple ! is called in subroutine CirculationCodeSelect + + ! this subroutine is for lines: 1) BellNippleToWell-NonFullWell : MUD(8)%Q + ! 2) PumpsToWell_KillLine : MUD(10)%Q + + Use GeoElements_FluidModule + USE CMudPropertiesVariables + USE MudSystemVARIABLES + USE Pump_VARIABLES + use CDrillWatchVariables + use CTanksVariables, TripTankVolume2 => TripTankVolume, TripTankDensity2 => TripTankDensity + USE sROP_Other_Variables + USE sROP_Variables + Use KickVariables + + implicit none + + real(8) deltaV,Xposition,FillingDensity + + integer kloc,SectionPosition + + + + + ! Well Is Not Full + + + + if (Ann_MudOrKick%Last() == 104) then ! Last Element is air we must observe: Ann_Mud_Forehead_X%Last()=0.0 + + write(*,*) 'FillingWell_By_BellNipple-Last Element is air' + + !write(*,*) '*Ann_Mud_Forehead_X%Last()=' , Ann_Mud_Forehead_X%Last() + !write(*,*) '*Ann_MudOrKick%Last()=' , Ann_MudOrKick%Last() + + + + FillingDensity= BellNippleDensity + +!**************************** + if ( Ann_MudDischarged_Volume%Last() > (((MUD(8)%Q+MUD(10)%Q)/60.)*DeltaT_Mudline)) then ! air baghi mimune + + kloc= Ann_MudDischarged_Volume%Length()-1 + + + + deltaV= ((MUD(8)%Q+MUD(10)%Q)/60.)*DeltaT_Mudline + + Ann_MudDischarged_Volume%Array(Ann_MudDischarged_Volume%Length())= Ann_MudDischarged_Volume%Array(Ann_MudDischarged_Volume%Length()) - deltaV + + +!========================ANNULUS ENTRANCE==================== + + if (ABS(Ann_Density%Array(kloc) - FillingDensity) >= DensityMixTol) then ! new mud is pumped + call Ann_Density%AddTo (kloc, FillingDensity) + call Ann_MudDischarged_Volume%AddTo (kloc, 0.0d0) + call Ann_Mud_Forehead_X%AddTo (kloc, 0.0d0) + call Ann_Mud_Forehead_section%AddTo (kloc, 1) + call Ann_Mud_Backhead_X%AddTo (kloc, 0.0d0) + call Ann_Mud_Backhead_section%AddTo (kloc, NoPipeSections) + call Ann_RemainedVolume_in_LastSection%AddTo (kloc, 0.0d0) + call Ann_EmptyVolume_inBackheadLocation%AddTo (kloc, 0.0d0) + call Ann_MudOrKick%AddTo (kloc, 0) + call Ann_CuttingMud%AddTo (kloc,0) + + !AnnulusSuctionDensity_Old= Hz_Density_Utube + endif + +!========================ANNULUS==================== + + Ann_MudDischarged_Volume%Array(kloc)= Ann_MudDischarged_Volume%Array(kloc)+ deltaV !(gal) + + + + else ! ( Ann_MudDischarged_Volume%Last() <= (((MUD(8)%Q+MUD(10)%Q)/60.)*DeltaT_Mudline)) then ! air baghi namune + + + + + kloc= Ann_MudDischarged_Volume%Length()-1 + + deltaV= Ann_MudDischarged_Volume%Last() + + + + if (ABS(Ann_Density%Array(kloc)-FillingDensity)< DensityMixTol .and. Ann_CuttingMud%Array(kloc)==0) then ! .OR. (Ann_MudDischarged_Volume%Array(kloc)< 42.) ) then ! 1-Pockets are Merged + Ann_Density%Array(kloc)= (Ann_Density%Array(kloc)*Ann_MudDischarged_Volume%Array(kloc)+FillingDensity*deltaV)/(Ann_MudDischarged_Volume%Array(kloc)+deltaV) + Ann_MudDischarged_Volume%Array(kloc)= Ann_MudDischarged_Volume%Array(kloc)+deltaV + Ann_Mud_Forehead_X%Array(kloc)= Xend_PipeSection(NoPipeSections) + Ann_Mud_Forehead_section%Array(kloc)= NoPipeSections + !Ann_Mud_Backhead_X%Array(kloc)= no change + !Ann_Mud_Backhead_section%Array(kloc)= no change + Ann_RemainedVolume_in_LastSection%Array(kloc)= (0.0) + Ann_EmptyVolume_inBackheadLocation%Array(kloc)= (0.0) + + call Ann_MudDischarged_Volume%Remove (kloc+1) + call Ann_Mud_Backhead_X%Remove (kloc+1) + call Ann_Mud_Backhead_section%Remove (kloc+1) + call Ann_Mud_Forehead_X%Remove (kloc+1) + call Ann_Mud_Forehead_section%Remove (kloc+1) + call Ann_Density%Remove (kloc+1) + call Ann_RemainedVolume_in_LastSection%Remove (kloc+1) + call Ann_EmptyVolume_inBackheadLocation%Remove (kloc+1) + call Ann_MudOrKick%Remove (kloc+1) + call Ann_CuttingMud%Remove (kloc+1) + + + else ! 2-Merging conditions are not meeted, so new pocket== air is replaced with filling mud + Ann_Density%Array(kloc+1) =FillingDensity + Ann_MudOrKick%Array(kloc+1)= 0 + + endif + + + endif + + ! end condition (Ann_MudOrKick%Last() == 104) ! Last Element is air + +!********************************************************************************************************************************************************** + + + + + else ! (Ann_MudOrKick%Last() == 0) then ! Last Element is NOT air- so we must observe: Ann_Mud_Forehead_X%Last()/=0.0 + + !write(*,*) 'FillingWell_By_BellNipple-Last Element is NOT air' + ! + !write(*,*) '*Ann_Mud_Forehead_X%Last()=' , Ann_Mud_Forehead_X%Last() + !write(*,*) '*Ann_MudOrKick%Last()=' , Ann_MudOrKick%Last() + + + deltaV= ((MUD(8)%Q+MUD(10)%Q)/60.)*DeltaT_Mudline + + kloc= Ann_MudDischarged_Volume%Length() + + + + + +!========================ANNULUS ENTRANCE==================== + + if (ABS(Ann_Density%Last() - FillingDensity) >= DensityMixTol .or. Ann_CuttingMud%Last()==1) then ! .OR. (Ann_MudDischarged_Volume%Array(kloc)>42.) ) then ! new mud is pumped + Xposition= Ann_Mud_Forehead_X%Last() + SectionPosition= Ann_Mud_Forehead_section%Last() + call Ann_Density%Add (FillingDensity) + call Ann_MudDischarged_Volume%Add (0.0d0) + call Ann_Mud_Forehead_X%Add (Xposition) + call Ann_Mud_Forehead_section%Add (SectionPosition) + call Ann_Mud_Backhead_X%Add (Xposition) + call Ann_Mud_Backhead_section%Add (SectionPosition) + call Ann_RemainedVolume_in_LastSection%Add (0.0d0) + call Ann_EmptyVolume_inBackheadLocation%Add (0.0d0) + call Ann_MudOrKick%Add (0) + call Ann_CuttingMud%Add (0) + + !AnnulusSuctionDensity_Old= Hz_Density_Utube + !endif + +!========================ANNULUS==================== + + Ann_MudDischarged_Volume%Array(Ann_MudDischarged_Volume%Length())= Ann_MudDischarged_Volume%Array(Ann_MudDischarged_Volume%Length())+ deltaV !(gal) + + + else ! Merged with last Mud + Ann_Density%Array(kloc)= (Ann_Density%Array(kloc)*Ann_MudDischarged_Volume%Array(kloc)+FillingDensity*deltaV)/(Ann_MudDischarged_Volume%Array(kloc)+deltaV) + Ann_MudDischarged_Volume%Array(kloc)= Ann_MudDischarged_Volume%Array(kloc)+deltaV + !Ann_Mud_Forehead_X%Array(kloc)= Xend_PipeSection(NoPipeSections) + !Ann_Mud_Forehead_section%Array(kloc)= NoPipeSections + !Ann_Mud_Backhead_X%Array(kloc)= no change + !Ann_Mud_Backhead_section%Array(kloc)= no change + Ann_RemainedVolume_in_LastSection%Array(kloc)= (0.0) + Ann_EmptyVolume_inBackheadLocation%Array(kloc)= (0.0) + endif + + + + + + + endif + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + end subroutine FillingWell_By_BellNipple \ No newline at end of file diff --git a/Equipments/MudSystem/Kick_Expansion_and_Contraction.f90 b/Equipments/MudSystem/Kick_Expansion_and_Contraction.f90 new file mode 100644 index 0000000..277aa6f --- /dev/null +++ b/Equipments/MudSystem/Kick_Expansion_and_Contraction.f90 @@ -0,0 +1,235 @@ +subroutine Kick_Expansion ! is called in subroutine CirculationCodeSelect + + Use GeoElements_FluidModule + USE CMudPropertiesVariables + USE MudSystemVARIABLES + USE Pump_VARIABLES + use CDrillWatchVariables + use CTanksVariables, TripTankVolume2 => TripTankVolume, TripTankDensity2 => TripTankDensity + USE sROP_Other_Variables + USE sROP_Variables + USE CReservoirVariables + USE KickVARIABLES + + + implicit none + real(8) ExpansionVolume + + + !write(*,*) 'Kick Expansion' + +ExpansionVolume= GasPocketDeltaVol%Array(NewInfluxNumber - KickNumber + 1) * 7.48 + +IF ( Kickexpansion_DueToMudLost ) ExpansionVolume = ((Qlost/60.0d0)*DeltaT_Mudline) + + +!============================== kick zire mate bashad ============================== + + if (Op_KickLoc > 0 .and. Ann_KickLoc==0) then ! .and. Op_KickLoc /= Op_MudOrKick%Length ()) then + + !write(*,*) 'expansion (1)' + + + Op_MudDischarged_Volume%Array(Op_KickLoc)= Op_MudDischarged_Volume%Array(Op_KickLoc)+ ExpansionVolume + + + !if (MUD(4)%Q > 0.) then + ! + ! if (abs(ChokeLine_Density%Array(1)-Ann_Density%Last())< DensityMixTol) then + ! ChokeLine_MudDischarged_Volume%Array(1)= ChokeLine_MudDischarged_Volume%Array(1) + ExpansionVolume + ! else + ! call ChokeLine_Density%AddToFirst (Ann_Density%Last()) + ! call ChokeLine_MudDischarged_Volume%AddToFirst (ExpansionVolume) ! farz kardam ke hameye hajm ro ba yek density ezafe konim + ! call ChokeLine_Mud_Forehead_X%AddToFirst (0.0d0) + ! call ChokeLine_Mud_Forehead_section%AddToFirst (1) + ! call ChokeLine_Mud_Backhead_X%AddToFirst (0.0d0) + ! call ChokeLine_Mud_Backhead_section%AddToFirst (1) + ! call ChokeLine_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + ! call ChokeLine_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + ! call ChokeLine_MudOrKick%AddToFirst (Ann_MudOrKick%Last()) + ! endif + ! + !endif + + endif +!======================================================================================== + + + +!============================= foreheade dar fazaye annulus bashad =========================== + ! agar kick be entehaye annulus reside bashe, expansion ra emaal nemikonim + if (Ann_KickLoc > 0) then ! .and. Ann_KickLoc /= Ann_MudOrKick%Length ()) then + !write(*,*) 'expansion (2)' + + !if ( sum(Ann_MudDischarged_Volume%Array(1:Ann_KickLoc)) + ExpansionVolume > sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) ) then ! agar khast az mate rad kone + ! ExpansionVolume= sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) - sum(Ann_MudDischarged_Volume%Array(1:Ann_KickLoc)) + !endif + + Ann_MudDischarged_Volume%Array(Ann_KickLoc)= Ann_MudDischarged_Volume%Array(Ann_KickLoc)+ ExpansionVolume + + !if (MUD(4)%Q > 0.) then + ! + ! + ! if (abs(ChokeLine_Density%Array(1)-Ann_Density%Last())< DensityMixTol) then + ! ChokeLine_MudDischarged_Volume%Array(1)= ChokeLine_MudDischarged_Volume%Array(1) + ExpansionVolume + ! else + ! call ChokeLine_Density%AddToFirst (Ann_Density%Last()) + ! call ChokeLine_MudDischarged_Volume%AddToFirst (ExpansionVolume) ! farz kardam ke hameye hajm ro ba yek density ezafe konim + ! call ChokeLine_Mud_Forehead_X%AddToFirst (0.0d0) + ! call ChokeLine_Mud_Forehead_section%AddToFirst (1) + ! call ChokeLine_Mud_Backhead_X%AddToFirst (0.0d0) + ! call ChokeLine_Mud_Backhead_section%AddToFirst (1) + ! call ChokeLine_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + ! call ChokeLine_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + ! call ChokeLine_MudOrKick%AddToFirst (Ann_MudOrKick%Last()) + ! endif + ! + !endif + + endif +!======================================================================================== + + + + + +!=============================== foreheade dar choke line bashad ============================= + + if (ChokeLine_KickLoc > 0 .and. Ann_KickLoc==0) then + + ChokeLine_MudDischarged_Volume%Array(ChokeLine_KickLoc)= ChokeLine_MudDischarged_Volume%Array(ChokeLine_KickLoc)+ ExpansionVolume + + endif + + +!======================================================================================== + + !write(*,*) 'Expansion======0' + ! !do imud=1, Ann_MudDischarged_Volume%Length() + ! ! write(*,*) 'Ann:', imud, Ann_MudDischarged_Volume%Array(imud), Ann_Density%Array(imud) ,Ann_MudOrKick%Array(imud) + ! !enddo + ! + ! do imud=1, Op_MudDischarged_Volume%Length() + ! write(*,*) 'Op:', imud, Op_MudDischarged_Volume%Array(imud), Op_Density%Array(imud) ,Op_MudOrKick%Array(imud) + ! enddo + !write(*,*) '0======expansion' + + + + end subroutine Kick_Expansion + + + + + +subroutine Kick_Contraction ! is called in subroutine CirculationCodeSelect + + Use GeoElements_FluidModule + USE CMudPropertiesVariables + USE MudSystemVARIABLES + USE Pump_VARIABLES + use CDrillWatchVariables + use CTanksVariables, TripTankVolume2 => TripTankVolume, TripTankDensity2 => TripTankDensity + USE sROP_Other_Variables + USE sROP_Variables + USE CReservoirVariables + USE KickVARIABLES + USE CError + + + implicit none + + integer jelement, jmud, jsection,ielement,i + integer jopelement,jopmud,jopsection + real(8) ContractionVolume + + +!********************************************************* + +! contraction is always with pump flow + +!********************************************************* + !write(*,*) 'Kick Contraction' + + !MUD(2)%Q= Total_Pump_Gpm + StringFlowRate= MUD(2)%Q + AnnulusFlowRate= MUD(2)%Q + + if (NewPipeFilling == 0) then + StringFlowRate= 0. + AnnulusFlowRate= 0. + endif + + + + + + !if (WellHeadIsOpen) then + ContractionVolume= - GasPocketDeltaVol%Array(NewInfluxNumber - KickNumber + 1) * 7.48 + !else + !ContractionVolume = (StringFlowRate/60.0d0)*DeltaT_Mudline + DeltaVolumePipe + if (KickNumber == 1 .and. WellHeadIsOpen==.false.) ContractionVolume = ContractionVolume + (StringFlowRate/60.0d0)*DeltaT_Mudline + DeltaVolumePipe + !endif + + +!************************************************************************************************************************************************************************** + + ! pump mud is added in "pump&TripIn" code + + IF (Op_KickLoc > 0 .and. Ann_KickLoc == 0) then ! All of kick is under bit (iloc == 1) + + Op_MudDischarged_Volume%Array(Op_KickLoc)= Op_MudDischarged_Volume%Array(Op_KickLoc) - ( ContractionVolume ) + + ELSE IF (Op_KickLoc == 0 .AND. Ann_KickLoc > 0 .AND. ChokeLine_KickLoc == 0) THEN ! All of kick is an Annulus (iloc == 1) + + Ann_MudDischarged_Volume%Array(Ann_KickLoc)= Ann_MudDischarged_Volume%Array(Ann_KickLoc) - ( ContractionVolume ) + + ELSE IF (Ann_KickLoc == 0 .AND. ChokeLine_KickLoc > 0) THEN ! kick is in chokeline only + + ChokeLine_MudDischarged_Volume%Array(ChokeLine_KickLoc)= ChokeLine_MudDischarged_Volume%Array(ChokeLine_KickLoc) - ( ContractionVolume ) + + ELSE IF (Op_KickLoc > 0 .AND. Ann_KickLoc > 0) THEN ! Kick is around bit (iloc==2) + + if (Ann_MudDischarged_Volume%Array(1) > ContractionVolume ) then + + Ann_MudDischarged_Volume%Array(1)= Ann_MudDischarged_Volume%Array(1) - ( ContractionVolume ) + + + elseif (Op_MudDischarged_Volume%Last() > ContractionVolume ) then + + Op_MudDischarged_Volume%Array(Op_MudDischarged_Volume%Length())= Op_MudDischarged_Volume%Array(Op_MudDischarged_Volume%Length()) - ( ContractionVolume ) + + else + Call ErrorStop ('kick contraction error 1') + endif + + ELSE IF (Ann_KickLoc > 0 .AND. ChokeLine_KickLoc > 0) THEN + + if (ChokeLine_MudDischarged_Volume%Array(1) > ContractionVolume ) then + + ChokeLine_MudDischarged_Volume%Array(1) = ChokeLine_MudDischarged_Volume%Array(1) - ( ContractionVolume ) + + + elseif (Ann_MudDischarged_Volume%Last() > ContractionVolume ) then + + Ann_MudDischarged_Volume%Array(Ann_MudDischarged_Volume%Length())= Ann_MudDischarged_Volume%Array(Ann_MudDischarged_Volume%Length()) - ( ContractionVolume ) + + else + Call ErrorStop ('kick contraction error 2') + endif + + + + endif + + ! write(*,*) 'contract======0' + !! !do imud=1, Ann_MudDischarged_Volume%Length() + !! ! write(*,*) 'Ann:', imud, Ann_MudDischarged_Volume%Array(imud), Ann_Density%Array(imud) ,Ann_MudOrKick%Array(imud) + !! !enddo + !! + ! do imud=1, Op_MudDischarged_Volume%Length() + ! write(*,*) 'Op:', imud, Op_MudDischarged_Volume%Array(imud), Op_Density%Array(imud) ,Op_MudOrKick%Array(imud) + ! enddo + !write(*,*) '0======contract' + +end subroutine Kick_Contraction diff --git a/Equipments/MudSystem/Kick_Influx.f90 b/Equipments/MudSystem/Kick_Influx.f90 new file mode 100644 index 0000000..c29d54a --- /dev/null +++ b/Equipments/MudSystem/Kick_Influx.f90 @@ -0,0 +1,215 @@ +subroutine Kick_Influx ! is called in subroutine CirculationCodeSelect + + Use GeoElements_FluidModule + USE CMudPropertiesVariables + USE MudSystemVARIABLES + USE Pump_VARIABLES + use CDrillWatchVariables + use CTanksVariables, TripTankVolume2 => TripTankVolume, TripTankDensity2 => TripTankDensity + USE sROP_Other_Variables + USE sROP_Variables + Use KickVariables + + + implicit none + + +!===========================================================WELL============================================================ +!===========================================================WELL============================================================ + + !write(*,*) 'Kick Influx' + + +!=================== Bottom Hole Kick Influx ENTRANCE(due to Kick) =================== + + Kick_Density= 2 + NewInflux_Density= Kick_Density + + + if ( NewInfluxElementCreated==0 ) then ! new kick is pumped- (it is set to zero in sheykh subroutine after a new kick influx) + call Op_Density%AddToFirst (NewInflux_Density) + call Op_MudDischarged_Volume%AddToFirst (0.0d0) + call Op_Mud_Forehead_X%AddToFirst (Xstart_OpSection(1)) + call Op_Mud_Forehead_section%AddToFirst (1) + call Op_Mud_Backhead_X%AddToFirst (Xstart_OpSection(1)) + call Op_Mud_Backhead_section%AddToFirst (1) + call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Op_MudOrKick%AddToFirst (NewInfluxNumber) ! KickNumber= NewInfluxNumber + + + NewInfluxElementCreated= 1 + endif + + + Op_MudDischarged_Volume%Array(1)= Op_MudDischarged_Volume%Array(1)+ ((GasKickPumpFlowRate/60.0d0)*DeltaT_Mudline) !(gal) due to KickFlux + !write(*,*) 'kick volume ok=' , Op_MudDischarged_Volume%Array(1) + + + + end subroutine Kick_Influx + + + + + + + + + + + +subroutine Instructor_CirculationMud_Edit ! is called in subroutine CirculationCodeSelect + + Use KickVariables + Use MudSystemVARIABLES + USE TD_DrillStemComponents + Use CUnityInputs + Use CUnityOutputs + USE CKellyConnectionEnumVariables + USE UTUBEVARS + use sROP_Variables + use sROP_Other_Variables + use CDownHoleVariables + + + implicit none + + + + + + if ( AnnDrillMud == .true. .and. (Rate_of_Penetration>0. .and. DeltaVolumeOp>0.0) ) then + + do imud= 1, Ann_Density%Length() + + if ( Ann_MudOrKick%Array(imud) == 0 ) then + Ann_Density%Array(imud)= (St_Density%Last() * AnnulusFlowRate + 141.4296E-4*Rate_of_Penetration*Diameter_of_Bit**2)/(AnnulusFlowRate+6.7995E-4*Rate_of_Penetration*Diameter_of_Bit**2) + Ann_CuttingMud%Array(imud)= 1 + endif + + enddo + + endif + + + if ( AnnCirculateMud == .true. ) then + + do imud= 1, Ann_Density%Length() + + if ( Ann_MudOrKick%Array(imud) == 0 ) then + Ann_Density%Array(imud)= ActiveTankDensity + Ann_CuttingMud%Array(imud)= 0 + endif + + enddo + + do imud= 1, St_Density%Length() + + St_Density%Array(imud)= ActiveTankDensity + + enddo + + endif + + + + + end subroutine Instructor_CirculationMud_Edit + + + +subroutine ShoeLostSub ! is called in subroutine CirculationCodeSelect + + Use KickVariables + Use MudSystemVARIABLES + USE TD_DrillStemComponents + Use CUnityInputs + Use CUnityOutputs + USE CKellyConnectionEnumVariables + USE UTUBEVARS + use sROP_Variables + use sROP_Other_Variables + use CDownHoleVariables + use CShoeVariables + USE PressureDisplayVARIABLES + Use CWarningsVariables + + + implicit none + + ShoeLost= .false. + Kickexpansion_DueToMudLost= .false. + + ShoeMudPressure= PressureGauges(5) + + + UGBOSuccessionCounter = UGBOSuccessionCounter + 1 + !write(*,*) 'check point 1' + + if (InactiveFracture == .FALSE. .AND. ((ShoeMudPressure >= FormationLostPressure) .or. ShoeFractured )) then + !write(*,*) 'check point 2 ,UGBOSuccessionCounter' , UGBOSuccessionCounter + + ! if ShoeFractured changed to true , then time counter is not needed more + if ( UGBOSuccessionCounter /= UGBOSuccessionCounterOld+1 .and. ShoeFractured==.false. ) then + UGBOSuccessionCounter = 0 ! also in starup + UGBOSuccessionCounterOld = 0 ! also in starup + return + else + UGBOSuccessionCounterOld= UGBOSuccessionCounter + endif + + if ( UGBOSuccessionCounter < 10 .and. ShoeFractured==.false.) then + return + endif + + !write(*,*) 'check point 3 ,UGBOSuccessionCounter' , UGBOSuccessionCounter + + + + ShoeFractured= .true. + + ShoeMudViscosity= MAX(ShoeMudViscosity, 12.d0) + !write(*,*) 'ShoeMudDensity , ShoeMudViscosity' , ShoeMudDensity , ShoeMudViscosity + ShoeLostCoef = 10.**(-8) * 1.15741d0 * 7.08d0 * 1000000.d0 * 1.d0 * ShoeMudDensity / & + (ShoeMudViscosity * LOG(10000.d0)) + !write(*,*) 'lost parameters 1' , ShoeMudPressure , FormationLostPressure + Qlost = MAX( (ShoeLostCoef * (ShoeMudPressure - (FormationLostPressure/2.0))) , 0.d0 ) + if (Qlost > 0.0) then + ShoeLost= .true. + else + ShoeLost= .false. + endif + + !write(*,*) 'Qlost=' , Qlost, ShoeMudPressure, FormationLostPressure + call Activate_UndergroundBlowout() + + + do imud= 1, Ann_Mud_Forehead_X%Length() + + IF ( ShoeLost .and. ShoeDepth < Ann_Mud_Backhead_X%Array(imud) .and. ShoeDepth >= Ann_Mud_Forehead_X%Array(imud) & + .and. Ann_MudOrKick%Array(imud) == 0 .and. WellHeadIsOpen == .FALSE. ) then + + Kickexpansion_DueToMudLost= .true. + write(*,*) 'Kickexpansion_DueToMudLost' + + EXIT + + ENDIF + + + enddo + + + + endif + + if (UndergroundBlowout == .false.) ShoeLost= .false. + + + + end subroutine ShoeLostSub + + + + \ No newline at end of file diff --git a/Equipments/MudSystem/Kick_Migration.f90 b/Equipments/MudSystem/Kick_Migration.f90 new file mode 100644 index 0000000..377589d --- /dev/null +++ b/Equipments/MudSystem/Kick_Migration.f90 @@ -0,0 +1,1181 @@ +subroutine Kick_Migration ! is called in subroutine CirculationCodeSelect + + Use GeoElements_FluidModule + USE CMudPropertiesVariables + USE MudSystemVARIABLES + USE Pump_VARIABLES + use CDrillWatchVariables + use CTanksVariables, TripTankVolume2 => TripTankVolume, TripTankDensity2 => TripTankDensity + USE sROP_Other_Variables + USE sROP_Variables + USE CReservoirVariables + USE KickVARIABLES + + + implicit none + + integer jelement, jmud, jsection,ielement,i + integer jopelement,jopmud,jopsection,CuttingValue + + + !MUD(2)%Q= Total_Pump_Gpm + !StringFlowRate= MUD(2)%Q + !AnnulusFlowRate= MUD(2)%Q + ! + !if (NewPipeFilling == 0) then + ! StringFlowRate= 0. + ! AnnulusFlowRate= 0. + !endif + + !StringFlowRateFinal= StringFlowRate + !AnnulusFlowRateFinal= AnnulusFlowRate + + + + !write(*,*) 'MUD(2)%Q=====' , MUD(2)%Q + !write(*,*) 'Kick Migration,NewInfluxNumber:' , NewInfluxNumber + + + + !FirstSetKickMigration + !write(*,*) 'NewInfluxNumber=' , NewInfluxNumber +DO KickNumber= NewInfluxNumber-NoGasPocket+1 , NewInfluxNumber + !write(*,*) 'KickNumber=' , KickNumber + + if (KickFlux .AND. NOT(KickOffBottom) .and. KickNumber == NewInfluxNumber) cycle + + if ( KickNumber == Ann_MudOrKick%Last() ) cycle ! when the last element in Annulus is kick, Migration is not called + + !write(*,*) 'Migration will be done for,KickNumber=' ,KickNumber + +!=================== Bottom Hole ENTRANCE(due to Kick) =================== + + !KickDx= (AutoMigrationRate/60.)*DeltaT_Mudline !3600 (ft/min)= 6 ft set in start up + + + Op_KickLoc= 0 + Ann_KickLoc= 0 + ChokeLine_KickLoc= 0 + + + do i = 1, Op_MudOrKick%Length () + if (Op_MudOrKick%Array(i) == KickNumber) then + Op_KickLoc = i + exit + endif + end do + + do i = 1, Ann_MudOrKick%Length () + if (Ann_MudOrKick%Array(i) == KickNumber) then + Ann_KickLoc = i + exit + endif + end do + + do i = 1, ChokeLine_MudOrKick%Length () + if (ChokeLine_MudOrKick%Array(i) == KickNumber) then + ChokeLine_KickLoc = i + exit + endif + end do + + !write(*,*) 'Op_KickLoc=' , Op_KickLoc + !write(*,*) 'Ann_KickLoc=' , Ann_KickLoc + !!write(*,*) 'ChokeLine_KickLoc=' , ChokeLine_KickLoc + ! + ! + !write(*,*) 'Op_MudOrKick%Length ()=' , Op_MudOrKick%Length () + ! + ! + + + + +!============================== foreheade kick be mate reside bashad *3 ============================== + + if (Op_KickLoc == Op_MudOrKick%Length () .and. Ann_KickLoc==0 ) then + !write(*,*) '****3' + + iloc= 2 + + KickDv= Area_OpSectionFt(Op_Mud_Forehead_section%Array(Op_KickLoc)) * KickDx * 7.48051948d0 ! ft^3 to gal + + + MinKickDv= min( KickDv,Ann_MudDischarged_Volume%Array (1), Op_MudDischarged_Volume%Last () ) + + NewDensity= Ann_Density%Array (1) + NewVolume= MinKickDv + + if ( MinKickDv == KickDv ) then !eleman bala sari baghi mimund, paeeni(kick) ham baghi mimund + + Ann_MudDischarged_Volume%Array (1)= Ann_MudDischarged_Volume%Array (1) - MinKickDv + + call Ann_Density%AddToFirst (Op_Density%Last()) + call Ann_MudDischarged_Volume%AddToFirst (MinKickDv) + call Ann_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) + call Ann_Mud_Forehead_section%AddToFirst (F_StringIntervalCounts+1) + call Ann_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) + call Ann_Mud_Backhead_section%AddToFirst (F_StringIntervalCounts+1) + call Ann_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Ann_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Ann_MudOrKick%AddToFirst (KickNumber) + call Ann_CuttingMud%AddToFirst (0) + + Op_MudDischarged_Volume%Array (Op_KickLoc)= Op_MudDischarged_Volume%Array (Op_KickLoc) - MinKickDv + + ! backheade kick zire mate bashad + if (Op_KickLoc > 1) then + !if ( Op_Density%Array (Op_KickLoc-1) /= NewDensity ) then + + if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) >= DensityMixTol ) then + + + Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + + call Op_Density%AddTo (Op_KickLoc,NewDensity) + call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) + call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) + call Op_MudOrKick%AddTo (Op_KickLoc,0) + + + else !Op_Density%Array (imudKick-1) == NewDensity + + Op_Density%Array(Op_KickLoc-1)= (Op_Density%Array(Op_KickLoc-1)*Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewDensity*NewVolume)/(Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewVolume) + Op_MudDischarged_Volume%Array(Op_KickLoc-1)= Op_MudDischarged_Volume%Array(Op_KickLoc-1) + NewVolume + + endif + else !if Op_KickLoc == 1 (*****Migration Start*****) *3-1=============================== + !write(*,*) '****3-1' + + + call Op_Density%AddToFirst (NewDensity) + call Op_MudDischarged_Volume%AddToFirst (NewVolume) + call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) + call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) + call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) + call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) + call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Op_MudOrKick%AddToFirst (0) + + endif + + + + elseif ( MinKickDv == Ann_MudDischarged_Volume%Array (1) ) then ! eleman bala sari baghi nemimund + + Ann_Density%Array(1)= Op_Density%Last() + Ann_MudOrKick%Array(1)= KickNumber + + Op_MudDischarged_Volume%Array (Op_KickLoc)= Op_MudDischarged_Volume%Array (Op_KickLoc) - MinKickDv + + ! backheade kick zire mate bashad + if (Op_KickLoc > 1) then + + !if ( Op_Density%Array (Op_KickLoc-1) /= NewDensity ) then + + if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) >= DensityMixTol ) then + + + Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + + call Op_Density%AddTo (Op_KickLoc,NewDensity) + call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) + call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) + call Op_MudOrKick%AddTo (Op_KickLoc,0) + + + else !Op_Density%Array (imudKick-1) == NewDensity + + Op_Density%Array(Op_KickLoc-1)= (Op_Density%Array(Op_KickLoc-1)*Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewDensity*NewVolume)/(Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewVolume) + Op_MudDischarged_Volume%Array(Op_KickLoc-1)= Op_MudDischarged_Volume%Array(Op_KickLoc-1) + NewVolume + + endif + + else !if Op_KickLoc == 1 (*****Migration Start*****) *3-2=============================== + !write(*,*) '****3-2' + + + call Op_Density%AddToFirst (NewDensity) + call Op_MudDischarged_Volume%AddToFirst (NewVolume) + call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) + call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) + call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) + call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) + call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Op_MudOrKick%AddToFirst (0) + + endif + + + ! + elseif ( MinKickDv == Op_MudDischarged_Volume%Last () ) then ! eleman balaee baghi mimund, kick hazf mishod + + Ann_MudDischarged_Volume%Array (1)= Ann_MudDischarged_Volume%Array (1) - MinKickDv + + call Ann_Density%AddToFirst (Op_Density%Last()) + call Ann_MudDischarged_Volume%AddToFirst (MinKickDv) + call Ann_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) + call Ann_Mud_Forehead_section%AddToFirst (F_StringIntervalCounts+1) + call Ann_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) + call Ann_Mud_Backhead_section%AddToFirst (F_StringIntervalCounts+1) + call Ann_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Ann_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Ann_MudOrKick%AddToFirst (KickNumber) + call Ann_CuttingMud%AddToFirst (0) + + + Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + + call Op_MudDischarged_Volume%Remove (Op_KickLoc) + call Op_Mud_Backhead_X%Remove (Op_KickLoc) + call Op_Mud_Backhead_section%Remove (Op_KickLoc) + call Op_Mud_Forehead_X%Remove (Op_KickLoc) + call Op_Mud_Forehead_section%Remove (Op_KickLoc) + call Op_Density%Remove (Op_KickLoc) + call Op_RemainedVolume_in_LastSection%Remove (Op_KickLoc) + call Op_EmptyVolume_inBackheadLocation%Remove (Op_KickLoc) + call Op_MudOrKick%Remove (Op_KickLoc) + + + ! backheade kick zire mate bashad + if (Op_KickLoc > 1) then + !if ( Op_Density%Array (Op_KickLoc-1) /= NewDensity ) then + + if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) >= DensityMixTol ) then + + + + call Op_Density%AddTo (Op_KickLoc,NewDensity) + call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) + call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) + call Op_MudOrKick%AddTo (Op_KickLoc,0) + + + else !Op_Density%Array (imudKick-1) == NewDensity + + Op_Density%Array(Op_KickLoc-1)= (Op_Density%Array(Op_KickLoc-1)*Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewDensity*NewVolume)/(Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewVolume) + Op_MudDischarged_Volume%Array(Op_KickLoc-1)= Op_MudDischarged_Volume%Array(Op_KickLoc-1) + NewVolume + + endif + + else !if Op_KickLoc == 1 (*****Migration Start*****) *3-3=============================== + !write(*,*) '****3-3' + + call Op_Density%AddToFirst (NewDensity) + call Op_MudDischarged_Volume%AddToFirst (NewVolume) + call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) + call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) + call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) + call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) + call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Op_MudOrKick%AddToFirst (0) + + endif + + + + + endif + + + endif + +!======================================================================================== + + +!============================== foreheade kick be mate reside bashad *3 with pump ============================== + +! if (Op_KickLoc == Op_MudOrKick%Length () .and. Ann_KickLoc==0 .and. AnnulusFlowRate /= 0.0 ) then +! write(*,*) '****3 with pump' +! +! KickMigration_2SideBit= .true. +! !iloc= 2 +! +! !KickDv= Area_OpSectionFt(Op_Mud_Forehead_section%Array(Op_KickLoc)) * KickDx * 7.48051948 ! ft^3 to gal +! +!!farz mikonam baraye in yek iteration kick az OP hazf nemishavad va hajme aan bishtar az pump flow ast +! +! KickDv= ((AnnulusFlowRate/60.0d0)*DeltaT_Mudline) +! +! call Ann_Density%AddToFirst (Kick_Density) +! call Ann_MudDischarged_Volume%AddToFirst (KickDv) +! call Ann_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) +! call Ann_Mud_Forehead_section%AddToFirst (F_StringIntervalCounts+1) +! call Ann_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) +! call Ann_Mud_Backhead_section%AddToFirst (F_StringIntervalCounts+1) +! call Ann_RemainedVolume_in_LastSection%AddToFirst (0.0d0) +! call Ann_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) +! call Ann_MudOrKick%AddToFirst (KickNumber) +! call Ann_CuttingMud%AddToFirst (0) +! +! Op_MudDischarged_Volume%Array (Op_KickLoc)= Op_MudDischarged_Volume%Array (Op_KickLoc) - MinKickDv +! +! ! +! !if ( ((AnnulusFlowRate/60.)*DeltaT_Mudline) >= KickDv ) then ! sorate pump bishtar az kick bashad +! ! +! ! KickDv= ((AnnulusFlowRate/60.)*DeltaT_Mudline) +! +! +! +! ! BackHead: +! if ( Op_Density%Array (Op_KickLoc-1) /= St_Density%Last() ) then +! +! +! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) +! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) +! +! call Op_Density%AddTo (Op_KickLoc,St_Density%Last()) +! call Op_MudDischarged_Volume%AddTo (Op_KickLoc,KickDv) +! call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) +! call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) +! call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) +! call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) +! call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) +! call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) +! call Op_MudOrKick%AddTo (Op_KickLoc,0) +! +! +! else !Op_Density%Array (imudKick-1) == NewDensity +! +! Op_MudDischarged_Volume%Array (Op_KickLoc-1)= Op_MudDischarged_Volume%Array (Op_KickLoc-1) + KickDv +! +! endif +! +! +! +! +! endif + +!======================================================================================== + + +!============================= tamame kick zire mate bashad *1 ================================ + if ( Op_KickLoc>0 .and. Op_KickLoc < Op_MudOrKick%Length () ) then + !write(*,*) '****1' + !iloc= 1 + + KickDv= Area_OpSectionFt(Op_Mud_Forehead_section%Array(Op_KickLoc)) * KickDx * 7.48051948d0 ! ft^3 to gal + + + Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + + if ( KickDv < Op_MudDischarged_Volume%Array (Op_KickLoc+1) ) then !eleman bala sari baghi mimund + + !write(*,*) 'cond 11111111111111' + + Op_MudDischarged_Volume%Array (Op_KickLoc+1)= Op_MudDischarged_Volume%Array (Op_KickLoc+1) - KickDv + + NewDensity= Op_Density%Array (Op_KickLoc+1) + NewVolume= KickDv + + else !KickDv > Op_MudDischarged_Volume%Array (imudKick+1) eleman baghi nemimund + + ! write(*,*) 'cond 22222222222222222' + + + KickDv= Op_MudDischarged_Volume%Array (Op_KickLoc+1) + + NewVolume= KickDv + NewDensity= Op_Density%Array (Op_KickLoc+1) + + + + + call Op_MudDischarged_Volume%Remove (Op_KickLoc+1) + call Op_Mud_Backhead_X%Remove (Op_KickLoc+1) + call Op_Mud_Backhead_section%Remove (Op_KickLoc+1) + call Op_Mud_Forehead_X%Remove (Op_KickLoc+1) + call Op_Mud_Forehead_section%Remove (Op_KickLoc+1) + call Op_Density%Remove (Op_KickLoc+1) + call Op_RemainedVolume_in_LastSection%Remove (Op_KickLoc+1) + call Op_EmptyVolume_inBackheadLocation%Remove (Op_KickLoc+1) + call Op_MudOrKick%Remove (Op_KickLoc+1) + + endif + + ! backheade kick zire mate bashad + if (Op_KickLoc > 1) then + !if ( Op_Density%Array (Op_KickLoc-1) /= NewDensity ) then + + if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) >= DensityMixTol ) then + + + + + call Op_Density%AddTo (Op_KickLoc,NewDensity) + call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) + call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) + call Op_MudOrKick%AddTo (Op_KickLoc,0) + + else !Op_Density%Array (Op_KickLoc-1) == NewDensity + + Op_Density%Array(Op_KickLoc-1)= (Op_Density%Array(Op_KickLoc-1)*Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewDensity*NewVolume)/(Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewVolume) + Op_MudDischarged_Volume%Array(Op_KickLoc-1)= Op_MudDischarged_Volume%Array(Op_KickLoc-1) + NewVolume + + endif + else !if Op_KickLoc == 1 (*****Migration Start*****) *5-1=============================== + !write(*,*) '****5-1' + + call Op_Density%AddToFirst (NewDensity) + call Op_MudDischarged_Volume%AddToFirst (NewVolume) + call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) + call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) + call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) + call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) + call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Op_MudOrKick%AddToFirst (0) + + endif + + + endif + +!======================================================================================== + + !write(*,*) 'a) density and cutting:' , Ann_Density%Length() , Ann_CuttingMud%Length() + + +!=========================== tamame kick balaye mate bashad *2 ================================== + + if ( Ann_KickLoc > 0 .and. Op_KickLoc==0 ) then + !write(*,*) '****2' + + !iloc= 1 + + KickDv= Area_PipeSectionFt(Ann_Mud_Forehead_section%Array(Ann_KickLoc)) * KickDx * 7.48051948d0 ! ft^3 to gal + + NewDensity= Ann_Density%Array (Ann_KickLoc+1) + NewVolume= KickDv + CuttingValue= Ann_CuttingMud%Array (Ann_KickLoc+1) + + if ( KickDv < Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) ) then !eleman bala sari baghi mimund + + Ann_MudDischarged_Volume%Array (Ann_KickLoc+1)= Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) - KickDv + + else !KickDv > Ann_MudDischarged_Volume%Array (imudKick+1) eleman baghi nemimund + + KickDv= Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) + NewVolume= KickDv + + call Ann_MudDischarged_Volume%Remove (Ann_KickLoc+1) + call Ann_Mud_Backhead_X%Remove (Ann_KickLoc+1) + call Ann_Mud_Backhead_section%Remove (Ann_KickLoc+1) + call Ann_Mud_Forehead_X%Remove (Ann_KickLoc+1) + call Ann_Mud_Forehead_section%Remove (Ann_KickLoc+1) + call Ann_Density%Remove (Ann_KickLoc+1) + call Ann_RemainedVolume_in_LastSection%Remove (Ann_KickLoc+1) + call Ann_EmptyVolume_inBackheadLocation%Remove (Ann_KickLoc+1) + call Ann_MudOrKick%Remove (Ann_KickLoc+1) + call Ann_CuttingMud%Remove (Ann_KickLoc+1) + + endif + + ! backheade kick balaye mate bashad + + if (Ann_KIckLoc > 1) then + !if ( Ann_Density%Array (Ann_KickLoc-1) /= NewDensity ) then + + if ( ABS(Ann_Density%Array (Ann_KickLoc-1) - NewDensity) >= DensityMixTol ) then + + Old_KickBackHead_X= Ann_Mud_Backhead_X%Array (Ann_KickLoc) + Old_KickBackHead_Section= Ann_Mud_Backhead_section%Array (Ann_KickLoc) + + + call Ann_Density%AddTo (Ann_KickLoc,NewDensity) + call Ann_MudDischarged_Volume%AddTo (Ann_KickLoc,NewVolume) + call Ann_Mud_Forehead_X%AddTo (Ann_KickLoc,Old_KickBackHead_X) + call Ann_Mud_Forehead_section%AddTo (Ann_KickLoc,Old_KickBackHead_Section) + call Ann_Mud_Backhead_X%AddTo (Ann_KickLoc,Old_KickBackHead_X) + call Ann_Mud_Backhead_section%AddTo (Ann_KickLoc,Old_KickBackHead_Section) + call Ann_RemainedVolume_in_LastSection%AddTo (Ann_KickLoc,0.0d0) + call Ann_EmptyVolume_inBackheadLocation%AddTo (Ann_KickLoc,0.0d0) + call Ann_MudOrKick%AddTo (Ann_KickLoc,0) + call Ann_CuttingMud%AddTo (Ann_KickLoc,0) + + else !Op_Density%Array (imudKick-1) == NewDensity + + Ann_Density%Array(Ann_KickLoc-1)= (Ann_Density%Array(Ann_KickLoc-1)*Ann_MudDischarged_Volume%Array(Ann_KickLoc-1)+NewDensity*NewVolume)/(Ann_MudDischarged_Volume%Array(Ann_KickLoc-1)+NewVolume) + Ann_MudDischarged_Volume%Array(Ann_KickLoc-1)= Ann_MudDischarged_Volume%Array(Ann_KickLoc-1) + NewVolume + + + endif + + else !if Ann_KickLoc == 1 *6 =============================== + !write(*,*) '****6' + + Old_KickBackHead_X= Ann_Mud_Backhead_X%Array (Ann_KickLoc) + Old_KickBackHead_Section= Ann_Mud_Backhead_section%Array (Ann_KickLoc) + + + call Ann_Density%AddToFirst (NewDensity) + call Ann_MudDischarged_Volume%AddToFirst (NewVolume) + call Ann_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) + call Ann_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) + call Ann_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) + call Ann_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) + call Ann_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Ann_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Ann_MudOrKick%AddToFirst (0) + call Ann_CuttingMud%AddToFirst (CuttingValue) + + endif + + endif + + !======================================================================================== + + + + + + + +!============================== kick 2 tarafe mate bashad *4 ============================== + + if ( Ann_KickLoc > 0 .and. Op_KickLoc > 0 ) then + !write(*,*) '****4' + + iloc= 2 + + KickDv= Area_PipeSectionFt(Ann_Mud_Forehead_section%Array(Ann_KickLoc)) * KickDx * 7.48051948d0 ! ft^3 to gal + + + MinKickDv= min( KickDv,Ann_MudDischarged_Volume%Array (Ann_KickLoc+1), Op_MudDischarged_Volume%Last () ) ! Ann_KickLoc+1=2 Op_MudDischarged_Volume%Last ()=kick + + NewDensity= Ann_Density%Array (Ann_KickLoc+1) + NewVolume= MinKickDv + + if ( MinKickDv == KickDv ) then !eleman bala sari baghi mimund, paeeni(kick) dar OP ham baghi mimund + !write(*,*) '****4----1' + + + Ann_MudDischarged_Volume%Array (Ann_KickLoc+1)= Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) - MinKickDv + + Ann_MudDischarged_Volume%Array (Ann_KickLoc)= Ann_MudDischarged_Volume%Array (Ann_KickLoc) + MinKickDv ! Ann_KickLoc= 1 + + Op_MudDischarged_Volume%Array (Op_KickLoc)= Op_MudDischarged_Volume%Array (Op_KickLoc) - MinKickDv ! Op_KickLoc= last + + + ! backheade kick zire mate bashad + if ( Op_KickLoc>1) then + + !if ( Op_Density%Array (Op_KickLoc-1) /= NewDensity ) then + + if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) >= DensityMixTol ) then + + Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + + call Op_Density%AddTo (Op_KickLoc,NewDensity) + call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) + call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) + call Op_MudOrKick%AddTo (Op_KickLoc,0) + + + else ! merge + + Op_Density%Array(Op_KickLoc-1)= (Op_Density%Array(Op_KickLoc-1)*Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewDensity*NewVolume)/(Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewVolume) + Op_MudDischarged_Volume%Array(Op_KickLoc-1)= Op_MudDischarged_Volume%Array(Op_KickLoc-1) + NewVolume + + endif + + else !if Op_KickLoc == 1 (*****Migration Start*****) *5-2=============================== + !write(*,*) '****5-2' + + Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + + + call Op_Density%AddToFirst (NewDensity) + call Op_MudDischarged_Volume%AddToFirst (NewVolume) + call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) + call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) + call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) + call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) + call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Op_MudOrKick%AddToFirst (0) + + endif + + + + elseif ( MinKickDv == Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) ) then ! eleman bala sari baghi nemimund + !write(*,*) '****4----2' + + call Ann_MudDischarged_Volume%Remove (Ann_KickLoc+1) + call Ann_Mud_Backhead_X%Remove (Ann_KickLoc+1) + call Ann_Mud_Backhead_section%Remove (Ann_KickLoc+1) + call Ann_Mud_Forehead_X%Remove (Ann_KickLoc+1) + call Ann_Mud_Forehead_section%Remove (Ann_KickLoc+1) + call Ann_Density%Remove (Ann_KickLoc+1) + call Ann_RemainedVolume_in_LastSection%Remove (Ann_KickLoc+1) + call Ann_EmptyVolume_inBackheadLocation%Remove (Ann_KickLoc+1) + call Ann_MudOrKick%Remove (Ann_KickLoc+1) + call Ann_CuttingMud%Remove (Ann_KickLoc+1) + + Ann_MudDischarged_Volume%Array (Ann_KickLoc)= Ann_MudDischarged_Volume%Array (Ann_KickLoc) + MinKickDv ! Ann_KickLoc= 1 + + Op_MudDischarged_Volume%Array (Op_KickLoc)= Op_MudDischarged_Volume%Array (Op_KickLoc) - MinKickDv ! Op_KickLoc= last + + ! backheade kick zire mate bashad + if (Op_KickLoc > 1) then + + !if ( Op_Density%Array (Op_KickLoc-1) /= NewDensity ) then + + if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) >= DensityMixTol ) then + + + Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + + call Op_Density%AddTo (Op_KickLoc,NewDensity) + call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) + call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) + call Op_MudOrKick%AddTo (Op_KickLoc,0) + + + else !Op_Density%Array (imudKick-1) == NewDensity + Op_Density%Array(Op_KickLoc-1)= (Op_Density%Array(Op_KickLoc-1)*Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewDensity*NewVolume)/(Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewVolume) + Op_MudDischarged_Volume%Array(Op_KickLoc-1)= Op_MudDischarged_Volume%Array(Op_KickLoc-1) + NewVolume + + endif + + else !if Op_KickLoc == 1 (*****Migration Start*****) *5-2=============================== + + Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + + + call Op_Density%AddToFirst (NewDensity) + call Op_MudDischarged_Volume%AddToFirst (NewVolume) + call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) + call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) + call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) + call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) + call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Op_MudOrKick%AddToFirst (0) + + endif + + + elseif ( MinKickDv == Op_MudDischarged_Volume%Last () ) then ! eleman balaee baghi mimund, kick az OP kamel kharej mishod + !write(*,*) '****4----3' + + + + Ann_MudDischarged_Volume%Array (Ann_KickLoc+1)= Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) - MinKickDv + + Ann_MudDischarged_Volume%Array (Ann_KickLoc)= Ann_MudDischarged_Volume%Array (Ann_KickLoc) + MinKickDv ! Ann_KickLoc= 1 + + + + Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + + + call Op_MudDischarged_Volume%Remove (Op_KickLoc) ! Op_KickLoc= last + call Op_Mud_Backhead_X%Remove (Op_KickLoc) + call Op_Mud_Backhead_section%Remove (Op_KickLoc) + call Op_Mud_Forehead_X%Remove (Op_KickLoc) + call Op_Mud_Forehead_section%Remove (Op_KickLoc) + call Op_Density%Remove (Op_KickLoc) + call Op_RemainedVolume_in_LastSection%Remove (Op_KickLoc) + call Op_EmptyVolume_inBackheadLocation%Remove (Op_KickLoc) + call Op_MudOrKick%Remove (Op_KickLoc) + + ! backheade kick zire mate bashad + if (Op_KickLoc > 1) then + + !if ( Op_Density%Array (Op_KickLoc-1) /= NewDensity ) then + + if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) >= DensityMixTol ) then + + + call Op_Density%AddTo (Op_KickLoc,NewDensity) + call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) + call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) + call Op_MudOrKick%AddTo (Op_KickLoc,0) + + else !Op_Density%Array (imudKick-1) == NewDensity + Op_Density%Array(Op_KickLoc-1)= (Op_Density%Array(Op_KickLoc-1)*Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewDensity*NewVolume)/(Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewVolume) + Op_MudDischarged_Volume%Array(Op_KickLoc-1)= Op_MudDischarged_Volume%Array(Op_KickLoc-1) + NewVolume + + endif + + else !if Op_KickLoc == 1 (*****Migration Start*****) *5-2=============================== + + call Op_Density%AddToFirst (NewDensity) + call Op_MudDischarged_Volume%AddToFirst (NewVolume) + call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) + call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) + call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) + call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) + call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Op_MudOrKick%AddToFirst (0) + + endif + + iloc= 1 ! ok + + endif + + + endif + +!======================================================================================== + + + +!============================== kick 2 tarafe mate bashad *4 with pump ============================== + + ! + !if ( Ann_KickLoc > 0 .and. Op_KickLoc > 0 .and. AnnulusFlowRate /= 0.0 ) then + ! write(*,*) '****4 with pump' + ! + ! KickMigration_2SideBit= .true. + ! + ! !iloc= 2 + ! + ! KickDv= Area_PipeSectionFt(Ann_Mud_Forehead_section%Array(Ann_KickLoc)) * KickDx * 7.48051948d0 ! ft^3 to gal + ! !MinKickDv= min( KickDv,Ann_MudDischarged_Volume%Array (Ann_KickLoc+1), Op_MudDischarged_Volume%Last () ) ! Ann_KickLoc+1=2 Op_MudDischarged_Volume%Last ()=kick + ! + ! + ! !MinKickDv= min( KickDv,Ann_MudDischarged_Volume%Array (Ann_KickLoc+1), Op_MudDischarged_Volume%Last () ) ! Ann_KickLoc+1=2 Op_MudDischarged_Volume%Last ()=kick + ! ! + ! !NewDensity= Ann_Density%Array (Ann_KickLoc+1) + ! !NewVolume= MinKickDv + ! + ! + ! if ( ((AnnulusFlowRate/60.0d0)*DeltaT_Mudline) >= KickDv ) then ! sorate pump bishtar az kick bashad---tu in halat aslan kari be elemane balaiye kick tuye Ann nadarim + ! !WRITE(*,*) '*****sorate pump bishtar az kick*******' + ! MinKickDv= ((AnnulusFlowRate/60.0d0)*DeltaT_Mudline) ! dar asl maxKickDv ast + ! + ! + ! + ! + ! + ! + ! + ! + ! if ( Op_MudDischarged_Volume%Last () > MinKickDv ) then !eleman paeeni(kick) dar OP baghi mimund + ! + ! Ann_MudDischarged_Volume%Array (Ann_KickLoc)= Ann_MudDischarged_Volume%Array (Ann_KickLoc) + MinKickDv ! Ann_KickLoc= 1 + ! + ! Op_MudDischarged_Volume%Array (Op_KickLoc)= Op_MudDischarged_Volume%Array (Op_KickLoc) - MinKickDv ! Op_KickLoc= last + ! + ! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + ! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + ! ! backheade kick zire mate bashad + ! if ( Op_KickLoc>1) then + ! + ! if ( Op_Density%Array (Op_KickLoc-1) /= St_Density%Last() ) then + ! + ! + ! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + ! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + ! + ! call Op_Density%AddTo (Op_KickLoc,St_Density%Last()) + ! call Op_MudDischarged_Volume%AddTo (Op_KickLoc,MinKickDv) + ! call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + ! call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + ! call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + ! call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + ! call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) + ! call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) + ! call Op_MudOrKick%AddTo (Op_KickLoc,0) + ! + ! + ! else !Op_Density%Array (imudKick-1) == NewDensity + ! + ! Op_MudDischarged_Volume%Array (Op_KickLoc-1)= Op_MudDischarged_Volume%Array (Op_KickLoc-1) + NewVolume + ! + ! endif + ! + ! else !if Op_KickLoc == 1 (*****Migration Start*****) *5-2=============================== + ! write(*,*) '****5-2 with pump' + ! + ! + ! !Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + ! !Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + ! + ! + ! call Op_Density%AddToFirst (St_Density%Last()) + ! call Op_MudDischarged_Volume%AddToFirst (MinKickDv) + ! call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) + ! call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) + ! call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) + ! call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) + ! call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + ! call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + ! call Op_MudOrKick%AddToFirst (0) + ! + ! endif + ! + ! elseif ( Op_MudDischarged_Volume%Last () <= MinKickDv ) then !eleman paeeni(kick) dar OP baghi nemimund yani kick az OP kamel kharej mishod + ! + ! MinKickDv= Op_MudDischarged_Volume%Last () + ! + ! + ! write(*,*) '****4----3 with pump a' + ! + ! + ! Ann_MudDischarged_Volume%Array (Ann_KickLoc+1)= Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) + ((AnnulusFlowRate/60.0d0)*DeltaT_Mudline)-MinKickDv + ! + ! Ann_MudDischarged_Volume%Array (Ann_KickLoc)= Ann_MudDischarged_Volume%Array (Ann_KickLoc) + MinKickDv ! Ann_KickLoc= 1 + ! + ! call Op_MudDischarged_Volume%Remove (Op_KickLoc) ! Op_KickLoc= last + ! call Op_Mud_Backhead_X%Remove (Op_KickLoc) + ! call Op_Mud_Backhead_section%Remove (Op_KickLoc) + ! call Op_Mud_Forehead_X%Remove (Op_KickLoc) + ! call Op_Mud_Forehead_section%Remove (Op_KickLoc) + ! call Op_Density%Remove (Op_KickLoc) + ! call Op_RemainedVolume_in_LastSection%Remove (Op_KickLoc) + ! call Op_EmptyVolume_inBackheadLocation%Remove (Op_KickLoc) + ! call Op_MudOrKick%Remove (Op_KickLoc) + ! + ! + ! ! backheade kick zire mate bashad + ! if (Op_KickLoc > 1) then + ! + ! if ( Op_Density%Array (Op_KickLoc-1) /= St_Density%Last() ) then + ! + ! + ! !Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + ! !Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + ! + ! call Op_Density%AddTo (Op_KickLoc,St_Density%Last()) + ! call Op_MudDischarged_Volume%AddTo (Op_KickLoc,MinKickDv) + ! call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + ! call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + ! call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + ! call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + ! call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) + ! call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) + ! call Op_MudOrKick%AddTo (Op_KickLoc,0) + ! + ! + ! + ! else !Op_Density%Array (imudKick-1) == NewDensity + ! + ! + ! Op_MudDischarged_Volume%Array (Op_KickLoc-1)= Op_MudDischarged_Volume%Array (Op_KickLoc-1) + MinKickDv + ! + ! endif + ! + ! else !if Op_KickLoc == 1 (*****Migration Start*****) *5-2=============================== + ! + ! + ! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + ! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + ! + ! + ! call Op_Density%AddToFirst (St_Density%Last()) + ! call Op_MudDischarged_Volume%AddToFirst (MinKickDv) + ! call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) + ! call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) + ! call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) + ! call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) + ! call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + ! call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + ! call Op_MudOrKick%AddToFirst (0) + ! + ! endif + ! + ! + ! endif ! ende 2 halat ke kick tuye Op baghi bemune ya namune- dar halati ke ((AnnulusFlowRate/60.)*DeltaT_Mudline) >= KickDv ) ! sorate pump bishtar az kick bashad + ! + ! + ! + ! + ! else !if( ((AnnulusFlowRate/60.)*DeltaT_Mudline) < KickDv ) then ! sorate pump kamtar az kick bashad + ! !WRITE(*,*) '*****sorate pump kamtar az kick*******' + ! + ! + ! + ! + ! MinKickDv= min( KickDv,Ann_MudDischarged_Volume%Array (Ann_KickLoc+1), Op_MudDischarged_Volume%Last () ) ! Ann_KickLoc+1=2 Op_MudDischarged_Volume%Last ()=kick + ! + ! + ! + ! !write(*,*) 'MinKickDv=' , MinKickDv + ! + ! + ! if ( MinKickDv == KickDv ) then !eleman bala sari baghi mimund, paeeni(kick) dar OP ham baghi mimund + ! !write(*,*) '****4----1 with pump' + ! !write(*,*) 'St_Density%Last()=' , St_Density%Last() + ! !write(*,*) '((AnnulusFlowRate/60.)*DeltaT_Mudline)=' , ((AnnulusFlowRate/60.)*DeltaT_Mudline) + ! !write(*,*) 'Ann_Density%Array(Ann_KickLoc+1)=' , Ann_Density%Array(Ann_KickLoc+1) + ! !write(*,*) '(MinKickDv-((AnnulusFlowRate/60.)*DeltaT_Mudline))=' , (MinKickDv-((AnnulusFlowRate/60.)*DeltaT_Mudline)) + ! + ! + ! NewDensity= (St_Density%Last()*((AnnulusFlowRate/60.0d0)*DeltaT_Mudline) + Ann_Density%Array(Ann_KickLoc+1)*(MinKickDv-((AnnulusFlowRate/60.0d0)*DeltaT_Mudline))) & + ! / (((AnnulusFlowRate/60.0d0)*DeltaT_Mudline) + (MinKickDv-((AnnulusFlowRate/60.0d0)*DeltaT_Mudline))) + ! NewVolume= MinKickDv + ! + ! + ! Ann_MudDischarged_Volume%Array (Ann_KickLoc+1)= Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) - (MinKickDv-((AnnulusFlowRate/60.0d0)*DeltaT_Mudline)) + ! + ! Ann_MudDischarged_Volume%Array (Ann_KickLoc)= Ann_MudDischarged_Volume%Array (Ann_KickLoc) + MinKickDv ! Ann_KickLoc= 1 + ! + ! Op_MudDischarged_Volume%Array (Op_KickLoc)= Op_MudDischarged_Volume%Array (Op_KickLoc) - MinKickDv ! Op_KickLoc= last + ! + ! + ! ! backheade kick zire mate bashad + ! if ( Op_KickLoc>1) then + ! + ! + ! + ! if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) > DensityMixTol) then ! .OR. (Op_MudDischarged_Volume%Array (Op_KickLoc-1)>42.) ) then + ! + ! + ! + ! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + ! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + ! + ! call Op_Density%AddTo (Op_KickLoc,NewDensity) + ! call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) + ! call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + ! call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + ! call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + ! call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + ! call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) + ! call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) + ! call Op_MudOrKick%AddTo (Op_KickLoc,0) + ! + ! + ! else !Merge Condition + ! + ! Op_MudDischarged_Volume%Array (Op_KickLoc-1)= Op_MudDischarged_Volume%Array (Op_KickLoc-1) + NewVolume + ! Op_Density%Array (Op_KickLoc-1)= (Op_MudDischarged_Volume%Array (Op_KickLoc-1)*Op_Density%Array (Op_KickLoc-1)+NewVolume*NewDensity) / & + ! (Op_MudDischarged_Volume%Array (Op_KickLoc-1)+NewVolume) + ! + ! + ! endif + ! + ! else !if Op_KickLoc == 1 (*****Migration Start*****) *5-2=============================== + ! write(*,*) '****5-2 with pump' + ! + ! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + ! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + ! + ! + ! call Op_Density%AddToFirst (NewDensity) + ! call Op_MudDischarged_Volume%AddToFirst (NewVolume) + ! call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) + ! call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) + ! call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) + ! call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) + ! call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + ! call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + ! call Op_MudOrKick%AddToFirst (0) + ! + ! endif + ! + ! + ! + ! elseif ( MinKickDv == Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) ) then ! eleman bala sari baghi nemimund + ! write(*,*) '****4----2 with pump' + ! + ! NewDensity= (St_Density%Last()*((AnnulusFlowRate/60.0d0)*DeltaT_Mudline) + Ann_Density%Array(Ann_KickLoc+1)*(MinKickDv-((AnnulusFlowRate/60.0d0)*DeltaT_Mudline))) & + ! / (((AnnulusFlowRate/60.0d0)*DeltaT_Mudline) + Ann_MudDischarged_Volume%Array (Ann_KickLoc+1)) + ! NewVolume= MinKickDv + ! + ! call RemoveAnnulusMudArrays(Ann_KickLoc+1) + ! + ! Ann_MudDischarged_Volume%Array (Ann_KickLoc)= Ann_MudDischarged_Volume%Array (Ann_KickLoc) + MinKickDv ! Ann_KickLoc= 1 + ! + ! Op_MudDischarged_Volume%Array (Op_KickLoc)= Op_MudDischarged_Volume%Array (Op_KickLoc) - MinKickDv ! Op_KickLoc= last + ! + ! ! backheade kick zire mate bashad + ! if (Op_KickLoc > 1) then + ! + ! if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) > DensityMixTol) then ! .OR. (Op_MudDischarged_Volume%Array (Op_KickLoc-1)>42.) ) then + ! + ! ! + ! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + ! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + ! + ! call Op_Density%AddTo (Op_KickLoc,NewDensity) + ! call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) + ! call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + ! call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + ! call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + ! call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + ! call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) + ! call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) + ! call Op_MudOrKick%AddTo (Op_KickLoc,0) + ! + ! + ! else !Merge Condition + ! + ! Op_MudDischarged_Volume%Array (Op_KickLoc-1)= Op_MudDischarged_Volume%Array (Op_KickLoc-1) + NewVolume + ! Op_Density%Array (Op_KickLoc-1)= (Op_MudDischarged_Volume%Array (Op_KickLoc-1)*Op_Density%Array (Op_KickLoc-1)+NewVolume*NewDensity) / & + ! (Op_MudDischarged_Volume%Array (Op_KickLoc-1)+NewVolume) + ! + ! + ! + ! endif + ! + ! else !if Op_KickLoc == 1 (*****Migration Start*****) *5-2=============================== + ! + ! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + ! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + ! + ! + ! call Op_Density%AddToFirst (NewDensity) + ! call Op_MudDischarged_Volume%AddToFirst (NewVolume) + ! call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) + ! call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) + ! call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) + ! call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) + ! call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + ! call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + ! call Op_MudOrKick%AddToFirst (0) + ! + ! endif + ! + ! + ! elseif ( MinKickDv == Op_MudDischarged_Volume%Last () ) then ! eleman balaee baghi mimund, kick az OP kamel kharej mishod + ! write(*,*) '****4----3 with pump b' + ! + ! NewDensity= St_Density%Last() + ! NewVolume= MinKickDv + ! + ! + ! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) + ! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) + ! + ! + ! !Ann_MudDischarged_Volume%Array (Ann_KickLoc+1)= Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) - MinKickDv farz kardam dast be elemane balaee nazanam + ! + ! Ann_MudDischarged_Volume%Array (Ann_KickLoc)= Ann_MudDischarged_Volume%Array (Ann_KickLoc) + MinKickDv ! Ann_KickLoc= 1 + ! !write(*,*) 'pointer 1' + ! call Op_MudDischarged_Volume%Remove (Op_KickLoc) ! Op_KickLoc= last + ! call Op_Mud_Backhead_X%Remove (Op_KickLoc) + ! call Op_Mud_Backhead_section%Remove (Op_KickLoc) + ! call Op_Mud_Forehead_X%Remove (Op_KickLoc) + ! call Op_Mud_Forehead_section%Remove (Op_KickLoc) + ! call Op_Density%Remove (Op_KickLoc) + ! call Op_RemainedVolume_in_LastSection%Remove (Op_KickLoc) + ! call Op_EmptyVolume_inBackheadLocation%Remove (Op_KickLoc) + ! call Op_MudOrKick%Remove (Op_KickLoc) + ! + ! !write(*,*) 'pointer 2' + ! + ! ! backheade kick zire mate bashad + ! if (Op_KickLoc > 1) then + ! + ! if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) > DensityMixTol) then ! .OR. (Op_MudDischarged_Volume%Array (Op_KickLoc-1)>42.) ) then + ! !write(*,*) 'pointer 3' + ! + ! + ! + ! + ! call Op_Density%AddTo (Op_KickLoc,NewDensity) + ! call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) + ! call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + ! call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + ! call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) + ! call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) + ! call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) + ! call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) + ! call Op_MudOrKick%AddTo (Op_KickLoc,0) + ! + ! !write(*,*) 'pointer 4' + ! + ! else !Merge Condition + ! + ! Op_MudDischarged_Volume%Array (Op_KickLoc-1)= Op_MudDischarged_Volume%Array (Op_KickLoc-1) + NewVolume + ! Op_Density%Array (Op_KickLoc-1)= (Op_MudDischarged_Volume%Array (Op_KickLoc-1)*Op_Density%Array (Op_KickLoc-1)+NewVolume*NewDensity) / & + ! (Op_MudDischarged_Volume%Array (Op_KickLoc-1)+NewVolume) + ! + ! endif + ! + ! else !if Op_KickLoc == 1 (*****Migration Start*****) *5-2=============================== + ! !write(*,*) 'pointer 5' + ! + ! + ! !write(*,*) 'pointer 6' + ! + ! + ! call Op_Density%AddToFirst (NewDensity) + ! call Op_MudDischarged_Volume%AddToFirst (NewVolume) + ! call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) + ! call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) + ! call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) + ! call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) + ! call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + ! call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + ! call Op_MudOrKick%AddToFirst (0) + ! !write(*,*) 'pointer 7' + ! + ! endif + ! + ! + ! endif + ! + ! + ! + ! endif !( ((AnnulusFlowRate/60.)*DeltaT_Mudline) < KickDv ) ! sorate pump kamtar az kick bashad + ! + ! + ! + ! + ! endif + +!======================================================================================== + +ENDDO ! KickNumber= 1, NewInfluxNumber + + + !write(*,*) 'c)Ann_MudDischarged_Volume%Array(:)=' , sum(Ann_MudDischarged_Volume%Array(:)) + + + + end subroutine Kick_Migration \ No newline at end of file diff --git a/Equipments/MudSystem/MudSystem.f90 b/Equipments/MudSystem/MudSystem.f90 new file mode 100644 index 0000000..ba554ae --- /dev/null +++ b/Equipments/MudSystem/MudSystem.f90 @@ -0,0 +1,3553 @@ +module MudSystem + + USE MudSystemVARIABLES + USE PressureDisplayVARIABLES + USE FricPressDropVars + USE Fluid_Flow_Startup_Vars + USE CMudPropertiesVariables + USE CManifolds + USE CPumpsVariables + USE CUnityOutputs + use CWarningsVariables + use DynamicIntegerArray + use CError + use CLog1 + USE CDataDisplayConsoleVariables + use CStudentStationVariables , PitGainLossReset=>PitGainLossZero + + + implicit none + + real j2,j12,j13,jj2,jj12,jj13 + real A71,A72,A73 + integer j3,B71,B77,B78 + integer j4 + real C71,C77,C78 + integer j5 + integer j6,D71,D80 + integer j7,j8,j9,j10,j11 + real E71,E72,E73 + real F71,F72,F73 + integer j14 + real G82,G83,G84 + integer j15 + real H82,H83,H84 + integer j16,K82,K83,K84,K79,K78 + integer j17,L82,L83,L84,L79,L78 + integer j18 + real M71,M77,M78, Pump1toCh,Pump2toCh,Pump3toCh,Denominator_a + integer j19 + real N82,N83,N84 + integer j20 + integer j21 + real unityreturn + + + + real(8) DumpPump1,DumpPump2,DumpCementPump,Denominator + real(8) Mp1Coef,Mp2Coef,CpCoef + real(8) PumpPressure1,PumpPressure2,PumpPressure3 + integer Mp1_NoPath,Mp2_NoPath,Cp_NoPath + real P1toSt,P2toSt,CptoSt + real(8) MaxWorkingPressure1,MaxWorkingPressure2,MaxWorkingPressure3,MaxWorkingPressure + + REAL(8) DumpFromKelly, DumpFromFillupHead + real(8) AddedVolumeToTank,PUMP1_Flow_Rate_Old,PUMP2_Flow_Rate_Old,PUMP3_Flow_Rate_Old + real(8) VolumeToActive,VolumeToBellNipple,BellNipple_FlowCoef,ChokeLine_FlowCoef + + + REAL RealJ2,RealJ12,RealJ13,RealJ4,RealJ18 + INTEGER active32,active33,active34,active35,active29 + + logical condition1, condition2, condition3, condition4, condition5, condition6, condition7, condition8, condition9, condition10, condition11, condition12, condition13, condition14, condition15 + logical condition16,condition17,condition18,condition19,condition20,condition21,condition22,condition23,condition24,condition25,condition26,condition27,condition28,condition29,condition30,condition31 + logical condition32,condition33,condition34,condition35,condition36,condition37,condition38,condition39,condition40,condition41,condition42,condition43,condition44,condition45 + logical condition46,condition47,condition48,condition49,condition50,condition51,condition52,condition53,condition54,condition55,condition56,condition57,condition58 + logical condition59,condition60,condition61 + logical ac32, ac33, ac34, ac35, ac29 + logical ThereIsPathFrom_71_72_73_To_82, ThereIsPathFrom_71_72_73_To_83, ThereIsPathFrom_71_72_73_To_84 + logical DumpFromKelly_Pump1, DumpFromKelly_Pump2, DumpFromKelly_Pump3 + logical DumpFromTopDrive_Pump1,DumpFromTopDrive_Pump2,DumpFromTopDrive_Pump3 + logical DumpFromFillupHead_Pump1, DumpFromFillupHead_Pump2, DumpFromFillupHead_Pump3 + logical State1,State2, State3, State4 + type(DynamicIntegerArrayType) Pump1_Lasts,Pump2_Lasts, Pump3_Lasts + REAL MP1_Q, MP2_Q, MP3_Q + real TimePassed + + real(8) active_after, active_before, active_increase, total_active_increase,total_decrease,sys_total_injected + real(8) total_annFlow,total_DeltaVPipe + contains + + subroutine LineupAndPath() + implicit none + +!=========================================================================== +! MUDLINE CODE +!=========================================================================== + ! Initialize + j2=0 + jj2=0 + A71=0 + A72=0 + A73=0 + RealJ2=0.0 + + j3=0 + B71=0 + B77=0 + B78=0 + + j4=0 + C71=0. + C77=0. + C78=0. + active32=0 + active33=0 + active34=0 + active35=0 + active29=0 + + + j5=0 + + j6=0 + D71=0 + D80=0 + + j7=0 + + j8=0 + + j9=0 + j10=0 + j11=0 + + j12=0 + jj12=0 + E71=0 + E72=0 + E73=0 + RealJ12=0.0 + + j13=0 + jj13=0 + F71=0 + F72=0 + F73=0 + RealJ13=0.0 + + j14=0 + G82=0 + G83=0 + G84=0 + + DumpPump1=0. + DumpPump2=0. + DumpCementPump=0. + + j15=0 + H82=0.0 + H83=0.0 + H84=0.0 + + Mp1Coef= 0.0 + Mp1Coef= 0.0 + CpCoef= 0.0 + + Mp1_NoPath= 0 + Mp2_NoPath= 0 + Cp_NoPath= 0 + + j16=0 + K82=0 + K83=0 + K84=0 + K78=0 + K79=0 + + + j17=0 + L82=0 + L83=0 + L84=0 + L78=0 + L79=0 + + j18=0 + M71=0. + M77=0. + M78=0. + Pump1toCh=0. + Pump2toCh=0. + Pump3toCh=0. + + + j19=0 + N82=0 + N83=0 + N84=0 + + j20=0 + + j21=0 + + + +!=========================================================================== + + !===============TanksToMudPump1================= + if(condition1) then + j2=j2+1 + A71=1 + jj2=1 + endif + + if(condition2) then + j2=j2+1 + A72=1 + jj2=1 + endif + + if(condition3) then + j2=j2+1 + A73=1 + jj2=1 + endif + + !================================================ + + !============BellNippleToPits-FullWell============== + if(FirstMudSet== 1 ) then !.and. WellisNOTFull== .false.) then ! Well Must Be Full !Ann_Mud_Forehead_X%Last()==AboveAnnularHeight .and. Ann_Density%Last()/=0.0) + if(condition4) then + j3=j3+1 + B71=1 + endif + + if(condition5) then + j3=j3+1 + B77=1 + endif + + if(condition6) then + j3=j3+1 + B78=1 + endif + + endif + + !================================================ + + !============WellToChokeManifold(Through 26)============== + if(condition7) then + j4=j4+1 + C71=1. + endif + + if(condition8) then + j4=j4+1 + C77=1. + endif + + if(condition45) then + j4=j4+1 + C78=1. + endif + if (ac32) active32=1 + if (ac33) active33=1 + if (ac34) active34=1 + if (ac35) active35=1 + if (ac29) active29=1 !BYPASS VALVE + + + + !================================================ + + + !============ActiveTankToTripTank============== + if(condition9) then + j5=j5+1 + endif + !================================================ + + !write(*,*) 'j5====' , j5 + !============TripTankToActiveTank And BellNipple============== + if(condition10) then + j6=j6+1 + D71=1 + endif + + if(condition11) then + j6=j6+1 + D80=1 + endif + !================================================ + + !============ActiveTankToDump============== + if(condition12) then + j7=j7+1 + endif + !================================================ + + !============TripTankToDump============== + if(condition13) then + j8=j8+1 + endif + !================================================ + + !============WellToBellNipple============== + if(condition14) then + j9=j9+1 + endif + !================================================ + + !============MudBucketToBellNipple============== + if(condition15) then + j10=j10+1 + endif + !================================================ + + !============BellNippleToWell-NonFullWell============== + + + if(condition16 .and. FirstMudSet== 1 .and. BellNippleVolume > 0.0001 .and. WellisNOTFull) then + + write(*,*) 'MUD(7)%Q=' , MUD(7)%Q + write(*,*) 'BellNippleVolume=' , BellNippleVolume + + + write(*,*) 'MudVolume_InjectedFromAnn-WellToBellNipple=' , MudVolume_InjectedFromAnn + + write(*,*) 'int:::=' , (Ann_Mud_Forehead_X%Last() - AboveAnnularHeight) + write(*,*) 'Ann_Mud_Forehead_X%Last()=' , Ann_Mud_Forehead_X%Last() + write(*,*) 'AboveAnnularHeight=' , AboveAnnularHeight + write(*,*) 'Ann_Density%Last()=' , Ann_Density%Last() + CALL ErrorStop('error stop1') + + j11=j11+1 + endif + !================================================ + + !===============TanksToMudPump2=================== + + if(condition17) then + j12=j12+1 + E71=1 + jj12=1 + endif + + if(condition18) then + j12=j12+1 + E72=1 + jj12=1 + endif + + if(condition19) then + j12=j12+1 + E73=1 + jj12=1 + endif + + !================================================ + + !===============TanksToCementPump=================== + if(condition20) then + j13=j13+1 + F71=1 + jj13=1 + endif + + if(condition21) then + j13=j13+1 + F72=1 + jj13=1 + endif + + if(condition22) then + j13=j13+1 + F73=1 + jj13=1 + endif + + !================================================ + + !===============PumpsToString=================== + if(condition23) then + j14=j14+1 + G82=1 + endif + + if(condition24) then + j14=j14+1 + G83=1 + endif + + if(condition25) then + j14=j14+1 + G84=1 + endif + !================================================ + + + !===============PumpsToDump=================== + if(condition26) then + DumpPump1=1.0 + endif + + if(condition27) then + DumpPump2=1.0 + endif + + if(condition28) then + DumpCementPump=1.0 + endif + !================================================ + + + !=======MudPumps1&2ToActiveTank_Through65&66========== + if(condition29) then + !write(*,*) 'condition 29' + j15=j15+1 + H82=1.0 + endif + + if(condition30) then + j15=j15+1 + H83=1.0 + endif + + !================================================ + + + !=======CementPumpToActiveTank_Through65========== + + if(condition31) then + + H84=1.0 + + endif + !================================================ + + !write(*,*) 'condition32===' , condition32 + + !============MudPump1HasNoPath=================== + if(condition32Final) then + !write(*,*) 'MudPump1HasNoPath' + Mp1_NoPath = 1 + endif + !================================================ + + !============MudPump2HasNoPath=================== + if(condition33Final) then + !write(*,*) 'MudPump2HasNoPath' + Mp2_NoPath = 1 + endif + !================================================ + + + !============CementPumpHasNoPath=================== + if(condition34Final) then + Cp_NoPath = 1 + endif + !================================================ + + !===============PathsToGauge75=================== + if(condition35) then !Pump1 to Gauge75 + j16=j16+1 + K82=1 + endif + + if(condition36) then !Pump2 to Gauge75 + j16=j16+1 + K83=1 + endif + + if(condition37) then !Pump3 to Gauge75 + j16=j16+1 + K84=1 + endif + + if(condition38) then !String to Gauge75 + j16=j16+1 + K79=1 + endif + + if(condition39) then !Dump to Gauge75 + j16=j16+1 + K78=1 + endif + + !================================================ + !write(*,*) '****j16=' , j16 + !===============PathsToGauge76=================== + if(condition40) then !Pump1 to Gauge76 + j17=j17+1 + L82=1 + endif + + if(condition41) then !Pump2 to Gauge76 + j17=j17+1 + L83=1 + endif + + if(condition42) then !Pump3 to Gauge76 + j17=j17+1 + L84=1 + endif + + if(condition43) then !String to Gauge76 + j17=j17+1 + L79=1 + endif + + if(condition44) then !Dump to Gauge76 + j17=j17+1 + L78=1 + endif + + !================================================ + + !====Pump1-StandPipeManifoldToChokeManifold-Through ChokeLine==== + if(condition46) then + j18=j18+1 + M71=1. + Pump1toCh= 1. + endif + + if(condition47) then + j18=j18+1 + M77=1. + Pump1toCh= 1. + endif + + if(condition48) then + j18=j18+1 + M78=1. + Pump1toCh= 1. + endif + !================================================================= + + + !====Pump2-StandPipeManifoldToChokeManifold-Through ChokeLine==== + if(condition49) then + j18=j18+1 + M71=1. + Pump2toCh= 1. + endif + + if(condition50) then + j18=j18+1 + M77=1. + Pump2toCh= 1. + endif + + if(condition51) then + j18=j18+1 + M78=1. + Pump2toCh= 1. + endif + !================================================================= + + + !====Pump3-StandPipeManifoldToChokeManifold-Through ChokeLine==== + if(condition52) then + j18=j18+1 + M71=1. + Pump3toCh= 1. + endif + + if(condition53) then + j18=j18+1 + M77=1. + Pump3toCh= 1. + endif + + if(condition54) then + j18=j18+1 + M78=1. + Pump3toCh= 1. + endif + !================================================================= + + + !===============PumpsToWell_KillLine============ + if(condition55) then + j19=j19+1 + N82=1 + endif + + if(condition56) then + j19=j19+1 + N83=1 + endif + + if(condition57) then + j19=j19+1 + N84=1 + endif + !================================================ + + !===============WellToChokeLineGauge============ + if(condition58) then + j20=j20+1 + endif + + if (j20>0) then + WellToChokeLineGauge= .true. + else + WellToChokeLineGauge= .false. + endif + !================================================ + + + !============ChokeLineGaugeToTanks=============== + if(condition59) then + j21=j21+1 + endif + + if(condition60) then + j21=j21+1 + endif + + if(condition61) then + j21=j21+1 + endif + + if (j21>0) then + ChokeLineGaugeToTanks= .true. + else + ChokeLineGaugeToTanks= .false. + endif + !================================================ + + + end subroutine + + subroutine main + Use GeoElements_FluidModule + USE Pump_VARIABLES + USE CHOKEVARIABLES + USE CDataDisplayConsoleVariables , StandPipePressureDataDisplay=>StandPipePressure + use CDrillWatchVariables , MudWeightIn2 => MudWeightIn, MudWeightOut2 => MudWeightOut, PumpPressureDW => PumpPressure + use CHOKEVARIABLES + use CChokeManifoldVariables + use CTanksVariables, TripTankVolume2 => TripTankVolume, TripTankDensity2 => TripTankDensity + Use KickVariables + Use CHoistingVariables + + implicit none + + Integer I + + + MudSys_timeCounter = MudSys_timeCounter + 1 + + if (ChokePanelStrokeResetSwitch == 1) then + MudSys_timeCounter= 0 + endif + + !WRITE (*,*) 'MudSys_timeCounter', MudSys_timeCounter + + + + + + + + + + + if (MudPump1ReliefValveIsSet==.false.) MudPump1ReliefValvePressure=6000. + if (MudPump2ReliefValveIsSet==.false.) MudPump2ReliefValvePressure=6000. + if (CementPumpReliefValveIsSet==.false.) CementPumpReliefValvePressure=6000. + + + + + + + + + + + + + + + + + + + + +!=========================================================================================================================== +!=========================================================================================================================== + + +! >>> Should Be on Top of Other Codes <<< + + + !ActiveTankVolume= ActiveMudVolumeGal ! update from student input + !ActiveTankDensity= ActiveDensity ! update from student input + !ReserveTankVolume= ReserveMudVolumeGal ! update from student input + !ReserveTankDensity= ReserveDensity ! update from student input + + + + if (j7 > 0) then !ActiveTankToDump + ActiveTankDensity= 0. + ActiveTankVolume= 0. + endif + + + if (j8 > 0) then !TripTankToDump + TripTankDensityCalc= 0. + TripTankVolumeCalc= 0. + endif + + + +!=========================================================================================================================== +!=========================================================================================================================== + if (j15 > 0) then !MudPumps1&2ToActiveTank_Through65&66 + !write(*,*) 'j15 is open' + ! << if H82 or H83 or H4 are open, no flow goes to other parts of system >> + + + if (j2>0) Mp1Coef= 1.0 + if (j12>0) Mp2Coef= 1.0 + + + if (j2 /= 0 .or. j12/= 0) then + + + ActiveTankDensity = (ActiveTankDensity*ActiveTankVolume+ Mp1Coef*Mp1Density*(PUMP(1)%Flow_Rate*DeltaT_Mudline/60.) + Mp2Coef*Mp2Density*(PUMP(2)%Flow_Rate*DeltaT_Mudline/60.))/ & + (ActiveTankVolume+ Mp1Coef*(PUMP(1)%Flow_Rate*DeltaT_Mudline/60.) + Mp2Coef*(PUMP(2)%Flow_Rate*DeltaT_Mudline/60.)) + + ActiveTankVolume= ActiveTankVolume+ Mp1Coef*PUMP(1)%Flow_Rate*DeltaT_Mudline/60. + Mp2Coef*PUMP(2)%Flow_Rate*DeltaT_Mudline/60. + !write(*,*) 'active by j15' + endif + + + ActiveTankVolume=min(ActiveTankVolume , ActiveTotalTankCapacityGal-ActiveSettledContentsGal) + !if ActiveTankVolume is higher, excess amount is dumped + + endif + + + if (H84 > 0.0) then !CementPumpToCementTank_Through67 + + if (j13>0) CpCoef= 1.0 + + + CementTankDensityCalc= (CementTankDensityCalc*CementTankVolumeCalc+ CpCoef*Mp3Density*(PUMP(3)%Flow_Rate*DeltaT_Mudline/60.) ) / & + (CementTankVolumeCalc+CpCoef*(PUMP(3)%Flow_Rate*DeltaT_Mudline/60.)) + + CementTankVolumeCalc= CementTankVolumeCalc+ CpCoef*(PUMP(3)%Flow_Rate*DeltaT_Mudline/60.) + + + endif + +!=========================================================================================================================== +!=========================================================================================================================== + + + ! DUMP Path + + PumpsDumpVolume= PumpsDumpVolume+ (jj2*(1-H82)*DumpPump1*PUMP(1)%Flow_Rate + jj12*(1-H83)*DumpPump2*PUMP(2)%Flow_Rate + jj13*(1-H84)*DumpCementPump*PUMP(3)%Flow_Rate) *DeltaT_Mudline/60. + PumpsDumpFlowRate= jj2*(1-H82)*DumpPump1*PUMP(1)%Flow_Rate + jj12*(1-H83)*DumpPump2*PUMP(2)%Flow_Rate + jj13*(1-H84)*DumpCementPump*PUMP(3)%Flow_Rate + !write(*,*) 'PumpsDumpFlowRate=' , PumpsDumpFlowRate + + if (DriveType==1 .and. PumpsDumpFlowRate > 0.0 .and. (DumpFromKelly_Pump1 .or. DumpFromKelly_Pump2 .or. DumpFromKelly_Pump3)) then + !write(*,*) 'Set_FlowFromKelly(.TRUE.)' + call Activate_PumpWithKellyDisconnected() + !write(*,*) 'PumpsDumpFlowRate=' , PumpsDumpFlowRate + CALL Set_FlowFromKelly(min(PumpsDumpFlowRate/6.,100.)) ! .TRUE. before + elseif (DriveType==1) then + call Deactivate_PumpWithKellyDisconnected() + CALL Set_FlowFromKelly(0.0) ! .FALSE. before + !write(*,*) 'Set_FlowFromKelly(.FALSE.)' + + endif + !write(*,*) 'DumpFromFillupHead_Pump1=' , DumpFromFillupHead_Pump1 + + + if (DriveType==0 .and. PumpsDumpFlowRate > 0.0 .and. (DumpFromTopDrive_Pump1 .or. DumpFromTopDrive_Pump2 .or. DumpFromTopDrive_Pump3)) then + !write(*,*) 'Set_FlowFromKelly(.TRUE.)' + call Activate_PumpWithTopdriveDisconnected() + CALL Set_FlowFromKelly(min(PumpsDumpFlowRate/6.,100.)) ! .TRUE. before + elseif (DriveType==0) then + call Deactivate_PumpWithTopdriveDisconnected() + CALL Set_FlowFromKelly(0.0) ! .FALSE. before + !write(*,*) 'Set_FlowFromKelly(.FALSE.)' + + endif + + + + if (PumpsDumpFlowRate > 0.0 .and. (DumpFromFillupHead_Pump1 .or. DumpFromFillupHead_Pump2 .or. DumpFromFillupHead_Pump3)) then + + !call Activate_PumpWithKellyDisconnected() + CALL Set_FlowFromFillupHead(min(PumpsDumpFlowRate/6.,100.)) ! .TRUE. before + else + !call Deactivate_PumpWithKellyDisconnected() + CALL Set_FlowFromFillupHead(0.0) ! .FALSE. before + + endif + + + + +!####C_Program -----> DriveType = + ! = 0 TopDrive_DriveType + ! = 1 Kelly_DriveType +!=========================================================================================================================== +!=========================================================================================================================== + ! ****** Calculating Maximum Working Pressure + + + if (MudPump1ReliefValveIsSet) then + MaxWorkingPressure1= MudPump1ReliefValvePressure + else + MaxWorkingPressure1= 6000. !psi + endif + + + if (MudPump2ReliefValveIsSet) then + MaxWorkingPressure2= MudPump2ReliefValvePressure + else + MaxWorkingPressure2= 6000. !psi + endif + + if (CementPumpReliefValveIsSet) then + MaxWorkingPressure3= CementPumpReliefValveIsSet + else + MaxWorkingPressure3= 6000. !psi + endif + + + if (State1) then + MaxWorkingPressure= min(MaxWorkingPressure1 , MaxWorkingPressure2 , MaxWorkingPressure3) + MaxWorkingPressure1= MaxWorkingPressure + MaxWorkingPressure2= MaxWorkingPressure + MaxWorkingPressure3= MaxWorkingPressure + endif + + + if (State2) then + MaxWorkingPressure= min(MaxWorkingPressure1 , MaxWorkingPressure2) + MaxWorkingPressure1= MaxWorkingPressure + MaxWorkingPressure2= MaxWorkingPressure + endif + + if (State3) then + MaxWorkingPressure= min(MaxWorkingPressure1 , MaxWorkingPressure3) + MaxWorkingPressure1= MaxWorkingPressure + MaxWorkingPressure3= MaxWorkingPressure + endif + + + if (State4) then + MaxWorkingPressure= min(MaxWorkingPressure2 , MaxWorkingPressure3) + MaxWorkingPressure2= MaxWorkingPressure + MaxWorkingPressure3= MaxWorkingPressure + endif + ! Calculating Maximum Working Pressure ****** + +!=========================================================================================================================== +!=========================================================================================================================== + + + ! ****** Blown Conditions + + !G: PumpsToString Coefficient + !jJ2,Jj12,Jj13: TanksToMudPump Coefficient + !H: Pumps To Tank_Through65 or 67 Coefficient + + !write(*,*) 'j12=' , j12 + !write(*,*) 'H83=' , H83 + !write(*,*) 'DumpPump2=' , DumpPump2 + !write(*,*) 'G83=' , G83 + + + + + PumpPressure1= jj2*(1-H82)*(1-DumpPump1)*G82* PressureGauges(1) + PumpPressure2= jj12*(1-H83)*(1-DumpPump2)*G83* PressureGauges(1) + PumpPressure3= jj13*(1-H84)*(1-DumpCementPump)*G84* PressureGauges(1) + ! + !write(*,*) 'jj2 , H82 , DumpPump1 , G82,PresCsureGauges(1)=' , jj2 , H82 , DumpPump1 , G82,PressureGauges(1) + !write(*,*) '1)PumpPressure1=' , PumpPressure1 + + !write(*,*) 'PumpPressure2=' , PumpPressure2 + + PumpToManifoldMudVol = 3.0 * 42.0 + !PumpToManifoldCompressedMudVol = PumpToManifoldCompressedMudVol + MP1_Q / ConvMinToSec * dt + !PumpToManifoldDeltaPDueToCompressibility = PumpToManifoldCompressedMudVol / (MudCompressibility * PumpToManifoldMudVol) + + IF(Mp1_NoPath == 1 .and. ThereIsPathFrom_71_72_73_To_82 .and. MP1_Q > 0.0) then + PumpToManifoldCompressedMudVol = PumpToManifoldCompressedMudVol + MP1_Q / ConvMinToSec * dt + PumpPressure1= PumpToManifoldCompressedMudVol / (MudCompressibility * PumpToManifoldMudVol) + write(*,*) '21)PumpPressure1=' , PumpPressure1 + + WRITE (*,*) ' valve 1 ', Valve(1)%Status + WRITE (*,*) ' valve 4 ', Valve(4)%Status + WRITE (*,*) ' valve 6 ', Valve(6)%Status + WRITE (*,*) ' valve 7 ', Valve(7)%Status + WRITE (*,*) ' valve 8 ', Valve(8)%Status + WRITE (*,*) ' valve 9 ', Valve(9)%Status + WRITE (*,*) ' valve 13 ', Valve(13)%Status + WRITE (*,*) ' valve 68 ', Valve(68)%Status + WRITE (*,*) ' valve 69 ', Valve(69)%Status + WRITE (*,*) ' valve 48 ', Valve(48)%Status + + !call DisplayOpenPathsWrite() + + ENDIF + + IF(Mp2_NoPath == 1 .and. ThereIsPathFrom_71_72_73_To_83 .and. MP2_Q > 0.0 ) then + PumpToManifoldCompressedMudVol = PumpToManifoldCompressedMudVol + MP2_Q / ConvMinToSec * dt + PumpPressure2= PumpToManifoldCompressedMudVol / (MudCompressibility * PumpToManifoldMudVol) + write(*,*) '22)PumpPressure1=' , PumpPressure2 + + WRITE (*,*) ' -valve 1 ', Valve(1)%Status + WRITE (*,*) ' -valve 4 ', Valve(4)%Status + WRITE (*,*) ' -valve 6 ', Valve(6)%Status + WRITE (*,*) ' -valve 7 ', Valve(7)%Status + WRITE (*,*) ' -valve 8 ', Valve(8)%Status + WRITE (*,*) ' -valve 9 ', Valve(9)%Status + WRITE (*,*) ' -valve 13 ', Valve(13)%Status + WRITE (*,*) ' -valve 68 ', Valve(68)%Status + WRITE (*,*) ' -valve 69 ', Valve(69)%Status + WRITE (*,*) ' -valve 48 ', Valve(48)%Status + + !call DisplayOpenPathsWrites() + ENDIF + + IF(Cp_NoPath == 1 .and. ThereIsPathFrom_71_72_73_To_84 .AND. MP3_Q > 0.0 ) then + PumpToManifoldCompressedMudVol = PumpToManifoldCompressedMudVol + MP3_Q / ConvMinToSec * dt + PumpPressure3= PumpToManifoldCompressedMudVol / (MudCompressibility * PumpToManifoldMudVol) + ENDIF + +!***************************************************************************** + + + !if(((Mp1_NoPath == 1 .and. ThereIsPathFrom_71_72_73_To_82) .or. ( PumpPressure1 >= MaxWorkingPressure1 ) & + !.or.(J14> 0 .and. j4==0 .and. j9==0 .and. NOT(ALLOCATED(GasPocketWeight%Array)))) .and. MP1_Q > 0.0 ) then + !write(*,*) ' failurrrrre ' + + if (PumpPressure1 >= MaxWorkingPressure1 .and. MP1_Q > 0.0) then + + + write(*,*) 'mp1,if=' , PumpPressure1 , MaxWorkingPressure1 , MP1_Q + Pump1BlownCount = Pump1BlownCount + 1 + !if (Pump1BlownStarted == .FALSE.) then + ! write(*,*) 'if (Pump1BlownStarted == .FALSE. ) then' + ! Pump1BlownInTimeStep = SimulationTime + BlownThresholdInSecond + ! Pump1BlownStarted = .TRUE. + !endif + !write(*,*) 'SimulationTime===', SimulationTime, Pump1BlownInTimeStep + if(MudPump1ReliefValveIsSet .and. Pump1BlownCount >= BlownThreshold) then + write(*,*) 'valve 65 open, BLOWN' + call ChangeValve(65, .TRUE.) + PumpToManifoldCompressedMudVol= 0.0 + Pump1BlownCount = 0 + !Pump1BlownStarted = .FALSE. + !else + ! write(*,*) 'PumpPressure1= 6000 psi' + ! PumpPressure1= 6000. !psi + endif + !else + !Pump1BlownInTimeStep = 0 + !Pump1BlownStarted = .FALSE. + !write(*,*) 'Pump1BlownStarted = .FALSE.' + endif + + !write(*,*) ' valve 65=' , Valve(65)%Status + + + + !if(((Mp2_NoPath == 1 .and. ThereIsPathFrom_71_72_73_To_83) .or. PumpPressure2 >= MaxWorkingPressure2 & + !.or.(J14> 0 .and. j4==0 .and. j9==0 .and. NOT(ALLOCATED(GasPocketWeight%Array))) ) .and. MP2_Q > 0.0 ) then + + if(PumpPressure2 >= MaxWorkingPressure2 .and. MP2_Q > 0.0 ) then + + write(*,*) 'mp2,if=' , PumpPressure2 , MaxWorkingPressure2 , MP2_Q + Pump2BlownCount = Pump2BlownCount + 1 + !if (Pump2BlownStarted == .FALSE. ) then + ! Pump2BlownInTimeStep = SimulationTime + BlownThresholdInSecond + ! Pump2BlownStarted = .TRUE. + !endif + !if (MudPump2ReliefValveIsSet .and. SimulationTime >= Pump2BlownInTimeStep .and. Pump2BlownStarted) then + if (MudPump2ReliefValveIsSet .and. Pump2BlownCount >= BlownThreshold) then + write(*,*) 'valve 66 open, BLOWN' + call ChangeValve(66, .TRUE.) + PumpToManifoldCompressedMudVol= 0.0 + Pump2BlownCount = 0 + !Pump2BlownInTimeStep = 0 + !Pump2BlownStarted = .FALSE. + !else + ! PumpPressure2= 6000. !psi + endif + !else + !Pump2BlownInTimeStep = 0 + !Pump2BlownStarted = .FALSE. + endif + + !if(((Cp_NoPath == 1 .and. ThereIsPathFrom_71_72_73_To_84) .or. PumpPressure3 >= MaxWorkingPressure3 & + !.or.(J14> 0 .and. j4==0 .and. j9==0 .and. NOT(ALLOCATED(GasPocketWeight%Array)))) .and. MP3_Q > 0.0 ) then + + if(PumpPressure3 >= MaxWorkingPressure3 .and. MP3_Q > 0.0 ) then + Pump3BlownCount = Pump3BlownCount + 1 + if (CementPumpReliefValveIsSet .and. Pump3BlownCount >= BlownThreshold) then + !write(*,*) 'valve 67 open, BLOWN' + call ChangeValve(67, .TRUE.) + PumpToManifoldCompressedMudVol= 0.0 + Pump3BlownCount = 0 + !else + ! PumpPressure3= 6000. !psi + endif + !else + !Pump3BlownInTimeStep = 0 + !Pump3BlownStarted = .FALSE. + endif + + !write(*,*) '3)PumpPressure1=' , PumpPressure1 + + if (PumpPressure1>= 6000.) then + Pump1BlownCount = Pump1BlownCount + 1 + if(Pump1BlownCount >= BlownThreshold) then + call ChangeValve(65, .TRUE.) + PumpToManifoldCompressedMudVol= 0.0 + call Activate_Pump1Failure() + Pump1OffFailure= .true. + Pump1BlownCount = 0 + endif + !else + !Pump1BlownInTimeStep = 0 + !Pump1BlownStarted = .FALSE. + endif + + if (PumpPressure2>= 6000.) then + Pump2BlownCount = Pump2BlownCount + 1 + if(Pump2BlownCount >= BlownThreshold) then + call ChangeValve(66, .TRUE.) + PumpToManifoldCompressedMudVol= 0.0 + call Activate_Pump2Failure() + Pump2OffFailure= .true. + Pump2BlownCount = 0 + endif + !else + !Pump2BlownInTimeStep = 0 + !Pump2BlownStarted = .FALSE. + endif + + if (PumpPressure3>= 6000.) then + Pump3BlownCount = Pump3BlownCount + 1 + if(Pump3BlownCount >= BlownThreshold) then + call ChangeValve(67, .TRUE.) + PumpToManifoldCompressedMudVol= 0.0 + call Activate_Pump3Failure() + Pump3OffFailure= .true. + Pump3BlownCount = 0 + endif + !else + !Pump3BlownInTimeStep = 0 + !Pump3BlownStarted = .FALSE. + endif + ! Blown Conditions ******** + + +!=========================================================================================================================== +!=========================================================================================================================== + if (j9 > 0 ) then !.and. WellisNOTFull== .false.) then !WellToBellNipple + !write(*,*) 'j9 is open' + + + !MUD(7)%Q= ( Ann_Saved_MudDischarged_Volume_Final+Ann_Kick_Saved_Volume_Final - ((Qlost/60.0d0)*DeltaT_Mudline) )*60.d0/DeltaT_Mudline + MUD(7)%Q= ( MudVolume_InjectedFromAnn + Ann_Kick_Saved_Volume )*60.d0/DeltaT_Mudline !Injected is referred only to Mud + + + if (j4 > 0) then + BellNipple_FlowCoef= 13.625/(13.625+ChokeLineId) ! 13.625= BellNipple ID (inch) + MUD(7)%Q= BellNipple_FlowCoef * MUD(7)%Q + endif + + !total_annFlow= total_annFlow+(AnnulusFlowRateFinal/600.d0) + !total_DeltaVPipe= total_DeltaVPipe + DeltaVolumePipe + !write(*,*) 'total_annFlow,total_DeltaVPipe' , total_annFlow,total_DeltaVPipe + + + + if (MUD(7)%Q < 0.0 ) MUD(7)%Q= 0.0 !.or. WellisNOTFull== .true.) MUD(7)%Q= 0.0 + !!AnnulusFlowRateFinal: flow from string mud , DeltaVolumeOp: due to trip in + + !write(*,*) 'MUD(7)%Q=' , MUD(7)%Q + !write(*,*) 'MudVolume_InjectedFromAnn-WellToBellNipple=' , MudVolume_InjectedFromAnn + !write(*,*) 'Ann_Kick_Saved_Volume=' , Ann_Kick_Saved_Volume + + sys_total_injected= sys_total_injected+ MudVolume_InjectedFromAnn + + + if (ChokePanelStrokeResetSwitch == 1) then + sys_total_injected= 0. + endif + + !write(*,*) 'sys_total_injected=' , sys_total_injected + + + + + + !WellOutletDensity= Ann_Density%Last() ! (ppg) <<< in CirculationCodeSelect Code + + + if ((BellNippleVolume+((MUD(7)%Q/60.)*DeltaT_Mudline)) /= 0.0) then + + BellNippleDensity= ((BellNippleDensity*BellNippleVolume)+(WellOutletDensity*(MUD(7)%Q/60.)*DeltaT_Mudline))/(BellNippleVolume+((MUD(7)%Q/60.)*DeltaT_Mudline)) + else + BellNippleDensity= 0.0 + endif + + + !IF (WellisNOTFull== .false.) THEN ! well must be full to do this order + BellNippleVolume= BellNippleVolume+ ((MUD(7)%Q/60.)*DeltaT_Mudline) + !ENDIF + + + VolumeToBellNipple= VolumeToBellNipple + BellNippleVolume + !write(*,*) 'VolumeToBellNipple*****=' , VolumeToBellNipple + + !write(*,*) 'BellNippleVolume in j9=' , BellNippleVolume , MUD(7)%Q + + + + + endif + + + if (j9 == 0 ) then !.or. WellisNOTFull== .true.) then + !write(*,*) 'WellisNOTFull=' , WellisNOTFull + MUD(7)%Q=0.0 ! for normal circulation input + endif + + if (j9 > 0) then + WellToPitsOpen= .true. + else + WellToPitsOpen= .false. + endif + + +!=========================================================================================================================== +!=========================================================================================================================== + + + if (j10 > 0) then !MudBucketToBellNipple + !write(*,*) 'j10 is open' + + ! + !MudBucketVolume= 0. + !MudBucketDensity= 0. + + + ! MudBucketVolume gets value in DisconnectingPipe subroutine + BellNippleVolume= BellNippleVolume+ MudBucketVolume + BellNippleDensity= ActiveTankDensity + + MudBucketVolume= 0. + + + endif + + + +!=========================================================================================================================== +!=========================================================================================================================== + + if (j6 > 0) then !TripTankToActiveTank And BellNipple + !write(*,*) 'j6 is open' + !write(*,*) 'active by j6' + MUD(6)%Q= 300. ! constant flow rate(gpm) + + + TripTankVolumeCalc= TripTankVolumeCalc - ((MUD(6)%Q/60.)*DeltaT_Mudline) + + + !write(*,*) 'ActiveTankVolume before=', ActiveTankVolume + + + if (j6 == 1 .and. D71==1) then + !write(*,*) 'add to active' + ActiveTankDensity= ((ActiveTankDensity*ActiveTankVolume)+(TripTankDensityCalc*(MUD(6)%Q/60.)*DeltaT_Mudline))/(ActiveTankVolume+((MUD(6)%Q/60.)*DeltaT_Mudline)) + ActiveTankVolume= ActiveTankVolume+ ((MUD(6)%Q/60.)*DeltaT_Mudline) + !write(*,*) 'ActiveTankVolume after=', ActiveTankVolume + + endif + + if (j6 == 1 .and. D80==1) then + BellNippleDensity= ((BellNippleDensity*BellNippleVolume)+(TripTankDensityCalc*(MUD(6)%Q/60.)*DeltaT_Mudline))/(BellNippleVolume+((MUD(6)%Q/60.)*DeltaT_Mudline)) + BellNippleVolume= BellNippleVolume+ ((MUD(6)%Q/60.)*DeltaT_Mudline) + endif + + if (j6 == 2) then + ActiveTankDensity= ((ActiveTankDensity*ActiveTankVolume)+(TripTankDensityCalc*(0.5*MUD(6)%Q/60.)*DeltaT_Mudline))/(ActiveTankVolume+((0.5*MUD(6)%Q/60.)*DeltaT_Mudline)) + BellNippleDensity= ((BellNippleDensity*BellNippleVolume)+(TripTankDensityCalc*(0.5*MUD(6)%Q/60.)*DeltaT_Mudline))/(BellNippleVolume+((0.5*MUD(6)%Q/60.)*DeltaT_Mudline)) + + ActiveTankVolume= ActiveTankVolume+ ((0.5*MUD(6)%Q/60.)*DeltaT_Mudline) + BellNippleVolume= BellNippleVolume+ ((0.5*MUD(6)%Q/60.)*DeltaT_Mudline) + endif + + + + ActiveTankVolume=min(ActiveTankVolume , ActiveTotalTankCapacityGal-ActiveSettledContentsGal) + !if ActiveTankVolume is higher, excess amount is dumped + + endif + + if (j6 == 0) then + MUD(6)%Q=0.0 + endif + +!=========================================================================================================================== +!=========================================================================================================================== + + CALL Set_FlowFromReturnLine(.false.) + + + if (j3 > 0) then !BellNippleToPits-FullWell - must be after **WellToBellNipple(j9)** + !write(*,*) 'j3 is open' + + !write(*,*) 'active by j3' + !BellNipple flow rate= sum flow rate (well+ mudbucket+ triptank) + + !Well to BellNipple: BellNippleVolume + !MudBucket to BellNipple: BellNippleVolume + !TripTnak to BellNipple: BellNippleVolume + + MUD(3)%Q = (BellNippleVolume/DeltaT_Mudline)*60.d0 ! (gpm) + + + !write(*,*) 'BellNippleVolume in j3 =' , BellNippleVolume + + !write(*,*) 'MUD(3)%Q =' , MUD(3)%Q + + call Set_FlowRate(real(100.*min(MUD(3)%Q,PedalMeter)/PedalMeter, 8)) ! for unity display + unityreturn = real(100.*min(MUD(3)%Q,PedalMeter)/PedalMeter, 8) + + !write(*,*) 'unity return=' , real(100.*min(MUD(3)%Q,PedalMeter)/PedalMeter, 8) + + + + + if (MUD(3)%Q > PedalMeter .and. B78==0) then + BellNippleDumpVolume= BellNippleDumpVolume + ((MUD(3)%Q/60.)*DeltaT_Mudline - (PedalMeter/60.)*DeltaT_Mudline) + + !BellNippleDumpRate= MUD(3)%Q - PedalMeter + + CALL Set_FlowFromReturnLine(.TRUE.) ! for unity display + + endif + + !VolumeToActive = VolumeToActive + BellNippleVolume + !write(*,*) 'VolumeToActive*******=' , VolumeToActive + + + active_before= ActiveTankVolume + + + BellNippleVolume= BellNippleVolume- ((MUD(3)%Q/60.)*DeltaT_Mudline) ! to be 0. + + + + if ( BellNippleDensity > 1.0) then + + if (j3 == 1 .and. B71==1) then !(volumes in galon) + + + MUD(3)%Q = min(MUD(3)%Q , PedalMeter) + !write(*,*) 'MUD(3)%Q=' , MUD(3)%Q + + IF (ActiveAutoDensity == .FALSE.) THEN + + ActiveTankDensity= ((ActiveTankDensity*ActiveTankVolume)+(BellNippleDensity*(MUD(3)%Q/60.)*DeltaT_Mudline))/(ActiveTankVolume+((MUD(3)%Q/60.)*DeltaT_Mudline)) + ActiveTankVolume= ActiveTankVolume+ ((MUD(3)%Q/60.)*DeltaT_Mudline) + + !write(*,*) 'active increase bell 1=' , ((MUD(3)%Q/60.)*DeltaT_Mudline) + + + ELSEIF (ActiveAutoDensity .and. BellNippleDensity > ActiveTankDensity) THEN + + + ActiveTankVolume= ActiveTankVolume+ ((20.8d0-BellNippleDensity)/(20.8d0-ActiveTankDensity))*((MUD(3)%Q/60.d0)*DeltaT_Mudline) ! asumed cutting density = 20.8 ppg + !write(*,*) 'active increase bell 2=' , ((20.8d0-BellNippleDensity)/(20.8d0-ActiveTankDensity))*((MUD(3)%Q/60.d0)*DeltaT_Mudline) + ELSEIF (ActiveAutoDensity .and. BellNippleDensity < 5.0) THEN + + ActiveTankVolume= ActiveTankVolume+ ((2.d0-BellNippleDensity)/(2.d0-ActiveTankDensity))*((MUD(3)%Q/60.d0)*DeltaT_Mudline) ! asumed GAS density = 2.0 ppg + !write(*,*) 'active increase bell 3=' , ((2.d0-BellNippleDensity)/(2.d0-ActiveTankDensity))*((MUD(3)%Q/60.d0)*DeltaT_Mudline) + + ELSEIF (ActiveAutoDensity .and. 5.0 < BellNippleDensity .and. BellNippleDensity <= ActiveTankDensity) THEN + !write(*,*) ' Auto true 3' + + + ActiveTankVolume= ActiveTankVolume+ ((MUD(3)%Q/60.d0)*DeltaT_Mudline) + !write(*,*) 'active increase bell 4=' , ((MUD(3)%Q/60.d0)*DeltaT_Mudline) + + ENDIF + endif + + if (j3 == 1 .and. B77==1) then + + MUD(3)%Q = min(MUD(3)%Q , PedalMeter) + + IF (ActiveAutoDensity == .FALSE.) THEN + + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(BellNippleDensity*(MUD(3)%Q/60.)*DeltaT_Mudline))/(TripTankVolumeCalc+((MUD(3)%Q/60.)*DeltaT_Mudline)) + TripTankVolumeCalc= TripTankVolumeCalc+ (MUD(3)%Q/60.)*DeltaT_Mudline + + ELSEIF (ActiveAutoDensity .and. BellNippleDensity > ActiveTankDensity) THEN + + AddedVolumeToTank= ((20.8d0-BellNippleDensity)/(20.8d0-ActiveTankDensity))*((MUD(3)%Q/60.d0)*DeltaT_Mudline) + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(ActiveTankDensity*AddedVolumeToTank))/(TripTankVolumeCalc+AddedVolumeToTank) + + TripTankVolumeCalc= TripTankVolumeCalc+ AddedVolumeToTank + + ELSEIF (ActiveAutoDensity .and. BellNippleDensity < 5.0) THEN + + AddedVolumeToTank= ((2.d0-BellNippleDensity)/(2.d0-ActiveTankDensity))*((MUD(3)%Q/60.d0)*DeltaT_Mudline) ! asumed GAS density = 2.0 ppg + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(ActiveTankDensity*AddedVolumeToTank))/(TripTankVolumeCalc+AddedVolumeToTank) + + TripTankVolumeCalc= TripTankVolumeCalc+ AddedVolumeToTank + + ELSEIF (ActiveAutoDensity .and. 5.0 < BellNippleDensity .and. BellNippleDensity <= ActiveTankDensity) THEN + + AddedVolumeToTank= ((MUD(3)%Q/60.d0)*DeltaT_Mudline) + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(ActiveTankDensity*AddedVolumeToTank))/(TripTankVolumeCalc+AddedVolumeToTank) + + TripTankVolumeCalc= TripTankVolumeCalc+ AddedVolumeToTank + + ENDIF + + endif + + + if (j3 == 1 .and. B78==1) then + + BellNippleDumpVolume= BellNippleDumpVolume+ (MUD(3)%Q/60.d0)*DeltaT_Mudline + + !BellNippleDumpRate= MUD(3)%Q + + endif + + + + if (j3 == 2) then !78 is not allowded in this position + + MUD(3)%Q = min(MUD(3)%Q , PedalMeter) + + IF (ActiveAutoDensity == .FALSE.) THEN + + ActiveTankDensity= ((ActiveTankDensity*ActiveTankVolume)+(BellNippleDensity*(0.5*MUD(3)%Q/60.)*DeltaT_Mudline))/(ActiveTankVolume+((0.5*MUD(3)%Q/60.)*DeltaT_Mudline)) + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(BellNippleDensity*(0.5*MUD(3)%Q/60.)*DeltaT_Mudline))/(TripTankVolumeCalc+((0.5*MUD(3)%Q/60.)*DeltaT_Mudline)) + + ActiveTankVolume= ActiveTankVolume+ ((0.5*MUD(3)%Q/60.)*DeltaT_Mudline) + TripTankVolumeCalc= TripTankVolumeCalc+ ((0.5*MUD(3)%Q/60.)*DeltaT_Mudline) + + ELSEIF (ActiveAutoDensity .and. BellNippleDensity > ActiveTankDensity) THEN + + + AddedVolumeToTank= ((20.8d0-BellNippleDensity)/(20.8d0-ActiveTankDensity))*((0.5d0*MUD(3)%Q/60.d0)*DeltaT_Mudline) + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(ActiveTankDensity*AddedVolumeToTank))/(TripTankVolumeCalc+AddedVolumeToTank) + + ActiveTankVolume= ActiveTankVolume+ AddedVolumeToTank + TripTankVolumeCalc= TripTankVolumeCalc+ AddedVolumeToTank + + ELSEIF (ActiveAutoDensity .and. 5.0 < ActiveTankDensity) THEN + + AddedVolumeToTank= ((2.d0-BellNippleDensity)/(2.d0-ActiveTankDensity))*((0.5d0*MUD(3)%Q/60.d0)*DeltaT_Mudline) ! asumed GAS density = 2.0 ppg + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(ActiveTankDensity*AddedVolumeToTank))/(TripTankVolumeCalc+AddedVolumeToTank) + + ActiveTankVolume= ActiveTankVolume+ AddedVolumeToTank + TripTankVolumeCalc= TripTankVolumeCalc+ AddedVolumeToTank + + ELSEIF (ActiveAutoDensity .and. 5.0 < BellNippleDensity .and. BellNippleDensity <= ActiveTankDensity) THEN + + AddedVolumeToTank= ((MUD(3)%Q/60.d0)*DeltaT_Mudline) + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(ActiveTankDensity*AddedVolumeToTank))/(TripTankVolumeCalc+AddedVolumeToTank) + + ActiveTankVolume= ActiveTankVolume+ AddedVolumeToTank + TripTankVolumeCalc= TripTankVolumeCalc+ AddedVolumeToTank + + + ENDIF + + + endif + + endif !( BellNippleDensity > 1.0) then + + active_after= ActiveTankVolume + + active_increase = active_after - active_before + + total_active_increase= total_active_increase + active_increase + + if (ChokePanelStrokeResetSwitch == 1) then + total_active_increase= 0. + endif + + !write(*,*) 'total_active_increase=' , total_active_increase + + + + !write(*,*) 'ReturnFlowRate=MUD(3)%Q= after' , MUD(3)%Q + + ReturnFlowRate = MUD(3)%Q + + TripTankVolumeCalc = min(TripTankVolumeCalc,50.*42.) !50. BBL *42. gal/BBL = gal + !if TripTankVolumeCalc>50 BBl, excess value(TripTankVolumeCalc-50) is dumped + + ActiveTankVolume = min(ActiveTankVolume , ActiveTotalTankCapacityGal - ActiveSettledContentsGal) + !if ActiveTankVolume is higher, excess amount is dumped + !write(*,*) 'BellNippleDensity=' , BellNippleDensity + + !MudWeightOut2 = BellNippleDensity !for drillwatch display + !write(*,*) 'MudWeightOut2=' , MudWeightOut2 + + !write(*,*) + + + endif + + if (j3 == 0) then + MUD(3)%Q=0.0 ! for normal circulation input + call Set_FlowRate(0d0) + endif + + + +!=========================================================================================================================== +!=========================================================================================================================== + + + + if (j11 > 0 .and. MudChecked== .true.) then !BellNippleToWell-NonFullWell ( FillingWell_By_BellNipple subroutine is called for this state ) + !write(*,*) 'j11 is open' + MudChecked= .false. !to be sure that well is not full after arranging muds + !WellToPitsOpen = .TRUE. + + !BellNipple flow rate= sum flow rate (well+ mudbucket+ triptank) + + !Well to BellNipple: BellNippleVolume + !MudBucket to BellNipple: BellNippleVolume + !TripTnak to BellNipple: BellNippleVolume + + MUD(8)%Q = (BellNippleVolume/DeltaT_Mudline)*60. + !write(*,*) 'MUD(8)%Q=' , MUD(8)%Q + + + BellNippleVolume= BellNippleVolume- ((MUD(8)%Q/60.)*DeltaT_Mudline) ! to be 0. + !write(*,*) 'BellNippleVolume-2nd Mode=' , BellNippleVolume + + !BellNippleDensity + ! + ! + !BellNippleDensity , MUD(8)%Q be code gel dade beshe + !shart: j11 > 0 , MUD(8)%Q > 0.0 + + + endif + + if (j11 == 0) then + MUD(8)%Q=0.0 ! for normal circulation input + !WellToPitsOpen= .false. + endif + + + +!=========================================================================================================================== +!=========================================================================================================================== + + + + !WRITE (*,*) 'choke condition', j4, ChokeLineNOTFull + if (j4 > 0 .and. ChokeLineNOTFull== .false.) then !WellToChokeManifold(Through 26) + !write(*,*) 'j4 is open' + !write(*,*) 'active by j4' + + + + !MUD(4)%Q= ( Ann_Saved_MudDischarged_Volume_Final+Ann_Kick_Saved_Volume_Final - ((Qlost/60.0d0)*DeltaT_Mudline) )*60.d0/DeltaT_Mudline + MUD(4)%Q= ( MudVolume_InjectedFromAnn + Ann_Kick_Saved_Volume )*60.d0/DeltaT_Mudline !Injected is referred only to Mud + + + !if ( WellisNOTFull== .true. ) MUD(4)%Q= 0.0 + + + if (j9 > 0) then + ChokeLine_FlowCoef= ChokeLineId/(13.625+ChokeLineId) ! 13.625= BellNipple ID (inch) + MUD(4)%Q= ChokeLine_FlowCoef * MUD(4)%Q + endif + + + !call Log_1('MUD(4)%Q=', MUD(4)%Q) + + ChokeOutletDensity= ChokeLine_Density%Last() ! <<< in CirculationCodeSelect Code + + + !MudWeightOut2= ChokeOutletDensity !for drillwatch display +! + !AnnulusFlowRateFinal: flow from string mud , DeltaVolumeOp: due to trip in + + + + + + RealJ4= real(j4) + + !C71: Active Tank C77: Trip Tank C78: ChokeManifoldDump + + if ( BellNippleDensity > 1.0) then + ! IN ALL CONDITIONS EFFECT OF 78 IS COMPUTED BY RealJ4 + if (C71==1 .and. C77==0) then !(volumes in galon) RealJ4: 1 OR 2(IF 78 IS OPEN) + + IF (ActiveAutoDensity == .FALSE.) THEN + + ActiveTankDensity= ((ActiveTankDensity*ActiveTankVolume)+(ChokeOutletDensity*((1./RealJ4)*MUD(4)%Q/60.)*DeltaT_Mudline))/(ActiveTankVolume+(((1./RealJ4)*MUD(4)%Q/60.)*DeltaT_Mudline)) + ActiveTankVolume= ActiveTankVolume+ (((1./RealJ4)*MUD(4)%Q/60.)*DeltaT_Mudline) + !write(*,*) 'active increase choke1=' , (((1./RealJ4)*MUD(4)%Q/60.)*DeltaT_Mudline) + ChokeManifoldDumpVolume= ChokeManifoldDumpVolume+ C78*(((1./RealJ4)*MUD(4)%Q/60.)*DeltaT_Mudline) + + ELSEIF (ActiveAutoDensity .and. ChokeOutletDensity > ActiveTankDensity) THEN + + + ActiveTankVolume= ActiveTankVolume+ ((20.8d0-ChokeOutletDensity)/(20.8d0-ActiveTankDensity))*(((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) ! asumed cutting density = 20.8 ppg + ChokeManifoldDumpVolume= ChokeManifoldDumpVolume+ C78*(((1./RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) + !write(*,*) 'active increase choke2=' , ((20.8d0-ChokeOutletDensity)/(20.8d0-ActiveTankDensity))*(((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) + + ELSEIF (ActiveAutoDensity .and. ChokeOutletDensity < 5.0) THEN + + ActiveTankVolume= ActiveTankVolume+ ((2.d0-ChokeOutletDensity)/(2.d0-ActiveTankDensity))*(((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) ! asumed GAS density = 2.0 ppg + ChokeManifoldDumpVolume= ChokeManifoldDumpVolume+ C78*(((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) + !write(*,*) 'active increase choke3=' ,((2.d0-ChokeOutletDensity)/(2.d0-ActiveTankDensity))*(((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) + + ELSEIF (ActiveAutoDensity .and. 5.0 < ChokeOutletDensity .and. ChokeOutletDensity <= ActiveTankDensity) THEN + !write(*,*) ' Auto true 3' + + + ActiveTankVolume= ActiveTankVolume+ (((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) + ChokeManifoldDumpVolume= ChokeManifoldDumpVolume+ C78*(((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) + + !write(*,*) 'active increase choke4=' , (((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) + + ENDIF + + + + endif + + if (C77==1 .and. C71==0) then !RealJ4: 1 OR 2(IF 78 IS OPEN) + + IF (ActiveAutoDensity == .FALSE.) THEN + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(ChokeOutletDensity*((1./RealJ4)*MUD(4)%Q/60.)*DeltaT_Mudline))/(TripTankVolumeCalc+(((1./RealJ4)*MUD(4)%Q/60.)*DeltaT_Mudline)) + TripTankVolumeCalc= TripTankVolumeCalc+ (((1./RealJ4)*MUD(4)%Q/60.)*DeltaT_Mudline) + + ChokeManifoldDumpVolume= ChokeManifoldDumpVolume+ C78*(((1./RealJ4)*MUD(4)%Q/60.)*DeltaT_Mudline) + + ELSEIF (ActiveAutoDensity .and. ChokeOutletDensity > ActiveTankDensity) THEN + + AddedVolumeToTank= ((20.8d0-ChokeOutletDensity)/(20.8d0-ActiveTankDensity))*(((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(ActiveTankDensity*AddedVolumeToTank))/(TripTankVolumeCalc+AddedVolumeToTank) + + TripTankVolumeCalc= TripTankVolumeCalc+ AddedVolumeToTank + + ChokeManifoldDumpVolume= ChokeManifoldDumpVolume+ C78*(((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) + + + ELSEIF (ActiveAutoDensity .and. ChokeOutletDensity < 5.0) THEN + + AddedVolumeToTank= ((2.d0-ChokeOutletDensity)/(2.d0-ActiveTankDensity))*(((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) ! asumed GAS density = 2.0 ppg + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(ActiveTankDensity*AddedVolumeToTank))/(TripTankVolumeCalc+AddedVolumeToTank) + + TripTankVolumeCalc= TripTankVolumeCalc+ AddedVolumeToTank + + ChokeManifoldDumpVolume= ChokeManifoldDumpVolume+ C78*(((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) + + ELSEIF (ActiveAutoDensity .and. 5.0 < ChokeOutletDensity .and. ChokeOutletDensity <= ActiveTankDensity) THEN + + AddedVolumeToTank= (((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(ActiveTankDensity*AddedVolumeToTank))/(TripTankVolumeCalc+AddedVolumeToTank) + + TripTankVolumeCalc= TripTankVolumeCalc+ AddedVolumeToTank + + ChokeManifoldDumpVolume= ChokeManifoldDumpVolume+ C78*(((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) + + ENDIF + + + + endif + + if (C71==1 .and. C77==1) then !RealJ4: 2 OR 3(IF 78 IS OPEN) + + IF (ActiveAutoDensity == .FALSE.) THEN + ActiveTankDensity= ((ActiveTankDensity*ActiveTankVolume)+(ChokeOutletDensity*((1./RealJ4)*MUD(4)%Q/60.)*DeltaT_Mudline))/(ActiveTankVolume+(((1./RealJ4)*MUD(4)%Q/60.)*DeltaT_Mudline)) + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(ChokeOutletDensity*((1./RealJ4)*MUD(4)%Q/60.)*DeltaT_Mudline))/(TripTankVolumeCalc+(((1./RealJ4)*MUD(4)%Q/60.)*DeltaT_Mudline)) + + ActiveTankVolume= ActiveTankVolume+ (((1./RealJ4)*MUD(4)%Q/60.)*DeltaT_Mudline) + TripTankVolumeCalc= TripTankVolumeCalc+ (((1./RealJ4)*MUD(4)%Q/60.)*DeltaT_Mudline) + + ChokeManifoldDumpVolume= ChokeManifoldDumpVolume+ C78*(((1./RealJ4)*MUD(4)%Q/60.)*DeltaT_Mudline) + + ELSEIF (ActiveAutoDensity .and. ChokeOutletDensity > ActiveTankDensity) THEN + + + AddedVolumeToTank= ((20.8d0-ChokeOutletDensity)/(20.8d0-ActiveTankDensity))*(((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(ActiveTankDensity*AddedVolumeToTank))/(TripTankVolumeCalc+AddedVolumeToTank) + + ActiveTankVolume= ActiveTankVolume+ AddedVolumeToTank + TripTankVolumeCalc= TripTankVolumeCalc+ AddedVolumeToTank + + ChokeManifoldDumpVolume= ChokeManifoldDumpVolume+ C78*(((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) + + ELSEIF (ActiveAutoDensity .and. 5.0 < ActiveTankDensity) THEN + + AddedVolumeToTank= ((2.d0-ChokeOutletDensity)/(2.d0-ActiveTankDensity))*(((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) ! asumed GAS density = 2.0 ppg + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(ActiveTankDensity*AddedVolumeToTank))/(TripTankVolumeCalc+AddedVolumeToTank) + + ActiveTankVolume= ActiveTankVolume+ AddedVolumeToTank + TripTankVolumeCalc= TripTankVolumeCalc+ AddedVolumeToTank + + ChokeManifoldDumpVolume= ChokeManifoldDumpVolume+ C78*(((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) + + ELSEIF (ActiveAutoDensity .and. 5.0 < ChokeOutletDensity .and. ChokeOutletDensity <= ActiveTankDensity) THEN + + AddedVolumeToTank= ((1.d0/RealJ4)*MUD(4)%Q/60.d0) + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(ActiveTankDensity*AddedVolumeToTank))/(TripTankVolumeCalc+AddedVolumeToTank) + + ActiveTankVolume= ActiveTankVolume+ AddedVolumeToTank + TripTankVolumeCalc= TripTankVolumeCalc+ AddedVolumeToTank + + ChokeManifoldDumpVolume= ChokeManifoldDumpVolume+ C78*(((1.d0/RealJ4)*MUD(4)%Q/60.d0)*DeltaT_Mudline) + + + ENDIF + + + endif + + + if (C71==0 .and. C77==0 .and. C78==1) then !RealJ4: 1 + ! autodensity niaz nadarad + ChokeManifoldDumpVolume= ChokeManifoldDumpVolume+ (((1./RealJ4)*MUD(4)%Q/60.)*DeltaT_Mudline) + + endif + + + + endif ! if ( BellNippleDensity > 1.0) then + + + TripTankVolumeCalc=min(TripTankVolumeCalc,50.*42.) !50. BBL *42. gal/BBL = gal + !if TripTankVolumeCalc>50 BBl, excess value(TripTankVolumeCalc-50) is dumped + + ActiveTankVolume=min(ActiveTankVolume , ActiveTotalTankCapacityGal-ActiveSettledContentsGal) + !if ActiveTankVolume is higher, excess amount is dumped + + endif + + + + + + if (j4 == 0 .or. ChokeLineNOTFull== .true.) then + !Pressure_BeforeChokes=0.0 ! for normal circulation input + MUD(4)%Q=0.0 ! for CirculationCodeSelect input. + endif + + + if (j4 > 0) then + WellToChokeManifoldOpen= .true. + else + WellToChokeManifoldOpen= .false. + endif + +!=========================================================================================================================== +!=========================================================================================================================== + + if (j18 > 0) then !StandPipeManifoldToChokeManifold-Through ChokeLine + !write(*,*) 'j18 is open' + !write(*,*) 'active by j18' + +! STEP 1: REDUCTION FROM PUMPS STEP 1: REDUCTION FROM PUMPS STEP 1: REDUCTION FROM PUMPS (SAME TO PumpsToString LINE) + ! (NOT NEEDED) + + + +! STEP 2: ADD TO TANKS STEP 2: ADD TO TANKS STEP 2: ADD TO TANKS STEP 2: ADD TO TANKS (SAME TO WellToChokeManifold LINE) + + !Pump1toCh: PumpsToChokeManifold Coefficient + !Jj2,Jj12,Jj13: TanksToMudPump Coefficient + !H: Pumps To Tank_Through65 or 67 Coefficient + + MUD(9)%Q= jj2*(1-H82)*(1-DumpPump1)*Pump1toCh*PUMP(1)%Flow_Rate + jj12*(1-H83)*(1-DumpPump2)*Pump2toCh*PUMP(2)%Flow_Rate + jj13*(1-H84)*(1-DumpCementPump)*Pump3toCh*PUMP(3)%Flow_Rate + + + + Denominator_a= (jj2*(1.-H82)*(1.-DumpPump1)*Pump1toCh*PUMP(1)%Flow_Rate + jj12*(1.-H83)*(1.-DumpPump2)*Pump2toCh*PUMP(2)%Flow_Rate + jj13*(1.-H84)*(1.-DumpCementPump)*Pump3toCh*PUMP(3)%Flow_Rate) + + if (Denominator_a /= 0.) then + Density_Ch= (jj2*(1.-H82)*(1.-DumpPump1)*Pump1toCh*Mp1Density*PUMP(1)%Flow_Rate + jj12*(1.-H83)*(1.-DumpPump2)*Pump2toCh*Mp2Density*PUMP(2)%Flow_Rate + jj13*(1.-H84)*(1.-DumpCementPump)*Pump3toCh*Mp3Density*PUMP(3)%Flow_Rate)/ & + Denominator_a + !write(*,*) 'Density_Ch=' , Density_Ch + ! + ! else + !Density_Ch= 0.0 + endif + + + RealJ18= M71+M77+M78 + + !C71: Active Tank C77: Trip Tank C78: ChokeManifoldDump + + + ! IN ALL CONDITIONS EFFECT OF 78 IS COMPUTED BY RealJ18 + if (M71==1 .and. M77==0) then !(volumes in galon) RealJ18: 1 OR 2(IF 78 IS OPEN) + + ! autodensity niaz nadarad + ActiveTankDensity= ((ActiveTankDensity*ActiveTankVolume)+(Density_Ch*((1./RealJ18)*MUD(9)%Q/60.)*DeltaT_Mudline))/(ActiveTankVolume+(((1./RealJ18)*MUD(9)%Q/60.)*DeltaT_Mudline)) + ActiveTankVolume= ActiveTankVolume+ (((1./RealJ18)*MUD(9)%Q/60.)*DeltaT_Mudline) + + ChokeManifoldDumpVolume= ChokeManifoldDumpVolume+ C78*(((1./RealJ18)*MUD(9)%Q/60.)*DeltaT_Mudline) + + endif + + if (M77==1 .and. M71==0) then !RealJ18: 1 OR 2(IF 78 IS OPEN) + + ! autodensity niaz nadarad + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(Density_Ch*((1./RealJ18)*MUD(9)%Q/60.)*DeltaT_Mudline))/(TripTankVolumeCalc+(((1./RealJ18)*MUD(9)%Q/60.)*DeltaT_Mudline)) + TripTankVolumeCalc= TripTankVolumeCalc+ (((1./RealJ18)*MUD(9)%Q/60.)*DeltaT_Mudline) + + ChokeManifoldDumpVolume= ChokeManifoldDumpVolume+ C78*(((1./RealJ18)*MUD(9)%Q/60.)*DeltaT_Mudline) + + endif + + if (M71==1 .and. M77==1) then !RealJ18: 2 OR 3(IF 78 IS OPEN) + + ! autodensity niaz nadarad + ActiveTankDensity= ((ActiveTankDensity*ActiveTankVolume)+(Density_Ch*((1./RealJ18)*MUD(9)%Q/60.)*DeltaT_Mudline))/(ActiveTankVolume+(((1./RealJ18)*MUD(9)%Q/60.)*DeltaT_Mudline)) + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(Density_Ch*((1./RealJ18)*MUD(9)%Q/60.)*DeltaT_Mudline))/(TripTankVolumeCalc+(((1./RealJ18)*MUD(9)%Q/60.)*DeltaT_Mudline)) + + ActiveTankVolume= ActiveTankVolume+ (((1./RealJ18)*MUD(9)%Q/60.)*DeltaT_Mudline) + TripTankVolumeCalc= TripTankVolumeCalc+ (((1./RealJ18)*MUD(9)%Q/60.)*DeltaT_Mudline) + + ChokeManifoldDumpVolume= ChokeManifoldDumpVolume+ C78*(((1./RealJ18)*MUD(9)%Q/60.)*DeltaT_Mudline) + + endif + + + if (M71==0 .and. M77==0 .and. M78==1) then !RealJ18: 1 + ! autodensity niaz nadarad + ChokeManifoldDumpVolume= ChokeManifoldDumpVolume+ (((1./RealJ18)*MUD(9)%Q/60.)*DeltaT_Mudline) + + endif + + + + + + + + + TripTankVolumeCalc=min(TripTankVolumeCalc,50.*42.) !50. BBL *42. gal/BBL = gal + !if TripTankVolumeCalc>50 BBl, excess value(TripTankVolumeCalc-50) is dumped + + ActiveTankVolume=min(ActiveTankVolume , ActiveTotalTankCapacityGal-ActiveSettledContentsGal) + !if ActiveTankVolume is higher, excess amount is dumped + + endif + + + if (j18 == 0) then + MUD(9)%Q=0.0 + endif + + +!=========================================================================================================================== +!=========================================================================================================================== + + if (j5 > 0 .and. (ActiveTankVolume/ActiveTankFloorArea) > (TripTankVolumeCalc/TripTankFloorArea)) then !ActiveTankToTripTank + ! second condition is for Utube flow + !write(*,*) 'j5 is open' + + ! ActiveTankVolume/ActiveTankFloorArea... means tank height + MUD(5)%Q= 300. ! constant flow rate(gpm) + + + ActiveTankVolume= ActiveTankVolume - ((MUD(5)%Q/60.)*DeltaT_Mudline) + TripTankVolumeCalc= TripTankVolumeCalc + ((MUD(5)%Q/60.)*DeltaT_Mudline) + + TripTankDensityCalc= ((TripTankDensityCalc*TripTankVolumeCalc)+(ActiveTankDensity*(MUD(5)%Q/60.)*DeltaT_Mudline))/(TripTankVolumeCalc+((MUD(5)%Q/60.)*DeltaT_Mudline)) + + + + TripTankVolumeCalc=min(TripTankVolumeCalc,50.*42.) !50. BBL *42. gal/BBL = gal + !if TripTankVolumeCalc>50, excess value(TripTankVolumeCalc-50) is dumped + + endif + + if (j5 == 0) then + MUD(5)%Q=0.0 + endif + +!=========================================================================================================================== +!=========================================================================================================================== + + if (j16 > 0) then !PathsToGauge75 + + if (K79 == 1) then + + PressureGauge75= PressureGauges(1) !String to Gauge75 + + elseif (K82 == 1 .and. k83 == 0 .and. k84 == 0 .and. k78 == 0) then + PressureGauge75= PumpPressure1 + elseif (K82 == 0 .and. k83 == 1 .and. k84 == 0 .and. k78 == 0) then + PressureGauge75= PumpPressure2 + elseif (K82 == 0 .and. k83 == 0 .and. k84 == 1 .and. k78 == 0) then + PressureGauge75= PumpPressure3 + elseif (K82 == 0 .and. k83 == 0 .and. k84 == 0 .and. k78 == 1) then + PressureGauge75= 0. + endif + + !if (K82 == 1) PressureGauge75= PumpPressure1 !Pump1 to Gauge75' + !if (K83 == 1) PressureGauge75= PumpPressure2 !Pump2 to Gauge75 + !if (K84 == 1) PressureGauge75= PumpPressure3 !Pump3 to Gauge75 + !if (K78 == 1) PressureGauge75= 0. !Dump to Gauge75 + + endif + + + StandPipeGauge1= (1 - StandPipeGauge1Malf) * PressureGauge75 ! for STManifold Display + !write(*,*) 'PressureGauge75=' , PressureGauge75 + !P1toSt= jj2*(1-H82)*(1-DumpPump1)*G82 + !P2toSt= jj12*(1-H83)*(1-DumpPump2)*G83 + !CptoSt= jj13*(1-H84)*(1-DumpCementPump)*G84 +!=========================================================================================================================== +!=========================================================================================================================== + + if (j17 > 0) then !PumpsToGauge76 + + if (L79 == 1) then + + PressureGauge76= PressureGauges(1) !String to Gauge76 + + elseif (L82 == 1 .and. L83 == 0 .and. L84 == 0 .and. L78 == 0) then + PressureGauge76= PumpPressure1 + elseif (L82 == 0 .and. L83 == 1 .and. L84 == 0 .and. L78 == 0) then + PressureGauge76= PumpPressure2 + elseif (L82 == 0 .and. L83 == 0 .and. L84 == 1 .and. L78 == 0) then + PressureGauge76= PumpPressure3 + elseif (L82 == 0 .and. L83 == 0 .and. L84 == 0 .and. L78 == 1) then + PressureGauge76= 0. + endif + + + !if (L79 == 1) PressureGauge76= PressureGauges(1) !String to Gauge76 + !if (L82 == 1) PressureGauge76= PumpPressure1 !Pump1 to Gauge76 + !if (L83 == 1) PressureGauge76= PumpPressure2 !Pump2 to Gauge76 + !if (L84 == 1) PressureGauge76= PumpPressure3 !Pump3 to Gauge76 + !if (L78 == 1) PressureGauge76= 0. !Dump to Gauge76 + + endif + StandPipeGauge2= (1 - StandPipeGauge2Malf) * PressureGauge76 ! for STManifold Display +!=========================================================================================================================== +!=========================================================================================================================== + ! + !if (PressureGauge75 == PressureGauges(1)) then ! means: 75 goes to string + ! PumpPressureDW= PressureGauges(1) !for DrillWatch Display + ! CALL Set_StandPipePressure(real(PressureGauges(1) , 8)) !for Data Display Console + !endif + ! + ! + !if (PressureGauge76 == PressureGauges(1)) then ! means: 76 goes to string + ! PumpPressureDW= PressureGauges(1) !for DrillWatch Display + ! CALL Set_StandPipePressure(real(PressureGauges(1) , 8)) !for Data Display Console + !endif + ! + !if (PressureGauge75 /= PressureGauges(1) .and. PressureGauge76 /= PressureGauges(1)) then ! means: non of gauges go to string + ! PumpPressureDW= max(PressureGauge75,PressureGauge76) !for DrillWatch Display + ! !StandPipePressureGauge= max(PressureGauge75,PressureGauge76) !for Data Display Console + ! CALL Set_StandPipePressure(real(max(PressureGauge75,PressureGauge76) , 8)) !for Data Display Console + !endif + !write(*,*) 'TapSelector=' , TapSelector + + + if (TapSelector == .false.) then + + PumpPressureDW= PressureGauge75 !for DrillWatch Display + CALL Set_StandPipePressure(real((1-DrillPipePressureMalf)*PressureGauge75 , 8)) !for Data Display Console + else + PumpPressureDW= PressureGauge76 !for DrillWatch Display + CALL Set_StandPipePressure(real((1-DrillPipePressureMalf)*PressureGauge76 , 8)) !for Data Display Console + endif + +!=========================================================================================================================== +!=========================================================================================================================== + ! SHOULD BE AT LAST TO HAVE THE CORRECT DENSITIES FOR Suction_Density_MudSystem + + if (j2 > 0) then !TanksToMudPump1 + + + !Relief= 0: deactive 1: active PUMP(1)%Flow_Rate , PUMP(2)%Flow_Rate + + + RealJ2= real(j2) + + if (A71==1 .and. (ActiveTankVolume-(((1./RealJ2)*PUMP(1)%Flow_Rate/60.)*DeltaT_Mudline)) < 0.0) then + A71= 0 + RealJ2= RealJ2-1 + write(*,*) 'ActiveTank Level Warning' + call Activate_ActiveTankUnderVolume() + endif + + if (A72==1 .and. (ReserveTankVolume-(((1./RealJ2)*PUMP(1)%Flow_Rate/60.)*DeltaT_Mudline)) < 0.0) then + A72= 0 + RealJ2= RealJ2-1 + write(*,*) 'ReserveTank Level Warning' + endif + + if (A71==3 .and. (CementTankVolumeCalc-(((1./RealJ2)*PUMP(1)%Flow_Rate/60.)*DeltaT_Mudline)) < 0.0) then + A73= 0 + RealJ2= RealJ2-1 + write(*,*) 'CementTank Level Warning' + endif + + + if(RealJ2> 0.0) then + + ActiveTankVolume= ActiveTankVolume- A71*(((1./RealJ2)*PUMP(1)%Flow_Rate/60.)*DeltaT_Mudline) + ReserveTankVolume= ReserveTankVolume- A72*(((1./RealJ2)*PUMP(1)%Flow_Rate/60.)*DeltaT_Mudline) + CementTankVolumeCalc= CementTankVolumeCalc- A73*(((1./RealJ2)*PUMP(1)%Flow_Rate/60.)*DeltaT_Mudline) + !write(*,*) 'Active-decline=' , A71*(((1./RealJ2)*PUMP(1)%Flow_Rate/60.)*DeltaT_Mudline) + total_decrease= total_decrease+ A71*(((1./RealJ2)*PUMP(1)%Flow_Rate/60.)*DeltaT_Mudline) + + if (ChokePanelStrokeResetSwitch == 1) then + total_decrease= 0. + endif + !write(*,*) 'total_decrease=' , total_decrease + + + Mp1Density= (A71*ActiveTankDensity+A72*ReserveTankDensity+A73*CementTankDensityCalc)/RealJ2 + else + write(*,*) 'stop' + endif + + + + endif + + +!=========================================================================================================================== +!=========================================================================================================================== + ! SHOULD BE AT LAST TO HAVE THE CORRECT DENSITIES FOR Suction_Density_MudSystem + + if (j12 > 0) then !TanksToMudPump2 + + + !Relief= 0: deactive 1: active PUMP(1)%Flow_Rate , PUMP(2)%Flow_Rate + + RealJ12= real(J12) + + if (E71==1 .and. (ActiveTankVolume-(((1/RealJ12)*PUMP(2)%Flow_Rate/60.)*DeltaT_Mudline)) < 0.0) then + E71= 0 + RealJ12= RealJ12-1 + write(*,*) 'ActiveTank Level Warning' + endif + + if (E72==1 .and. (ReserveTankVolume-(((1/RealJ12)*PUMP(2)%Flow_Rate/60.)*DeltaT_Mudline)) < 0.0) then + E72= 0 + RealJ12= RealJ12-1 + write(*,*) 'ReserveTank Level Warning' + endif + + if (E71==3 .and. (CementTankVolumeCalc-(((1/RealJ12)*PUMP(2)%Flow_Rate/60.)*DeltaT_Mudline)) < 0.0) then + E73= 0 + RealJ12= RealJ12-1 + write(*,*) 'CementTank Level Warning' + endif + + + if(RealJ12> 0.0) then + + ActiveTankVolume= ActiveTankVolume- E71*(((1/RealJ12)*PUMP(2)%Flow_Rate/60.)*DeltaT_Mudline) + ReserveTankVolume= ReserveTankVolume- E72*(((1/RealJ12)*PUMP(2)%Flow_Rate/60.)*DeltaT_Mudline) + CementTankVolumeCalc= CementTankVolumeCalc- E73*(((1/RealJ12)*PUMP(2)%Flow_Rate/60.)*DeltaT_Mudline) + + + + Mp2Density= (E71*ActiveTankDensity+E72*ReserveTankDensity+E73*CementTankDensityCalc)/RealJ12 + else + write(*,*) 'stop' + endif + + + endif + + +!=========================================================================================================================== +!=========================================================================================================================== + ! SHOULD BE AT LAST TO HAVE THE CORRECT DENSITIES FOR Suction_Density_MudSystem + + if (j13 > 0) then !TanksToCementPump + + + !Relief= 0: deactive 1: active PUMP(1)%Flow_Rate , PUMP(2)%Flow_Rate + + + RealJ13= real(J13) + + if (F71==1 .and. (ActiveTankVolume-(((1/RealJ13)*PUMP(3)%Flow_Rate/60.)*DeltaT_Mudline)) < 0.0) then + F71= 0 + RealJ13= RealJ13-1 + write(*,*) 'ActiveTank Level Warning' + endif + + if (F72==1 .and. (ReserveTankVolume-(((1/RealJ13)*PUMP(3)%Flow_Rate/60.)*DeltaT_Mudline)) < 0.0) then + F72= 0 + RealJ13= RealJ13-1 + write(*,*) 'ReserveTank Level Warning' + endif + + if (F71==3 .and. (CementTankVolumeCalc-(((1/RealJ13)*PUMP(3)%Flow_Rate/60.)*DeltaT_Mudline)) < 0.0) then + F73= 0 + RealJ13= RealJ13-1 + write(*,*) 'CementTank Level Warning' + endif + + + if(RealJ13> 0.0) then + + ActiveTankVolume= ActiveTankVolume- F71*(((1/RealJ13)*PUMP(3)%Flow_Rate/60.)*DeltaT_Mudline) + ReserveTankVolume= ReserveTankVolume- F72*(((1/RealJ13)*PUMP(3)%Flow_Rate/60.)*DeltaT_Mudline) + CementTankVolumeCalc= CementTankVolumeCalc- F73*(((1/RealJ13)*PUMP(3)%Flow_Rate/60.)*DeltaT_Mudline) + + + Mp3Density= (F71*ActiveTankDensity+F72*ReserveTankDensity+F73*CementTankDensityCalc)/RealJ13 + else + write(*,*) 'stop' + endif + + + endif + + + +!=========================================================================================================================== +!=========================================================================================================================== + ! SHOULD BE AT LAST TO HAVE THE CORRECT DENSITIES FOR Suction_Density_MudSystem + + if (j14 > 0) then !PumpsToString Suction_Density_MudSystem is used for Mud Circulation Code + !write(*,*) 'j14 is open' + !call Log_1('j14 is open') + + ! << if H82 or H83 or H4 are open, no flow goes to other parts of system >> + + ! pump flow rate1 be sharti be samte string miravad ke masire j2 bar gharar bashad + ! pump flow rate2 be sharti be samte string miravad ke masire j12 bar gharar bashad + ! pump flow rate3 be sharti be samte string miravad ke masire j13 bar gharar bashad + + !G: PumpsToString Coefficient + !Jj2,Jj12,Jj13: TanksToMudPump Coefficient + !H: Pumps To Tank_Through65 or 67 Coefficient + ! + !write(*,*) 'jj2=' , jj2 + !write(*,*) 'jj12=' , jj12 + !write(*,*) 'jj13=' , jj13 + !write(*,*) 'H82=' , H82 + !write(*,*) 'H83=' , H83 + !write(*,*) 'H84=' , H84 + !write(*,*) 'DumpPump1=' , DumpPump1 + !write(*,*) 'DumpPump2=' , DumpPump2 + !write(*,*) 'DumpCementPump=' , DumpCementPump + !write(*,*) 'G82=' , G82 + !write(*,*) 'G83=' , G83 + !write(*,*) 'G84=' , G84 + !write(*,*) 'Mp1Density=' , Mp1Density + !write(*,*) 'Mp2Density=' , Mp2Density + !write(*,*) 'Mp3Density=' , Mp3Density + ! + ! + + + + !PumpsDumpVolume= PumpsDumpVolume+ jj2*(1-H82)*DumpPump1*PUMP(1)%Flow_Rate + jj12*(1-H83)*DumpPump2*PUMP(2)%Flow_Rate + jj13*(1-H84)*DumpCementPump*PUMP(3)%Flow_Rate + + Denominator= (jj2*(1.-H82)*(1.-DumpPump1)*G82*PUMP(1)%Flow_Rate + jj12*(1.-H83)*(1.-DumpPump2)*G83*PUMP(2)%Flow_Rate + jj13*(1.-H84)*(1.-DumpCementPump)*G84*PUMP(3)%Flow_Rate) + + if (Denominator /= 0.) then + Suction_Density_MudSystem= (jj2*(1.-H82)*(1.-DumpPump1)*G82*Mp1Density*PUMP(1)%Flow_Rate + jj12*(1.-H83)*(1.-DumpPump2)*G83*Mp2Density*PUMP(2)%Flow_Rate + jj13*(1.-H84)*(1.-DumpCementPump)*G84*Mp3Density*PUMP(3)%Flow_Rate)/ & + Denominator + endif + + CompressedMudDensity= Suction_Density_MudSystem + + MudWeightIn2= Suction_Density_MudSystem !for drillwatch display + + + MUD(2)%Q= jj2*(1-H82)*(1-DumpPump1)*G82*PUMP(1)%Flow_Rate + jj12*(1-H83)*(1-DumpPump2)*G83*PUMP(2)%Flow_Rate + jj13*(1-H84)*(1-DumpCementPump)*G84*PUMP(3)%Flow_Rate + + !write(*,*) 'MUD(2)%Q=' , MUD(2)%Q + + + + !jj2*(1-H82)*(1-DumpPump1)*G82 :if ==1, Pump1 to String is open + !jj12*(1-H83)*(1-DumpPump2)*G83 :if ==1, Pump2 to String is open + !jj13*(1-H84)*(1-DumpCementPump)*G84 :if ==1, Cement to String is open + + + + endif + + if (j14 == 0) then ! for normal circulation input + MUD(2)%Q=0.0 + !PumpPressure1= 0.0 + !PumpPressure2= 0.0 + !PumpPressure3= 0.0 + endif + + + +!=========================================================================================================================== +!=========================================================================================================================== + + if (j19 > 0 .and. MudChecked== .true.) then !PumpsToWell_KillLine Suction_Density_PumpsToWell is used for Mud Circulation Code + !write(*,*) 'j19 is open' + MudChecked= .false. !to be sure that well is not full after arranging muds + + ! << if H82 or H83 or H4 are open, no flow goes to other parts of system >> + + ! pump flow rate1 be sharti be samte well miravad ke masire j2 bar gharar bashad + ! pump flow rate2 be sharti be samte well miravad ke masire j12 bar gharar bashad + ! pump flow rate3 be sharti be samte well miravad ke masire j13 bar gharar bashad + + !G: PumpsToString Coefficient + !Jj2,Jj12,Jj13: TanksToMudPump Coefficient + !H: Pumps To Tank_Through65 or 67 Coefficient + ! + !write(*,*) 'jj2=' , jj2 + !write(*,*) 'jj12=' , jj12 + !write(*,*) 'jj13=' , jj13 + !write(*,*) 'H82=' , H82 + !write(*,*) 'H83=' , H83 + !write(*,*) 'H84=' , H84 + !write(*,*) 'DumpPump1=' , DumpPump1 + !write(*,*) 'DumpPump2=' , DumpPump2 + !write(*,*) 'DumpCementPump=' , DumpCementPump + !write(*,*) 'G82=' , G82 + !write(*,*) 'G83=' , G83 + !write(*,*) 'G84=' , G84 + !write(*,*) 'Mp1Density=' , Mp1Density + !write(*,*) 'Mp2Density=' , Mp2Density + !write(*,*) 'Mp3Density=' , Mp3Density + ! + ! + + + + !PumpsDumpVolume= PumpsDumpVolume+ jj2*(1-H82)*DumpPump1*PUMP(1)%Flow_Rate + jj12*(1-H83)*DumpPump2*PUMP(2)%Flow_Rate + jj13*(1-H84)*DumpCementPump*PUMP(3)%Flow_Rate + + Denominator= (jj2*(1.-H82)*(1.-DumpPump1)*N82*PUMP(1)%Flow_Rate + jj12*(1.-H83)*(1.-DumpPump2)*N83*PUMP(2)%Flow_Rate + jj13*(1.-H84)*(1.-DumpCementPump)*N84*PUMP(3)%Flow_Rate) + + if (Denominator /= 0.) then + Suction_Density_PumpsToWell= (jj2*(1.-H82)*(1.-DumpPump1)*N82*Mp1Density*PUMP(1)%Flow_Rate + jj12*(1.-H83)*(1.-DumpPump2)*N83*Mp2Density*PUMP(2)%Flow_Rate + jj13*(1.-H84)*(1.-DumpCementPump)*N84*Mp3Density*PUMP(3)%Flow_Rate)/ & + Denominator + endif + + + + + + MUD(10)%Q= jj2*(1-H82)*(1-DumpPump1)*N82*PUMP(1)%Flow_Rate + jj12*(1-H83)*(1-DumpPump2)*N83*PUMP(2)%Flow_Rate + jj13*(1-H84)*(1-DumpCementPump)*N84*PUMP(3)%Flow_Rate + + + + + + + endif + + if (j19 == 0) then ! for normal circulation input + MUD(10)%Q=0.0 + !PumpPressure1= 0.0 + !PumpPressure2= 0.0 + !PumpPressure3= 0.0 + endif +!=========================================================================================================================== +!=========================================================================================================================== + + + +!AnnulusFlowRateFinal = 0.d0 ! this is a reset for calculated flow rate in UTUBES,TRIPIN,TRIPOUT codes + + + + + + + + + + + + + +!!====================================================================== +!! Well Head Condition Determination +!!====================================================================== + + + if ( WellToChokeManifoldOpen .or. WellToPitsOpen) then + WellHeadIsOpen= .true. + else + WellHeadIsOpen= .false. + endif + + + + + + + +!!====================================================================== +!! WARNINGS +!!====================================================================== + + + IF (Valve(65)%Status == .TRUE.) call Activate_Pump1PopOffValveBlown() !Pump1PopOffValveBlown= .TRUE. + IF (Valve(66)%Status == .TRUE.) call Activate_Pump2PopOffValveBlown() ! Pump2PopOffValveBlown= .TRUE. + IF (Valve(67)%Status == .TRUE.) call Activate_Pump3PopOffValveBlown() !Pump2PopOffValveBlown= .TRUE. + + + IF (ActiveTankVolume >= (ActiveTotalTankCapacityGal-ActiveSettledContentsGal)) THEN + ActiveTankVolume = (ActiveTotalTankCapacityGal-ActiveSettledContentsGal) + call Activate_ActiveTankOverflow() + ELSE + call Deactivate_ActiveTankOverflow() + ENDIF + + + +!!====================================================================== +!! UPDATING TANKS DENSITIES & Volumes FOR MUD CIRCULATION +!!====================================================================== + + !write(*,*) 'ReserveTankVolume=' , real(ReserveTankVolume) + + call Set_ActiveMudVolume_StudentStation(real(ActiveTankVolume/42.,8)) ! 42: gal to bbl + call Set_ActiveDensity_StudentStation(real(ActiveTankDensity,8)) + call Set_ReserveMudVolume_StudentStation(real(ReserveTankVolume/42.,8)) ! 42: gal to bbl + call Set_ReserveDensity_StudentStation(real(ReserveTankDensity,8)) + KillMudVolume= ReserveTankVolume/42. ! for DrillWatch + !PitGainLose= + + +!!====================================================================== +!! DRILLING DATA DISPLAY +!!====================================================================== + + + IF (TotalStrokeCounterResetSwitch == 1) then !for drilling data display + TotalStrokesPump1=0. + TotalStrokesPump2=0. + ENDIF + + TotalStrokesPump1=TotalStrokesPump1+((MP1SPMGauge)/60.)*DeltaT_Mudline !for drilling data display + TotalStrokesPump2=TotalStrokesPump2+((MP2SPMGauge)/60.)*DeltaT_Mudline !for drilling data display + GraphTotalStrokes=GraphTotalStrokes+((MP1SPMGauge)/60.)*DeltaT_Mudline+((MP2SPMGauge)/60.)*DeltaT_Mudline + + + Total_Stroke_Counter_For_Plot = Total_Stroke_Counter_For_Plot + ((MP1SPMGauge + MP2SPMGauge) / 60.0) * DeltaT_Mudline + + CALL SetTotalStrokes(INT(Total_Stroke_Counter_For_Plot)) + + TotalStrokeCounter= real(nint(TotalStrokesPump1+TotalStrokesPump2)) !for drilling data display + +!=========================================================================== +! MUD PUMP STROKES +! & TOTAL STROKE- CHOKE CONTROL PANEL +!=========================================================================== + !write(*,*) 'a)))' , ChokePanelStrokeResetSwitch + if (ChokePanelStrokeResetSwitch == 1) then + IF (ChokePanelPumpSelectorSwitch == 1) THEN + !write(*,*) '1 reset' + TotalStrokes1 =0. + elseif (ChokePanelPumpSelectorSwitch == 2) THEN + !write(*,*) '2 reset' + TotalStrokes2 =0. + else + !write(*,*) 'both reset' + + TotalStrokes1 =0. + TotalStrokes2 =0. + endif + endif + + !write(*,*) 'b)))' , ChokePanelStrokeResetSwitch + + + TotalStrokes1= TotalStrokes1+((MP1SPMGauge)/60.)*DeltaT_Mudline + TotalStrokes2= TotalStrokes2+((MP2SPMGauge)/60.)*DeltaT_Mudline + + + + IF (ChokePanelPumpSelectorSwitch == 1) THEN + ChokePanelSPMCounter = real(nint(MP1SPMGauge)) + ChokePanelTotalStrokeCounter = real(nint(TotalStrokes1)) + ELSEIF (ChokePanelPumpSelectorSwitch == 2) THEN + ChokePanelSPMCounter = real(nint(MP2SPMGauge)) + ChokePanelTotalStrokeCounter = real(nint(TotalStrokes2)) + ELSE + ChokePanelSPMCounter= real(nint(MP1SPMGauge+MP2SPMGauge)) + ChokePanelTotalStrokeCounter = real(nint(TotalStrokes1+TotalStrokes2)) + ENDIF + + ! ChokePanelStrokeResetSwitch = 0 +!====================================================================== + +!!====================================================================== +!! MUD VOLUME TOTALIZER DISPLAY VALUES +!!====================================================================== + + + PitVolume= ActiveTankVolume/42.d0 !(bbl) For DrillWatch Display + + !write(*,*) 'PitVolume,ActiveTankVolume=' ,PitVolume,ActiveTankVolume + + + MudTank1_vol= ActiveTankVolume/3. ! (gal) + MudTank2_vol= ActiveTankVolume/3. ! (gal) + MudTank3_vol= ActiveTankVolume/3. ! (gal) + MudTank4_vol= TripTankVolumeCalc + + + + + + IF (MVTPowerSwitch==1) THEN + MudTanksVolumeGauge= (1 - MudTanksVolumeGaugeMalf) *((MudTank1_vol*MudTank1Switch)+(MudTank2_vol*MudTank2Switch)+ & + (MudTank3_vol*MudTank3Switch)+(MudTank4_vol*MudTank4Switch)+ActiveTankSettled) !(gal) + ELSEIF (MVTPowerSwitch==0) THEN + MudTanksVolumeGauge= (1 - MudTanksVolumeGaugeMalf) *0. + ENDIF + +!!====================================================================== +!! MUD VOLUME TOTALIZER +!!====================================================================== + + + + + IF (MVTPowerSwitch==1 .and. IsPortable==.false.) THEN + + + + IF (MVTSetAlarmSwitch==0) THEN + + PitGainLossGauge= ( ((ActiveTankVolume/42.) - RefrencePitVolume)) - PitGainLossGaugeMalf*(( ((ActiveTankVolume/42.) - RefrencePitVolume))+50) !(bbl) + + ELSEIF (MVTSetAlarmSwitch==-1) THEN + + + MVT_MinVol_Allowded= PitGainLossZero+ MIN(0.,(MVTSetAlarmLowKnob-50))-0.1 + PitGainLossGauge= MVT_MinVol_Allowded - PitGainLossGaugeMalf*(MVT_MinVol_Allowded+50) + ! - PitGainLossGaugeMalf*(MVT_MinVol_Allowded+50) : Malf effect + !PitGainLose=(MVT_MinVol_Allowded) ! DrillWatch (incorrect) + !RefrencePitVolume= ActiveTankVolume/42. !(bbl) + + ELSE !(MVTSetAlarmSwitch==1) + + MVT_MaxVol_Allowded= PitGainLossZero+ MAX(0., (MVTSetAlarmHighKnob-50.))+0.1 + PitGainLossGauge= MVT_MaxVol_Allowded - PitGainLossGaugeMalf*(MVT_MaxVol_Allowded+50) + ! - PitGainLossGaugeMalf*(MVT_MaxVol_Allowded+50) : Malf effect + !PitGainLose=(MVT_MaxVol_Allowded) ! DrillWatch (incorrect) + !RefrencePitVolume= ActiveTankVolume/42. !(bbl) + ENDIF + + !PitGainLossZero_Old= PitGainLossZero + !MVTCoarseKnob_Old= MVTCoarseKnob + !MVTFineKnob_Old= MVTFineKnob + !FirstSet_Time= .false. + + + + IF ( ActiveTankVolume/42. < (RefrencePitVolume-ABS(MVT_MinVol_Allowded)) .OR. ActiveTankVolume/42. > (RefrencePitVolume+ABS(MVT_MaxVol_Allowded)) ) THEN + + MVTAlarmLED = 1 !(blinking) + IF (MVTHornSwitch) THEN + Buzzer2= .TRUE. + ELSE + Buzzer2= .FALSE. + ENDIF + + ELSE + MVTAlarmLED = 0 !(OFF) + Buzzer2= .false. + ENDIF + + + + ELSEIF (MVTPowerSwitch==0) THEN + !MudTanksVolumeGauge= 0. + PitGainLossGauge= -50 + MVTAlarmLED= 0 + Buzzer2= .false. + + + ENDIF + +!!====================================================================== +!! RETURN CALCULATIONS +!!====================================================================== + + + + + PercentFlow= (ReturnFlowRate/PedalMeter) *100. !(percent) ! for DrillWatch display + if (abs(PercentFlow - unityreturn) > 1.0) then + + write(*,*) 'PercentFlow,ReturnFlowRate,PedalMeter=' , PercentFlow,ReturnFlowRate,PedalMeter + write(*,*) 'unityreturn=' , unityreturn + endif + + + ! ReturnFlowRate=800. set in startup as initial value + ReturnFlowPercent= (ReturnFlowRate/PedalMeter) *100. !(percent) + !write(*,*) 'ReturnFlowPercent,ReturnFlowRate=' , ReturnFlowPercent,ReturnFlowRate + ! if ReturnFlowRate>PedalMeter, excess value(ReturnFlowRate-PedalMeter) is dumped in the code before + + +!!====================================================================== +!! DRILL WATCH +!!====================================================================== + + PitGainLose= ((ActiveTankVolume/42.) - RefrencePitVolume_DrillWatch) ! DrillWatch + !write(*,*) 'PitGainLose galon' , PitGainLose*42. + + + if (IsPortable) then + + MVT_MinVol_Allowded= PitAlarmLow + MVT_MaxVol_Allowded= PitAlarmHigh + + IF ( ActiveTankVolume/42. < (RefrencePitVolume-ABS(MVT_MinVol_Allowded)) .OR. ActiveTankVolume/42. > (RefrencePitVolume+ABS(MVT_MaxVol_Allowded)) ) THEN + + MVTAlarmLED = 1 !(blinking) + IF (MVTHornSwitch) THEN + Buzzer2= .TRUE. + ELSE + Buzzer2= .FALSE. + ENDIF + + ELSE + MVTAlarmLED = 0 !(OFF) + Buzzer2= .false. + ENDIF + + endif + + + if (PitGainLossReset) then + + PitGainLose= 0.d0 !DrillWatch + RefrencePitVolume_DrillWatch= ActiveTankVolume/42. !(bbl) !DrillWatch + !********************************************* + + PitGainLossGauge= 0. !MFF Indicator + RefrencePitVolume= ActiveTankVolume/42. !(bbl) !MFF Indicator + + endif + + + + + + + +!!====================================================================== +!! MUD FLOW-FILL INDICATOR +!!====================================================================== + + IF (MFFIPowerSwitch==1 .and. IsPortable==.false.) THEN + + +!====================TotalStrokes Reset and Calculate====================== + if (MFFIResetTotalStrokes == 1) then + IF (MFFIPumpSelectorSwitch == 1) THEN + TotalStrokes1MFFI =0. + elseif (MFFIPumpSelectorSwitch == 2) THEN + TotalStrokes2MFFI =0. + else + TotalStrokes1MFFI =0. + TotalStrokes2MFFI =0. + endif + endif + TotalStrokes1MFFI= TotalStrokes1MFFI+((MP1SPMGauge)/60.)*DeltaT_Mudline + TotalStrokes2MFFI= TotalStrokes2MFFI+((MP2SPMGauge)/60.)*DeltaT_Mudline + +!==================FillStrokes Reset and Calculate========================= + if (MFFIResetFillCounter == 1) then + IF (MFFIPumpSelectorSwitch == 1) THEN + TotalFillStrokes1MFFI =0. + elseif (MFFIPumpSelectorSwitch == 2) THEN + TotalFillStrokes2MFFI =0. + else + TotalFillStrokes1MFFI =0. + TotalFillStrokes2MFFI =0. + endif + endif + + + TotalFillStrokes1MFFI= TotalFillStrokes1MFFI+((MP1SPMGauge)/60.)*DeltaT_Mudline + TotalFillStrokes2MFFI= TotalFillStrokes2MFFI+((MP2SPMGauge)/60.)*DeltaT_Mudline +!=================================================================== + + + if (MFFIPumpSelectorSwitch == 1) then + MFFITotalStrokeCounter = real(nint(TotalStrokes1MFFI)) !TotalStroke LED + elseif (MFFIPumpSelectorSwitch == 2) then + MFFITotalStrokeCounter = real(nint(TotalStrokes2MFFI)) !TotalStroke LED + elseif (MFFIPumpSelectorSwitch == 3) then + MFFITotalStrokeCounter = real(nint(TotalStrokes1MFFI+TotalStrokes2MFFI)) !TotalStroke LED + endif + + + IF (MFFIFillSPMSelectorSwitch== .false.) THEN !(spm mode) + if (MFFIPumpSelectorSwitch == 1) then + FillStrokeCounter = real(nint(MP1SPMGauge)) !Fill or SPM LED + elseif (MFFIPumpSelectorSwitch == 2) then + FillStrokeCounter = real(nint(MP2SPMGauge)) !Fill or SPM LED + elseif (MFFIPumpSelectorSwitch == 3) then + FillStrokeCounter= real(nint(MP1SPMGauge+MP2SPMGauge)) !Fill or SPM LED + endif + + ELSE ! (MFFIFillSPMSelectorSwitch== .true.) then !(fill mode) + if (ReturnFlowRate== 0) then + if (MFFIPumpSelectorSwitch == 1) then + FillStrokeCounter = real(nint(TotalFillStrokes1MFFI)) !Fill or SPM LED + elseif (MFFIPumpSelectorSwitch == 2) then + FillStrokeCounter = real(nint(TotalFillStrokes2MFFI)) !Fill or SPM LED + elseif (MFFIPumpSelectorSwitch == 3) then + FillStrokeCounter= real(nint(TotalFillStrokes1MFFI+TotalFillStrokes2MFFI)) !Fill or SPM LED + endif + + + TotalFilledStrokesBy1MFFI = real(nint(TotalFillStrokes1MFFI))! for values=fix on LED after the well filled + TotalFilledStrokesBy2MFFI = real(nint(TotalFillStrokes2MFFI))! for values=fix on LED after the well filled + TotalFilledStrokesBy1and2MFFI= real(nint(TotalFillStrokes1MFFI+TotalFillStrokes2MFFI))! for values=fix on LED after the well filled + + + + else !(ReturnFlowRate>0) + + ! these values=fix on LED after the well filled + if (MFFIPumpSelectorSwitch == 1) then + FillStrokeCounter = TotalFilledStrokesBy1MFFI !Fill or SPM LED + elseif (MFFIPumpSelectorSwitch == 2) then + FillStrokeCounter = TotalFilledStrokesBy2MFFI !Fill or SPM LED + elseif (MFFIPumpSelectorSwitch == 3) then + FillStrokeCounter= TotalFilledStrokesBy1and2MFFI !Fill or SPM LED + endif + endif + + + ENDIF + + + + !=================================================================================== + + + + + if (ReturnFlowRate>0) then + MFFIPumpLED=1 !(Returns Lamp) + else + MFFIPumpLED=0 !(Returns Lamp) + endif + + + + IF (MFFISetAlarmSwitch==0) THEN + + ReturnMudFlowGauge= (1 - ReturnMudFlowGaugeMalf)*ReturnFlowPercent !(percent) + + ELSEIF (MFFISetAlarmSwitch==-1) THEN + MFFI_MinPercent_Allowded=MFFISetAlarmLowKnob + ReturnMudFlowGauge= (1 - ReturnMudFlowGaugeMalf)*MFFI_MinPercent_Allowded + + ELSE !(MFFISetAlarmSwitch==1) + + MFFI_MaxPercent_Allowded=MFFISetAlarmHighKnob + ReturnMudFlowGauge= (1 - ReturnMudFlowGaugeMalf)*MFFI_MaxPercent_Allowded + ENDIF + + + IF (ReturnFlowPercentMFFI_MaxPercent_Allowded) THEN + !write(*,*) 'alarm return:' , ReturnFlowRate + MFFIAlarmLED = 2 !(blinking) + IF (MFFIHornSwitch) THEN + Buzzer3= .true. + ELSE + Buzzer3= .FALSE. + ENDIF + ELSE + MFFIAlarmLED = 0 !(OFF) + Buzzer3= .false. + ENDIF + !=================================================================================== + + + ELSEIF (MFFIPowerSwitch==0) THEN + ReturnMudFlowGauge= 0. + FillStrokeCounter= 0 + MFFITotalStrokeCounter= 0 + MFFIAlarmLED= 0 + Buzzer3= .false. + ENDIF + + + if ( IsPortable ) then + + MFFI_MinPercent_Allowded=RetFlowAlarmLow + MFFI_MaxPercent_Allowded=RetFlowAlarmHigh + + + IF (ReturnFlowPercentMFFI_MaxPercent_Allowded) THEN + + MFFIAlarmLED = 1 !(blinking) + IF (MFFIHornSwitch) THEN + Buzzer3= .true. + ELSE + Buzzer3= .FALSE. + ENDIF + ELSE + MFFIAlarmLED = 0 !(OFF) + Buzzer3= .false. + ENDIF + + endif + + +!!====================================================================== +!! TRIP TANK PANEL DISPLAY VALUES +!!====================================================================== + + TripTankVolume2= TripTankVolumeCalc/42. !(Drill Watch display) + TripTankDensity2= TripTankDensityCalc !(display) + + + IF (TripTankPowerSwitch==1 .and. IsPortable==.false.) THEN + + IF (TripTankSetAlarmSwitch==0) THEN + + TripTankGauge= (1 - TripTankPressure_DataDisplayMalf) * TripTankVolumeCalc ! (gal) + ELSEIF (TripTankSetAlarmSwitch==-1) THEN + + TripTank_MinVol_Allowded= TripTankSetAlarmLow/2. ! 2: because knob input is 0-100 but gauge is 0-50 + TripTankGauge= (1 - TripTankPressure_DataDisplayMalf) * TripTank_MinVol_Allowded + + ELSE !(TripTankSetAlarmSwitch==1) + TripTank_MaxVol_Allowded= TripTankSetAlarmHigh/2. ! 2: because knob input is 0-100 but gauge is 0-50 + TripTankGauge= (1 - TripTankPressure_DataDisplayMalf) * TripTank_MaxVol_Allowded + ENDIF + + + + IF ((TripTankVolumeCalc < TripTank_MinVol_Allowded) .OR. (TripTankVolumeCalc > TripTank_MaxVol_Allowded)) THEN + TripTankAlarmLED = 2 !(blinking) + IF (TripTankHornSwitch) THEN + Buzzer1= .true. + ELSE + Buzzer1= .false. + ENDIF + ELSE + TripTankAlarmLED = 0 !(OFF) + Buzzer1= .false. + ENDIF + + TripTankPumpLED= TripTankPumpSwitch + + + ELSEIF (TripTankPowerSwitch==0) THEN + TripTankGauge= 0. !(gal) + TripTankAlarmLED= 0 + TripTankPumpLED= 0 + Buzzer1= .false. + ENDIF + + + if ( IsPortable ) then + + TripTank_MinVol_Allowded= TripAlarmLow + TripTank_MaxVol_Allowded= TripAlarmHigh + + + IF ((TripTankVolumeCalc < TripTank_MinVol_Allowded) .OR. (TripTankVolumeCalc > TripTank_MaxVol_Allowded)) THEN + TripTankAlarmLED = 1 !(blinking) + IF (TripTankHornSwitch) THEN + Buzzer1= .true. + ELSE + Buzzer1= .false. + ENDIF + ELSE + TripTankAlarmLED = 0 !(OFF) + Buzzer1= .false. + ENDIF + + endif + + + + + !write(*,*) '=====================================================================' + + + + if (IsStopped) return + + end subroutine main + + + + + !=================================================================================================================== + !=================================================================================================================== + !=================================================================================================================== + + subroutine ActiveMudVolumeChanged(v) + !use CLog4 + implicit none + real(8), intent (in) :: v + !call Log_4('ActiveMudVolumeChanged=', v) + ActiveTankVolume= ActiveMudVolumeGal ! update from student input + end subroutine + + subroutine ActiveDensityChanged(v) + !use CLog4 + implicit none + real(8), intent (in) :: v + !call Log_4('ActiveDensityChanged=', v) + ActiveTankDensity= ActiveDensity ! update from student input + end subroutine + + subroutine ReserveMudVolumeChanged(v) + !use CLog4 + implicit none + real(8), intent (in) :: v + !call Log_4('ReserveMudVolumeChanged=', v) + ReserveTankVolume= ReserveMudVolumeGal ! update from student input + end subroutine + + subroutine ReserveDensityChanged(v) + !use CLog4 + implicit none + real(8), intent (in) :: v + !call Log_4('ReserveDensityChanged=', v) + ReserveTankDensity= ReserveDensity ! update from student input + end subroutine + + subroutine SetupMudSystem() + use CPathChangeEvents + use CMudPropertiesVariables + implicit none + + call BeforeTraverse%Add(InitialVarsBeforePathsChanges) + call AfterTraverse%Add(AfterPathsChanges) + call OnPathOpen%Add(WhenPathOpen) + + + call OnActiveMudVolumeChange%Add(ActiveMudVolumeChanged) + call OnActiveDensityChange%Add(ActiveDensityChanged) + call OnReserveMudVolumeChange%Add(ReserveMudVolumeChanged) + call OnReserveDensityChange%Add(ReserveDensityChanged) + + end subroutine + + subroutine AfterPathsChanges() + implicit none + integer i + + if(Pump1_Lasts%Length() <= 0) return + do i = 1, Pump1_Lasts%Length() + if(Pump2_Lasts%Length() <= 0) cycle + if(any(Pump2_Lasts%Array == Pump1_Lasts%Array(i))) then + State2 = .true. ! Pumps 1 & 2 have same destination + !print*, 'State2 = .true.' + endif + if(Pump3_Lasts%Length() <= 0) cycle + if(any(Pump3_Lasts%Array == Pump1_Lasts%Array(i))) then + State3 = .true. ! Pumps 1 & 3 have same destination + !print*, 'State3 = .true.' + endif + enddo + + if(Pump2_Lasts%Length() <= 0) return + do i = 1, Pump2_Lasts%Length() + if(Pump3_Lasts%Length() <= 0) cycle + if(any(Pump3_Lasts%Array == Pump2_Lasts%Array(i))) then + State4 = .true. ! Pumps 2 & 3 have same destination + !print*, 'State4 = .true.' + endif + enddo + + State1 = State2 .and. State3 ! Pumps 1 & 2 & 3 have same destination + !if(State1) print*, 'State1 = .true.' + + end subroutine + + subroutine InitialVarsBeforePathsChanges() + implicit none + + condition1 = .false. + condition2 = .false. + condition3 = .false. + condition4 = .false. + condition5 = .false. + condition6 = .false. + condition7 = .false. + condition8 = .false. + condition9 = .false. + condition10 = .false. + condition11 = .false. + condition12 = .false. + condition13 = .false. + condition14 = .false. + condition15 = .false. + condition16 = .false. + condition17 = .false. + condition18 = .false. + condition19 = .false. + condition20 = .false. + condition21 = .false. + condition22 = .false. + condition23 = .false. + condition24 = .false. + condition25 = .false. + condition26 = .false. + condition27 = .false. + condition28 = .false. + condition29 = .false. + condition30 = .false. + condition31 = .false. + condition32 = .true. + condition33 = .true. + condition34 = .true. + condition35 = .false. + condition36 = .false. + condition37 = .false. + condition38 = .false. + condition39 = .false. + condition40 = .false. + condition41 = .false. + condition42 = .false. + condition43 = .false. + condition44 = .false. + condition45 = .false. + condition46 = .false. + condition47 = .false. + condition48 = .false. + condition49 = .false. + condition50 = .false. + condition51 = .false. + condition52 = .false. + condition53 = .false. + condition54 = .false. + condition55 = .false. + condition56 = .false. + condition57 = .false. + condition58 = .false. + condition59= .false. + condition60= .false. + condition61= .false. + + + + + + + + !ThereIsPathFrom82 = .false. + !!print*, "ThereIsPathFrom82=",ThereIsPathFrom82 + !ThereIsPathFrom83 = .false. + !!print*, "ThereIsPathFrom82=",ThereIsPathFrom82 + !ThereIsPathFrom84 = .false. + !!print*, "ThereIsPathFrom82=",ThereIsPathFrom82 + + ThereIsPathFrom_71_72_73_To_82 = .false. + !print*, "ThereIsPathFrom_71_72_73_To_82=",ThereIsPathFrom_71_72_73_To_82 + ThereIsPathFrom_71_72_73_To_83 = .false. + !print*, "ThereIsPathFrom_71_72_73_To_83=",ThereIsPathFrom_71_72_73_To_83 + ThereIsPathFrom_71_72_73_To_84 = .false. + !print*, "ThereIsPathFrom_71_72_73_To_84=",ThereIsPathFrom_71_72_73_To_84 + + DumpFromKelly_Pump1 = .false. + DumpFromFillupHead_Pump1 = .false. + DumpFromTopDrive_Pump1 = .false. + + + DumpFromKelly_Pump2 = .false. + DumpFromFillupHead_Pump2 = .false. + DumpFromTopDrive_Pump2 = .false. + + + DumpFromKelly_Pump3 = .false. + DumpFromFillupHead_Pump3 = .false. + DumpFromTopDrive_Pump3 = .false. + + + + State1 = .false. + State2 = .false. + State3 = .false. + State4 = .false. + + call Pump1_Lasts%Empty() + call Pump2_Lasts%Empty() + call Pump3_Lasts%Empty() + + + + + + ac32 = .false. + ac33 = .false. + ac34 = .false. + ac35 = .false. + ac29 = .false. + + end subroutine + + subroutine WhenPathOpen(valves) + use Pump_VARIABLES + implicit none + integer, allocatable, intent (in) :: valves(:) + integer :: first, last + if (.not.allocated(valves)) return + if(size(valves) <= 0) return + + if ( any(valves == 32)) ac32 = .true. + if ( any(valves == 33)) ac33 = .true. + if ( any(valves == 34)) ac34 = .true. + if ( any(valves == 35)) ac35 = .true. + if ( any(valves == 29)) ac29 = .true. + + + first = 1 + last = size(valves) + + MP1_Q = PUMP(1)%Flow_Rate + MP2_Q = PUMP(2)%Flow_Rate + MP3_Q = PUMP(3)%Flow_Rate + + + + if(valves(first) == 82) call Pump1_Lasts%Add(valves(last)) + if(valves(first) == 83) call Pump2_Lasts%Add(valves(last)) + if(valves(first) == 84) call Pump3_Lasts%Add(valves(last)) + + !print*, '==============================================' + !do i = 1, Pump1_Lasts%Length() + ! print*, 'mp1=', Pump1_Lasts%Array(i) + !enddo + ! + !print*, '-------------------------------' + ! + !do i = 1, Pump2_Lasts%Length() + ! print*, 'mp2=', Pump2_Lasts%Array(i) + !enddo + ! + !print*, '-------------------------------' + ! + ! + !do i = 1, Pump3_Lasts%Length() + ! print*, 'mp3=', Pump3_Lasts%Array(i) + !enddo + ! + !print*, '==============================================' + + + !if(valves(first)==82 .and. (valves(last)==79 .or. valves(last)==78 .or. valves(last)==77 .or. valves(last)==71)) then + ! ThereIsPathFrom82 = .true. + ! !print*, "ThereIsPathFrom82=",ThereIsPathFrom82 + !endif + ! + !if(valves(first)==83 .and. (valves(last)==79 .or. valves(last)==78 .or. valves(last)==77 .or. valves(last)==71)) then + ! ThereIsPathFrom83 = .true. + ! !print*, "ThereIsPathFrom83=",ThereIsPathFrom83 + !endif + ! + !if(valves(first)==84 .and. (valves(last)==79 .or. valves(last)==78 .or. valves(last)==77 .or. valves(last)==71)) then + ! ThereIsPathFrom84 = .true. + ! !print*, "ThereIsPathFrom84=",ThereIsPathFrom84 + !endif + + if(valves(last)==82 .and. (valves(first)==71 .or. valves(first)==72 .or. valves(first)==73)) then + ThereIsPathFrom_71_72_73_To_82 = .true. + !print*, "ThereIsPathFrom_71_72_73_To_82=",ThereIsPathFrom_71_72_73_To_82 + endif + + if(valves(last)==83 .and. (valves(first)==71 .or. valves(first)==72 .or. valves(first)==73)) then + ThereIsPathFrom_71_72_73_To_83 = .true. + !print*, "ThereIsPathFrom_71_72_73_To_83=",ThereIsPathFrom_71_72_73_To_83 + endif + + if(valves(last)==84 .and. (valves(first)==71 .or. valves(first)==72 .or. valves(first)==73)) then + ThereIsPathFrom_71_72_73_To_84 = .true. + !print*, "ThereIsPathFrom_71_72_73_To_84=",ThereIsPathFrom_71_72_73_To_84 + endif + + !if (.not.allocated(OpenPaths)) exit + !===============TanksToMudPump1=================== + if(valves(last)==82) then + if(valves(first)==71) then + !j2=j2+1 + !A71=1 + condition1 = .true. + endif + + if(valves(first)==72) then + !j2=j2+1 + !A72=1 + condition2 = .true. + endif + + if(valves(first)==73) then + !j2=j2+1 + !A73=1 + condition3 = .true. + endif + + endif + !================================================ + + + !============BellNippleToPits-FullWell(MLnumber=3)============== + + if ( Valve(41)%Status == .false. .and. Valve(42)%Status == .false. ) then + call ChangeValve(60, .TRUE.) + else + call ChangeValve(60, .FALSE.) + endif + + if(valves(first)==80 .and. valves(last)==71 .and. any(valves == 42)) condition4 = .true. + if(valves(first)==80 .and. valves(last)==77 .and. any(valves == 41)) condition5 = .true. + if(valves(first)==80 .and. valves(last)==78) condition6 = .true. + + !================================================ + + + !============WellToChokeManifold(Through 26)============== + if(valves(first)==79 .and. any(valves == 26)) then + if(valves(last)==71) then + !j4=j4+1 + !C71=1. + condition7 = .true. + endif + + if(valves(last)==77) then + !j4=j4+1 + !C77=1. + condition8 = .true. + endif + + if(valves(last)==78) then + !j4=j4+1 + !C78=1. + condition45 = .true. + endif + + endif + + !================================================ + + + !============ActiveTankToTripTank============== + if(valves(first)==71 .and. valves(last)==77) then + !j5=j5+1 + condition9 = .true. + endif + !================================================ + + + + !============TripTankToActiveTank And BellNipple============== + if(valves(first)==77) then + if(valves(last)==71) then + !j6=j6+1 + !D71=1 + condition10 = .true. + endif + + if(valves(last)==80) then + !j6=j6+1 + !D80=1 + condition11 = .true. + endif + + endif + !================================================ + + + !============ActiveTankToDump============== + if(valves(first)==71 .and. valves(last)==78) then + !j7=j7+1 + condition12 = .true. + endif + !================================================ + + + !============TripTankToDump============== + if(valves(first)==77 .and. valves(last)==78) then + !j8=j8+1 + condition13 = .true. + endif + !================================================ + + + !============WellToBellNipple============== + if(valves(first)==79 .and. valves(last)==80) then + !j9=j9+1 + condition14 = .true. + endif + !================================================ + + !============MudBucketToBellNipple============== + if(valves(first)==81 .and. valves(last)==80) then + !j10=j10+1 + condition15 = .true. + endif + !================================================ + + + !============BellNippleToWell-NonFullWell============== + if(valves(first)==80 .and. valves(last)==79) then ! Well is NOT Full + !j11=j11+1 + condition16 = .true. + endif + !================================================ + + !===============TanksToMudPump2=================== + if(valves(last)==83) then + if(valves(first)==71) then + !j12=j12+1 + !E71=1 + condition17 = .true. + endif + + if(valves(first)==72) then + !j12=j12+1 + !E72=1 + condition18 = .true. + endif + + if(valves(first)==73) then + !j12=j12+1 + !E73=1 + condition19 = .true. + endif + + endif + !================================================ + + + !===============TanksToCementPump=================== + if(valves(last)==84) then + if(valves(first)==71) then + !j13=j13+1 + !F71=1 + condition20 = .true. + endif + + if(valves(first)==72) then + !j13=j13+1 + !F72=1 + condition21 = .true. + endif + + if(valves(first)==73) then + !j13=j13+1 + !F73=1 + condition22 = .true. + endif + + endif + !================================================ + + !===============PumpsToString=================== + if(valves(last)==79) then + if(valves(first)==82) then + !j14=j14+1 + !G82=1 + condition23 = .true. + endif + + if(valves(first)==83) then + !j14=j14+1 + !G83=1 + condition24 = .true. + endif + + if(valves(first)==84) then + !j14=j14+1 + !G84=1 + condition25 = .true. + endif + + endif + !================================================ + + + + + + !============MudPump1HasPath=================== + if(ThereIsPathFrom_71_72_73_To_82 .and. (valves(first)==82 .and. (valves(last)==79 .or. valves(last)==78 .or. valves(last)==77 .or. valves(last)==71))) then + !Mp1_NoPath= 0 + condition32 = .false. + endif + condition32Final = condition32 + !================================================ + + + !============MudPump2HasPath=================== + if(ThereIsPathFrom_71_72_73_To_83 .and. (valves(first)==83 .and. (valves(last)==79 .or. valves(last)==78 .or. valves(last)==77 .or. valves(last)==71))) then + !write(*,*) 'condition33 ******' + !Mp2_NoPath= 0 + condition33 = .false. + endif + condition33Final= condition33 + !================================================ + + + !============CementPumpHasNoPath=================== + if(ThereIsPathFrom_71_72_73_To_84 .and. (valves(first)==84 .and. (valves(last)==79 .or. valves(last)==78 .or. valves(last)==77 .or. valves(last)==71))) then + !Cp_NoPath= 1 + condition34 = .false. + endif + condition34Final = condition34 + !================================================ + + + + + !===============PumpsToDump=================== + !DumpFromKelly = 0.0 + !DumpFromFillupHead= 0.0 + + if(valves(last)==78) then + if(valves(first)==82) then + !DumpPump1=1 + condition26 = .true. + IF(any(valves == 56)) DumpFromKelly_Pump1 = .true. + IF(any(valves == 14)) DumpFromFillupHead_Pump1 = .true. + IF(any(valves == 70)) DumpFromTopDrive_Pump1 = .true. + + + endif + + + if(valves(first)==83) then + !DumpPump2=1 + print*, "THERE IS DUMP" + condition27 = .true. + IF(any(valves == 56)) DumpFromKelly_Pump2 = .true. + IF(any(valves == 14)) DumpFromFillupHead_Pump2 = .true. + IF(any(valves == 70)) DumpFromTopDrive_Pump2 = .true. + + endif + + + if(valves(first)==84) then + !DumpCementPump=1 + condition28 = .true. + IF(any(valves == 56)) DumpFromKelly_Pump3 = .true. + IF(any(valves == 14)) DumpFromFillupHead_Pump3 = .true. + IF(any(valves == 70)) DumpFromTopDrive_Pump3 = .true. + + endif + + ! DumpFromKelly + !if (DumpFromKelly_Pump1 .or. DumpFromKelly_Pump2 .or. DumpFromKelly_Pump3) then + ! DumpFromKelly = 1.0 + !else + ! DumpFromKelly = 0.0 + !endif + + + ! DumpFromFillupHead + if (DumpFromFillupHead_Pump1 .or. DumpFromFillupHead_Pump2 .or. DumpFromFillupHead_Pump3) then + DumpFromFillupHead = 1.0 + else + DumpFromFillupHead = 0.0 + endif + + endif + + + + !================================================ + + + !=======MudPumps1&2ToActiveTank_Through65&66========== + + ! << if H82 or H83 or H4 are open, no flow goes to other parts of system >> + + + if(valves(last)==71) then + if(valves(first)==82 .and. any(valves == 65)) then + !j15=j15+1 + !H82=1.0 + condition29 = .true. + endif + + if(valves(first)==83 .and. any(valves == 66)) then + !j15=j15+1 + !H83=1.0 + condition30 = .true. + endif + + endif + !================================================ + + !=======CementPumpToCementTank_Through67========== + + ! << if H82 or H83 or H4 are open, no flow goes to other parts of system >> + + + if(valves(last)==73 .and. valves(first)==84 .and. any(valves == 67)) then + + !H84=1.0 + condition31 = .true. + + endif + !================================================ + + + + !===============PathsToGauge75=================== + if(valves(last)==75) then + if(valves(first)==82) then !Pump1 to Gauge75 + !j16=j16+1 + !K82=1 + condition35 = .true. + endif + + if(valves(first)==83) then !Pump2 to Gauge75 + !j16=j16+1 + !K83=1 + condition36 = .true. + endif + + if(valves(first)==84) then !Pump3 to Gauge75 + !j16=j16+1 + !K84=1 + condition37 = .true. + endif + + if(valves(first)==79) then !String to Gauge75 + !j16=j16+1 + !K79=1 + condition38 = .true. + endif + + if(valves(first)==78) then !Dump to Gauge75 + !j16=j16+1 + !K78=1 + condition39 = .true. + endif + + endif + !================================================ + + !===============PathsToGauge76=================== + if(valves(last)==76) then + if(valves(first)==82) then !Pump1 to Gauge76 + !j17=j17+1 + !L82=1 + condition40 = .true. + endif + + if(valves(first)==83) then !Pump2 to Gauge76 + !j17=j17+1 + !L83=1 + condition41 = .true. + endif + + if(valves(first)==84) then !Pump3 to Gauge76 + !j17=j17+1 + !L84=1 + condition42 = .true. + endif + + if(valves(first)==79) then !String to Gauge76 + !j17=j17+1 + !L79=1 + condition43 = .true. + endif + + if(valves(first)==78) then !Dump to Gauge76 + !j17=j17+1 + !L78=1 + condition44 = .true. + endif + + endif + !================================================ + + + !====Pump1-StandPipeManifoldToChokeManifold-Through ChokeLine==== + if(valves(first)==82 .and. any(valves == 2)) then + if(valves(last)==71) then + !j18=j18+1 + !M71=1. + !Pump1toCh= 1. + condition46 = .true. + endif + + if(valves(last)==77) then + !j18=j18+1 + !M77=1. + !Pump1toCh= 1. + condition47 = .true. + endif + + if(valves(last)==78) then + !j18=j18+1 + !M78=1. + !Pump1toCh= 1. + condition48 = .true. + endif + + endif + !================================================================= + + + !====Pump2-StandPipeManifoldToChokeManifold-Through ChokeLine==== + if(valves(first)==83 .and. any(valves == 2)) then + if(valves(last)==71) then + !j18=j18+1 + !M71=1. + !Pump2toCh= 1. + condition49 = .true. + endif + + if(valves(last)==77) then + !j18=j18+1 + !M77=1. + !Pump2toCh= 1. + condition50 = .true. + endif + + if(valves(last)==78) then + !j18=j18+1 + !M78=1. + !Pump2toCh= 1. + condition51 = .true. + endif + + endif + !================================================================= + + + !====Pump3-StandPipeManifoldToChokeManifold-Through ChokeLine==== + if(valves(first)==84 .and. any(valves == 2)) then + if(valves(last)==71) then + !j18=j18+1 + !M71=1. + !Pump3toCh= 1. + condition52 = .true. + endif + + if(valves(last)==77) then + !j18=j18+1 + !M77=1. + !Pump3toCh= 1. + condition53 = .true. + endif + + if(valves(last)==78) then + !j18=j18+1 + !M78=1. + !Pump3toCh= 1. + condition54 = .true. + endif + + endif + !================================================================= + + + + + !===============PumpsToWell_KillLine============ + if(valves(last)==79) then + if(valves(first)==82) then + !j19=j19+1 + !N82=1 + condition55 = .true. + endif + + if(valves(first)==83) then + !j19=j19+1 + !N83=1 + condition56 = .true. + endif + + if(valves(first)==84) then + !j19=j19+1 + !N84=1 + condition57 = .true. + endif + + endif + !================================================ + + !===============WellToChokeLineGauge============ + if(valves(first)==79 .and. valves(last)==85) then + !j20=j20+1 + condition58 = .true. + endif + !================================================ + + + !============ChokeLineGaugeToTanks=============== + if(valves(first)==85) then + if(valves(last)==71) then + !j21=j21+1 + condition59 = .true. + endif + + if(valves(last)==77) then + !j21=j21+1 + condition60 = .true. + endif + + if(valves(last)==78) then + !j21=j21+1 + condition61 = .true. + endif + + endif + !================================================ + + + + + + + + + + end subroutine + + + + +end module MudSystem \ No newline at end of file diff --git a/Equipments/MudSystem/MudSystemMain.f90 b/Equipments/MudSystem/MudSystemMain.f90 new file mode 100644 index 0000000..898626a --- /dev/null +++ b/Equipments/MudSystem/MudSystemMain.f90 @@ -0,0 +1,85 @@ +module MudSystemMain + implicit none + public + contains + + subroutine MudSystem_Setup() + use CSimulationVariables + use MudSystem + implicit none + call SetupMudSystem() + call OnSimulationStop%Add(MudSystem_Stop) + call OnMudSystemStart%Add(MudSystem_Start) + call OnMudSystemStep%Add(MudSystem_Step) + call OnMudSystemMain%Add(MudSystemMainBody) + end subroutine + + subroutine MudSystem_Stop + implicit none + !print* , 'MudSystem_Stop' + CALL DEALLOCATE_ARRAYS_MudSystem() + end subroutine MudSystem_Stop + + subroutine MudSystem_Start + implicit none + !print* , 'MudSystem_Start' + CALL MudSystem_StartUp() + end subroutine MudSystem_Start + + subroutine MudSystem_Step + use MudSystem + use CManifolds + implicit none + !print* , 'MudSystem_Step' + !CALL main + if(IsTraverse) then + call LineupAndPath() + IsTraverse = .false. + endif + call main() + end subroutine MudSystem_Step + + subroutine MudSystemMainBody + USE CSimulationVariables + use MudSystem + implicit none + +! INTEGER :: MudDuration +! integer,dimension(8) :: MudStartTime , MudEndTime +! +!CALL MudSystem_StartUp() +! loop1: DO +! +! CALL DATE_AND_TIME(values=MudStartTime) +! !WRITE (*,*) '***MudSys_timeCounter', MudSys_timeCounter +! +! +! CALL main +! +! CALL DATE_AND_TIME(values=MudEndTime) +! +! MudDuration = 3600000 * (MudEndTime(5) - MudStartTime(5)) + 60000 * (MudEndTime(6) - MudStartTime(6)) + 1000 * (MudEndTime(7) - MudStartTime(7)) + (MudEndTime(8) - MudStartTime(8)) +! +! if (MudDuration < 100) then +! ELSE +! WRITE (*,*) 'Mud System run duration exceeded 100 ms and =', MudDuration +! end if +! +! IF (IsStopped==.true.) THEN +! EXIT loop1 +! ENDIF +! +! !CALL DATE_AND_TIME(values=FlowEndTime) +! !WRITE (*,*) 'FlowEndTime=' , FlowEndTime +! +! !FlowDuration = FlowEndTime(8) - FlowStartTime(8) +! +! !WRITE (*,*) 'FlowDuration Mud system=' , FlowDuration +! +! ENDDO loop1 +! +! CALL DEALLOCATE_ARRAYS_MudSystem() + + end subroutine MudSystemMainBody + +end module MudSystemMain \ No newline at end of file diff --git a/Equipments/MudSystem/MudSystemStartup.f90 b/Equipments/MudSystem/MudSystemStartup.f90 new file mode 100644 index 0000000..f48c2f0 --- /dev/null +++ b/Equipments/MudSystem/MudSystemStartup.f90 @@ -0,0 +1,501 @@ + SUBROUTINE NormalCirculation_StartUp() ! is called in module FluidFlowMain + + USE MudSystemVARIABLES + use CTanksVariables + USE CMudPropertiesVariables + Use GeoElements_FluidModule + Use KickVariables + Use CUnityOutputs + Use CShoeVariables + USE Pump_VARIABLES + + implicit none + + ! temporary varibales for solving pressure jerks -- 1399-11-09 + !Pump1BlownInTimeStep = 0 + !Pump2BlownInTimeStep = 0 + !Pump3BlownInTimeStep = 0 + + !Pump1BlownStarted = .FALSE. + !Pump2BlownStarted = .FALSE. + !Pump3BlownStarted = .FALSE. + + Pump1BlownCount = 0 + Pump2BlownCount = 0 + Pump3BlownCount = 0 + + +DeltaWellCap=0. +WellCapOld = 0. +AnnCapOld=0. +DeltaAnnCap=0. + + + Total_Stroke_Counter_For_Plot = 0.0 + + DeltaT_Mudline=0.1 !second + + Call Set_FlowKellyDisconnect(.false.) + Call Set_FlowPipeDisconnect(.false.) + +!HZ_ADD= 0.d0 +Flow_timeCounter= 0 +MudSys_timeCounter= 0 +FluidFlowCounter = 0 +!======================================================================== +! MUD CIRCULATION STARTUP +!======================================================================== + + FormationLostPressure= LeakOff * ShoeDepth + ShoeFractured= .false. + + UGBOSuccessionCounter = 0 ! also in starup + UGBOSuccessionCounterOld = 0 ! also in starup + + + + ChokeLineFlowRate= 0.0 + StringFlowRate= 0.0 + AnnulusFlowRate= 0.0 + + MudVolume_InjectedFromAnn= 0.D0 + MudVolume_InjectedToBH= 0.D0 + + DensityMixTol= 0.1 !(ppg) + CuttingDensityMixTol= 0.5 + NewPipeFilling= 1 + UtubeFilling= 1 + UtubeEmptyVolume= 0.0 + + UtubeMode1Activated= .false. + UtubeMode2Activated= .false. + UtubePossibility= .false. + + + !KickMigration_2SideBit = .FALSE. + + KickDx= (AutoMigrationRate/3600.)*DeltaT_Mudline !AutoMigrationRate (ft/h)= ft per DeltaT_Mudline + + + NewInfluxElementCreated= 0 + NewInfluxNumber= 0 + + !KickVolumeinAnnulus= 0.0 + KickDeltaVinAnnulus= 0.0 + GasKickPumpFlowRate= 0.0 + + FirstMudSet= 0 + FirstSetUtube1=0 + FirstSetUtube2=0 + SuctionMud=1 + ImudCount= 1 + imud=1 + iLoc= 1 ! for Kick + + Suction_Density_MudSystem= ActiveDensity + SuctionDensity_Old= ActiveDensity ! initial(ppg) + StringDensity_Old= ActiveDensity ! initial(ppg) + AnnulusSuctionDensity_Old= ActiveDensity ! initial(ppg) + ChokeLineDensity_Old= ActiveDensity ! initial(ppg) + + TotalAddedVolume= 0. + + + xx=0. + + + + END SUBROUTINE NormalCirculation_StartUp + + + + + + + + SUBROUTINE MudSystem_StartUp() + USE CMudPropertiesVariables + USE MudSystemVARIABLES + USE CDataDisplayConsoleVariables + USE CHOKEVARIABLES + USE Pump_VARIABLES + USE CBopStackVariables + USE CPumpsVariables + use CTanksVariables + USE KickVariables + implicit none + + + + + + CALL MUDLINE_LOSS_INPUTS() + +!Total_Pump_Gpm=10. ! Initial Value + MUD%Q=0. ! Initial Value + + Q_flow32=0. + Q_flow33=0. + Q_flow34=0. + Q_flow35=0. + + DeltaT_Mudline=0.1 !second + + GasKickPumpFlowRate= 0. + BellNippleVolume= 0. + BellNippleDensity= 0. + MudBucketVolume= 0. + MudBucketDensity= 0. + BellNippleDumpVolume= 0. + !BellNippleDumpRate= 0. + !BellNippleToPitsRate= 0.0 + MudChecked= .true. + + condition32Final= .TRUE. + condition33Final= .TRUE. + condition34Final= .TRUE. + + +PressureGauge75= 0.0 +PressureGauge76 = 0.0 + + +!!====================================================================== +!! TRIP TANK +!!====================================================================== + + TripTank_MinVol_Allowded= 50.*42. !(bbl to gal, initial value) + TripTank_MaxVol_Allowded= 50. *42. !(bbl to gal, initial value) + + +ActiveTankFloorArea= (ActiveTotalTankCapacityGal) / (7.48051948*100./12.) ! (ft^2) - Tank Height= 100 inch , 12=inch to ft 7.48051948=gal to ft^3 +TripTankFloorArea= (50.*42.) / (7.48051948*100./12.) ! (ft^2) - 50.*42.=Trip Tank Capacity in BBl*42= Gal , Tank Height= 100 inch , 12=inch to ft 7.48051948=gal to ft^3 + + + +TripTank_Vol= InitialTripTankMudVolumeGal !(gal) +TripTank_Dens= 1. +TripTankGauge=0. + + + +ReturnToTrip_Q= 1. +ActiveToTrip_Q= 1. + + +TripTankPump_Q= .8 + + +ReturnToTrip_Dens=1.0 ! ppg(lbm/gal) +ActiveToTrip_Dens=1.0 + +!!====================================================================== +!! MUD VOLUME TOTALIZER +!!====================================================================== + +Mp1Density= 0.0 !(VALVE82) +Mp2Density= 0.0 !(VALVE83) +Mp3Density= 0.0 !(VALVE84) + + +ReserveTankVolume= ReserveMudVolumeGal ! initial volume (gal) +ReserveTankDensity= ReserveDensity ! initial + + + +CementTankVolumeCalc= CementTankVolume !movaghat--- initial volume (gal) +CementTankDensityCalc= CementTankDensity !movaghat--- initial + +PumpsDumpVolume=0.0 +PumpsDumpFlowRate= 0.0 + + + +ActiveTankVolume= ActiveMudVolumeGal ! initial volume (gal) +RefrencePitVolume= ActiveTankVolume/42. !(bbl) +RefrencePitVolume_DrillWatch= ActiveTankVolume/42. !(bbl) + +MVT_MinVol_Allowded= 0. +MVT_MaxVol_Allowded= 0. + +MudTank1_vol= ActiveMudVolumeGal/3. ! (gal) +MudTank2_vol= ActiveMudVolumeGal/3. ! (gal) +MudTank3_vol= ActiveMudVolumeGal/3. ! (gal) +ActiveTankSettled= ActiveSettledContentsGal ! (gal) +MudTank4_vol= InitialTripTankMudVolumeGal ! (gal) + +TripTankVolumeCalc= InitialTripTankMudVolumeGal ! initial volume (gal) +ActiveTankDensity= ActiveDensity ! initial(ppg) +TripTankDensityCalc= TripTankDensity ! initial(ppg) + +ChokeManifoldDumpVolume= 0.0 + +PitGainLossZero= 0. +PitGainLossZero_Old= PitGainLossZero +MVTCoarseKnob_Old= MVTCoarseKnob +MVTFineKnob_Old= MVTFineKnob +FirstSet_Time= .true. + + + +PedalMeter= PedalFlowMeter !1600. !(gpm) +ReturnFlowRate=0. + + + + TotalStrokes1MFFI =0. + TotalStrokes2MFFI =0. + + TotalStrokesPump1=0. + TotalStrokesPump2=0. + GraphTotalStrokes=0. + + + TotalStrokes1 =0. + TotalStrokes2 =0. + + + + + + + end + + + + + + + + + + + +SUBROUTINE MUDLINE_LOSS_INPUTS() +USE MudSystemVARIABLES +USE CBopStackVariables +USE CPumpsVariables +implicit none +INTEGER I + + + +!=========================================================================== +! MUDLINE MINOR LOSSES INPUT +!=========================================================================== + +NO_MudMinors=4 + +ALLOCATE (MudMinors(NO_MudMinors,4)) + +! ID(INCH) LF CV NOTE(BAR) DESCRIPTION +MudMinors(1,1)= MudPump1Output +MudMinors(1,2:4)= (/1.5*8., 0., 0./) !elbow (MLnumber=1,,PumpsToString) +MudMinors(2,1)= MudPump1Output +MudMinors(2,2:4)= (/1.5*6., 0., 0./) !elbow (MLnumber=2,,STGaugeToString) +MudMinors(3,1:4)= (/0., 0., 0., 0./) !elbow (MLnumber=3,,WellToPits) +MudMinors(4,1)= ChokeLineId +MudMinors(4,2:4)= (/1.5*7., 0., 0./) !elbow (MLnumber=4,,WellToChokeManifold) + + + +ALLOCATE (MINORDIAMETER_MUDLINE(NO_MudMinors),AREAMINOR_MUDLINE(NO_MudMinors),LF_MUDLINE(NO_MudMinors),CV_MUDLINE(NO_MudMinors) & + ,NOTE_MUDLINE(NO_MudMinors)) + + + +DO I=1,NO_MudMinors + MINORDIAMETER_MUDLINE(I)=MudMinors(I,1) + LF_MUDLINE(I)=MudMinors(I,2) + CV_MUDLINE(I)=MudMinors(I,3) + NOTE_MUDLINE(I)=MudMinors(I,4) + + + AREAMINOR_MUDLINE(I)=PII*(MINORDIAMETER_MUDLINE(I)*0.0254)**2/4. !D(in), AREA(m^2) +ENDDO + +!=========================================================================== +! MUDLINE PIPNING LOSSES INPUT +!=========================================================================== +NO_PIPINGSMUDLINE=4 + +ALLOCATE (PIPINGS_MUDLINE(NO_PIPINGSMUDLINE,3)) + + ! ID(INCH) L(FEET) ROUGHNESS(MM)=e DESCRIPTION +PIPINGS_MUDLINE(1,1)= MudPump1Output +PIPINGS_MUDLINE(1,2:3)= (/265., 0.03/) !(MLnumber=1,,PumpsToString) +PIPINGS_MUDLINE(2,1)= MudPump1Output +PIPINGS_MUDLINE(2,2:3)= (/100., 0.03/) !(MLnumber=2,,STGaugeToString) +PIPINGS_MUDLINE(3,1:3)= (/0., 0., 0./) !(MLnumber=3,,WellToPits) +PIPINGS_MUDLINE(4,1)= ChokeLineId +PIPINGS_MUDLINE(4,2)= ChokeLineLength +PIPINGS_MUDLINE(4,3)= 0.03 !(MLnumber=4,,WellToChokeManifold) + +Area_ChokeLineFt= PII*((ChokeLineId/12.)**2)/4. !D(in), AREA(ft^2) +ChokeLine_VolumeCapacity= Area_ChokeLineFt* ChokeLineLength* 7.48051948 ! (gal) + + ALLOCATE (DIAM_MUDLINE_INCH(NO_PIPINGSMUDLINE), & + AREA_MUDLINE(NO_PIPINGSMUDLINE),LENGT_MUDLINE(NO_PIPINGSMUDLINE),ROUGHNESS_MUDLINE(NO_PIPINGSMUDLINE),RELROUGH_MUDLINE(NO_PIPINGSMUDLINE)) + + +DO I=1,NO_PIPINGSMUDLINE + DIAM_MUDLINE_INCH(I)=PIPINGS_MUDLINE(I,1) + LENGT_MUDLINE(I)=PIPINGS_MUDLINE(I,2) + ROUGHNESS_MUDLINE(I)=PIPINGS_MUDLINE(I,3) + + + + AREA_MUDLINE(I)=PII*(DIAM_MUDLINE_INCH(I)*0.0254)**2/4 !D(in), AREA(m^2) + RELROUGH_MUDLINE(I)=ROUGHNESS_MUDLINE(I)/(DIAM_MUDLINE_INCH(I)*25.4) !e/D + !DIAM_MUDLINE_MM(I)=DIAM_MUDLINE_MM(I)*.001 ! (m) + LENGT_MUDLINE(I)=LENGT_MUDLINE(I)*.3048 ! (m) +ENDDO + + +!=========================================================================== +! MUDLINE STATIC LOSSES INPUT +!=========================================================================== + +! Height are in (meter) +Pumps_Height= 0. +STpipeGauge_Height= 2. !(m) +Pits_Height= 1. !(m) +ChokeManifold_Height= 1.*0.3048 !(ft to meter) +WellChokeExit_Height= GroundLevel-KillHeight + + + + + + + + + + + + + + END + + + + + SUBROUTINE MUDLINE_LOSSES(MLnumber) + + USE MudSystemVARIABLES + implicit none + integer I + INTEGER MLnumber + + +!===============================PIPE LOSS=================================== + MUD(MLnumber)%Re_MUDline=MUD(MLnumber)%Q*6.30902e-5*DIAM_MUDLINE_INCH(MLnumber)*0.0254/(AREA_MUDLINE(MLnumber)*MUD(MLnumber)%nu) !<<<<<< nu: DOROST SHAVAD.ALAN DAR STARTUP SET SHODE +!write(*,*) 'MUD(MLnumber)%Re_MUDline=' , MUD(MLnumber)%Re_MUDline +! Q*6.30902e-5 for (gpm) to (m^3/sec) + if ( MUD(MLnumber)%Re_MUDlineStandPipePressure + !use CManifolds + use CDrillWatchVariables + !use CHOKEVARIABLES + !use CChokeManifoldVariables + use CTanksVariables, TripTankVolume2 => TripTankVolume, TripTankDensity2 => TripTankDensity + USE sROP_Other_Variables + USE sROP_Variables + Use KickVariables + USE CKellyConnectionEnumVariables + USE UTUBEVARS + use CLog1 + Use CError + Use , intrinsic :: IEEE_Arithmetic + + implicit none + + integer jelement, jmud, jsection,ielement,i + integer jopelement,jopmud,jopsection + character(len=120) :: temp1, temp2 + + + + + if (ChokePanelStrokeResetSwitch == 1) then + write(*,*) 'well cap=' , sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) + DeltaWellCap= sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) - WellCapOld + WellCapOld= sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) + write(*,*) 'cap_reset,DeltaWellCap=' , DeltaWellCap + endif + + + + +!========================ANNULUS END================= +if ((Ann_Mud_Forehead_X%Last() - AboveAnnularHeight) > 0.8 .or. Ann_Density%Last()==0.0) then ! for Line (BellNippleToWell-NonFullWell) + WellisNOTFull= .true. +else + WellisNOTFull= .false. +endif + +!WRITE(*,*) 'Ann_Mud_Forehead_X%Last() , KillHeight', Ann_Mud_Forehead_X%Last() , KillHeight +if ((Ann_Mud_Forehead_X%Last() - KillHeight)>0.8 .or. Ann_Density%Last()==0.0) then ! for Line j4 , WellToChokeManifold(Through 26) + ChokeLineNOTFull= .true. +else + ChokeLineNOTFull= .false. +endif + + + +!========================================================= + + jmud= 1 + jsection= 1 + jelement= 0 ! number of final mud elements + + + + call Xend_MudElement%Empty() + call TVDend_MudElement%Empty() + call Density_MudElement%Empty() + call MudGeoType%Empty() + call PipeID_MudElement%Empty() + call PipeOD_MudElement%Empty() + !call Angle_MudElement%Empty() + call MudType_MudElement%Empty() + + + + DO WHILE(jmud <= Hz_Mud_Forehead_X%Length() .and. jsection<=1) + + jelement= jelement+1 + TrueMinValue= min(Hz_Mud_Forehead_X%Array(jmud), Xend_PipeSection(jsection)) + + call Xend_MudElement%Add(TrueMinValue) + call TVD_Calculator(TrueMinValue,MudCircVerticalDepth) + call TVDend_MudElement%Add(MudCircVerticalDepth) + call Density_MudElement%Add(Hz_Density%Array(jmud)) + call PipeID_MudElement%Add(ID_PipeSectionInch(jsection)) + call PipeOD_MudElement%Add(OD_PipeSectionInch(jsection)) + !call Angle_MudElement%Add(Angle_PipeSection(jsection)) + call MudType_MudElement%Add(Hz_MudOrKick%Array(jmud)) + + + if (Xend_MudElement%Array(jelement)== Hz_Mud_Forehead_X%Array(jmud)) then + jmud= jmud+1 + else + jsection= jsection+1 + endif + + ENDDO + + NoHorizontalMudElements= jelement + + + + + jmud= 1 + jsection= 2 + + DO WHILE(jmud <= St_Mud_Forehead_X%Length() .and. jsection<=F_StringIntervalCounts) + + jelement= jelement+1 + TrueMinValue= min(St_Mud_Forehead_X%Array(jmud), Xend_PipeSection(jsection)) + + call Xend_MudElement%Add(TrueMinValue) + call TVD_Calculator(TrueMinValue,MudCircVerticalDepth) + call TVDend_MudElement%Add(MudCircVerticalDepth) + call Density_MudElement%Add(St_Density%Array(jmud)) + call PipeID_MudElement%Add(ID_PipeSectionInch(jsection)) + call PipeOD_MudElement%Add(OD_PipeSectionInch(jsection)) + !call Angle_MudElement%Add(Angle_PipeSection(jsection)) + call MudType_MudElement%Add(St_MudOrKick%Array(jmud)) + + + if (Xend_MudElement%Array(jelement)== St_Mud_Forehead_X%Array(jmud)) then + jmud= jmud+1 + else + jsection= jsection+1 + endif + + ENDDO + + NoStringMudElements= jelement- NoHorizontalMudElements + + + + + + jmud= 1 + jsection= F_StringIntervalCounts+1 + DO WHILE(jmud<= Ann_Mud_Forehead_X%Length() .and. jsection<=NoPipeSections) + + jelement= jelement+1 + TrueMinValue= max(Ann_Mud_Forehead_X%Array(jmud), Xend_PipeSection(jsection)) + + call Xend_MudElement%Add(TrueMinValue) + call TVD_Calculator(TrueMinValue,MudCircVerticalDepth) + call TVDend_MudElement%Add(MudCircVerticalDepth) + call Density_MudElement%Add(Ann_Density%Array(jmud)) + call PipeID_MudElement%Add(ID_PipeSectionInch(jsection)) + call PipeOD_MudElement%Add(OD_PipeSectionInch(jsection)) + !call Angle_MudElement%Add(Angle_PipeSection(jsection)) + call MudType_MudElement%Add(Ann_MudOrKick%Array(jmud)) + + + if (Xend_MudElement%Array(jelement)== Ann_Mud_Forehead_X%Array(jmud)) then + jmud= jmud+1 + else + jsection= jsection+1 + endif + + ENDDO + + do i= 2, Xend_MudElement%Length() + if ( i== NoHorizontalMudElements+NoStringMudElements+1) then + call Xstart_MudElement%Add (Ann_Mud_Backhead_X%Array(1)) ! start of annulus + call TVD_Calculator(Ann_Mud_Backhead_X%Array(1),MudCircVerticalDepth) + call TVDstart_MudElement%Add(MudCircVerticalDepth) + elseif ( i== NoHorizontalMudElements+1 ) then + call Xstart_MudElement%Add (St_Mud_Backhead_X%Array(1)) ! start of stirng + call TVD_Calculator(St_Mud_Backhead_X%Array(1),MudCircVerticalDepth) + call TVDstart_MudElement%Add(MudCircVerticalDepth) + else + call Xstart_MudElement%Add(Xend_MudElement%Array(i-1)) ! normal calculation + call TVDstart_MudElement%Add(TVDend_MudElement%Array(i-1)) ! normal calculation + endif + + enddo + + NoCasingMudElements = jelement- NoStringMudElements- NoHorizontalMudElements + + +!=========================For Torque and Drag======================== + if (allocated(TDXstart_MudElementArray)) deallocate(TDXstart_MudElementArray) + allocate(TDXstart_MudElementArray(NoHorizontalMudElements+NoStringMudElements+NoCasingMudElements)) + if (allocated(TDXend_MudElementArray)) deallocate(TDXend_MudElementArray) + allocate(TDXend_MudElementArray(NoHorizontalMudElements+NoStringMudElements+NoCasingMudElements)) + if (allocated(TDDensity_MudElementArray)) deallocate(TDDensity_MudElementArray) + allocate(TDDensity_MudElementArray(NoHorizontalMudElements+NoStringMudElements+NoCasingMudElements)) + + TDNoHorizontalMudElements= NoHorizontalMudElements + TDNoStringMudElements= NoStringMudElements + TDNoCasingMudElements= NoCasingMudElements + + + TDXstart_MudElementArray(:) = Xstart_MudElement%Array(:) + TDXend_MudElementArray(:) = Xend_MudElement%Array(:) + TDDensity_MudElementArray(:) = Density_MudElement%Array(:) +!===================================================================== + + + !do i=NoHorizontalMudElements+1, NoHorizontalMudElements+NoStringMudElements ! 2-string elements + ! write(*,333) 'STRING:', i,'Xstart\=', Xstart_MudElement%Array(i), 'Xend=' , Xend_MudElement%Array(i), 'Density=' , Density_MudElement%Array(i), 'MudType=' , MudType_MudElement%Array(i) + !enddo + + + + !================================================================ + + ! Open Hole Mud Elements + jopmud= 1 + jopsection= 1 + jopelement= 0 ! number of final mud elements + + + call Xend_OpMudElement%Empty() + call TVDend_OpMudElement%Empty() + call Density_OpMudElement%Empty() + call PipeID_OpMudElement%Empty() + call PipeOD_OpMudElement%Empty() + !call Angle_OpMudElement%Empty() + call MudTypeOp_MudElement%Empty() + + + + DO WHILE(jopmud<= Op_Mud_Forehead_X%Length() .and. jopsection<=F_BottomHoleIntervalCounts) + + jopelement= jopelement+1 + TrueMinValue= max(Op_Mud_Forehead_X%Array(jopmud), Xend_OpSection(jopsection)) + call Xend_OpMudElement%Add(TrueMinValue) + call TVD_Calculator(TrueMinValue,MudCircVerticalDepth) + call TVDend_OpMudElement%Add(MudCircVerticalDepth) + call Density_OpMudElement%Add(Op_Density%Array(jopmud)) + call PipeID_OpMudElement%Add(ID_OpSectionInch(jopsection)) + call PipeOD_OpMudElement%Add(OD_OpSectionInch(jopsection)) + !call Angle_MudElement%Add(Angle_PipeSection(jopsection)) + call MudTypeOp_MudElement%Add(Op_MudOrKick%Array(jopmud)) + + + if (Xend_OpMudElement%Array(jopelement)== Op_Mud_Forehead_X%Array(jopmud)) then + jopmud= jopmud+1 + else + jopsection= jopsection+1 + endif + + ENDDO + + do i= 2, Xend_OpMudElement%Length() + call Xstart_OpMudElement%Add(Xend_OpMudElement%Array(i-1)) + call TVDstart_OpMudElement%Add(TVDend_OpMudElement%Array(i-1)) + enddo + + NoBottomHoleMudElements = jopelement + + + !================================================================ + + + + if(allocated(StringMudElement)) deallocate(StringMudElement) + allocate(StringMudElement(NoStringMudElements)) + + if(allocated(CasingMudElement)) deallocate(CasingMudElement) + allocate(CasingMudElement(NoCasingMudElements+NoBottomHoleMudElements)) + + istring=0 + icasing=0 + + BitMudDensity= Density_MudElement%Array(NoHorizontalMudElements+NoStringMudElements) ! (for ROP module) + !================================================================ + + !============================ UTUBE ============================= + + !IF (UtubePossibility== .true. .and. Get_KellyConnection() /= KELLY_CONNECTION_STRING .and. WellHeadIsOpen) THEN + IF (UtubePossibility== .true. .and. TD_FluidStringConnectionMode==0 .and. WellHeadIsOpen .AND. NoGasPocket == 0) THEN + CALL WellPressureDataTransfer + !WRITE (*,*) ' U-Tube Done 1' + CALL Utube + !WRITE (*,*) ' U-Tube Done 2' + if (QUtubeInput> 0.0) call Utube1_and_TripIn + if (QUtubeOutput> 0.0) call Utube2_and_TripIn + END IF + + !========================== UTUBE- end ========================= + + ! do imud=1, st_MudDischarged_Volume%Length() + ! write(*,*) 'st-plot:', imud, St_MudDischarged_Volume%Array(imud), St_Mud_Backhead_X%Array(imud) ,St_Mud_Forehead_X%Array(imud) + !enddo +!==================== Display ======================== + !do i=1, St_MudOrKick%Length() + ! write(*,555) i,'St_Volume(i), type=' ,St_MudDischarged_Volume%Array(i),St_MudOrKick%Array(i) + ! + ! IF (IEEE_Is_NaN(St_MudDischarged_Volume%Array(i))) call ErrorStop('NaN in St Volume-Plot') + ! IF (St_MudDischarged_Volume%Array(i)<0.) call ErrorStop('St Volume <0' , St_MudDischarged_Volume%Array(i)) + !enddo + + + IF (ANY(IEEE_Is_NaN(Op_MudDischarged_Volume%Array(:))) .OR. ANY(Op_MudDischarged_Volume%Array(:) <= 0.0)) THEN + do i = 1 , Op_MudOrKick%Length() + write(*,555) i,'Op_Volume(i), type=' ,Op_MudDischarged_Volume%Array(i) , Op_MudOrKick%Array(i) , Op_Density%Array(i) + end do + call ErrorStop('NaN in Op Volume-Plot or Op Volume <=0') + END IF + + + IF (ANY(IEEE_Is_NaN(Ann_MudDischarged_Volume%Array(:))) .OR. ANY(Ann_MudDischarged_Volume%Array(:) <= 0.0)) THEN + do i = 1 , Ann_MudOrKick%Length() + write(*,555) i,'Ann_Volume(i), type=' ,Ann_MudDischarged_Volume%Array(i) , Ann_MudOrKick%Array(i) , Ann_Density%Array(i) + end do + call ErrorStop('NaN in Ann Volume-Plot or Ann Volume <=0') + END IF + + !do i=1, Ann_MudOrKick%Length() + ! !write(*,555) i,'Ann_Volume(i), type=' ,Ann_MudDischarged_Volume%Array(i),Ann_MudOrKick%Array(i),Ann_Density%Array(i) + ! + ! IF (IEEE_Is_NaN(Ann_MudDischarged_Volume%Array(i))) call ErrorStop('NaN in Ann Volume-Plot') + ! IF (Ann_MudDischarged_Volume%Array(i)<=0.) call ErrorStop('Ann Volume <=0' , Ann_MudDischarged_Volume%Array(i)) + !enddo + +555 FORMAT(I3,5X,A42,(f12.5),5X,I3,5X,(f12.5)) + + NoStringMudElementsForPlot= NoStringMudElements + + ! 1-Horizontal Mud Elements are not shown + !write(*,333) 'Horiz:', 1,'Xstart\=', Xstart_MudElement%Array(1), 'Xend=' , Xend_MudElement%Array(1), 'Density=' , Density_MudElement%Array(1), 'MudType=' , MudType_MudElement%Array(1) + + do i=NoHorizontalMudElements+1, NoHorizontalMudElements+NoStringMudElements ! 2-string elements + if (Xend_MudElement%Array(i) <= 0.0) then + NoStringMudElementsForPlot= NoStringMudElementsForPlot-1 + cycle + endif + istring= istring+1 + StringMudElement(istring)%StartMd = Xstart_MudElement%Array(i) + StringMudElement(istring)%EndMd = Xend_MudElement%Array(i) + !StringMudElement(istring)%Id = PipeID_MudElement%Array(i) + !StringMudElement(istring)%Od = PipeOD_MudElement%Array(i) + StringMudElement(istring)%Density = Density_MudElement%Array(i) + + if (MudType_MudElement%Array(i) == 104) then + MudType_MudElement%Array(i)= 4 ! air + elseif (MudType_MudElement%Array(i) > 0 .and. MudType_MudElement%Array(i) < 100) then ! all kicks + MudType_MudElement%Array(i)= 1 ! gas kick + endif + + StringMudElement(istring)%MudType = MudType_MudElement%Array(i) + !write(*,333) 'STRING:', i,'Xstart\=', Xstart_MudElement%Array(i), 'Xend=' , Xend_MudElement%Array(i), 'Density=' , Density_MudElement%Array(i), 'MudType=' , MudType_MudElement%Array(i) + enddo + + + + do i=Xend_MudElement%Length(), NoHorizontalMudElements+NoStringMudElements+1 , -1 ! 3-casing elements + icasing= icasing+1 + CasingMudElement(icasing)%StartMd = Xend_MudElement%Array(i) + CasingMudElement(icasing)%EndMd = Xstart_MudElement%Array(i) + !CasingMudElement(icasing)%Id = PipeID_MudElement%Array(i) + !CasingMudElement(icasing)%Od = PipeOD_MudElement%Array(i) + !write(*,333) 'CASING:', i,'Xstart\=', Xstart_MudElement%Array(i), 'Xend=' , Xend_MudElement%Array(i), 'Density=' , Density_MudElement%Array(i), 'MudType=' , MudType_MudElement%Array(i) + !call Log_1(temp1) + !write(*,444) 'CASING:', i,'Xstart\=', Xstart_MudElement%Array(i), 'Xend=' , Xend_MudElement%Array(i), 'PipeID_MudElement%Array(i)=' , PipeID_MudElement%Array(i), 'PipeOD_MudElement%Array(i)=' , PipeOD_MudElement%Array(i) + CasingMudElement(icasing)%Density = Density_MudElement%Array(i) + + if (MudType_MudElement%Array(i) == 104) then + MudType_MudElement%Array(i)= 4 ! air + elseif (MudType_MudElement%Array(i) > 0 .and. MudType_MudElement%Array(i) < 100) then + MudType_MudElement%Array(i)= 1 ! gas kick + endif + + CasingMudElement(icasing)%MudType = MudType_MudElement%Array(i) + + enddo + + do i= NoBottomHoleMudElements, 1 , -1 ! 4-open hole elements + icasing= icasing+1 + CasingMudElement(icasing)%StartMd = Xend_OpMudElement%Array(i) + CasingMudElement(icasing)%EndMd = Xstart_OpMudElement%Array(i) + !CasingMudElement(icasing)%Id = PipeID_OpMudElement%Array(i) + !CasingMudElement(icasing)%Od = PipeOD_OpMudElement%Array(i) + !write(*,333) 'OpenHole:',i,'Xstart\=', Xstart_OpMudElement%Array(i), 'Xend=' , Xend_OpMudElement%Array(i), 'Density=' , Density_OpMudElement%Array(i), 'MudType=' , MudTypeOp_MudElement%Array(i) + !call Log_1(temp2) + !write(*,444) 'OpenHole:',i,'Xstart\=', Xstart_OpMudElement%Array(i), 'Xend=' , Xend_OpMudElement%Array(i), 'PipeID_MudElement%Array(i)=' , PipeID_MudElement%Array(i), 'PipeOD_MudElement%Array(i)=' , PipeOD_MudElement%Array(i) + CasingMudElement(icasing)%Density = Density_OpMudElement%Array(i) + + if (MudTypeOp_MudElement%Array(i) == 104) then + MudTypeOp_MudElement%Array(i)= 4 ! air + elseif (MudTypeOp_MudElement%Array(i) > 0 .and. MudTypeOp_MudElement%Array(i) < 100) then + MudTypeOp_MudElement%Array(i)= 1 ! gas kick + endif + + CasingMudElement(icasing)%MudType = MudTypeOp_MudElement%Array(i) + enddo + + + +333 FORMAT(A10,I3,5X,A8,(f12.5),5X,A8,(f12.5),5X,A8,(f12.5),5X,A8,I3) +444 FORMAT(A10,I2,5X,A8,(f12.3),5X,A8,(f12.3),5X,A8,(f12.3),5X,A8,(f12.3)) + + + + ! shomare gozari be tartib HZ mud, ST mud, Casing + ! shomare gzari OpenHole jodagane ast az 1 + + call SetStringFluids(NoStringMudElementsForPlot, StringMudElement) !for data display in string + call SetAnnalusFluids(NoCasingMudElements+NoBottomHoleMudElements, CasingMudElement) !for data display in casing + + +!=========================================================================================================================== +!=========================================================================================================================== + + + end subroutine PlotFinalMudElements + + + diff --git a/Equipments/MudSystem/Pump_and_Trip_In.f90 b/Equipments/MudSystem/Pump_and_Trip_In.f90 new file mode 100644 index 0000000..7a2c79b --- /dev/null +++ b/Equipments/MudSystem/Pump_and_Trip_In.f90 @@ -0,0 +1,1626 @@ +subroutine Pump_and_TripIn ! is called in subroutine CirculationCodeSelect + + Use GeoElements_FluidModule + USE CMudPropertiesVariables + USE MudSystemVARIABLES + USE Pump_VARIABLES + !USE CHOKEVARIABLES + !USE CDataDisplayConsoleVariables , StandPipePressureDataDisplay=>StandPipePressure + !use CManifolds + use CDrillWatchVariables + !use CHOKEVARIABLES + !use CChokeManifoldVariables + use CTanksVariables, TripTankVolume2 => TripTankVolume, TripTankDensity2 => TripTankDensity + USE sROP_Other_Variables + USE sROP_Variables + Use KickVariables + Use CShoeVariables + + + implicit none + +integer i,ii,AddLocation +!===========================================================WELL============================================================ +!===========================================================WELL============================================================ + + StringFlowRate= MUD(2)%Q + AnnulusFlowRate= MUD(2)%Q + + + !write(*,*) 'Trip In' + + +!========================Horizontal PIPE ENTRANCE================= + + if (ABS(SuctionDensity_Old - Suction_Density_MudSystem) >= DensityMixTol) then ! new mud is pumped + + call Hz_Density%AddToFirst (Suction_Density_MudSystem) + call Hz_MudDischarged_Volume%AddToFirst (0.0d0) + call Hz_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(1)) + call Hz_Mud_Forehead_section%AddToFirst (1) + call Hz_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(1)) + call Hz_Mud_Backhead_section%AddToFirst (1) + call Hz_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Hz_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Hz_MudOrKick%AddToFirst (0) + + SuctionDensity_Old= Suction_Density_MudSystem + endif + +!========================Horizontal PIPE STRING================= + + Hz_MudDischarged_Volume%Array(1)= Hz_MudDischarged_Volume%Array(1)+ ((StringFlowRate/60.0d0)*DeltaT_Mudline) !(gal) + + total_add = total_add + ((StringFlowRate/60.0d0)*DeltaT_Mudline) + + if (ChokePanelStrokeResetSwitch == 1) then + total_add= 0. + endif + + + !write(*,*) ' total decrease(add to HZ)=' , total_add + !write(*,*) ' add to HZ=' , ((StringFlowRate/60.0d0)*DeltaT_Mudline) + +imud=0 + do while (imud < Hz_Mud_Forehead_X%Length()) + imud = imud + 1 + + if (imud> 1) then + Hz_Mud_Backhead_X%Array(imud)= Hz_Mud_Forehead_X%Array(imud-1) + Hz_Mud_Backhead_section%Array(imud)= Hz_Mud_Forehead_section%Array(imud-1) + endif + + + DirectionCoef= (Xend_PipeSection(Hz_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(Hz_Mud_Backhead_section%Array(imud))) & + / ABS(Xend_PipeSection(Hz_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(Hz_Mud_Backhead_section%Array(imud))) + ! +1 for string , -1 for annulus + + + Hz_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (Xend_PipeSection(Hz_Mud_Backhead_section%Array(imud))- Hz_Mud_Backhead_X%Array(imud))* & + Area_PipeSectionFt(Hz_Mud_Backhead_section%Array(imud)) !(ft^3) + Hz_EmptyVolume_inBackheadLocation%Array(imud)= Hz_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal + + + if ( Hz_MudDischarged_Volume%Array(imud) <= Hz_EmptyVolume_inBackheadLocation%Array(imud)) then + Hz_Mud_Forehead_section%Array(imud)= Hz_Mud_Backhead_section%Array(imud) + Hz_Mud_Forehead_X%Array(imud)= Hz_Mud_Backhead_X%Array(imud)+ DirectionCoef*(Hz_MudDischarged_Volume%Array(imud)/7.48051948d0)/Area_PipeSectionFt(Hz_Mud_Backhead_section%Array(imud)) + + else + + + isection= Hz_Mud_Backhead_section%Array(imud)+1 + Hz_RemainedVolume_in_LastSection%Array(imud)= Hz_MudDischarged_Volume%Array(imud)- Hz_EmptyVolume_inBackheadLocation%Array(imud) + + do + if (isection > 1) then ! (horizontal pipe exit) + Hz_MudDischarged_Volume%Array(imud)= Hz_MudDischarged_Volume%Array(imud)- Hz_RemainedVolume_in_LastSection%Array(imud) + Hz_Mud_Forehead_X%Array(imud)= Xend_PipeSection(1) + Hz_Mud_Forehead_section%Array(imud)= 1 + + if (Hz_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the string + call RemoveHzMudArrays(imud) + endif + + exit + endif + + xx= Hz_RemainedVolume_in_LastSection%Array(imud)/ PipeSection_VolumeCapacity(isection) !(gal) + + if (xx<= 1.0) then + Hz_Mud_Forehead_section%Array(imud)= isection + Hz_Mud_Forehead_X%Array(imud)= (xx * (Xend_PipeSection(isection)- Xstart_PipeSection(isection)))+ Xstart_PipeSection(isection) + exit + else + Hz_RemainedVolume_in_LastSection%Array(imud)= Hz_RemainedVolume_in_LastSection%Array(imud)- PipeSection_VolumeCapacity(isection) + isection= isection+ 1 + + endif + + enddo + + endif + + enddo +!========================Horizontal PIPE END================= + + +!========================Utube1 Air Element Removing================= + + !if (UtubeMode1Activated== .true.) then ! StringUpdate == .true. + ! + ! + ! !StringDensity_Old= St_Density%Array(2) + ! + ! write(*,*) 'StringDensity_Old=' , StringDensity_Old + ! + ! UtubeMode1Activated= .false. + !endif + +!========================Utube1 Air Element Removing End================= + +!!========================Utube2 Removing from Annulus================= not needed 97.04.26 +! +! if (UtubeMode2Activated== .true.) then ! StringUpdate == .true. +! +! if (Ann_MudOrKick%Last() == 104) then !movaghati. albate age merge anjam shode bashe moshkeli nist +! call RemoveAnnulusMudArrays(Ann_MudOrKick%Length()) +! endif +! +! UtubeMode2Activated= .false. +! endif +! +! +!!========================Utube2 Removing from Annulus End================= + +!========================New Pipe Filling================= + + !if (F_StringIntervalCounts > F_StringIntervalCountsOld) then ! StringUpdate == .true. + if (AddedElementsToString > 0) then ! StringUpdate == .true. + + !NoPipeAdded= F_StringIntervalCounts - F_StringIntervalCountsOld + + + NewPipeFilling=0 + + IF (St_MudOrKick%First() == 104) then + St_MudDischarged_Volume%Array(1) = St_MudDischarged_Volume%Array(1) + sum(PipeSection_VolumeCapacity(2:1+AddedElementsToString)) ! new pipe is filled by air + else + call St_Density%AddToFirst (0.d0) + call St_MudDischarged_Volume%AddToFirst (sum(PipeSection_VolumeCapacity(2:1+AddedElementsToString))) + call St_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(2)) + call St_Mud_Forehead_section%AddToFirst (2) + call St_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(2)) + call St_Mud_Backhead_section%AddToFirst (2) + call St_RemainedVolume_in_LastSection%AddToFirst (0.d0) + call St_EmptyVolume_inBackheadLocation%AddToFirst (0.d0) + call St_MudOrKick%AddToFirst (104) + endif + + endif + + !F_StringIntervalCountsOld= F_StringIntervalCounts + + + + if (NewPipeFilling == 0) then ! 2= is the first element of string (1= is for Hz pipe) + + + LackageMudVolume= St_MudDischarged_Volume%Array(1) ! = Air element + + + write(*,*) 'LackageMudVolume=' , LackageMudVolume + + + + if (ABS(St_Density%Array(2) - Hz_Density%Last()) >= DensityMixTol) then ! new mud is pumped + call St_Density%AddTo (2,Hz_Density%Last()) + call St_MudDischarged_Volume%AddTo (2, 0.d0) + call St_Mud_Forehead_X%AddTo (2,Xstart_PipeSection(2)) + call St_Mud_Forehead_section%AddTo (2 , 2) + call St_Mud_Backhead_X%AddTo (2,Xstart_PipeSection(2)) + call St_Mud_Backhead_section%AddTo (2 ,2) + call St_RemainedVolume_in_LastSection%AddTo (2,0.d0) + call St_EmptyVolume_inBackheadLocation%AddTo (2,0.d0) + call St_MudOrKick%AddTo (2,0) + + !StringDensity_Old= Hz_Density%Last() + endif + + + St_MudDischarged_Volume%Array(2)= St_MudDischarged_Volume%Array(2)+ min( ((StringFlowRate/60.0d0)*DeltaT_Mudline), LackageMudVolume) !(gal) + + St_MudDischarged_Volume%Array(1)= St_MudDischarged_Volume%Array(1)- min( ((StringFlowRate/60.0d0)*DeltaT_Mudline), LackageMudVolume) ! air(gal) + + !LackageMudVolumeAfterFilling= sum(PipeSection_VolumeCapacity(2:F_StringIntervalCounts)) - sum(St_MudDischarged_Volume%Array(:)) + + LackageMudVolumeAfterFilling= St_MudDischarged_Volume%Array(1) ! last time it should be zero + + + + if (LackageMudVolumeAfterFilling == 0.) then + NewPipeFilling= 1 + call RemoveStringMudArrays(1) + St_Mud_Backhead_X%Array(1) = Xstart_PipeSection(2) + St_Mud_Backhead_section%Array(1) = 2 + endif + + endif + +!========================New Pipe Filling End================= + + + + + if (NewPipeFilling == 0) then + StringFlowRate= 0. + AnnulusFlowRate= 0. + endif + + StringFlowRateFinal= StringFlowRate + AnnulusFlowRateFinal= AnnulusFlowRate + + + + +!========================STRING ENTRANCE================= + + if (StringFlowRateFinal > 0.0 .and. ABS(St_Density%First() - Hz_Density%Last()) >= DensityMixTol) then ! new mud is pumped + call St_Density%AddToFirst (Hz_Density%Last()) + call St_MudDischarged_Volume%AddToFirst (0.0d0) + call St_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(2)) + call St_Mud_Forehead_section%AddToFirst (2) + call St_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(2)) + call St_Mud_Backhead_section%AddToFirst (2) + call St_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call St_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call St_MudOrKick%AddToFirst (0) + + !StringDensity_Old= Hz_Density%Last() + endif + + + St_MudDischarged_Volume%Array(1)= St_MudDischarged_Volume%Array(1)+ ((StringFlowRate/60.0d0)*DeltaT_Mudline) !(gal) + +!=============== save String Mud data=========== + + + + + StMudVolumeSum= 0.d0 + !St_MudSaved_Density= 0.d0 + St_Saved_MudDischarged_Volume= 0.d0 + !Saved_St_MudOrKick= 0 + !Ann_to_Choke_2mud= .false. + + do imud=1, St_MudDischarged_Volume%Length() + + StMudVolumeSum = StMudVolumeSum + St_MudDischarged_Volume%Array(imud) + + if ( StMudVolumeSum > sum(PipeSection_VolumeCapacity(2:F_StringIntervalCounts)) ) then + + !IF (St_MudOrKick%Array(imud) == 0) THEN + St_MudSaved_Density = St_Density%Array(imud) + St_Saved_MudDischarged_Volume = StMudVolumeSum - sum(PipeSection_VolumeCapacity(2:F_StringIntervalCounts)) + !ELSEIF (St_MudOrKick%Array(imud) > 0 .AND. St_MudOrKick%Array(imud) <100) THEN ! 104= AIR + ! St_Kick_Saved_Volume = StMudVolumeSum - sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + ! Saved_St_MudOrKick= St_MudOrKick%Array (imud) + ! St_KickSaved_Density= St_Density%Array(imud) + !END IF + + do ii= imud + 1, St_MudDischarged_Volume%Length() + !IF (St_MudOrKick%Array(ii) == 0) THEN + St_MudSaved_Density = ((St_MudSaved_Density * St_Saved_MudDischarged_Volume) + (St_Density%Array(ii) * St_MudDischarged_Volume%Array(ii))) / (St_Saved_MudDischarged_Volume + St_MudDischarged_Volume%Array(ii)) + St_Saved_MudDischarged_Volume = St_Saved_MudDischarged_Volume + St_MudDischarged_Volume%Array(ii) + + !ELSEIF (St_MudOrKick%Array(imud) > 0 .AND. St_MudOrKick%Array(imud) <100) THEN ! 104= AIR + ! St_Kick_Saved_Volume = St_Kick_Saved_Volume + St_MudDischarged_Volume%Array(ii) + ! Saved_St_MudOrKick= St_MudOrKick%Array (ii) + ! St_KickSaved_Density= St_Density%Array(ii) + !END IF + enddo + + + !WRITE (*,*) 'St_Saved_Mud_Volume, St_Kick_Saved_Volume', St_Saved_MudDischarged_Volume, St_Kick_Saved_Volume + exit ! exits do + + endif + + enddo +St_Saved_MudDischarged_Volume_Final = St_Saved_MudDischarged_Volume + +IF (WellHeadIsOpen) MudVolume_InjectedToBH = St_Saved_MudDischarged_Volume_Final +!====================================================================== + +!========================STRING================= + +imud=0 + do while (imud < St_Mud_Forehead_X%Length()) + imud = imud + 1 + + if (imud> 1) then + St_Mud_Backhead_X%Array(imud)= St_Mud_Forehead_X%Array(imud-1) + St_Mud_Backhead_section%Array(imud)= St_Mud_Forehead_section%Array(imud-1) + endif + + DirectionCoef= (Xend_PipeSection(St_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(St_Mud_Backhead_section%Array(imud))) & + / ABS(Xend_PipeSection(St_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(St_Mud_Backhead_section%Array(imud))) + ! +1 for string , -1 for annulus + + + St_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (Xend_PipeSection(St_Mud_Backhead_section%Array(imud))- St_Mud_Backhead_X%Array(imud))* & + Area_PipeSectionFt(St_Mud_Backhead_section%Array(imud)) !(ft^3) + St_EmptyVolume_inBackheadLocation%Array(imud)= St_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal + + + !write(*,*) 'St_Mud_Backhead_section%Array(1)=' , St_Mud_Backhead_section%Array(1) + !write(*,*) 'Xend_PipeSection(St_Mud_Backhead_section%Array(1))=' , Xend_PipeSection(St_Mud_Backhead_section%Array(1)) + ! + !write(*,*) 'St_EmptyVolume_inBackheadLocation%Array(1)=' , St_EmptyVolume_inBackheadLocation%Array(1) + !write(*,*) 'St_Mud_Backhead_X%Array(1)=' , St_Mud_Backhead_X%Array(1) + + + if ( St_MudDischarged_Volume%Array(imud) <= St_EmptyVolume_inBackheadLocation%Array(imud)) then + St_Mud_Forehead_section%Array(imud)= St_Mud_Backhead_section%Array(imud) + St_Mud_Forehead_X%Array(imud)= St_Mud_Backhead_X%Array(imud)+ DirectionCoef*(St_MudDischarged_Volume%Array(imud)/7.48051948d0)/Area_PipeSectionFt(St_Mud_Backhead_section%Array(imud)) + ! 7.48 is for gal to ft^3 + + else + + isection= St_Mud_Backhead_section%Array(imud)+1 + St_RemainedVolume_in_LastSection%Array(imud)= St_MudDischarged_Volume%Array(imud)- St_EmptyVolume_inBackheadLocation%Array(imud) + + do + if (isection > F_StringIntervalCounts) then ! last pipe section(string exit) F_StringIntervalCounts includes Horizontal line + St_MudDischarged_Volume%Array(imud)= St_MudDischarged_Volume%Array(imud)- St_RemainedVolume_in_LastSection%Array(imud) + St_Mud_Forehead_X%Array(imud)= Xend_PipeSection(F_StringIntervalCounts) + St_Mud_Forehead_section%Array(imud)= F_StringIntervalCounts + + if (St_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the string + call RemoveStringMudArrays(imud) + endif + + exit + endif + + xx= St_RemainedVolume_in_LastSection%Array(imud)/ PipeSection_VolumeCapacity(isection) !(gal) + + if (xx<= 1.0) then + St_Mud_Forehead_section%Array(imud)= isection + St_Mud_Forehead_X%Array(imud)= (xx * (Xend_PipeSection(isection)- Xstart_PipeSection(isection)))+ Xstart_PipeSection(isection) + exit + else + St_RemainedVolume_in_LastSection%Array(imud)= St_RemainedVolume_in_LastSection%Array(imud)- PipeSection_VolumeCapacity(isection) + isection= isection+ 1 + + + endif + + enddo + + endif + + enddo + + + !write(*,*) ' a before==' + ! + ! do imud=1, Op_MudDischarged_Volume%Length() + ! write(*,*) 'Op:', imud, Op_MudDischarged_Volume%Array(imud), Op_Density%Array(imud) ,Op_MudOrKick%Array(imud) + ! enddo + ! + ! do imud=1, Ann_MudDischarged_Volume%Length() + ! write(*,*) 'Ann:', imud, Ann_MudDischarged_Volume%Array(imud), Ann_Density%Array(imud) ,Ann_MudOrKick%Array(imud) + ! enddo + ! + !write(*,*) '==== a before' + + + + + !write(*,*) ' iloc (a): ' , iloc + +!========================STRING END================= + + IF (Op_MudOrKick%Last() /= 0 .and. Op_MudOrKick%Last()==Ann_MudOrKick%First()) iLoc=2 ! it may be 1,2,3 or more, all of them are kick +!write(*,*) ' iloc (b): ' , iloc + +!=============================Add PumpFlowRate to Bottom Hole ============================== + !if ( AnnulusFlowRate>0.0 ) then + if ( MudVolume_InjectedToBH > 0.0 ) then + + + if (KickOffBottom) then ! (kickOffBottom = F) means kick is next to the bottom hole and usually kick is entering the + AddLocation= Op_Density%Length()-iloc+1+1 ! well, thus pumped mud should be placed above the kick + else + AddLocation= Op_Density%Length()+1 + endif + !write(*,*) 'AddLocation====' , AddLocation + if ( AddLocation== 0) CALL ErrorStop ('AddLocation=0') + + + if ( ABS(St_Density%Last() - Op_Density%Array(AddLocation-1)) >= DensityMixTol ) then + !write(*,*) 'new pocket**' + !write(*,*) 'St_Density%Last()=' , St_Density%Last() + !write(*,*) 'Op_Density%Array(AddLocation-1)=' , Op_Density%Array(AddLocation-1) + + + call Op_Density% AddTo (AddLocation,St_Density%Last()) + !call Op_MudDischarged_Volume%AddTo (AddLocation,((AnnulusFlowRate/60.d0)*DeltaT_Mudline)) + call Op_MudDischarged_Volume%AddTo (AddLocation,MudVolume_InjectedToBH) + call Op_Mud_Forehead_X%AddTo (AddLocation,Xstart_OpSection(1)) + call Op_Mud_Forehead_section%AddTo (AddLocation,1) + call Op_Mud_Backhead_X%AddTo (AddLocation,Xstart_OpSection(1)) + call Op_Mud_Backhead_section%AddTo (AddLocation,1) + call Op_RemainedVolume_in_LastSection%AddTo (AddLocation,0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddTo (AddLocation,0.0d0) + call Op_MudOrKick%AddTo (AddLocation,0) + else + !write(*,*) 'merge**' + !write(*,*) 'density before=' , Op_Density%Array(AddLocation-1) + !write(*,*) 'St_Density%Last() for mix=' , St_Density%Last() + + !Op_Density%Array(AddLocation-1)= (Op_Density%Array(AddLocation-1)*Op_MudDischarged_Volume%Array(AddLocation-1)+St_Density%Last()*((AnnulusFlowRate/60.d0)*DeltaT_Mudline))/(Op_MudDischarged_Volume%Array(AddLocation-1)+((AnnulusFlowRate/60.d0)*DeltaT_Mudline)) + !Op_MudDischarged_Volume%Array(AddLocation-1)= Op_MudDischarged_Volume%Array(AddLocation-1) + ((AnnulusFlowRate/60.d0)*DeltaT_Mudline) + + Op_Density%Array(AddLocation-1)= (Op_Density%Array(AddLocation-1)*Op_MudDischarged_Volume%Array(AddLocation-1)+St_Density%Last()*MudVolume_InjectedToBH)/(Op_MudDischarged_Volume%Array(AddLocation-1)+MudVolume_InjectedToBH) + Op_MudDischarged_Volume%Array(AddLocation-1)= Op_MudDischarged_Volume%Array(AddLocation-1) + MudVolume_InjectedToBH + !write(*,*) 'density after=' , Op_Density%Array(AddLocation-1) + + endif + + endif +!=======================Add PumpFlowRate to Bottom Hole- End ============================== + + + + +!=============== save OP Mud data to transfer to the annulus enterance due to tripin or kick + OpMudVolumeSum= 0.d0 + !Op_MudSaved_Density= 0.d0 + !Op_KickSaved_Density= 0.d0 + Op_Saved_MudDischarged_Volume= 0.d0 + Op_Kick_Saved_Volume= 0.d0 + Saved_Op_MudOrKick= 0 + + + + !write(*,*) 'Op_Capacity===' , sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) + !write(*,*) 'Op_MudDischarged_Volume%Length()===' , Op_MudDischarged_Volume%Length() + ! + + do imud=1, Op_MudDischarged_Volume%Length() + !write(*,*) 'imud, Op_MudDischarged_Volume%Array(imud)=' , imud,Op_MudDischarged_Volume%Array(imud) + + OpMudVolumeSum= OpMudVolumeSum + Op_MudDischarged_Volume%Array(imud) + + if ( OpMudVolumeSum > sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) ) then + + IF (Op_MudOrKick%Array(imud) == 0) THEN + Op_MudSaved_Density = Op_Density%Array(imud) + Op_Saved_MudDischarged_Volume = OpMudVolumeSum - sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) + ELSE + Op_Kick_Saved_Volume = OpMudVolumeSum - sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) + !write(*,*) 'cond 1- Op_MudOrKick%Array (imud),Op_Density%Array(imud):' ,Op_MudOrKick%Array (imud),Op_Density%Array(imud) + Saved_Op_MudOrKick= Op_MudOrKick%Array (imud) + Op_KickSaved_Density= Op_Density%Array(imud) + iloc= 2 + END IF + + do ii= imud + 1, Op_MudDischarged_Volume%Length() + IF (Op_MudOrKick%Array(ii) == 0) THEN + Op_MudSaved_Density = ((Op_MudSaved_Density * Op_Saved_MudDischarged_Volume) + (Op_Density%Array(ii) * Op_MudDischarged_Volume%Array(ii))) / (Op_Saved_MudDischarged_Volume + Op_MudDischarged_Volume%Array(ii)) + Op_Saved_MudDischarged_Volume = Op_Saved_MudDischarged_Volume + Op_MudDischarged_Volume%Array(ii) + ELSE + Op_Kick_Saved_Volume = Op_Kick_Saved_Volume + Op_MudDischarged_Volume%Array(ii) + !write(*,*) 'cond 2- Op_MudOrKick%Array (ii),Op_Density%Array(ii):' ,Op_MudOrKick%Array (ii),Op_Density%Array(ii) + Saved_Op_MudOrKick= Op_MudOrKick%Array (ii) + Op_KickSaved_Density= Op_Density%Array(ii) + iloc= 2 + END IF + enddo + + exit ! exits do + + endif + + enddo + !WRITE (*,*) 'Op_Saved_MudDischarged_Volume, Op_Kick_Saved_Volume',Op_Saved_MudDischarged_Volume, Op_Kick_Saved_Volume +!write(*,*) ' iloc (c): ' , iloc + +!====================================================================== + +!====================================================================== + + + + + + !if (iLoc == 1) then + MudSection= F_StringIntervalCounts+1 + BackheadX= Xstart_PipeSection(F_StringIntervalCounts+1) + !elseif (iLoc == 2) then + ! MudSection= Kick_Forehead_section + ! BackheadX= Kick_Forehead_X + !endif + +!========================ANNULUS ENTRANCE==================== + !if (KickMigration_2SideBit == .FALSE.) then ! because its effect is applied in Migration Code + ! !write(*,*) 'iloc=====' , iLoc bejaye Rate_of_Penetration ==0. in bude: DeltaVolumeOp == 0.0 + ! if (ABS(AnnulusSuctionDensity_Old-St_Density%Last()) >= DensityMixTol .OR. (DeltaVolumeOp == 0.0 .and. ABS(Ann_Density%Array(iLoc)-St_Density%Last())>=DensityMixTol .and. AnnulusFlowRate/=0.0d0) ) then ! new mud is pumped + ! call Ann_Density%AddTo (iLoc,St_Density%Last()) + ! call Ann_MudDischarged_Volume%AddTo (iLoc,0.0d0) + ! call Ann_Mud_Forehead_X%AddTo (iLoc,BackheadX) + ! call Ann_Mud_Forehead_section%AddTo (iLoc,MudSection) + ! call Ann_Mud_Backhead_X%AddTo (iLoc,BackheadX) + ! call Ann_Mud_Backhead_section%AddTo (iLoc,MudSection) + ! call Ann_RemainedVolume_in_LastSection%AddTo (iLoc,0.0d0) + ! call Ann_EmptyVolume_inBackheadLocation%AddTo (iLoc,0.0d0) + ! call Ann_MudOrKick%AddTo (iLoc,0) + ! call Ann_CuttingMud%AddTo (iLoc,0) + ! !write(*,*) 'c) annLength=' , Ann_Density%Length() + ! + ! AnnulusSuctionDensity_Old= St_Density%Last() + ! + ! MudIsChanged= .true. + ! endif + ! + ! Ann_MudDischarged_Volume%Array(iLoc)= Ann_MudDischarged_Volume%Array(iLoc)+ ((AnnulusFlowRate/60.d0)*DeltaT_Mudline) !(gal) + ! + !endif + + + + + + + Ann_Mud_Backhead_section%Array(1)= MudSection !it is needed to be updated for a condition that one pipe is removed from Annulus due to trip out + Ann_Mud_Backhead_X%Array(1)= BackheadX + + + + ! write(*,*) 'zero)Ann_Mud sum=' , sum(Ann_MudDischarged_Volume%Array(:)) + ! + ! + !write(*,*) 'pump added-before add to ann==' + ! + ! do imud=1, Op_MudDischarged_Volume%Length() + ! write(*,*) 'Op:', imud, Op_MudDischarged_Volume%Array(imud), Op_Density%Array(imud) ,Op_MudOrKick%Array(imud) + ! enddo + ! + ! do imud=1, Ann_MudDischarged_Volume%Length() + ! write(*,*) 'Ann:', imud, Ann_MudDischarged_Volume%Array(imud), Ann_Density%Array(imud) ,Ann_MudOrKick%Array(imud) + ! enddo + ! + !write(*,*) '====pump added-before add to ann' + + + +!========================Tripping In==================== + +!write(*,*) 'DeltaVolumeOp=' , DeltaVolumeOp + if (Rate_of_Penetration==0.) then ! .and. Op_MudOrKick%Last() == 0) then ! trip in mode(loole paeen) Mud + + !write(*,*) 'Tripping In' + !write(*,*) 'before' ,'Ann_Volume%Array(1)=' , Ann_MudDischarged_Volume%Array(1) + + !if ( MudIsChanged== .true. ) then + ! call RemoveAnnulusMudArrays(iLoc) + !endif + + + if (Op_Kick_Saved_Volume > 0.0 .and. Ann_MudOrKick%First() == 0) then + write(*,*) 'Kick influx enters Annulus' + call Ann_Density%AddToFirst (Op_KickSaved_Density) + call Ann_MudDischarged_Volume%AddToFirst (Op_Kick_Saved_Volume) + call Ann_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) + call Ann_Mud_Forehead_section%AddToFirst (F_StringIntervalCounts+1) + call Ann_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) + call Ann_Mud_Backhead_section%AddToFirst (F_StringIntervalCounts+1) + call Ann_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Ann_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Ann_MudOrKick%AddToFirst (Saved_Op_MudOrKick) !<<<<<<<< + call Ann_CuttingMud%AddToFirst (0) + elseif (Op_Kick_Saved_Volume > 0.0 .and. Ann_MudOrKick%First() /= 0) then + Ann_MudDischarged_Volume%Array(1)= Ann_MudDischarged_Volume%Array(1) + Op_Kick_Saved_Volume + endif + + + if (Op_Saved_MudDischarged_Volume> 0.0) then + NewDensity= Op_MudSaved_Density + NewVolume= Op_Saved_MudDischarged_Volume + !write(*,*) 'NewVolume=' , NewVolume + !write(*,*) 'iloc=' , iloc,'Ann_MudDischarged_Volume%Array(1)=' , Ann_MudDischarged_Volume%Array(1) + + + + if ((Rate_of_Penetration==0 .and. abs(Ann_Density%Array(iLoc)-NewDensity)< DensityMixTol) & + .or. (Rate_of_Penetration>0. .and. Ann_CuttingMud%Array(iLoc)==1 .and. abs(Ann_Density%Array(iLoc)-NewDensity)< CuttingDensityMixTol) & + .or. (Rate_of_Penetration>0. .and. Ann_CuttingMud%Array(iLoc)==0 .and. Ann_MudDischarged_Volume%Array(iLoc) < 42.) ) then ! 1-Pockets are Merged + + Ann_Density%Array(iLoc)= (Ann_Density%Array(iLoc)*Ann_MudDischarged_Volume%Array(iLoc)+NewDensity*NewVolume)/(Ann_MudDischarged_Volume%Array(iLoc)+NewVolume) + Ann_MudDischarged_Volume%Array(iLoc)= Ann_MudDischarged_Volume%Array(iLoc)+NewVolume + Ann_Mud_Forehead_X%Array(iLoc)= BackheadX + Ann_Mud_Forehead_section%Array(iLoc)= MudSection + Ann_Mud_Backhead_X%Array(iLoc)= BackheadX + Ann_Mud_Backhead_section%Array(iLoc)= MudSection + Ann_RemainedVolume_in_LastSection%Array(iLoc)= (0.0d0) + Ann_EmptyVolume_inBackheadLocation%Array(iLoc)= (0.0d0) + !write(*,*) 'merge' ,'Ann_Volume%Array(1)=' , Ann_MudDischarged_Volume%Array(1) + + else ! 2-Merging conditions are not meeted, so new pocket + call Ann_Density%AddTo (iLoc,NewDensity) + call Ann_MudDischarged_Volume%AddTo (iLoc,NewVolume) + call Ann_Mud_Forehead_X%AddTo (iLoc,BackheadX) + call Ann_Mud_Forehead_section%AddTo (iLoc,MudSection) + call Ann_Mud_Backhead_X%AddTo (iLoc,BackheadX) + call Ann_Mud_Backhead_section%AddTo (iLoc,MudSection) + call Ann_RemainedVolume_in_LastSection%AddTo (iLoc,0.0d0) + call Ann_EmptyVolume_inBackheadLocation%AddTo (iLoc,0.0d0) + call Ann_MudOrKick%AddTo (iLoc,0) + call Ann_CuttingMud%AddTo (iLoc,0) + !write(*,*) 'd) annLength=' , Ann_Density%Length() + !write(*,*) 'new' ,'Ann_Volume%Array(1)=' , Ann_MudDischarged_Volume%Array(1) + + endif + endif + + endif + +!========================Tripping In - End==================== + +!========================Drilling Mode======================== + + if (Rate_of_Penetration>0. .and. DeltaVolumeOp>0.0) then ! trip in mode(loole paeen) DrillingMode== .true. + !write(*,*) 'Drilling Mode' + + !if ( MudIsChanged== .true. ) then + ! call RemoveAnnulusMudArrays(iLoc) + !endif + !write(*,*) 'before' ,'Ann_Volume%Array(1)=' , Ann_MudDischarged_Volume%Array(1) + + + !NewDensity= (St_Density%Last() * AnnulusFlowRate + 141.4296E-4*Rate_of_Penetration*Diameter_of_Bit**2)/(AnnulusFlowRate+6.7995E-4*Rate_of_Penetration*Diameter_of_Bit**2) + + NewDensity= St_Density%Last() + + + !NewVolume= ((AnnulusFlowRate/60.0d0)*DeltaT_Mudline)+DeltaVolumeOp + !!! Density in ppg, flow rate in gpm, ROP in ft/s, bit diameter in inch + + + do imud=1, Op_MudDischarged_Volume%Length() + if ( Op_MudOrKick%Array(imud) == 0 ) then + Op_Density%Array(imud)= NewDensity + + endif + enddo + + + + if (Op_Kick_Saved_Volume > 0.0 .and. Ann_MudOrKick%First() == 0) then + write(*,*) 'Kick influx enters Annulus first time' + !write(*,*) 'Saved_Op_MudOrKick=',Saved_Op_MudOrKick + call Ann_Density%AddToFirst (Op_KickSaved_Density) + call Ann_MudDischarged_Volume%AddToFirst (Op_Kick_Saved_Volume) + call Ann_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) + call Ann_Mud_Forehead_section%AddToFirst (F_StringIntervalCounts+1) + call Ann_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) + call Ann_Mud_Backhead_section%AddToFirst (F_StringIntervalCounts+1) + call Ann_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Ann_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Ann_MudOrKick%AddToFirst (Saved_Op_MudOrKick) !<<<<<<<< + call Ann_CuttingMud%AddToFirst (0) + elseif (Op_Kick_Saved_Volume > 0.0 .and. Ann_MudOrKick%First() /= 0) then + Ann_MudDischarged_Volume%Array(1)= Ann_MudDischarged_Volume%Array(1) + Op_Kick_Saved_Volume + endif + + + if (Op_Saved_MudDischarged_Volume> 0.0) then + !write(*,*) 'Op_Saved_Mud added' + NewDensity= NewDensity !(drilling density) + NewVolume= Op_Saved_MudDischarged_Volume + DeltaVolumeOp ! (DeltaVolumeOp: for Cuttings Volume) + !write(*,*) 'NewVolume=' , NewVolume + !write(*,*) 'iloc=' , iloc,'Ann_MudDischarged_Volume%Array(1)=' , Ann_MudDischarged_Volume%Array(1) + + if ( (Ann_CuttingMud%Array(iloc)==1 .and. abs(Ann_Density%Array(iLoc)-NewDensity)< CuttingDensityMixTol ) & + .or. (Ann_CuttingMud%Array(iLoc)==0 .and. Ann_MudDischarged_Volume%Array(iLoc) < 42.) ) then ! 1-Pockets are Merged + + Ann_Density%Array(iLoc)= (Ann_Density%Array(iLoc)*Ann_MudDischarged_Volume%Array(iLoc)+NewDensity*NewVolume)/(Ann_MudDischarged_Volume%Array(iLoc)+NewVolume) + Ann_MudDischarged_Volume%Array(iLoc)= Ann_MudDischarged_Volume%Array(iLoc)+NewVolume + Ann_Mud_Forehead_X%Array(iLoc)= BackheadX + Ann_Mud_Forehead_section%Array(iLoc)= MudSection + Ann_Mud_Backhead_X%Array(iLoc)= BackheadX + Ann_Mud_Backhead_section%Array(iLoc)= MudSection + Ann_RemainedVolume_in_LastSection%Array(iLoc)= (0.0d0) + Ann_EmptyVolume_inBackheadLocation%Array(iLoc)= (0.0d0) + Ann_CuttingMud%Array(iLoc)= 1 + !write(*,*) 'merge' ,'Ann_Volume%Array(1)=' , Ann_MudDischarged_Volume%Array(1) + + else ! 2-Merging conditions are not meeted, so new pocket + !write(*,*) 'before e) ', iloc, Ann_Density%Array(iLoc),NewDensity + !write(*,*) 'before e) Ann_MudDischarged_Volume%Array(iLoc)=' , Ann_MudDischarged_Volume%Array(iLoc) + + + call Ann_Density%AddTo (iLoc,NewDensity) + call Ann_MudDischarged_Volume%AddTo (iLoc,NewVolume) + call Ann_Mud_Forehead_X%AddTo (iLoc,BackheadX) + call Ann_Mud_Forehead_section%AddTo (iLoc,MudSection) + call Ann_Mud_Backhead_X%AddTo (iLoc,BackheadX) + call Ann_Mud_Backhead_section%AddTo (iLoc,MudSection) + call Ann_RemainedVolume_in_LastSection%AddTo (iLoc,0.0d0) + call Ann_EmptyVolume_inBackheadLocation%AddTo (iLoc,0.0d0) + call Ann_MudOrKick%AddTo (iLoc,0) + call Ann_CuttingMud%AddTo (iLoc,1) ! 1= cutting 0= mud + !write(*,*) 'new' ,'Ann_Volume%Array(1)=' , Ann_MudDischarged_Volume%Array(1) + + !write(*,*) 'e) annLength=' , Ann_Density%Length() + + + endif + + + endif + + endif +!=================================================================== + + !write(*,*) 'after add to ann==' + ! + ! do imud=1, Op_MudDischarged_Volume%Length() + ! write(*,*) 'Op:', imud, Op_MudDischarged_Volume%Array(imud), Op_Density%Array(imud) ,Op_MudOrKick%Array(imud) + ! enddo + ! + ! do imud=1, Ann_MudDischarged_Volume%Length() + ! write(*,*) 'Ann:', imud, Ann_MudDischarged_Volume%Array(imud), Ann_Density%Array(imud) ,Ann_MudOrKick%Array(imud) + ! enddo + ! + !write(*,*) '==after add to ann' + + NewVolume= ((AnnulusFlowRate/60.d0)*DeltaT_Mudline) - Op_Saved_MudDischarged_Volume + + if (iloc==2 .and. Op_MudOrKick%Last()==0 .and. NewVolume > 0.d0 ) then ! for avoid kick separation + !write(*,*) 'avoid kick separation' + + + NewDensity= Op_MudSaved_Density + + call RemoveOpMudArrays(Op_Density%Length()) ! mud here is removed and then will be added to iloc=2 in Ann + if ( Ann_MudDischarged_Volume%Array(1) > ((AnnulusFlowRate/60.d0)*DeltaT_Mudline)- Op_Saved_MudDischarged_Volume) then! 1st in Ann = kick + !write(*,*) 'mode1' + Ann_MudDischarged_Volume%Array(1)= Ann_MudDischarged_Volume%Array(1) - (((AnnulusFlowRate/60.d0)*DeltaT_Mudline) -Op_Saved_MudDischarged_Volume) + Op_MudDischarged_Volume%Array(Op_Density%Length())= Op_MudDischarged_Volume%Array(Op_Density%Length())+ (((AnnulusFlowRate/60.d0)*DeltaT_Mudline) - Op_Saved_MudDischarged_Volume) !kick + else + call RemoveAnnulusMudArrays(1) !kick is removed + iloc= 1 + Op_MudDischarged_Volume%Array(Op_Density%Length())= Op_MudDischarged_Volume%Array(Op_Density%Length())+ (((AnnulusFlowRate/60.d0)*DeltaT_Mudline) - Op_Saved_MudDischarged_Volume) + !write(*,*) 'mode2' + + ! including a little expand + endif + + + if ((Rate_of_Penetration==0 .and. abs(Ann_Density%Array(iLoc)-NewDensity)< DensityMixTol) & + .or. (Rate_of_Penetration>0. .and. Ann_CuttingMud%Array(iLoc)==1 .and. abs(Ann_Density%Array(iLoc)-NewDensity)< CuttingDensityMixTol) & + .or. (Rate_of_Penetration>0. .and. Ann_CuttingMud%Array(iLoc)==0 .and. Ann_MudDischarged_Volume%Array(iLoc) < 42.) ) then ! 1-Pockets are Merged + + Ann_Density%Array(iLoc)= (Ann_Density%Array(iLoc)*Ann_MudDischarged_Volume%Array(iLoc)+NewDensity*NewVolume)/(Ann_MudDischarged_Volume%Array(iLoc)+NewVolume) + Ann_MudDischarged_Volume%Array(iLoc)= Ann_MudDischarged_Volume%Array(iLoc)+NewVolume + Ann_Mud_Forehead_X%Array(iLoc)= BackheadX + Ann_Mud_Forehead_section%Array(iLoc)= MudSection + Ann_Mud_Backhead_X%Array(iLoc)= BackheadX + Ann_Mud_Backhead_section%Array(iLoc)= MudSection + Ann_RemainedVolume_in_LastSection%Array(iLoc)= (0.0d0) + Ann_EmptyVolume_inBackheadLocation%Array(iLoc)= (0.0d0) + else ! 2-Merging conditions are not meeted, so new pocket + call Ann_Density%AddTo (iLoc,NewDensity) + call Ann_MudDischarged_Volume%AddTo (iLoc,NewVolume) + call Ann_Mud_Forehead_X%AddTo (iLoc,BackheadX) + call Ann_Mud_Forehead_section%AddTo (iLoc,MudSection) + call Ann_Mud_Backhead_X%AddTo (iLoc,BackheadX) + call Ann_Mud_Backhead_section%AddTo (iLoc,MudSection) + call Ann_RemainedVolume_in_LastSection%AddTo (iLoc,0.0d0) + call Ann_EmptyVolume_inBackheadLocation%AddTo (iLoc,0.0d0) + call Ann_MudOrKick%AddTo (iLoc,0) + call Ann_CuttingMud%AddTo (iLoc,0) + !write(*,*) 'd) annLength=' , Ann_Density%Length() + + endif + + + endif +!=================================================================== + if( Op_MudOrKick%Last() == 1 .and. Ann_MudOrKick%First() == 0 ) then + + write(*,*) '***error2****==' + + write(*,*) 'Op_Kick_Saved_Volume,Op_Saved_MudDischarged_Volume=' , Op_Kick_Saved_Volume,Op_Saved_MudDischarged_Volume + + + write(*,*) 'after add to ann==' + + do imud=1, Op_MudDischarged_Volume%Length() + write(*,*) 'Op:', imud, Op_MudDischarged_Volume%Array(imud), Op_Density%Array(imud) ,Op_MudOrKick%Array(imud) + enddo + + do imud=1, Ann_MudDischarged_Volume%Length() + write(*,*) 'Ann:', imud, Ann_MudDischarged_Volume%Array(imud), Ann_Density%Array(imud) ,Ann_MudOrKick%Array(imud) + enddo + + write(*,*) '==after add to ann' + + write(*,*) 'NewVolume,Op_MudOrKick%Last=' , NewVolume,Op_MudOrKick%Last() + write(*,*) '==***error2****' + + endif + + + + + +!=============== save Ann Mud data to transfer to the ChokeLine enterance + AnnMudVolumeSum= 0.d0 + !Ann_MudSaved_Density= 0.d0 + !Ann_KickSaved_Density= 0.d0 + Ann_Saved_MudDischarged_Volume= 0.d0 + Ann_Kick_Saved_Volume= 0.d0 + Saved_Ann_MudOrKick= 0 + Ann_to_Choke_2mud= .false. + + + + + do imud=1, Ann_MudDischarged_Volume%Length() + + AnnMudVolumeSum= AnnMudVolumeSum + Ann_MudDischarged_Volume%Array(imud) + + if ( AnnMudVolumeSum > sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) ) then + + IF (Ann_MudOrKick%Array(imud) == 0) THEN + Ann_MudSaved_Density = Ann_Density%Array(imud) + Ann_Saved_MudDischarged_Volume = AnnMudVolumeSum - sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + ELSEIF (Ann_MudOrKick%Array(imud) > 0 .AND. Ann_MudOrKick%Array(imud) <100) THEN ! 104= AIR + Ann_Kick_Saved_Volume = AnnMudVolumeSum - sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + Saved_Ann_MudOrKick= Ann_MudOrKick%Array (imud) + Ann_KickSaved_Density= Ann_Density%Array(imud) + END IF + + do ii= imud + 1, Ann_MudDischarged_Volume%Length() + IF (Ann_MudOrKick%Array(ii) == 0) THEN + Ann_MudSaved_Density = ((Ann_MudSaved_Density * Ann_Saved_MudDischarged_Volume) + (Ann_Density%Array(ii) * Ann_MudDischarged_Volume%Array(ii))) / (Ann_Saved_MudDischarged_Volume + Ann_MudDischarged_Volume%Array(ii)) + Ann_Saved_MudDischarged_Volume = Ann_Saved_MudDischarged_Volume + Ann_MudDischarged_Volume%Array(ii) + Ann_to_Choke_2mud= .true. + ELSEIF (Ann_MudOrKick%Array(ii) > 0 .AND. Ann_MudOrKick%Array(ii) <100) THEN ! 104= AIR + Ann_Kick_Saved_Volume = Ann_Kick_Saved_Volume + Ann_MudDischarged_Volume%Array(ii) + Saved_Ann_MudOrKick= Ann_MudOrKick%Array (ii) + Ann_KickSaved_Density= Ann_Density%Array(ii) + END IF + enddo + + + !WRITE (*,*) 'Ann_Saved_Mud_Volume, Ann_Kick_Saved_Volume', Ann_Saved_MudDischarged_Volume, Ann_Kick_Saved_Volume + exit + + endif + + enddo +Ann_Saved_MudDischarged_Volume_Final= Ann_Saved_MudDischarged_Volume !+ Ann_Kick_Saved_Volume +Ann_Kick_Saved_Volume_Final= Ann_Kick_Saved_Volume +IF (WellHeadIsOpen) MudVolume_InjectedFromAnn = Ann_Saved_MudDischarged_Volume_Final -((Qlost/60.0d0)*DeltaT_Mudline) +!WRITE (*,*) 'MudVolume_InjectedFromAnn=', MudVolume_InjectedFromAnn +!====================================================================== + + !write(*,*) 'c)Ann_Mud sum=' , sum(Ann_MudDischarged_Volume%Array(:)) + !write(*,*) 'Ann cap=' , sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + !write(*,*) 'Ann_Saved_Mud=' , Ann_Saved_MudDischarged_Volume + + total_injected = total_injected + MudVolume_InjectedFromAnn + + if (ChokePanelStrokeResetSwitch == 1) then + total_injected= 0. + endif + + !write(*,*) ' total injected-tripin =' , total_injected + !write(*,*) 'injected-tripin =' , MudVolume_InjectedFromAnn + + + + + +!======================== Annulus ==================== + + !MudIsChanged= .false. + +imud= 0 + + do while (imud < Ann_Mud_Forehead_X%Length()) + imud = imud + 1 + + if (imud> 1) then + Ann_Mud_Backhead_X%Array(imud)= Ann_Mud_Forehead_X%Array(imud-1) + Ann_Mud_Backhead_section%Array(imud)= Ann_Mud_Forehead_section%Array(imud-1) + endif + + + +! <<< Fracture Shoe Lost + IF ( ShoeLost .and. ShoeDepth < Ann_Mud_Backhead_X%Array(imud) .and. ShoeDepth >= Ann_Mud_Forehead_X%Array(imud) ) then + !write(*,*) 'ShoeLost imud,AnnVolume(imud), VolumeLost:' , imud,Ann_MudDischarged_Volume%Array(imud), (( Qlost/60.0d0)*DeltaT_Mudline) + Ann_MudDischarged_Volume%Array(imud)= Ann_MudDischarged_Volume%Array(imud)-((Qlost/60.0d0)*DeltaT_Mudline) !(gal) + if (Ann_MudDischarged_Volume%Array(imud) < 0.0) then + !write(*,*) 'mud is removed by shoe lost, imud=' , imud + call RemoveAnnulusMudArrays(imud) + imud= imud-1 + cycle + endif + + ENDIF +! Fracture Shoe Lost >>> + + + DirectionCoef= (Xend_PipeSection(Ann_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(Ann_Mud_Backhead_section%Array(imud))) & + / ABS(Xend_PipeSection(Ann_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(Ann_Mud_Backhead_section%Array(imud))) + ! +1 for string , -1 for annulus + + + Ann_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (Xend_PipeSection(Ann_Mud_Backhead_section%Array(imud))- Ann_Mud_Backhead_X%Array(imud))* & + Area_PipeSectionFt(Ann_Mud_Backhead_section%Array(imud)) !(ft^3) + Ann_EmptyVolume_inBackheadLocation%Array(imud)= Ann_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal + + + if ( Ann_MudDischarged_Volume%Array(imud) <= Ann_EmptyVolume_inBackheadLocation%Array(imud)) then + Ann_Mud_Forehead_section%Array(imud)= Ann_Mud_Backhead_section%Array(imud) + Ann_Mud_Forehead_X%Array(imud)= Ann_Mud_Backhead_X%Array(imud)+ DirectionCoef*(Ann_MudDischarged_Volume%Array(imud)/7.48051948d0)/Area_PipeSectionFt(Ann_Mud_Backhead_section%Array(imud)) + ! 7.48 is for gal to ft^3 + + else + + isection= Ann_Mud_Backhead_section%Array(imud)+1 + Ann_RemainedVolume_in_LastSection%Array(imud)= Ann_MudDischarged_Volume%Array(imud)- Ann_EmptyVolume_inBackheadLocation%Array(imud) + + do + if (isection > NoPipeSections) then ! last pipe section(well exit) + Ann_MudDischarged_Volume%Array(imud)= Ann_MudDischarged_Volume%Array(imud)- Ann_RemainedVolume_in_LastSection%Array(imud) + Ann_Mud_Forehead_X%Array(imud)= Xend_PipeSection(NoPipeSections) + Ann_Mud_Forehead_section%Array(imud)= NoPipeSections + + if (Ann_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the well + !write(*,*) 'remove******' + call RemoveAnnulusMudArrays(imud) + endif + exit + endif + + xx= Ann_RemainedVolume_in_LastSection%Array(imud)/ PipeSection_VolumeCapacity(isection) !(gal) + + if (xx<= 1.0) then + Ann_Mud_Forehead_section%Array(imud)= isection + Ann_Mud_Forehead_X%Array(imud)= (xx * (Xend_PipeSection(isection)- Xstart_PipeSection(isection)))+ Xstart_PipeSection(isection) + exit + else + Ann_RemainedVolume_in_LastSection%Array(imud)= Ann_RemainedVolume_in_LastSection%Array(imud)- PipeSection_VolumeCapacity(isection) + isection= isection+ 1 + + endif + + enddo + + endif +! write(*,*) 'imud=' , imud +!write(*,*) 'Pinter4 **Ann_Length()=' , Ann_Mud_Forehead_X%Length() +! write(*,*) 'Ann_Density%Array (imud)=' , Ann_Density%Array (imud) +! +! +!write(*,*) imud,'Ann_Mud_Forehead_X%Array(imud)=' , Ann_Mud_Forehead_X%Array(imud) + + !if (Ann_Mud_Forehead_X%Array(imud) < Xend_PipeSection(NoPipeSections)) then + ! Ann_Mud_Forehead_X%Array(imud) = Xend_PipeSection(NoPipeSections) ! for error preventing + !endif + + !write(*,*) imud, 'Ann_MudDischarged_Volume%Array(imud)=' , Ann_MudDischarged_Volume%Array(imud), Ann_Density%Array(imud) + + + enddo + + if (Ann_Mud_Forehead_X%Last() < Xend_PipeSection(NoPipeSections)) then + Ann_Mud_Forehead_X%Array(Ann_Mud_Forehead_X%Length()) = Xend_PipeSection(NoPipeSections) ! for error preventing + endif + +!========================ANNULUS END================= + !write(*,*) 'sum(Ann_MudDischarged_Volume%Array())=' , sum(Ann_MudDischarged_Volume%Array(:)) + +!========================================================= + + + !write(*,*) 'before======2' + ! + ! do imud=1, Op_MudDischarged_Volume%Length() + ! write(*,*) 'Op:', imud, Op_MudDischarged_Volume%Array(imud), Op_Density%Array(imud) ,Op_MudOrKick%Array(imud) + ! enddo + !write(*,*) '2======before' + + +!========================Bottom Hole================= +imud=0 + do while (imud < Op_Mud_Forehead_X%Length()) + imud = imud + 1 + + if (imud> 1) then + Op_Mud_Backhead_X%Array(imud)= Op_Mud_Forehead_X%Array(imud-1) + Op_Mud_Backhead_section%Array(imud)= Op_Mud_Forehead_section%Array(imud-1) + endif + !write(*,*) 'imud**=' , imud + DirectionCoef= (Xend_OpSection(Op_Mud_Backhead_section%Array(imud))-Xstart_OpSection(Op_Mud_Backhead_section%Array(imud))) & + / ABS(Xend_OpSection(Op_Mud_Backhead_section%Array(imud))-Xstart_OpSection(Op_Mud_Backhead_section%Array(imud))) + ! +1 for string , -1 for annulus + + + Op_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (Xend_OpSection(Op_Mud_Backhead_section%Array(imud))- Op_Mud_Backhead_X%Array(imud))* & + Area_OpSectionFt(Op_Mud_Backhead_section%Array(imud)) !(ft^3) + Op_EmptyVolume_inBackheadLocation%Array(imud)= Op_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal + !write(*,*) ' Op_EmptyVolume_inBackheadLocation%Array(1) =' , Op_EmptyVolume_inBackheadLocation%Array(1) + if ( Op_EmptyVolume_inBackheadLocation%Array(1) < 0.0) CALL ErrorStop1 ('Negative Empty volume') + + if ( Op_MudDischarged_Volume%Array(imud) <= Op_EmptyVolume_inBackheadLocation%Array(imud)) then + Op_Mud_Forehead_section%Array(imud)= Op_Mud_Backhead_section%Array(imud) + Op_Mud_Forehead_X%Array(imud)= Op_Mud_Backhead_X%Array(imud)+ DirectionCoef*(Op_MudDischarged_Volume%Array(imud)/7.48051948d0)/Area_OpSectionFt(Op_Mud_Backhead_section%Array(imud)) + ! 7.48 is for gal to ft^3 + + else + + + isection= Op_Mud_Backhead_section%Array(imud)+1 + Op_RemainedVolume_in_LastSection%Array(imud)= Op_MudDischarged_Volume%Array(imud)- Op_EmptyVolume_inBackheadLocation%Array(imud) + + do + if (isection > F_BottomHoleIntervalCounts) then ! last pipe section(well exit) + !if( imud==1) KickDeltaVinAnnulus= Op_RemainedVolume_in_LastSection%Array(imud) ! Kick enters Annulus space + Op_MudDischarged_Volume%Array(imud)= Op_MudDischarged_Volume%Array(imud)- Op_RemainedVolume_in_LastSection%Array(imud) + Op_Mud_Forehead_X%Array(imud)= Xend_OpSection(F_BottomHoleIntervalCounts) + Op_Mud_Forehead_section%Array(imud)= F_BottomHoleIntervalCounts + + if (Op_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the well + call RemoveOpMudArrays(imud) + endif + + exit + endif + + xx= Op_RemainedVolume_in_LastSection%Array(imud)/ OpSection_VolumeCapacity(isection) !(gal) + + if (xx<= 1.0) then + Op_Mud_Forehead_section%Array(imud)= isection + Op_Mud_Forehead_X%Array(imud)= (xx * (Xend_OpSection(isection)- Xstart_OpSection(isection)))+ Xstart_OpSection(isection) + exit + else + Op_RemainedVolume_in_LastSection%Array(imud)= Op_RemainedVolume_in_LastSection%Array(imud)- OpSection_VolumeCapacity(isection) + isection= isection+ 1 + + endif + + enddo + + endif +! for OP remove: + + if (Op_Mud_Forehead_X%Array(imud)== Xend_OpSection(F_BottomHoleIntervalCounts)) then + totalLength = Op_MudDischarged_Volume%Length() + do while(imud < totalLength) + + !imud = imud + 1 + call RemoveOpMudArrays(totalLength) + totalLength = totalLength - 1 + + + enddo + + exit ! + + endif + + + + + !if (Op_Mud_Forehead_X%Array(imud)== Xend_OpSection(F_BottomHoleIntervalCounts)) then + ! totalLength = Op_MudDischarged_Volume%Length() + ! do while(imud <= totalLength) + ! + ! imud = imud + 1 + ! call RemoveOpMudArrays(imud) + ! totalLength = totalLength - 1 + ! + ! + ! enddo + ! + ! exit ! + ! + !endif + + enddo + + !write(*,*) 'OpSection_VolumeCapacity sum=' , sum(OpSection_VolumeCapacity(:)) + + + +!========================Bottom Hole END================= + + + !write(*,*) 'after sorting==' + ! + ! do imud=1, Op_MudDischarged_Volume%Length() + ! write(*,*) 'Op:', imud, Op_MudDischarged_Volume%Array(imud), Op_Density%Array(imud) ,Op_MudOrKick%Array(imud) + ! enddo + ! + ! do imud=1, Ann_MudDischarged_Volume%Length() + ! write(*,*) 'Ann:', imud, Ann_MudDischarged_Volume%Array(imud), Ann_Density%Array(imud) ,Ann_MudOrKick%Array(imud) + ! enddo + ! + ! ! + ! !do imud=1, st_MudDischarged_Volume%Length() + ! ! write(*,*) 'st:', imud, St_MudDischarged_Volume%Array(imud), St_Mud_Backhead_X%Array(imud) ,St_Mud_Forehead_X%Array(imud) + ! !enddo + ! + !write(*,*) '==after sorting' + + + ! write(*,*) 'after sorting st==' + ! + ! do imud=1, st_MudDischarged_Volume%Length() + ! write(*,*) 'st-plot:', imud, St_MudDischarged_Volume%Array(imud), St_Mud_Backhead_X%Array(imud) ,St_Mud_Forehead_X%Array(imud),St_Density%Array(imud) + ! enddo + ! + !write(*,*) '==after sorting st' + + + + + !write(*,*) '**Ann_Kick_Saved_Final,Mud_InjectedFromAnn' , Ann_Kick_Saved_Volume_Final,MudVolume_InjectedFromAnn + + end subroutine Pump_and_TripIn + + + + + + + + + + + + subroutine ChokeLineMud ! is called in subroutine CirculationCodeSelect + + Use GeoElements_FluidModule + USE CMudPropertiesVariables + USE MudSystemVARIABLES + USE Pump_VARIABLES + !USE CHOKEVARIABLES + !USE CDataDisplayConsoleVariables , StandPipePressureDataDisplay=>StandPipePressure + !use CManifolds + use CDrillWatchVariables + !use CHOKEVARIABLES + !use CChokeManifoldVariables + use CTanksVariables, TripTankVolume2 => TripTankVolume, TripTankDensity2 => TripTankDensity + USE sROP_Other_Variables + USE sROP_Variables + Use KickVariables + USE PressureDisplayVARIABLES + Use CError + Use , intrinsic :: IEEE_Arithmetic + + + implicit none + + integer i,ii,error_occured + + error_occured = 0 + + + + + !write(*,*) 'begining chokeline==' + !write(*,*) 'Ann last:', Ann_MudDischarged_Volume%Last(), Ann_Density%Last() ,Ann_MudOrKick%Last() + ! + !do imud=1, ChokeLine_MudDischarged_Volume%Length() + ! write(*,*) 'ChokeLine:', imud, ChokeLine_MudDischarged_Volume%Array(imud), ChokeLine_Density%Array(imud) ,ChokeLine_MudOrKick%Array(imud) + !enddo + + + + !write(*,*) 'Ann_Kick_Saved_Volume_Final,MudVolume_InjectedFromAnn' , Ann_Kick_Saved_Volume_Final,MudVolume_InjectedFromAnn + + !write(*,*) 'begining chokeline==' + + + + + + + + ChokeLineFlowRate = MUD(4)%Q + !WRITE (*,*) 'MUD(4)%Q', MUD(4)%Q + + + if (NewPipeFilling == 0) then ! .or. UtubeFilling==0) then + ChokeLineFlowRate= 0. + endif + + + do imud=1, ChokeLine_MudDischarged_Volume%Length()-2 + if ( ChokeLine_MudOrKick%Array(imud) ==1 .and. ChokeLine_MudOrKick%Array(imud+1) ==0 .and. ChokeLine_MudOrKick%Array(imud+2) ==1 ) then + write(*,*) 'error_location is 1' + error_occured = 1 + endif + enddo + + + + ! + !do imud=1, st_MudDischarged_Volume%Length() + ! write(*,*) 'st:', imud, St_MudDischarged_Volume%Array(imud), St_Mud_Backhead_X%Array(imud) ,St_Mud_Forehead_X%Array(imud) + !enddo + + + !========================CHOKE LINE ENTRANCE================= + + !if ( Ann_Kick_Saved_Volume > 0.0 .and. ( Ann_Saved_MudDischarged_Volume-((Qlost/60.0d0)*DeltaT_Mudline) ) == 0.0 ) then + if ( Ann_Kick_Saved_Volume > 1.0e-5 .and. ( MudVolume_InjectedFromAnn ) <= 1.0e-5 ) then + + !WRITE (*,*) 'only kick enters to chokeline, Casing pressure = ', PressureGauges(2) + + if (ChokeLine_MudOrKick%First() == 0) then + call ChokeLine_Density%AddToFirst (Ann_KickSaved_Density) + call ChokeLine_MudDischarged_Volume%AddToFirst (0.d0) + call ChokeLine_Mud_Forehead_X%AddToFirst (0.0d0) + call ChokeLine_Mud_Forehead_section%AddToFirst (1) + call ChokeLine_Mud_Backhead_X%AddToFirst (0.0d0) + call ChokeLine_Mud_Backhead_section%AddToFirst (1) + call ChokeLine_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call ChokeLine_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call ChokeLine_MudOrKick%AddToFirst (Saved_Ann_MudOrKick) + + ChokeLineDensity_Old= Ann_KickSaved_Density + + endif + + ChokeLine_MudDischarged_Volume%Array(1)= ChokeLine_MudDischarged_Volume%Array(1)+ Ann_Kick_Saved_Volume !(gal) + + endif + + + do imud=1, ChokeLine_MudDischarged_Volume%Length()-2 + if ( ChokeLine_MudOrKick%Array(imud) ==1 .and. ChokeLine_MudOrKick%Array(imud+1) ==0 .and. ChokeLine_MudOrKick%Array(imud+2) ==1 ) then + write(*,*) 'error_location is 2' + + error_occured = 1 + + endif + enddo + + + + !if ( Ann_Kick_Saved_Volume == 0.0 .and. ( Ann_Saved_MudDischarged_Volume - ((Qlost/60.0d0)*DeltaT_Mudline) ) > 0.0 ) then + if ( Ann_Kick_Saved_Volume <= 1.0e-5 .and. MudVolume_InjectedFromAnn > 1.0e-5 ) then + + !WRITE (*,*) 'only mud enters to chokeline' + + + if ((Ann_to_Choke_2mud == .false. .and. ABS(ChokeLineDensity_Old - Ann_MudSaved_Density) >= DensityMixTol) .or. ChokeLine_MudOrKick%First() /= 0) then ! new mud is pumped + call ChokeLine_Density%AddToFirst (Ann_MudSaved_Density) + call ChokeLine_MudDischarged_Volume%AddToFirst (0.0d0) + call ChokeLine_Mud_Forehead_X%AddToFirst (0.0d0) + call ChokeLine_Mud_Forehead_section%AddToFirst (1) + call ChokeLine_Mud_Backhead_X%AddToFirst (0.0d0) + call ChokeLine_Mud_Backhead_section%AddToFirst (1) + call ChokeLine_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call ChokeLine_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call ChokeLine_MudOrKick%AddToFirst (0) + + ChokeLineDensity_Old= Ann_MudSaved_Density + endif + + !ChokeLine_MudDischarged_Volume%Array(1)= ChokeLine_MudDischarged_Volume%Array(1)+ (Ann_Saved_MudDischarged_Volume - ((Qlost/60.0d0)*DeltaT_Mudline) ) !(gal) + ChokeLine_MudDischarged_Volume%Array(1)= ChokeLine_MudDischarged_Volume%Array(1)+ (MudVolume_InjectedFromAnn) !(gal) + + + + endif + + + + do imud=1, ChokeLine_MudDischarged_Volume%Length()-2 + if ( ChokeLine_MudOrKick%Array(imud) ==1 .and. ChokeLine_MudOrKick%Array(imud+1) ==0 .and. ChokeLine_MudOrKick%Array(imud+2) ==1 ) then + write(*,*) 'error_location is 3' + error_occured = 1 + + endif + enddo + + + !if ( Ann_Kick_Saved_Volume > 0.0 .and. (Ann_Saved_MudDischarged_Volume - ((Qlost/60.0d0)*DeltaT_Mudline) ) > 0.0 .and. ChokeLine_MudOrKick%First() /= 0 ) then + if ( Ann_Kick_Saved_Volume > 1.0e-5 .and. (MudVolume_InjectedFromAnn) > 1.0e-5 .and. ChokeLine_MudOrKick%First() /= 0 ) then + + WRITE (*,*) 'Kick Enters Choke line Last Time' + + ChokeLine_MudDischarged_Volume%Array(1)= ChokeLine_MudDischarged_Volume%Array(1)+ Ann_Kick_Saved_Volume !(gal) + + + + call ChokeLine_Density%AddToFirst (Ann_MudSaved_Density) + !call ChokeLine_MudDischarged_Volume%AddToFirst (Ann_Saved_MudDischarged_Volume - ((Qlost/60.0d0)*DeltaT_Mudline) ) + call ChokeLine_MudDischarged_Volume%AddToFirst (MudVolume_InjectedFromAnn) + call ChokeLine_Mud_Forehead_X%AddToFirst (0.0d0) + call ChokeLine_Mud_Forehead_section%AddToFirst (1) + call ChokeLine_Mud_Backhead_X%AddToFirst (0.0d0) + call ChokeLine_Mud_Backhead_section%AddToFirst (1) + call ChokeLine_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call ChokeLine_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call ChokeLine_MudOrKick%AddToFirst (0) + + ChokeLineDensity_Old= Ann_MudSaved_Density + + + + + + !ELSE if ( Ann_Kick_Saved_Volume > 0.0 .and. ( Ann_Saved_MudDischarged_Volume - ((Qlost/60.0d0)*DeltaT_Mudline) ) > 0.0 .and. ChokeLine_MudOrKick%First() == 0 ) then + ELSE if ( Ann_Kick_Saved_Volume > 1.0e-5 .and. ( MudVolume_InjectedFromAnn ) > 1.0e-5 .and. ChokeLine_MudOrKick%First() == 0 ) then + WRITE (*,*) 'Kick Enters Choke line First Time' + + + + !ChokeLine_MudDischarged_Volume%Array(1)= ChokeLine_MudDischarged_Volume%Array(1)+ ( Ann_Saved_MudDischarged_Volume - ((Qlost/60.0d0)*DeltaT_Mudline) ) !(gal) + ChokeLine_MudDischarged_Volume%Array(1)= ChokeLine_MudDischarged_Volume%Array(1)+ ( MudVolume_InjectedFromAnn ) !(gal) + + + + + call ChokeLine_Density%AddToFirst (Ann_KickSaved_Density) + call ChokeLine_MudDischarged_Volume%AddToFirst (Ann_Kick_Saved_Volume) + call ChokeLine_Mud_Forehead_X%AddToFirst (0.0d0) + call ChokeLine_Mud_Forehead_section%AddToFirst (1) + call ChokeLine_Mud_Backhead_X%AddToFirst (0.0d0) + call ChokeLine_Mud_Backhead_section%AddToFirst (1) + call ChokeLine_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call ChokeLine_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call ChokeLine_MudOrKick%AddToFirst (Saved_Ann_MudOrKick) + + ChokeLineDensity_Old= Ann_KickSaved_Density + + + endif + + do imud=1, ChokeLine_MudDischarged_Volume%Length()-2 + if ( ChokeLine_MudOrKick%Array(imud) ==1 .and. ChokeLine_MudOrKick%Array(imud+1) ==0 .and. ChokeLine_MudOrKick%Array(imud+2) ==1 ) then + write(*,*) 'error_location is 4' + error_occured = 1 + + endif + enddo + + if (error_occured == 1) then + + do imud=1, ChokeLine_MudDischarged_Volume%Length() + write(*,*) 'ChokeLine:', imud, ChokeLine_Density%Array(imud) ,ChokeLine_MudOrKick%Array(imud) + enddo + + endif + + +!========================================================== + + ! + !write(*,*) 'after add chokeline==' + ! + ! do imud=1, ChokeLine_MudDischarged_Volume%Length() + ! write(*,*) 'ChokeLine:', imud, ChokeLine_MudDischarged_Volume%Array(imud), ChokeLine_Density%Array(imud) ,ChokeLine_MudOrKick%Array(imud) + ! enddo + ! + !write(*,*) 'after add chokeline==' + ! + ! + + +!=============== save Choke Mud data========================== + ChokeMudVolumeSum= 0.d0 + !Ann_MudSaved_Density= 0.d0 + !Ann_KickSaved_Density= 0.d0 + Choke_Saved_MudDischarged_Volume= 0.d0 + Choke_Kick_Saved_Volume= 0.d0 + Saved_Choke_MudOrKick= 0 + + + + + do imud=1, ChokeLine_MudDischarged_Volume%Length() + + ChokeMudVolumeSum= ChokeMudVolumeSum + ChokeLine_MudDischarged_Volume%Array(imud) + + if ( ChokeMudVolumeSum > ChokeLine_VolumeCapacity ) then + + IF (ChokeLine_MudOrKick%Array(imud) == 0) THEN + Choke_MudSaved_Density = ChokeLine_Density%Array(imud) + Choke_Saved_MudDischarged_Volume = ChokeMudVolumeSum - ChokeLine_VolumeCapacity + ELSEIF (ChokeLine_MudOrKick%Array(imud) > 0 .AND. ChokeLine_MudOrKick%Array(imud) <100) THEN ! 104= AIR + Choke_Kick_Saved_Volume = ChokeMudVolumeSum - ChokeLine_VolumeCapacity + Saved_Choke_MudOrKick= ChokeLine_MudOrKick%Array (imud) + Choke_KickSaved_Density= ChokeLine_Density%Array(imud) + END IF + + do ii= imud + 1, ChokeLine_MudDischarged_Volume%Length() + + IF (ChokeLine_MudOrKick%Array(ii) == 0) THEN + Choke_MudSaved_Density = ((Choke_MudSaved_Density * Choke_Saved_MudDischarged_Volume) + (ChokeLine_Density%Array(ii) * ChokeLine_MudDischarged_Volume%Array(ii))) / (Choke_Saved_MudDischarged_Volume + ChokeLine_MudDischarged_Volume%Array(ii)) + Choke_Saved_MudDischarged_Volume = Choke_Saved_MudDischarged_Volume + ChokeLine_MudDischarged_Volume%Array(ii) + ELSEIF (ChokeLine_MudOrKick%Array(ii) > 0 .AND. ChokeLine_MudOrKick%Array(ii) <100) THEN ! 104= AIR + Choke_Kick_Saved_Volume = Choke_Kick_Saved_Volume + ChokeLine_MudDischarged_Volume%Array(ii) + Saved_Choke_MudOrKick= ChokeLine_MudOrKick%Array (ii) + Choke_KickSaved_Density= ChokeLine_Density%Array(ii) + END IF + enddo + + + !WRITE (*,*) 'Choke_Saved_Mud_Volume, Choke_Kick_Saved_Volume', Choke_Saved_MudDischarged_Volume, Choke_Kick_Saved_Volume + exit ! exits do + + endif + + enddo +Choke_Saved_MudDischarged_Volume_Final= Choke_Saved_MudDischarged_Volume !+ Choke_Kick_Saved_Volume +Choke_Kick_Saved_Volume_Final= Choke_Kick_Saved_Volume +!====================================================================== + + + ! + !do imud=1, ChokeLine_MudDischarged_Volume%Length() + ! write(*,*) 'a)ChokeLine:', imud, ChokeLine_MudDischarged_Volume%Array(imud) ,ChokeLine_MudOrKick%Array(imud) + !enddo + + + !write(*,*) 'choke_Mud sum=' , sum(ChokeLine_MudDischarged_Volume%Array(:)) + !write(*,*) 'choke_cap=' , ChokeLine_VolumeCapacity + !write(*,*) 'Choke_Saved_Mud=' , Choke_Saved_MudDischarged_Volume_Final + !write(*,*) 'Choke_Saved_Kick=' , Choke_Kick_Saved_Volume_Final + + + +!========================Choke Line================= + +imud=0 + do while (imud < ChokeLine_Mud_Forehead_X%Length()) + imud = imud + 1 + + if (imud> 1) then + ChokeLine_Mud_Backhead_X%Array(imud)= ChokeLine_Mud_Forehead_X%Array(imud-1) + ChokeLine_Mud_Backhead_section%Array(imud)= ChokeLine_Mud_Forehead_section%Array(imud-1) + endif + + + !DirectionCoef= (Xend_PipeSection(St_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(St_Mud_Backhead_section%Array(imud))) & + ! / ABS(Xend_PipeSection(St_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(St_Mud_Backhead_section%Array(imud))) + ! +1 for string , -1 for annulus + + + ChokeLine_EmptyVolume_inBackheadLocation%Array(imud)= (ChokeLineLength- ChokeLine_Mud_Backhead_X%Array(imud))* Area_ChokeLineFt !(ft^3) + + ChokeLine_EmptyVolume_inBackheadLocation%Array(imud)= ChokeLine_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal + + if ( ChokeLine_MudDischarged_Volume%Array(imud) <= ChokeLine_EmptyVolume_inBackheadLocation%Array(imud)) then + ChokeLine_Mud_Forehead_section%Array(imud)= ChokeLine_Mud_Backhead_section%Array(imud) + ChokeLine_Mud_Forehead_X%Array(imud)= ChokeLine_Mud_Backhead_X%Array(imud)+ (ChokeLine_MudDischarged_Volume%Array(imud)/7.48051948d0)/Area_ChokeLineFt + ! 7.48 is for gal to ft^3 + + else + + isection= ChokeLine_Mud_Backhead_section%Array(imud)+1 + ChokeLine_RemainedVolume_in_LastSection%Array(imud)= ChokeLine_MudDischarged_Volume%Array(imud)- ChokeLine_EmptyVolume_inBackheadLocation%Array(imud) + + do + if (isection > 1) then ! last pipe section(Chokeline exit) + ChokeLine_MudDischarged_Volume%Array(imud)= ChokeLine_MudDischarged_Volume%Array(imud)- ChokeLine_RemainedVolume_in_LastSection%Array(imud) + ChokeLine_Mud_Forehead_X%Array(imud)= ChokeLineLength + ChokeLine_Mud_Forehead_section%Array(imud)= 1 + if (ChokeLine_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the string + call ChokeLine_MudDischarged_Volume%Remove (imud) + call ChokeLine_Mud_Backhead_X%Remove (imud) + call ChokeLine_Mud_Backhead_section%Remove (imud) + call ChokeLine_Mud_Forehead_X%Remove (imud) + call ChokeLine_Mud_Forehead_section%Remove (imud) + call ChokeLine_Density%Remove (imud) + call ChokeLine_RemainedVolume_in_LastSection%Remove (imud) + call ChokeLine_EmptyVolume_inBackheadLocation%Remove (imud) + call ChokeLine_MudOrKick%Remove (imud) + + endif + exit + endif + + xx= ChokeLine_RemainedVolume_in_LastSection%Array(imud)/ ChokeLine_VolumeCapacity !(gal) + + if (xx<= 1.0) then + ChokeLine_Mud_Forehead_section%Array(imud)= isection + ChokeLine_Mud_Forehead_X%Array(imud)= xx * ChokeLineLength + exit + else + ChokeLine_RemainedVolume_in_LastSection%Array(imud)= ChokeLine_RemainedVolume_in_LastSection%Array(imud)- ChokeLine_VolumeCapacity + isection= isection+ 1 + + + endif + + enddo + + endif + + enddo +!========================Choke Line END================= + + !do imud=1, ChokeLine_MudDischarged_Volume%Length() + ! write(*,*) 'b)ChokeLine:', imud, ChokeLine_MudDischarged_Volume%Array(imud) ,ChokeLine_MudOrKick%Array(imud) + !enddo + + ChokeOutletDensity= ChokeLine_Density%Last() ! used in MudSystem + + + + + + do i=1, ChokeLine_MudOrKick%Length() + !write(*,555) i,'Choke_Volume(i), type=' ,ChokeLine_MudDischarged_Volume%Array(i),ChokeLine_MudOrKick%Array(i) + + IF (IEEE_Is_NaN(ChokeLine_MudDischarged_Volume%Array(i))) call ErrorStop('NaN in Choke Volume-Plot') + IF (ChokeLine_MudDischarged_Volume%Array(i)<=0.) call ErrorStop('Choke Volume= <=0' , ChokeLine_MudDischarged_Volume%Array(i)) + enddo + +555 FORMAT(I3,5X,A42,(f12.5),5X,I3) + + + !write(*,*) 'after sorting chokeline==' + !IF (ANY(ChokeLine_MudOrKick%Array(:) > 0)) THEN + ! do imud=1, ChokeLine_MudDischarged_Volume%Length() + ! write(*,*) 'ChokeLine:', imud, ChokeLine_MudDischarged_Volume%Array(imud), ChokeLine_Density%Array(imud) ,ChokeLine_MudOrKick%Array(imud) + ! enddo + !END IF + + + !do imud=1, Ann_MudDischarged_Volume%Length() + ! write(*,*) 'Ann:', imud, Ann_MudDischarged_Volume%Array(imud), Ann_Density%Array(imud) ,Ann_MudOrKick%Array(imud) + !enddo + ! + !write(*,*) 'Ann cap=' , sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + ! write(*,*) 'Ann mud sum vol=' , sum(Ann_MudDischarged_Volume%Array(:)) + + + !write(*,*) '==after sorting chokeline' + + + end subroutine ChokeLineMud + + + + + +subroutine Choke_GasSound ! is called in subroutine CirculationCodeSelect + + +use CSounds + !Use GeoElements_FluidModule + !USE CMudPropertiesVariables + USE MudSystemVARIABLES + !USE Pump_VARIABLES + !!USE CHOKEVARIABLES + !!USE CDataDisplayConsoleVariables , StandPipePressureDataDisplay=>StandPipePressure + !!use CManifolds + !use CDrillWatchVariables + !!use CHOKEVARIABLES + !!use CChokeManifoldVariables + !use CTanksVariables, TripTankVolume2 => TripTankVolume, TripTankDensity2 => TripTankDensity + !USE sROP_Other_Variables + !USE sROP_Variables + !Use KickVariables + !USE PressureDisplayVARIABLES + !Use CError + !Use , intrinsic :: IEEE_Arithmetic + + + + + + if ( ChokeLine_MudOrKick%Last() > 0 .AND. WellToChokeManifoldOpen == .true.) then + !WellToChokeManifoldWasOpen + + SoundGasThroughChoke = 100 !100:chon dar adadhaye kamtar az 100 seda ghaat mishavad. eslah shavad.5.8.98 !int (min(ChokeLineFlowRate/2. , 100.)) + print* , 'SoundGasThroughChoke1=', SoundGasThroughChoke + !WRITE (*,*) 'WellToChokeManifoldWasOpen-Sound', WellToChokeManifoldWasOpen + WRITE (*,*) 'WellToChokeManifoldOpen', WellToChokeManifoldOpen + else + SoundGasThroughChoke = 0 + print* , 'SoundGasThroughChoke2=', SoundGasThroughChoke + endif + !print* , 'SoundGasThroughChoke3=', SoundGasThroughChoke + + + + call SetSoundGasThroughChoke(SoundGasThroughChoke) + + + end subroutine Choke_GasSound \ No newline at end of file diff --git a/Equipments/MudSystem/Trip_Out_andPump.f90 b/Equipments/MudSystem/Trip_Out_andPump.f90 new file mode 100644 index 0000000..18921d2 --- /dev/null +++ b/Equipments/MudSystem/Trip_Out_andPump.f90 @@ -0,0 +1,1366 @@ +subroutine TripOut_and_Pump ! is called in subroutine CirculationCodeSelect + + Use GeoElements_FluidModule + USE CMudPropertiesVariables + USE MudSystemVARIABLES + USE Pump_VARIABLES + !USE CHOKEVARIABLES + !USE CDataDisplayConsoleVariables , StandPipePressureDataDisplay=>StandPipePressure + !use CManifolds + use CDrillWatchVariables + !use CHOKEVARIABLES + !use CChokeManifoldVariables + use CTanksVariables, TripTankVolume2 => TripTankVolume, TripTankDensity2 => TripTankDensity + USE sROP_Other_Variables + USE sROP_Variables + Use KickVariables + Use CShoeVariables + + implicit none + +integer i,ii,AddLocation, iloc_edited, iloc_changedTo2 +Real(8) ExcessMudVolume_Remained,SavedDensityForOp + +!===========================================================WELL============================================================ +!===========================================================WELL============================================================ + + StringFlowRate= MUD(2)%Q + AnnulusFlowRate= MUD(2)%Q + !write(*,*) 'MUD(2)%Q=====' , MUD(2)%Q + + + write(*,*) 'Trip Out' + + ! write(*,*) 'check point 1==' + ! + ! + ! + ! do imud=1, Ann_MudDischarged_Volume%Length() + ! write(*,*) 'Ann:', imud, Ann_MudDischarged_Volume%Array(imud), Ann_Density%Array(imud) ,Ann_MudOrKick%Array(imud) + ! enddo + ! + ! write(*,*) 'Ann cap=' , sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + ! write(*,*) 'Ann mud sum vol=' , sum(Ann_MudDischarged_Volume%Array(:)) + ! + ! + !write(*,*) '==check point 1' + +!========================Horizontal PIPE ENTRANCE================= + + if (ABS(SuctionDensity_Old - Suction_Density_MudSystem) >= DensityMixTol) then ! new mud is pumped + + call Hz_Density%AddToFirst (Suction_Density_MudSystem) + call Hz_MudDischarged_Volume%AddToFirst (0.0d0) + call Hz_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(1)) + call Hz_Mud_Forehead_section%AddToFirst (1) + call Hz_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(1)) + call Hz_Mud_Backhead_section%AddToFirst (1) + call Hz_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Hz_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Hz_MudOrKick%AddToFirst (0) + + SuctionDensity_Old= Suction_Density_MudSystem + endif + +!========================Horizontal PIPE STRING================= + + Hz_MudDischarged_Volume%Array(1)= Hz_MudDischarged_Volume%Array(1)+ ((StringFlowRate/60.0d0)*DeltaT_Mudline) !(gal) + + + total_add = total_add + ((StringFlowRate/60.0d0)*DeltaT_Mudline) + + + if (ChokePanelStrokeResetSwitch == 1) then + total_add= 0. + endif + + !write(*,*) ' total decrease(add to HZ)=' , total_add + !write(*,*) ' add to HZ=' , ((StringFlowRate/60.0d0)*DeltaT_Mudline) + + + +imud=0 + do while (imud < Hz_Mud_Forehead_X%Length()) + imud = imud + 1 + + if (imud> 1) then + Hz_Mud_Backhead_X%Array(imud)= Hz_Mud_Forehead_X%Array(imud-1) + Hz_Mud_Backhead_section%Array(imud)= Hz_Mud_Forehead_section%Array(imud-1) + endif + + + DirectionCoef= (Xend_PipeSection(Hz_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(Hz_Mud_Backhead_section%Array(imud))) & + / ABS(Xend_PipeSection(Hz_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(Hz_Mud_Backhead_section%Array(imud))) + ! +1 for string , -1 for annulus + + + Hz_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (Xend_PipeSection(Hz_Mud_Backhead_section%Array(imud))- Hz_Mud_Backhead_X%Array(imud))* & + Area_PipeSectionFt(Hz_Mud_Backhead_section%Array(imud)) !(ft^3) + Hz_EmptyVolume_inBackheadLocation%Array(imud)= Hz_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal + + + if ( Hz_MudDischarged_Volume%Array(imud) <= Hz_EmptyVolume_inBackheadLocation%Array(imud)) then + Hz_Mud_Forehead_section%Array(imud)= Hz_Mud_Backhead_section%Array(imud) + Hz_Mud_Forehead_X%Array(imud)= Hz_Mud_Backhead_X%Array(imud)+ DirectionCoef*(Hz_MudDischarged_Volume%Array(imud)/7.48051948d0)/Area_PipeSectionFt(Hz_Mud_Backhead_section%Array(imud)) + + else + + + isection= Hz_Mud_Backhead_section%Array(imud)+1 + Hz_RemainedVolume_in_LastSection%Array(imud)= Hz_MudDischarged_Volume%Array(imud)- Hz_EmptyVolume_inBackheadLocation%Array(imud) + + do + if (isection > 1) then ! (horizontal pipe exit) + Hz_MudDischarged_Volume%Array(imud)= Hz_MudDischarged_Volume%Array(imud)- Hz_RemainedVolume_in_LastSection%Array(imud) + Hz_Mud_Forehead_X%Array(imud)= Xend_PipeSection(1) + Hz_Mud_Forehead_section%Array(imud)= 1 + + if (Hz_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the string + call RemoveHzMudArrays(imud) + endif + + exit + endif + + xx= Hz_RemainedVolume_in_LastSection%Array(imud)/ PipeSection_VolumeCapacity(isection) !(gal) + + if (xx<= 1.0) then + Hz_Mud_Forehead_section%Array(imud)= isection + Hz_Mud_Forehead_X%Array(imud)= (xx * (Xend_PipeSection(isection)- Xstart_PipeSection(isection)))+ Xstart_PipeSection(isection) + exit + else + Hz_RemainedVolume_in_LastSection%Array(imud)= Hz_RemainedVolume_in_LastSection%Array(imud)- PipeSection_VolumeCapacity(isection) + isection= isection+ 1 + + endif + + enddo + + endif + + enddo +!========================Horizontal PIPE END================= + + + +!========================Utube1 Air Element Removing================= + + !if (UtubeMode1Activated== .true.) then ! StringUpdate == .true. + ! + ! StringDensity_Old= St_Density%Array(2) + ! + ! UtubeMode1Activated= .false. + !endif + +!========================Utube1 Air Element Removing================= + + +!========================Utube2 Removing from Annulus================= + + if (UtubeMode2Activated== .true.) then ! StringUpdate == .true. + TotalAddedVolume=0. + + if (Ann_MudOrKick%Last() == 104) then !movaghati. albate age merge anjam shode bashe moshkeli nist + call RemoveAnnulusMudArrays(Ann_MudOrKick%Length()) + endif + + UtubeMode2Activated= .false. + endif + + +!========================Utube2 Removing from Annulus End================= + +!========================New Pipe Filling================= + + if (AddedElementsToString > 0) then ! StringUpdate == .true. + + !NoPipeAdded= F_StringIntervalCounts - F_StringIntervalCountsOld + + + NewPipeFilling=0 + + IF (St_MudOrKick%First() == 104) then + St_MudDischarged_Volume%Array(1) = St_MudDischarged_Volume%Array(1) + sum(PipeSection_VolumeCapacity(2:1+AddedElementsToString)) ! new pipe is filled by air + else + call St_Density%AddToFirst (0.d0) + call St_MudDischarged_Volume%AddToFirst (sum(PipeSection_VolumeCapacity(2:1+AddedElementsToString))) + call St_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(2)) + call St_Mud_Forehead_section%AddToFirst (2) + call St_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(2)) + call St_Mud_Backhead_section%AddToFirst (2) + call St_RemainedVolume_in_LastSection%AddToFirst (0.d0) + call St_EmptyVolume_inBackheadLocation%AddToFirst (0.d0) + call St_MudOrKick%AddToFirst (104) + endif + + endif + + !F_StringIntervalCountsOld= F_StringIntervalCounts + + + + if (NewPipeFilling == 0) then ! 2= is the first element of string (1= is for Hz pipe) + + + LackageMudVolume= St_MudDischarged_Volume%Array(1) ! = Air element + + + !write(*,*) 'LackageMudVolume=' , LackageMudVolume + + + + if (ABS(St_Density%Array(2) - Hz_Density%Last()) >= DensityMixTol) then ! new mud is pumped + call St_Density%AddTo (2,Hz_Density%Last()) + call St_MudDischarged_Volume%AddTo (2,0.d0) + call St_Mud_Forehead_X%AddTo (2,Xstart_PipeSection(2)) + call St_Mud_Forehead_section%AddTo (2 , 2) + call St_Mud_Backhead_X%AddTo (2,Xstart_PipeSection(2)) + call St_Mud_Backhead_section%AddTo (2 ,2) + call St_RemainedVolume_in_LastSection%AddTo (2,0.d0) + call St_EmptyVolume_inBackheadLocation%AddTo (2,0.d0) + call St_MudOrKick%AddTo (2,0) + + !StringDensity_Old= Hz_Density%Last() + endif + + + St_MudDischarged_Volume%Array(2)= St_MudDischarged_Volume%Array(2)+ min( ((StringFlowRate/60.0d0)*DeltaT_Mudline), LackageMudVolume) !(gal) + + St_MudDischarged_Volume%Array(1)= St_MudDischarged_Volume%Array(1)- min( ((StringFlowRate/60.0d0)*DeltaT_Mudline), LackageMudVolume) ! air(gal) + + !LackageMudVolumeAfterFilling= sum(PipeSection_VolumeCapacity(2:F_StringIntervalCounts)) - sum(St_MudDischarged_Volume%Array(:)) + + LackageMudVolumeAfterFilling= St_MudDischarged_Volume%Array(1) ! last time it should be zero + + + + if (LackageMudVolumeAfterFilling == 0.) then + NewPipeFilling= 1 + call RemoveStringMudArrays(1) + St_Mud_Backhead_X%Array(1) = Xstart_PipeSection(2) + St_Mud_Backhead_section%Array(1) = 2 + endif + + endif + +!========================New Pipe Filling End================= + + + if (NewPipeFilling == 0) then + StringFlowRate= 0. + AnnulusFlowRate= 0. + endif + + StringFlowRateFinal= StringFlowRate + AnnulusFlowRateFinal= AnnulusFlowRate + + +!========================STRING ENTRANCE================= + if (StringFlowRateFinal > 0.0 .and. ABS(St_Density%First() - Hz_Density%Last()) >= DensityMixTol) then ! new mud is pumped + !if (ABS(StringDensity_Old - Hz_Density%Last()) >= DensityMixTol) then ! new mud is pumped + call St_Density%AddToFirst (Hz_Density%Last()) + call St_MudDischarged_Volume%AddToFirst (0.0d0) + call St_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(2)) + call St_Mud_Forehead_section%AddToFirst (2) + call St_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(2)) + call St_Mud_Backhead_section%AddToFirst (2) + call St_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call St_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call St_MudOrKick%AddToFirst (0) + + !StringDensity_Old= Hz_Density%Last() + endif + St_MudDischarged_Volume%Array(1)= St_MudDischarged_Volume%Array(1)+ ((StringFlowRate/60.0d0)*DeltaT_Mudline) !(gal) + +!=============== save String Mud data=========== + StMudVolumeSum= 0.d0 + !St_MudSaved_Density= 0.d0 + St_Saved_MudDischarged_Volume= 0.d0 + !Saved_St_MudOrKick= 0 + !Ann_to_Choke_2mud= .false. + + do imud=1, St_MudDischarged_Volume%Length() + + StMudVolumeSum= StMudVolumeSum + St_MudDischarged_Volume%Array(imud) + + if ( StMudVolumeSum > sum(PipeSection_VolumeCapacity(2:F_StringIntervalCounts)) ) then + + !IF (St_MudOrKick%Array(imud) == 0) THEN + St_MudSaved_Density = St_Density%Array(imud) + St_Saved_MudDischarged_Volume = StMudVolumeSum - sum(PipeSection_VolumeCapacity(2:F_StringIntervalCounts)) + !ELSEIF (St_MudOrKick%Array(imud) > 0 .AND. St_MudOrKick%Array(imud) <100) THEN ! 104= AIR + ! St_Kick_Saved_Volume = StMudVolumeSum - sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + ! Saved_St_MudOrKick= St_MudOrKick%Array (imud) + ! St_KickSaved_Density= St_Density%Array(imud) + !END IF + + do ii= imud + 1, St_MudDischarged_Volume%Length() + !IF (St_MudOrKick%Array(ii) == 0) THEN + St_MudSaved_Density = ((St_MudSaved_Density * St_Saved_MudDischarged_Volume) + (St_Density%Array(ii) * St_MudDischarged_Volume%Array(ii))) / (St_Saved_MudDischarged_Volume + St_MudDischarged_Volume%Array(ii)) + St_Saved_MudDischarged_Volume = St_Saved_MudDischarged_Volume + St_MudDischarged_Volume%Array(ii) + + !ELSEIF (St_MudOrKick%Array(imud) > 0 .AND. St_MudOrKick%Array(imud) <100) THEN ! 104= AIR + ! St_Kick_Saved_Volume = St_Kick_Saved_Volume + St_MudDischarged_Volume%Array(ii) + ! Saved_St_MudOrKick= St_MudOrKick%Array (ii) + ! St_KickSaved_Density= St_Density%Array(ii) + !END IF + enddo + + + !WRITE (*,*) 'St_Saved_Mud_Volume, St_Kick_Saved_Volume', St_Saved_MudDischarged_Volume, St_Kick_Saved_Volume + exit ! exits do + + endif + + enddo +St_Saved_MudDischarged_Volume_Final= St_Saved_MudDischarged_Volume + +IF (WellHeadIsOpen) MudVolume_InjectedToBH = St_Saved_MudDischarged_Volume_Final + +!====================================================================== + + +!========================STRING================= + +imud=0 + do while (imud < St_Mud_Forehead_X%Length()) + imud = imud + 1 + + if (imud> 1) then + St_Mud_Backhead_X%Array(imud)= St_Mud_Forehead_X%Array(imud-1) + St_Mud_Backhead_section%Array(imud)= St_Mud_Forehead_section%Array(imud-1) + endif + + DirectionCoef= (Xend_PipeSection(St_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(St_Mud_Backhead_section%Array(imud))) & + / ABS(Xend_PipeSection(St_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(St_Mud_Backhead_section%Array(imud))) + ! +1 for string , -1 for annulus + + + St_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (Xend_PipeSection(St_Mud_Backhead_section%Array(imud))- St_Mud_Backhead_X%Array(imud))* & + Area_PipeSectionFt(St_Mud_Backhead_section%Array(imud)) !(ft^3) + St_EmptyVolume_inBackheadLocation%Array(imud)= St_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal + + if ( St_MudDischarged_Volume%Array(imud) <= St_EmptyVolume_inBackheadLocation%Array(imud)) then + St_Mud_Forehead_section%Array(imud)= St_Mud_Backhead_section%Array(imud) + St_Mud_Forehead_X%Array(imud)= St_Mud_Backhead_X%Array(imud)+ DirectionCoef*(St_MudDischarged_Volume%Array(imud)/7.48051948d0)/Area_PipeSectionFt(St_Mud_Backhead_section%Array(imud)) + ! 7.48 is for gal to ft^3 + + else + + isection= St_Mud_Backhead_section%Array(imud)+1 + St_RemainedVolume_in_LastSection%Array(imud)= St_MudDischarged_Volume%Array(imud)- St_EmptyVolume_inBackheadLocation%Array(imud) + + do + if (isection > F_StringIntervalCounts) then ! last pipe section(string exit) + St_MudDischarged_Volume%Array(imud)= St_MudDischarged_Volume%Array(imud)- St_RemainedVolume_in_LastSection%Array(imud) + St_Mud_Forehead_X%Array(imud)= Xend_PipeSection(F_StringIntervalCounts) + St_Mud_Forehead_section%Array(imud)= F_StringIntervalCounts + + if (St_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the string + call RemoveStringMudArrays(imud) + endif + + exit + endif + + xx= St_RemainedVolume_in_LastSection%Array(imud)/ PipeSection_VolumeCapacity(isection) !(gal) + + if (xx<= 1.0) then + St_Mud_Forehead_section%Array(imud)= isection + St_Mud_Forehead_X%Array(imud)= (xx * (Xend_PipeSection(isection)- Xstart_PipeSection(isection)))+ Xstart_PipeSection(isection) + exit + else + St_RemainedVolume_in_LastSection%Array(imud)= St_RemainedVolume_in_LastSection%Array(imud)- PipeSection_VolumeCapacity(isection) + isection= isection+ 1 + + + endif + + enddo + + endif + + enddo +!========================STRING END================= + + !write(*,*) ' a before==' + ! + ! do imud=1, Op_MudDischarged_Volume%Length() + ! write(*,*) 'Op:', imud, Op_MudDischarged_Volume%Array(imud), Op_Density%Array(imud) ,Op_MudOrKick%Array(imud) + ! enddo + ! + ! do imud=1, Ann_MudDischarged_Volume%Length() + ! write(*,*) 'Ann:', imud, Ann_MudDischarged_Volume%Array(imud), Ann_Density%Array(imud) ,Ann_MudOrKick%Array(imud) + ! enddo + ! + ! write(*,*) 'Ann cap=' , sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + ! write(*,*) 'Ann mud sum vol=' , sum(Ann_MudDischarged_Volume%Array(:)) + ! + ! + !write(*,*) '==== a before' + + iloc_changedTo2 = 0 + + IF (Op_MudOrKick%Last() /= 0 .and. Op_MudOrKick%Last()==Ann_MudOrKick%First()) then + iLoc=2 ! it may be 1,2,3 or more, all of them are kick + iloc_changedTo2= 1 + endif + + + + iloc_edited= 0 + !write(*,*) sum(Op_MudDischarged_Volume%Array(:)) , ((AnnulusFlowRate/60.d0)*DeltaT_Mudline) , Ann_MudDischarged_Volume%First() , sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) + if (iloc==2 .and. sum(Op_MudDischarged_Volume%Array(:))+((AnnulusFlowRate/60.d0)*DeltaT_Mudline)+Ann_MudDischarged_Volume%First() < sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) ) then + iloc = 1 + iloc_edited = 1 + !write(*,*) 'hellooooooo' + endif + + +!write(*,*) 'ann-cap:' , sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1 :F_StringIntervalCounts+F_AnnulusIntervalCounts) ) + + + !write(*,*) 'iloc====' , iloc + !MudVolume_InjectedToBH + + +!=============================Add PumpFlowRate to Bottom Hole ============================== + !if ( AnnulusFlowRate>0.0 ) then + if ( MudVolume_InjectedToBH > 0.0 ) then + + + if (KickOffBottom) then ! (kickOffBottom = F) means kick is next to the bottom hole and usually kick is entering the + AddLocation= Op_Density%Length()-iloc+1+1 ! well, thus pumped mud should be placed above the kick + else + AddLocation= Op_Density%Length()+1 + endif + !write(*,*) 'AddLocation====' , AddLocation + if ( AddLocation== 0) CALL ErrorStop ('AddLocation=0') + + + if ( ABS(St_Density%Last() - Op_Density%Array(AddLocation-1)) >= DensityMixTol ) then + !write(*,*) 'new pocket**' + !write(*,*) 'St_Density%Last()=' , St_Density%Last() + !write(*,*) 'Op_Density%Array(AddLocation-1)=' , Op_Density%Array(AddLocation-1) + + + call Op_Density% AddTo (AddLocation,St_Density%Last()) + !call Op_MudDischarged_Volume%AddTo (AddLocation,((AnnulusFlowRate/60.d0)*DeltaT_Mudline)) + call Op_MudDischarged_Volume%AddTo (AddLocation,MudVolume_InjectedToBH) + call Op_Mud_Forehead_X%AddTo (AddLocation,Xstart_OpSection(1)) + call Op_Mud_Forehead_section%AddTo (AddLocation,1) + call Op_Mud_Backhead_X%AddTo (AddLocation,Xstart_OpSection(1)) + call Op_Mud_Backhead_section%AddTo (AddLocation,1) + call Op_RemainedVolume_in_LastSection%AddTo (AddLocation,0.0d0) + call Op_EmptyVolume_inBackheadLocation%AddTo (AddLocation,0.0d0) + call Op_MudOrKick%AddTo (AddLocation,0) + else + !write(*,*) 'merge**' + !write(*,*) 'density before=' , Op_Density%Array(AddLocation-1) + !write(*,*) 'St_Density%Last() for mix=' , St_Density%Last() + + !Op_Density%Array(AddLocation-1)= (Op_Density%Array(AddLocation-1)*Op_MudDischarged_Volume%Array(AddLocation-1)+St_Density%Last()*((AnnulusFlowRate/60.d0)*DeltaT_Mudline))/(Op_MudDischarged_Volume%Array(AddLocation-1)+((AnnulusFlowRate/60.d0)*DeltaT_Mudline)) + !Op_MudDischarged_Volume%Array(AddLocation-1)= Op_MudDischarged_Volume%Array(AddLocation-1) + ((AnnulusFlowRate/60.d0)*DeltaT_Mudline) + + Op_Density%Array(AddLocation-1)= (Op_Density%Array(AddLocation-1)*Op_MudDischarged_Volume%Array(AddLocation-1)+St_Density%Last()*MudVolume_InjectedToBH)/(Op_MudDischarged_Volume%Array(AddLocation-1)+MudVolume_InjectedToBH) + Op_MudDischarged_Volume%Array(AddLocation-1)= Op_MudDischarged_Volume%Array(AddLocation-1) + MudVolume_InjectedToBH + !write(*,*) 'density after=' , Op_Density%Array(AddLocation-1) + + endif + + endif +!=======================Add PumpFlowRate to Bottom Hole- End ============================== + + !write(*,*) 'pump added-before add to ann==' + ! + ! do imud=1, Op_MudDischarged_Volume%Length() + ! write(*,*) 'Op:', imud, Op_MudDischarged_Volume%Array(imud), Op_Density%Array(imud) ,Op_MudOrKick%Array(imud) + ! enddo + ! + ! do imud=1, Ann_MudDischarged_Volume%Length() + ! write(*,*) 'Ann:', imud, Ann_MudDischarged_Volume%Array(imud), Ann_Density%Array(imud) ,Ann_MudOrKick%Array(imud) + ! enddo + ! + ! write(*,*) 'Ann cap=' , sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + ! write(*,*) 'Ann mud sum vol=' , sum(Ann_MudDischarged_Volume%Array(:)) + ! + ! + ! + !write(*,*) 'pump added====before add to ann' + + +!=============== save OP Mud data to transfer to the annulus enterance due to tripin or kick + OpMudVolumeSum= 0.d0 + !Op_MudSaved_Density= 0.d0 + !Op_KickSaved_Density= 0.d0 + Op_Saved_MudDischarged_Volume= 0.d0 + Op_Kick_Saved_Volume= 0.d0 + Saved_Op_MudOrKick= 0 + Op_NeededVolume_ToFill= 0.d0 + + + + + do imud=1, Op_MudDischarged_Volume%Length() + + OpMudVolumeSum= OpMudVolumeSum + Op_MudDischarged_Volume%Array(imud) + + if ( OpMudVolumeSum > sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) ) then !1st mode + + IF (Op_MudOrKick%Array(imud) == 0) THEN + Op_MudSaved_Density = Op_Density%Array(imud) + Op_Saved_MudDischarged_Volume = OpMudVolumeSum - sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) + ELSE + + Op_Kick_Saved_Volume = OpMudVolumeSum - sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) + Saved_Op_MudOrKick= Op_MudOrKick%Array (imud) + Op_KickSaved_Density= Op_Density%Array(imud) + iloc= 2 + iloc_changedTo2= 2 + END IF + + do ii= imud + 1, Op_MudDischarged_Volume%Length() + IF (Op_MudOrKick%Array(ii) == 0) THEN + Op_MudSaved_Density = ((Op_MudSaved_Density * Op_Saved_MudDischarged_Volume) + (Op_Density%Array(ii) * Op_MudDischarged_Volume%Array(ii))) / (Op_Saved_MudDischarged_Volume + Op_MudDischarged_Volume%Array(ii)) + Op_Saved_MudDischarged_Volume = Op_Saved_MudDischarged_Volume + Op_MudDischarged_Volume%Array(ii) + ELSE + Op_Kick_Saved_Volume = Op_Kick_Saved_Volume + Op_MudDischarged_Volume%Array(ii) + Saved_Op_MudOrKick= Op_MudOrKick%Array (ii) + Op_KickSaved_Density= Op_Density%Array(ii) + iloc= 2 + iloc_changedTo2= 3 + END IF + enddo + + exit ! exits do + + endif + + enddo + + if ( sum(Op_MudDischarged_Volume%Array(:)) < sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) ) then !2nd & 3rd mode + + Op_NeededVolume_ToFill= sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) - sum(Op_MudDischarged_Volume%Array(:)) + endif + + + ! + !write(*,*) 'Op_NeededVolume_ToFill=' , Op_NeededVolume_ToFill + !write(*,*) 'Op_Saved_MudDischarged_Volume=' , Op_Saved_MudDischarged_Volume + !write(*,*) 'Op_Kick_Saved_Volume=' , Op_Kick_Saved_Volume + ! + !write(*,*) 'op cap=' , sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) + !write(*,*) ' op sum mud=' , sum(Op_MudDischarged_Volume%Array(:)) + + + + + +!====================================================================== + + + + +!========================Tripping Out- 1st & 3rd Mode==================== + + + + if ( (Op_Kick_Saved_Volume > 0.0 .or. Op_Saved_MudDischarged_Volume> 0.0) .or. & ! 1st Mode-Pump flow is more than trip out so fluid Level in Annulus Increases + (Op_NeededVolume_ToFill < ABS(DeltaVolumeAnnulusCapacity)) ) then !3rd Mode-fluid Level in Annulus Increases + + + !if ( Op_Kick_Saved_Volume > 0.0 .or. Op_Saved_MudDischarged_Volume> 0.0 ) write(*,*) 'trip out 1st mode' + + if ( Op_NeededVolume_ToFill > 0.0 .and. Op_NeededVolume_ToFill < ABS(DeltaVolumeAnnulusCapacity) ) then + ! write(*,*) 'trip out 3rd mode' + + NewVolume= 0.d0 ! for condition iloc=1 + + SavedDensityForOp= Ann_Density%Array(1) + + ExcessMudVolume_Remained= Op_NeededVolume_ToFill + + + imud=1 + + Do + + if(Ann_MudDischarged_Volume%Array(imud) < ExcessMudVolume_Remained) then + ExcessMudVolume_Remained= ExcessMudVolume_Remained- Ann_MudDischarged_Volume%Array(imud) + call Ann_MudDischarged_Volume%Remove (imud) + call Ann_Mud_Backhead_X%Remove (imud) + call Ann_Mud_Backhead_section%Remove (imud) + call Ann_Mud_Forehead_X%Remove (imud) + call Ann_Mud_Forehead_section%Remove (imud) + call Ann_Density%Remove (imud) + call Ann_RemainedVolume_in_LastSection%Remove (imud) + call Ann_EmptyVolume_inBackheadLocation%Remove (imud) + call Ann_MudOrKick%Remove (imud) + + elseif(Ann_MudDischarged_Volume%Array(imud) > ExcessMudVolume_Remained) then + Ann_MudDischarged_Volume%Array(imud)= Ann_MudDischarged_Volume%Array(imud)- ExcessMudVolume_Remained + exit + + else !(Ann_MudDischarged_Volume%Array(imud) == ExcessMudVolume_Remained) + call Ann_MudDischarged_Volume%Remove (imud) + call Ann_Mud_Backhead_X%Remove (imud) + call Ann_Mud_Backhead_section%Remove (imud) + call Ann_Mud_Forehead_X%Remove (imud) + call Ann_Mud_Forehead_section%Remove (imud) + call Ann_Density%Remove (imud) + call Ann_RemainedVolume_in_LastSection%Remove (imud) + call Ann_EmptyVolume_inBackheadLocation%Remove (imud) + call Ann_MudOrKick%Remove (imud) + exit + + endif + + enddo + + + !write(*,*) 'Op_NeededVolume_ToFill=' ,Op_NeededVolume_ToFill + !write(*,*) 'ABS(DeltaVolumeAnnulusCapacity)=' ,ABS(DeltaVolumeAnnulusCapacity) + !write(*,*) 'Op_MudOrKick%Last()=' ,Op_MudOrKick%Last() + !write(*,*) 'iloc=' ,iloc + !write(*,*) 'iloc_edited=' ,iloc_edited + + + endif + + + ! (AnnulusFlowRate/60.)*DeltaT_Mudline) - DeltaVolumeOp will be added to annulus + + !if (iLoc == 1) then + MudSection= F_StringIntervalCounts+1 + BackheadX= Xstart_PipeSection(F_StringIntervalCounts+1) + !elseif (iLoc == 2) then + ! MudSection= Kick_Forehead_section + ! BackheadX= Kick_Forehead_X + !endif + +!========================ANNULUS ENTRANCE==================== + !if (KickMigration_2SideBit == .FALSE.) then + ! if ( ABS(AnnulusSuctionDensity_Old - St_Density%Last()) >= DensityMixTol ) then ! new mud is pumped + ! call Ann_Density%AddTo (iLoc,St_Density%Last()) + ! call Ann_MudDischarged_Volume%AddTo (iLoc,0.0d0) + ! call Ann_Mud_Forehead_X%AddTo (iLoc,BackheadX) + ! call Ann_Mud_Forehead_section%AddTo (iLoc,MudSection) + ! call Ann_Mud_Backhead_X%AddTo (iLoc,BackheadX) + ! call Ann_Mud_Backhead_section%AddTo (iLoc,MudSection) + ! call Ann_RemainedVolume_in_LastSection%AddTo (iLoc,0.0d0) + ! call Ann_EmptyVolume_inBackheadLocation%AddTo (iLoc,0.0d0) + ! call Ann_MudOrKick%AddTo (iLoc,0) + ! call Ann_CuttingMud%AddTo (iLoc,0) + ! + ! AnnulusSuctionDensity_Old= St_Density%Last() + ! + ! MudIsChanged= .true. + ! endif + ! + ! Ann_MudDischarged_Volume%Array(iLoc)= Ann_MudDischarged_Volume%Array(iLoc)+ ((AnnulusFlowRate/60.0d0)*DeltaT_Mudline) - ((2-iloc)*ABS(DeltaVolumePipe)) !(gal) + ! + !endif + + + + + Ann_Mud_Backhead_section%Array(1)= MudSection !it is needed to be updated for (a condition that one pipe is removed from Annulus due to trip out)- (and add pipe) + Ann_Mud_Backhead_X%Array(1)= BackheadX + + + + !iloc=1 : (2-iloc)=1 normal + !iloc=2 : (2-iloc)=0 kick influx or migration is in annulus + +!========================Same to Tripping In==================== + + !write(*,*) 'Op_Kick_Saved_Volume,Op_Saved_MudDischarged_Volume=' , Op_Kick_Saved_Volume,Op_Saved_MudDischarged_Volume + + + if (Op_Kick_Saved_Volume > 0.0 .and. Ann_MudOrKick%First() == 0) then !1st Mode + write(*,*) 'Kick influx enters Annulus' + call Ann_Density%AddToFirst (Op_KickSaved_Density) + call Ann_MudDischarged_Volume%AddToFirst (Op_Kick_Saved_Volume) + call Ann_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) + call Ann_Mud_Forehead_section%AddToFirst (F_StringIntervalCounts+1) + call Ann_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) + call Ann_Mud_Backhead_section%AddToFirst (F_StringIntervalCounts+1) + call Ann_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call Ann_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call Ann_MudOrKick%AddToFirst (Saved_Op_MudOrKick) !<<<<<<<< + call Ann_CuttingMud%AddToFirst (0) + elseif (Op_Kick_Saved_Volume > 0.0 .and. Ann_MudOrKick%First() /= 0) then + Ann_MudDischarged_Volume%Array(1)= Ann_MudDischarged_Volume%Array(1) + Op_Kick_Saved_Volume + endif + + + + if ( Op_NeededVolume_ToFill > 0.0 .and. (Op_NeededVolume_ToFill < ABS(DeltaVolumeAnnulusCapacity)) .and. Op_MudOrKick%Last() == 0 .and. (iloc==2 .or. iloc_edited==1)) then !3rd Mode + !write(*,*) 'checkpoint 0' + !! for avoid kick separation -Op_MudOrKick%Last() == 0: because of pump + NewVolume= ((AnnulusFlowRate/60.d0)*DeltaT_Mudline) ! =volume that should be added to iloc=2 in Ann + call RemoveOpMudArrays(Op_Density%Length()) ! mud here is removed and then will be added to iloc=2 in Ann in %%1 section + if ( Ann_MudDischarged_Volume%Array(1) > ((AnnulusFlowRate/60.d0)*DeltaT_Mudline) ) then! 1st in Ann = kick ,, we expect: ((AnnulusFlowRate/60.d0)*DeltaT_Mudline)= OpMudVolLast + Ann_MudDischarged_Volume%Array(1)= Ann_MudDischarged_Volume%Array(1) - ((AnnulusFlowRate/60.d0)*DeltaT_Mudline) + Op_MudDischarged_Volume%Array(Op_Density%Length())= Op_MudDischarged_Volume%Array(Op_Density%Length())+ ((AnnulusFlowRate/60.d0)*DeltaT_Mudline) ! kick + else + call RemoveAnnulusMudArrays(1) !kick is removed + iloc= 1 + Op_MudDischarged_Volume%Array(Op_Density%Length())= Op_MudDischarged_Volume%Array(Op_Density%Length())+ ((AnnulusFlowRate/60.d0)*DeltaT_Mudline) + write(*,*) 'little expand' + ! including a little expand + endif + endif + + if (Op_Saved_MudDischarged_Volume> 0.0) then !1st Mode + NewDensity= Op_MudSaved_Density + !write(*,*) 'iloc,...' , iloc,((AnnulusFlowRate/60.d0)*DeltaT_Mudline),Op_Saved_MudDischarged_Volume + if (iloc==1) then + !write(*,*) 'checkpoint 1' + NewVolume= Op_Saved_MudDischarged_Volume + elseif (real(((AnnulusFlowRate/60.d0)*DeltaT_Mudline)) - real(Op_Saved_MudDischarged_Volume) > 0.d0 ) then ! for avoid kick separation + !write(*,*) 'checkpoint 2' + NewVolume= ((AnnulusFlowRate/60.d0)*DeltaT_Mudline) !- Op_Saved_MudDischarged_Volume + call RemoveOpMudArrays(Op_Density%Length()) ! mud here is removed and then will be added to iloc=2 in Ann + if ( Ann_MudDischarged_Volume%Array(1) > (((AnnulusFlowRate/60.d0)*DeltaT_Mudline) - Op_Saved_MudDischarged_Volume) ) then! 1st in Ann = kick + Ann_MudDischarged_Volume%Array(1)= Ann_MudDischarged_Volume%Array(1) - (((AnnulusFlowRate/60.d0)*DeltaT_Mudline) - Op_Saved_MudDischarged_Volume) + Op_MudDischarged_Volume%Array(Op_Density%Length())= Op_MudDischarged_Volume%Array(Op_Density%Length())+ (((AnnulusFlowRate/60.d0)*DeltaT_Mudline) - Op_Saved_MudDischarged_Volume) !kick + else + call RemoveAnnulusMudArrays(1) !kick is removed + iloc =1 + Op_MudDischarged_Volume%Array(Op_Density%Length())= Op_MudDischarged_Volume%Array(Op_Density%Length())+ (((AnnulusFlowRate/60.d0)*DeltaT_Mudline) - Op_Saved_MudDischarged_Volume) + write(*,*) 'little expand' + + ! including a little expand + endif + + + else ! iloc==2 , ((AnnulusFlowRate/60.d0)*DeltaT_Mudline) == Op_Saved_MudDischarged_Volume + !write(*,*) 'checkpoint 3' + NewVolume= Op_Saved_MudDischarged_Volume ! it is normal mode + endif + + + endif + + !write(*,*) 'NewVolume=' ,NewVolume + + + if( Ann_Density%Length() == 1 .and. iloc ==2 ) then + + write(*,*) '***errorb****==' + + write(*,*) 'iloc_edited=' , iloc_edited + write(*,*) 'iloc_changedTo2=' , iloc_changedTo2 + + write(*,*) 'Op_Capacity===' , sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) + + WRITE (*,*) 'Op_Saved_MudDischarged_Volume, Op_Kick_Saved_Volume',Op_Saved_MudDischarged_Volume, Op_Kick_Saved_Volume + + do imud=1, Op_MudDischarged_Volume%Length() + write(*,*) 'Op:', imud, Op_MudDischarged_Volume%Array(imud), Op_Density%Array(imud) ,Op_MudOrKick%Array(imud) + enddo + + do imud=1, Ann_MudDischarged_Volume%Length() + write(*,*) 'Ann:', imud, Ann_MudDischarged_Volume%Array(imud), Ann_Density%Array(imud) ,Ann_MudOrKick%Array(imud) + enddo + + + + write(*,*) '==***errorb****' + endif + + + + + + if ((Rate_of_Penetration==0 .and. abs(Ann_Density%Array(iLoc)-NewDensity)< DensityMixTol) & !%%1 section + .or. (Rate_of_Penetration>0. .and. Ann_CuttingMud%Array(iLoc)==1 .and. abs(Ann_Density%Array(iLoc)-NewDensity)< CuttingDensityMixTol) & + .or. (Rate_of_Penetration>0. .and. Ann_CuttingMud%Array(iLoc)==0 .and. Ann_MudDischarged_Volume%Array(iLoc) < 42.) ) then ! 1-Pockets are Merged + !write(*,*) '%%1 section a)' + Ann_Density%Array(iLoc)= (Ann_Density%Array(iLoc)*Ann_MudDischarged_Volume%Array(iLoc)+NewDensity*NewVolume)/(Ann_MudDischarged_Volume%Array(iLoc)+NewVolume) + Ann_MudDischarged_Volume%Array(iLoc)= Ann_MudDischarged_Volume%Array(iLoc)+NewVolume + Ann_Mud_Forehead_X%Array(iLoc)= BackheadX + Ann_Mud_Forehead_section%Array(iLoc)= MudSection + Ann_Mud_Backhead_X%Array(iLoc)= BackheadX + Ann_Mud_Backhead_section%Array(iLoc)= MudSection + Ann_RemainedVolume_in_LastSection%Array(iLoc)= (0.0d0) + Ann_EmptyVolume_inBackheadLocation%Array(iLoc)= (0.0d0) + else ! 2-Merging conditions are not meeted, so new pocket + !write(*,*) '%%1 section b)' + + call Ann_Density%AddTo (iLoc,NewDensity) + call Ann_MudDischarged_Volume%AddTo (iLoc,NewVolume) + call Ann_Mud_Forehead_X%AddTo (iLoc,BackheadX) + call Ann_Mud_Forehead_section%AddTo (iLoc,MudSection) + call Ann_Mud_Backhead_X%AddTo (iLoc,BackheadX) + call Ann_Mud_Backhead_section%AddTo (iLoc,MudSection) + call Ann_RemainedVolume_in_LastSection%AddTo (iLoc,0.0d0) + call Ann_EmptyVolume_inBackheadLocation%AddTo (iLoc,0.0d0) + call Ann_MudOrKick%AddTo (iLoc,0) + call Ann_CuttingMud%AddTo (iLoc,0) + !write(*,*) 'd) annLength=' , Ann_Density%Length() + + endif + + + + +!========================Same to Tripping In - End==================== + + !write(*,*) 'b)Ann_Mud sum=' , sum(Ann_MudDischarged_Volume%Array(:)) + + !write(*,*) 'no======2' + ! + ! do imud=1, Op_MudDischarged_Volume%Length() + ! write(*,*) 'Op:', imud, Op_MudDischarged_Volume%Array(imud), Op_Density%Array(imud) ,Op_MudOrKick%Array(imud) + ! enddo + ! + ! do imud=1, Ann_MudDischarged_Volume%Length() + ! write(*,*) 'Ann:', imud, Ann_MudDischarged_Volume%Array(imud), Ann_Density%Array(imud) ,Ann_MudOrKick%Array(imud) + ! enddo + ! + ! + ! write(*,*) 'Ann cap=' , sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + ! write(*,*) 'Ann mud sum vol=' , sum(Ann_MudDischarged_Volume%Array(:)) + ! + ! + !write(*,*) '2======no' + +!=============== save Ann Mud data to transfer to the ChokeLine enterance + AnnMudVolumeSum= 0.d0 + !Ann_MudSaved_Density= 0.d0 + !Ann_KickSaved_Density= 0.d0 + Ann_Saved_MudDischarged_Volume= 0.d0 + Ann_Kick_Saved_Volume= 0.d0 + Saved_Ann_MudOrKick= 0 + Ann_to_Choke_2mud= .false. + + + + + do imud=1, Ann_MudDischarged_Volume%Length() + + AnnMudVolumeSum= AnnMudVolumeSum + Ann_MudDischarged_Volume%Array(imud) + + if ( AnnMudVolumeSum > sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) ) then + + IF (Ann_MudOrKick%Array(imud) == 0) THEN + Ann_MudSaved_Density = Ann_Density%Array(imud) + Ann_Saved_MudDischarged_Volume = AnnMudVolumeSum - sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + ELSEIF (Ann_MudOrKick%Array(imud) > 0 .AND. Ann_MudOrKick%Array(imud) <100) THEN ! 104= AIR + Ann_Kick_Saved_Volume = AnnMudVolumeSum - sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + Saved_Ann_MudOrKick= Ann_MudOrKick%Array (imud) + Ann_KickSaved_Density= Ann_Density%Array(imud) + END IF + + do ii= imud + 1, Ann_MudDischarged_Volume%Length() + IF (Ann_MudOrKick%Array(ii) == 0) THEN + Ann_MudSaved_Density = ((Ann_MudSaved_Density * Ann_Saved_MudDischarged_Volume) + (Ann_Density%Array(ii) * Ann_MudDischarged_Volume%Array(ii))) / (Ann_Saved_MudDischarged_Volume + Ann_MudDischarged_Volume%Array(ii)) + Ann_Saved_MudDischarged_Volume = Ann_Saved_MudDischarged_Volume + Ann_MudDischarged_Volume%Array(ii) + Ann_to_Choke_2mud= .true. + ELSEIF (Ann_MudOrKick%Array(ii) > 0 .AND. Ann_MudOrKick%Array(ii) <100) THEN ! 104= AIR + Ann_Kick_Saved_Volume = Ann_Kick_Saved_Volume + Ann_MudDischarged_Volume%Array(ii) + Saved_Ann_MudOrKick= Ann_MudOrKick%Array (ii) + Ann_KickSaved_Density= Ann_Density%Array(ii) + END IF + enddo + + exit ! exits do + + endif + + enddo + +Ann_Saved_MudDischarged_Volume_Final= Ann_Saved_MudDischarged_Volume +Ann_Kick_Saved_Volume_Final= Ann_Kick_Saved_Volume + !write(*,*) 'Ann cap=' , sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + !write(*,*) 'Ann mud sum vol=' , sum(Ann_MudDischarged_Volume%Array(:)) + +IF (WellHeadIsOpen) MudVolume_InjectedFromAnn = Ann_Saved_MudDischarged_Volume_Final-((Qlost/60.0d0)*DeltaT_Mudline) + !NoGasPocket +!write(*,*) 'Ann_Saved_Mud_Vol,Ann_Kick_Saved_Vol=' , Ann_Saved_MudDischarged_Volume,Ann_Kick_Saved_Volume + +!====================================================================== + + + !write(*,*) 'Ann_Saved_Mud=' , Ann_Saved_MudDischarged_Volume +!======================== Annulus ==================== + + !MudIsChanged= .false. + +imud= 0 + + do while (imud < Ann_Mud_Forehead_X%Length()) + imud = imud + 1 + + if (imud> 1) then + Ann_Mud_Backhead_X%Array(imud)= Ann_Mud_Forehead_X%Array(imud-1) + Ann_Mud_Backhead_section%Array(imud)= Ann_Mud_Forehead_section%Array(imud-1) + endif + + ! write(*,*) 'imud==' , imud + !write(*,*) '***)Ann_Mud_Backhead_section(imud)= ' , Ann_Mud_Backhead_section%Array(imud), Ann_density%Array(imud) + + + DirectionCoef= (Xend_PipeSection(Ann_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(Ann_Mud_Backhead_section%Array(imud))) & + / ABS(Xend_PipeSection(Ann_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(Ann_Mud_Backhead_section%Array(imud))) + ! +1 for string , -1 for annulus + + + Ann_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (Xend_PipeSection(Ann_Mud_Backhead_section%Array(imud))- Ann_Mud_Backhead_X%Array(imud))* & + Area_PipeSectionFt(Ann_Mud_Backhead_section%Array(imud)) !(ft^3) + Ann_EmptyVolume_inBackheadLocation%Array(imud)= Ann_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal + + + if ( Ann_MudDischarged_Volume%Array(imud) <= Ann_EmptyVolume_inBackheadLocation%Array(imud)) then + Ann_Mud_Forehead_section%Array(imud)= Ann_Mud_Backhead_section%Array(imud) + Ann_Mud_Forehead_X%Array(imud)= Ann_Mud_Backhead_X%Array(imud)+ DirectionCoef*(Ann_MudDischarged_Volume%Array(imud)/7.48051948d0)/Area_PipeSectionFt(Ann_Mud_Backhead_section%Array(imud)) + ! 7.48 is for gal to ft^3 + + else + + isection= Ann_Mud_Backhead_section%Array(imud)+1 + Ann_RemainedVolume_in_LastSection%Array(imud)= Ann_MudDischarged_Volume%Array(imud)- Ann_EmptyVolume_inBackheadLocation%Array(imud) + + do + if (isection > NoPipeSections) then ! last pipe section(well exit) + Ann_MudDischarged_Volume%Array(imud)= Ann_MudDischarged_Volume%Array(imud)- Ann_RemainedVolume_in_LastSection%Array(imud) + Ann_Mud_Forehead_X%Array(imud)= Xend_PipeSection(NoPipeSections) + Ann_Mud_Forehead_section%Array(imud)= NoPipeSections + + if (Ann_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the well + call RemoveAnnulusMudArrays(imud) + endif + + exit + endif + + xx= Ann_RemainedVolume_in_LastSection%Array(imud)/ PipeSection_VolumeCapacity(isection) !(gal) + + if (xx<= 1.0) then + Ann_Mud_Forehead_section%Array(imud)= isection + Ann_Mud_Forehead_X%Array(imud)= (xx * (Xend_PipeSection(isection)- Xstart_PipeSection(isection)))+ Xstart_PipeSection(isection) + exit + else + Ann_RemainedVolume_in_LastSection%Array(imud)= Ann_RemainedVolume_in_LastSection%Array(imud)- PipeSection_VolumeCapacity(isection) + isection= isection+ 1 + + endif + + enddo + + endif + + enddo + + if (Ann_Mud_Forehead_X%Last() < Xend_PipeSection(NoPipeSections)) then + Ann_Mud_Forehead_X%Array(Ann_Mud_Forehead_X%Length()) = Xend_PipeSection(NoPipeSections) ! for error preventing + endif + +!========================ANNULUS END================= + + + +!************************************************************************************************************************* + +!========================Tripping Out- 2nd Mode==================== + + + elseif ( Op_NeededVolume_ToFill > ABS(DeltaVolumeAnnulusCapacity) ) then !pump is off or Pump flow is less than trip out so fluid Level in Annulus decreases + !write(*,*) 'trip out 2nd mode' + + + SavedDensityForOp= Ann_Density%Array(1) +!========================ANNULUS ENTRANCE==================== + + ! <<< SIMILAR TO UTUBE 2 >>> + if ( Ann_Density%Last() /= 0.0 ) then ! new mud is pumped + call Ann_Density%Add (0.0d0) + call Ann_MudDischarged_Volume%Add (0.0d0) + call Ann_Mud_Forehead_X%Add (Xend_PipeSection(NoPipeSections)) + call Ann_Mud_Forehead_section%Add (NoPipeSections) + call Ann_Mud_Backhead_X%Add (Xstart_PipeSection(NoPipeSections)) + call Ann_Mud_Backhead_section%Add (NoPipeSections) + call Ann_RemainedVolume_in_LastSection%Add (0.0d0) + call Ann_EmptyVolume_inBackheadLocation%Add (0.0d0) + call Ann_MudOrKick%Add (104) + call Ann_CuttingMud%Add (0) + + !AnnulusSuctionDensity_Old= Hz_Density%Last() + endif + + Ann_Mud_Forehead_section%Array(Ann_Mud_Forehead_section%Length())= NoPipeSections !it is needed to be updated for (a condition that one pipe is removed from Annulus due to trip out)- (and add pipe) + Ann_Mud_Forehead_X%Array(Ann_Mud_Forehead_X%Length())= Xend_PipeSection(NoPipeSections) + + + Ann_MudDischarged_Volume%Array(Ann_MudDischarged_Volume%Length())= Ann_MudDischarged_Volume%Last()+ (Op_NeededVolume_ToFill - ABS(DeltaVolumeAnnulusCapacity)) ! Op_NeededVolume_ToFill !ABS(DeltaVolumePipe) - ((AnnulusFlowRate/60.)*DeltaT_Mudline) !(gal) + +!=================================================================== + + + + if ( (iloc==2 .or. iloc_edited==1) .and. Op_MudOrKick%Last()==0 ) then ! for avoid kick separation + !write(*,*) 'here mud should be removed from Op last' + + if (abs(Ann_Density%Array(iloc)-Op_Density%Last())< DensityMixTol) then + + Ann_Density%Array(iLoc)= (Ann_Density%Array(iLoc)*Ann_MudDischarged_Volume%Array(iLoc)+Op_Density%Last()*Op_MudDischarged_Volume%Last())/(Ann_MudDischarged_Volume%Array(iLoc)+Op_MudDischarged_Volume%Last()) + Ann_MudDischarged_Volume%Array(iLoc)= Ann_MudDischarged_Volume%Array(iLoc)+Op_MudDischarged_Volume%Last() ! OP_Last is mud(effect of pump added mud) + Ann_Mud_Forehead_X%Array(iLoc)= BackheadX + Ann_Mud_Forehead_section%Array(iLoc)= MudSection + Ann_Mud_Backhead_X%Array(iLoc)= BackheadX + Ann_Mud_Backhead_section%Array(iLoc)= MudSection + Ann_RemainedVolume_in_LastSection%Array(iLoc)= (0.0d0) + Ann_EmptyVolume_inBackheadLocation%Array(iLoc)= (0.0d0) + !write(*,*) 'merge' ,'Ann_Volume%Array(1)=' , Ann_MudDischarged_Volume%Array(1) + + else ! 2-Merging conditions are not meeted, so new pocket + call Ann_Density%AddTo (iLoc,Op_Density%Last()) + call Ann_MudDischarged_Volume%AddTo (iLoc,Op_MudDischarged_Volume%Last()) + call Ann_Mud_Forehead_X%AddTo (iLoc,BackheadX) + call Ann_Mud_Forehead_section%AddTo (iLoc,MudSection) + call Ann_Mud_Backhead_X%AddTo (iLoc,BackheadX) + call Ann_Mud_Backhead_section%AddTo (iLoc,MudSection) + call Ann_RemainedVolume_in_LastSection%AddTo (iLoc,0.0d0) + call Ann_EmptyVolume_inBackheadLocation%AddTo (iLoc,0.0d0) + call Ann_MudOrKick%AddTo (iLoc,0) + call Ann_CuttingMud%AddTo (iLoc,0) + endif + + Op_NeededVolume_ToFill= Op_NeededVolume_ToFill + Op_MudDischarged_Volume%Last() ! OP_Last is mud(effect of pump added mud) + + call RemoveOpMudArrays(Op_MudOrKick%Length()) + + + endif +!=================================================================== + + +!=============== save Ann Mud data to transfer to the ChokeLine enterance + !AnnMudVolumeSum= 0.d0 + !!Ann_MudSaved_Density= 0.d0 + !!Ann_KickSaved_Density= 0.d0 + Ann_Saved_MudDischarged_Volume= 0.d0 + Ann_Kick_Saved_Volume= 0.d0 + !Saved_Ann_MudOrKick= 0 + !Ann_to_Choke_2mud= .false. + + + + + !do imud=1, Ann_MudDischarged_Volume%Length() + ! + ! AnnMudVolumeSum= AnnMudVolumeSum + Ann_MudDischarged_Volume%Array(imud) + ! + ! if ( AnnMudVolumeSum > sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) ) then + ! + ! IF (Ann_MudOrKick%Array(imud) == 0) THEN + ! Ann_MudSaved_Density = Ann_Density%Array(imud) + ! Ann_Saved_MudDischarged_Volume = AnnMudVolumeSum - sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + ! ELSEIF (Ann_MudOrKick%Array(imud) > 0 .AND. Ann_MudOrKick%Array(imud) <100) THEN ! 104= AIR + ! Ann_Kick_Saved_Volume = AnnMudVolumeSum - sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + ! Saved_Ann_MudOrKick= Ann_MudOrKick%Array (imud) + ! Ann_KickSaved_Density= Ann_Density%Array(imud) + ! END IF + ! + ! do ii= imud + 1, Ann_MudDischarged_Volume%Length() + ! IF (Ann_MudOrKick%Array(ii) == 0) THEN + ! Ann_MudSaved_Density = ((Ann_MudSaved_Density * Ann_Saved_MudDischarged_Volume) + (Ann_Density%Array(ii) * Ann_MudDischarged_Volume%Array(ii))) / (Ann_Saved_MudDischarged_Volume + Ann_MudDischarged_Volume%Array(ii)) + ! Ann_Saved_MudDischarged_Volume = Ann_Saved_MudDischarged_Volume + Ann_MudDischarged_Volume%Array(ii) + ! Ann_to_Choke_2mud= .true. + ! ELSEIF (Ann_MudOrKick%Array(ii) > 0 .AND. Ann_MudOrKick%Array(ii) <100) THEN ! 104= AIR + ! Ann_Kick_Saved_Volume = Ann_Kick_Saved_Volume + Ann_MudDischarged_Volume%Array(ii) + ! Saved_Ann_MudOrKick= Ann_MudOrKick%Array (ii) + ! Ann_KickSaved_Density= Ann_Density%Array(ii) + ! END IF + ! enddo + ! + ! exit ! exits do + ! + ! endif + ! + !enddo + + + ! write(*,*) 'check point 2==' + ! + ! + ! + ! do imud=1, Ann_MudDischarged_Volume%Length() + ! write(*,*) 'Ann:', imud, Ann_MudDischarged_Volume%Array(imud), Ann_Density%Array(imud) ,Ann_MudOrKick%Array(imud) + ! enddo + ! + ! write(*,*) 'Ann cap=' , sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + ! write(*,*) 'Ann mud sum vol=' , sum(Ann_MudDischarged_Volume%Array(:)) + ! + ! + !write(*,*) '==check point 2' + + + + + +Ann_Saved_MudDischarged_Volume_Final= Ann_Saved_MudDischarged_Volume +Ann_Kick_Saved_Volume_Final= Ann_Kick_Saved_Volume + !write(*,*) 'Ann cap=' , sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + !write(*,*) 'Ann mud sum vol=' , sum(Ann_MudDischarged_Volume%Array(:)) + + !write(*,*) 'Ann_Saved_MudDischarged_Volume_Final=' , Ann_Saved_MudDischarged_Volume_Final + + + +IF (WellHeadIsOpen) MudVolume_InjectedFromAnn = Ann_Saved_MudDischarged_Volume_Final-((Qlost/60.0d0)*DeltaT_Mudline) + !! NoGasPocket > 0 .AND. + +!write(*,*) 'Ann_Saved_Mud_Vol,Ann_Kick_Saved_Vol=' , Ann_Saved_MudDischarged_Volume,Ann_Kick_Saved_Volume + + +!====================================================================== + +!========================ANNULUS==================== + ! <<< SIMILAR TO UTUBE 2 >>> + + !write(*,*) Ann_MudOrKick%Last(), 'DeltaVolumePipe , after volume=' ,ABS(DeltaVolumePipe), Ann_MudDischarged_Volume%Last() +imud= Ann_Mud_Forehead_X%Length() + 1 + + do while (imud > 1) + imud = imud - 1 + + if (imud< Ann_Mud_Forehead_X%Length()) then + Ann_Mud_Forehead_X%Array(imud)= Ann_Mud_Backhead_X%Array(imud+1) + Ann_Mud_Forehead_section%Array(imud)= Ann_Mud_Backhead_section%Array(imud+1) + endif + + +! <<< Fracture Shoe Lost + IF ( ShoeLost .and. ShoeDepth < Ann_Mud_Backhead_X%Array(imud) .and. ShoeDepth >= Ann_Mud_Forehead_X%Array(imud) ) then + !write(*,*) 'ShoeLost imud,AnnVolume(imud), VolumeLost:' , imud,Ann_MudDischarged_Volume%Array(imud), (( Qlost/60.0d0)*DeltaT_Mudline) + Ann_MudDischarged_Volume%Array(imud)= Ann_MudDischarged_Volume%Array(imud)-((Qlost/60.0d0)*DeltaT_Mudline) !(gal) + if (Ann_MudDischarged_Volume%Array(imud) < 0.0) then + !write(*,*) 'mud is removed by shoe lost, imud=' , imud + call RemoveAnnulusMudArrays(imud) + imud= imud-1 + cycle + endif + LostInTripOutIsDone= .true. + ENDIF +! Fracture Shoe Lost >>> + + + + + + + + + !write(*,*) 'a)imud,Ann_Mud_Forehead_section=',imud,Ann_Mud_Forehead_section%Array(imud) + + DirectionCoef= (Xend_PipeSection(Ann_Mud_Forehead_section%Array(imud))-Xstart_PipeSection(Ann_Mud_Forehead_section%Array(imud))) & + / ABS(Xend_PipeSection(Ann_Mud_Forehead_section%Array(imud))-Xstart_PipeSection(Ann_Mud_Forehead_section%Array(imud))) + ! +1 for string , -1 for annulus + + !write(*,*) 'b)imud,Forehead_X,Xstart_PipeSection=',imud,Ann_Mud_Forehead_X%Array(imud),Xstart_PipeSection(Ann_Mud_Forehead_section%Array(imud)) + + Ann_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (Ann_Mud_Forehead_X%Array(imud)- Xstart_PipeSection(Ann_Mud_Forehead_section%Array(imud)))* & + Area_PipeSectionFt(Ann_Mud_Forehead_section%Array(imud)) !(ft^3) + Ann_EmptyVolume_inBackheadLocation%Array(imud)= Ann_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal + + if ( Ann_MudDischarged_Volume%Array(imud) <= Ann_EmptyVolume_inBackheadLocation%Array(imud)) then + Ann_Mud_Backhead_section%Array(imud)= Ann_Mud_Forehead_section%Array(imud) + Ann_Mud_Backhead_X%Array(imud)= Ann_Mud_Forehead_X%Array(imud)- DirectionCoef*(Ann_MudDischarged_Volume%Array(imud)/7.48051948d0)/Area_PipeSectionFt(Ann_Mud_Forehead_section%Array(imud)) + ! 7.48051948 is for gal to ft^3 + else + isection= Ann_Mud_Forehead_section%Array(imud)-1 + Ann_RemainedVolume_in_LastSection%Array(imud)= Ann_MudDischarged_Volume%Array(imud)- Ann_EmptyVolume_inBackheadLocation%Array(imud) + + do + if (isection < F_StringIntervalCounts+1) then ! last pipe section(well exit) F_StringIntervalCounts+1 is the first section in Annulus + Ann_MudDischarged_Volume%Array(imud)= Ann_MudDischarged_Volume%Array(imud)- Ann_RemainedVolume_in_LastSection%Array(imud) + Ann_Mud_Backhead_X%Array(imud)= Xstart_PipeSection(F_StringIntervalCounts+1) + Ann_Mud_Backhead_section%Array(imud)= F_StringIntervalCounts+1 + + if (Ann_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the well + call RemoveAnnulusMudArrays(imud) + endif + + exit + endif + + xx= Ann_RemainedVolume_in_LastSection%Array(imud)/ PipeSection_VolumeCapacity(isection) !(gal) + + if (xx<= 1.0) then + Ann_Mud_Backhead_section%Array(imud)= isection + Ann_Mud_Backhead_X%Array(imud)= (xx * (Xstart_PipeSection(isection)- Xend_PipeSection(isection)))+ Xend_PipeSection(isection) + exit + else + Ann_RemainedVolume_in_LastSection%Array(imud)= Ann_RemainedVolume_in_LastSection%Array(imud)- PipeSection_VolumeCapacity(isection) + isection= isection- 1 + + + endif + + enddo + + endif + + enddo +!========================ANNULUS END================= + + endif ! end of 1st &3rd & 2nd Mode + + +!************************************************************************************************************************* + + + + + + +!======================== Bottom Hole Entrance ========================== + !if (iloc == 1) then + if ( Op_NeededVolume_ToFill > 0.0 ) then ! it is needed for 2nd & 3rd mode + !write(*,*) 'op add for 2nd & 3rd mode done' + + + + if ( ABS(Op_Density%Last() - SavedDensityForOp ) >= DensityMixTol) then ! .OR. (Op_MudDischarged_Volume%Last()>42.) ) then ! 1-Merging conditions are not meeted, so new pocket + + call Op_Density%Add (SavedDensityForOp) + call Op_MudDischarged_Volume%Add (Op_NeededVolume_ToFill) + call Op_Mud_Forehead_X%Add (0.0d0) + call Op_Mud_Forehead_section%Add (1) + call Op_Mud_Backhead_X%Add (0.0d0) + call Op_Mud_Backhead_section%Add (1) + call Op_RemainedVolume_in_LastSection%Add (0.0d0) + call Op_EmptyVolume_inBackheadLocation%Add (0.0d0) + call Op_MudOrKick%Add (Ann_MudOrKick%Array(1)) + else ! 2-Pockets are Merged + + Op_Density%Array (Op_Density%Length())= (SavedDensityForOp*Op_NeededVolume_ToFill+Op_Density%Last()*Op_MudDischarged_Volume%Last())/(Op_MudDischarged_Volume%Last()+Op_NeededVolume_ToFill) + Op_MudDischarged_Volume%Array (Op_Density%Length())= Op_MudDischarged_Volume%Array (Op_Density%Length()) + Op_NeededVolume_ToFill + Op_RemainedVolume_in_LastSection%Array (Op_Density%Length())= 0.0 + Op_EmptyVolume_inBackheadLocation%Array (Op_Density%Length())= 0.0 + + endif + + endif + + + + +!============================= Bottom Hole ============================== + +imud=0 + do while (imud < Op_Mud_Forehead_X%Length()) + imud = imud + 1 + + if (imud> 1) then + Op_Mud_Backhead_X%Array(imud)= Op_Mud_Forehead_X%Array(imud-1) + Op_Mud_Backhead_section%Array(imud)= Op_Mud_Forehead_section%Array(imud-1) + endif + + DirectionCoef= (Xend_OpSection(Op_Mud_Backhead_section%Array(imud))-Xstart_OpSection(Op_Mud_Backhead_section%Array(imud))) & + / ABS(Xend_OpSection(Op_Mud_Backhead_section%Array(imud))-Xstart_OpSection(Op_Mud_Backhead_section%Array(imud))) + ! +1 for string , -1 for annulus + + + + Op_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (Xend_OpSection(Op_Mud_Backhead_section%Array(imud))- Op_Mud_Backhead_X%Array(imud))* & + Area_OpSectionFt(Op_Mud_Backhead_section%Array(imud)) !(ft^3) + Op_EmptyVolume_inBackheadLocation%Array(imud)= Op_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal + + + if ( Op_MudDischarged_Volume%Array(imud) <= Op_EmptyVolume_inBackheadLocation%Array(imud)) then + Op_Mud_Forehead_section%Array(imud)= Op_Mud_Backhead_section%Array(imud) + Op_Mud_Forehead_X%Array(imud)= Op_Mud_Backhead_X%Array(imud)+ DirectionCoef*(Op_MudDischarged_Volume%Array(imud)/7.48051948d0)/Area_OpSectionFt(Op_Mud_Backhead_section%Array(imud)) + ! 7.48051948 is for gal to ft^3 + + else + + isection= Op_Mud_Backhead_section%Array(imud)+1 + Op_RemainedVolume_in_LastSection%Array(imud)= Op_MudDischarged_Volume%Array(imud)- Op_EmptyVolume_inBackheadLocation%Array(imud) + + do + if (isection > F_BottomHoleIntervalCounts) then ! last pipe section(well exit) + !if( imud==1) KickDeltaVinAnnulus= Op_RemainedVolume_in_LastSection%Array(imud) ! Kick enters Annulus space + Op_MudDischarged_Volume%Array(imud)= Op_MudDischarged_Volume%Array(imud)- Op_RemainedVolume_in_LastSection%Array(imud) + Op_Mud_Forehead_X%Array(imud)= Xend_OpSection(F_BottomHoleIntervalCounts) + Op_Mud_Forehead_section%Array(imud)= F_BottomHoleIntervalCounts + + if (Op_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the well + call Op_MudDischarged_Volume%Remove (imud) + call Op_Mud_Backhead_X%Remove (imud) + call Op_Mud_Backhead_section%Remove (imud) + call Op_Mud_Forehead_X%Remove (imud) + call Op_Mud_Forehead_section%Remove (imud) + call Op_Density%Remove (imud) + call Op_RemainedVolume_in_LastSection%Remove (imud) + call Op_EmptyVolume_inBackheadLocation%Remove (imud) + call Op_MudOrKick%Remove (imud) + + endif + + exit + endif + + xx= Op_RemainedVolume_in_LastSection%Array(imud)/ OpSection_VolumeCapacity(isection) !(gal) + + if (xx<= 1.0) then + Op_Mud_Forehead_section%Array(imud)= isection + Op_Mud_Forehead_X%Array(imud)= (xx * (Xend_OpSection(isection)- Xstart_OpSection(isection)))+ Xstart_OpSection(isection) + exit + else + Op_RemainedVolume_in_LastSection%Array(imud)= Op_RemainedVolume_in_LastSection%Array(imud)- OpSection_VolumeCapacity(isection) + isection= isection+ 1 + + endif + + enddo + + endif + + enddo + + + +!========================Bottom Hole END================= + ! write(*,*) 'after sorting==' + !!! + ! do imud=1, Op_MudDischarged_Volume%Length() + ! write(*,*) 'Op:', imud, Op_MudDischarged_Volume%Array(imud), Op_Density%Array(imud) ,Op_MudOrKick%Array(imud) + ! enddo + ! + ! do imud=1, Ann_MudDischarged_Volume%Length() + ! write(*,*) 'Ann:', imud, Ann_MudDischarged_Volume%Array(imud), Ann_Density%Array(imud) ,Ann_MudOrKick%Array(imud) + ! enddo + !!! + !! write(*,*) 'Ann cap=' , sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + !! write(*,*) 'Ann mud sum vol=' , sum(Ann_MudDischarged_Volume%Array(:)) + !!! + !!! + !write(*,*) '==after sorting' + +!========================================================= + + + total_injected = total_injected + MudVolume_InjectedFromAnn + + if (ChokePanelStrokeResetSwitch == 1) then + total_injected= 0. + endif + !write(*,*) ' MudVolume_InjectedFromAnn =' , MudVolume_InjectedFromAnn + + !write(*,*) ' total injected-tripout =' , total_injected + !write(*,*) ' injected-tripout =' , MudVolume_InjectedFromAnn + + + + + + + + end subroutine TripOut_and_Pump + + + diff --git a/Equipments/MudSystem/Utube1_and_Trip_In.f90 b/Equipments/MudSystem/Utube1_and_Trip_In.f90 new file mode 100644 index 0000000..f01639d --- /dev/null +++ b/Equipments/MudSystem/Utube1_and_Trip_In.f90 @@ -0,0 +1,532 @@ +SUBROUTINE Utube1_and_TripIn ! is called in subroutine CirculationCodeSelect string to annulus + + Use UTUBEVARS + Use GeoElements_FluidModule + USE CMudPropertiesVariables + USE MudSystemVARIABLES + USE Pump_VARIABLES + USE sROP_Variables + use CDrillWatchVariables + use CTanksVariables, TripTankVolume2 => TripTankVolume, TripTankDensity2 => TripTankDensity + Use CShoeVariables + Use CUnityOutputs + + implicit none + + write(*,*) 'Utube1 code' +!===========================================================WELL============================================================ +!===========================================================WELL============================================================ + UtubeMode1Activated= .true. + !write(*,*) 'QUTubeInput=' , QUTubeInput + !Qinput=5000. + StringFlowRate= QUTubeInput ! (gpm) + AnnulusFlowRate= QUTubeInput + StringFlowRateFinal= StringFlowRate + AnnulusFlowRateFinal= AnnulusFlowRate +!=========================================== + + if (FirstSetUtube1==0) then + ! call St_MudDischarged_Volume%AddToFirst (REAL(sum(F_Interval(1:F_StringIntervalCounts)%Volume))) !startup initial + ! call St_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(1)) + ! call St_Mud_Backhead_section%AddToFirst (1) + ! call St_Mud_Forehead_X%AddToFirst (Xend_PipeSection(F_StringIntervalCounts)) + ! call St_Mud_Forehead_section%AddToFirst (F_StringIntervalCounts) + ! call St_Density%AddToFirst (REAL(ActiveDensity)) ! initial(ppg) + ! call St_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + ! call St_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + ! + ! call Ann_MudDischarged_Volume%AddToFirst (REAL(sum(F_Interval((F_StringIntervalCounts+F_BottomHoleIntervalCounts+1):F_IntervalsTotalCounts)%Volume))) !startup initial + ! call Ann_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) + ! call Ann_Mud_Backhead_section%AddToFirst (F_StringIntervalCounts+1) + ! call Ann_Mud_Forehead_X%AddToFirst (Xend_PipeSection(NoPipeSections)) + ! call Ann_Mud_Forehead_section%AddToFirst (NoPipeSections) + ! call Ann_Density%AddToFirst (REAL(ActiveDensity)) ! initial(ppg) + ! call Ann_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + ! call Ann_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + !Hz_Density%Array(:)= 0.0 !commented + !Hz_MudOrKick%Array(:)= 104 !commented + + Hz_Density_Utube= 0.0 + Hz_MudOrKick_Utube= 104 + + FirstSetUtube1= 1 + endif + + + + +!========================Horizontal PIPE ENTRANCE================= + + !if (SuctionDensity_Old >= (ActiveDensity+0.05) .or. SuctionDensity_Old <= (ActiveDensity-0.05)) then ! new mud is pumped + ! !ImudCount= ImudCount+1 + ! !SuctionMud= ImudCount + ! call Hz_Density%AddToFirst (REAL(ActiveDensity)) !ActiveDensity : badan in moteghayer bayad avaz beshe + ! call Hz_MudDischarged_Volume%AddToFirst (0.0d0) + ! call Hz_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(1)) + ! call Hz_Mud_Forehead_section%AddToFirst (1) + ! call Hz_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(1)) + ! call Hz_Mud_Backhead_section%AddToFirst (1) + ! call Hz_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + ! call Hz_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + ! call Hz_MudOrKick%AddToFirst (0) + ! + ! SuctionDensity_Old= ActiveDensity + !endif + +!========================Horizontal PIPE STRING================= + + !commented + +! Hz_MudDischarged_Volume%Array(1)= Hz_MudDischarged_Volume%Array(1)+ ((StringFlowRate/60.)*DeltaT_Mudline) !(gal) +! +!imud=0 +! do while (imud < Hz_Mud_Forehead_X%Length()) +! imud = imud + 1 +! +! if (imud> 1) then +! Hz_Mud_Backhead_X%Array(imud)= Hz_Mud_Forehead_X%Array(imud-1) +! Hz_Mud_Backhead_section%Array(imud)= Hz_Mud_Forehead_section%Array(imud-1) +! endif +! +! +! DirectionCoef= (Xend_PipeSection(Hz_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(Hz_Mud_Backhead_section%Array(imud))) & +! / ABS(Xend_PipeSection(Hz_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(Hz_Mud_Backhead_section%Array(imud))) +! ! +1 for string , -1 for annulus +! +! +! Hz_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (Xend_PipeSection(Hz_Mud_Backhead_section%Array(imud))- Hz_Mud_Backhead_X%Array(imud))* & +! Area_PipeSectionFt(Hz_Mud_Backhead_section%Array(imud)) !(ft^3) +! Hz_EmptyVolume_inBackheadLocation%Array(imud)= Hz_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948 ! ft^3 to gal +! +! +! if ( Hz_MudDischarged_Volume%Array(imud) <= Hz_EmptyVolume_inBackheadLocation%Array(imud)) then +! Hz_Mud_Forehead_section%Array(imud)= Hz_Mud_Backhead_section%Array(imud) +! Hz_Mud_Forehead_X%Array(imud)= Hz_Mud_Backhead_X%Array(imud)+ DirectionCoef*(Hz_MudDischarged_Volume%Array(imud)/7.48051948)/Area_PipeSectionFt(Hz_Mud_Backhead_section%Array(imud)) +! ! 7.48 is for gal to ft^3 +! else +! +! isection= Hz_Mud_Backhead_section%Array(imud)+1 +! Hz_RemainedVolume_in_LastSection%Array(imud)= Hz_MudDischarged_Volume%Array(imud)- Hz_EmptyVolume_inBackheadLocation%Array(imud) +! +! do +! if (isection > 1) then ! (horizontal pipe exit) +! Hz_MudDischarged_Volume%Array(imud)= Hz_MudDischarged_Volume%Array(imud)- Hz_RemainedVolume_in_LastSection%Array(imud) +! Hz_Mud_Forehead_X%Array(imud)= Xend_PipeSection(1) +! Hz_Mud_Forehead_section%Array(imud)= 1 +! if (Hz_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the string +! call Hz_MudDischarged_Volume%Remove (imud) +! call Hz_Mud_Backhead_X%Remove (imud) +! call Hz_Mud_Backhead_section%Remove (imud) +! call Hz_Mud_Forehead_X%Remove (imud) +! call Hz_Mud_Forehead_section%Remove (imud) +! call Hz_Density%Remove (imud) +! call Hz_RemainedVolume_in_LastSection%Remove (imud) +! call Hz_EmptyVolume_inBackheadLocation%Remove (imud) +! call Hz_MudOrKick%Remove (imud) +! +! endif +! exit +! endif +! +! xx= Hz_RemainedVolume_in_LastSection%Array(imud)/ PipeSection_VolumeCapacity(isection) !(gal) +! +! if (xx<= 1.0) then +! Hz_Mud_Forehead_section%Array(imud)= isection +! Hz_Mud_Forehead_X%Array(imud)= (xx * (Xend_PipeSection(isection)- Xstart_PipeSection(isection)))+ Xstart_PipeSection(isection) +! exit +! else +! Hz_RemainedVolume_in_LastSection%Array(imud)= Hz_RemainedVolume_in_LastSection%Array(imud)- PipeSection_VolumeCapacity(isection) +! isection= isection+ 1 +! +! +! endif +! +! enddo +! +! endif +! +! enddo + + !commented + +!========================Horizontal PIPE END================= + +!========================STRING ENTRANCE================= + !write(*,*) 'a) St_Density%Length()=' , St_Density%Length() + + if (ABS(St_Density%First() - Hz_Density_Utube) >= DensityMixTol) then ! new mud is pumped + call St_Density%AddToFirst (Hz_Density_Utube) + call St_MudDischarged_Volume%AddToFirst (0.0d0) + call St_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(2)) + call St_Mud_Forehead_section%AddToFirst (2) + call St_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(2)) + call St_Mud_Backhead_section%AddToFirst (2) + call St_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + call St_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + call St_MudOrKick%AddToFirst (Hz_MudOrKick_Utube) ! Hz_MudOrKick%Last() = 104 + + !StringDensity_Old= Hz_Density_Utube + endif + !write(*,*) 'b) St_Density%Length()=' , St_Density%Length() + !write(*,*) 'b) St_Density%Array(1)=' , St_Density%Array(1) + !write(*,*) 'b) St_MudOrKick%Array(1)=' , St_MudOrKick%Array(1) + + +!========================STRING================= + !WRITE (*,*) 'Utube1 StringFlowRate', StringFlowRate + St_MudDischarged_Volume%Array(1)= St_MudDischarged_Volume%Array(1)+ ((StringFlowRate/60.d0)*DeltaT_Mudline) !(gal) + +imud=0 + do while (imud < St_Mud_Forehead_X%Length()) + imud = imud + 1 + + + if (imud> 1) then + St_Mud_Backhead_X%Array(imud)= St_Mud_Forehead_X%Array(imud-1) + St_Mud_Backhead_section%Array(imud)= St_Mud_Forehead_section%Array(imud-1) + endif + + DirectionCoef= (Xend_PipeSection(St_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(St_Mud_Backhead_section%Array(imud))) & + / ABS(Xend_PipeSection(St_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(St_Mud_Backhead_section%Array(imud))) + ! +1 for string , -1 for annulus + + + St_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (Xend_PipeSection(St_Mud_Backhead_section%Array(imud))- St_Mud_Backhead_X%Array(imud))* & + Area_PipeSectionFt(St_Mud_Backhead_section%Array(imud)) !(ft^3) + St_EmptyVolume_inBackheadLocation%Array(imud)= St_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal + + if ( St_MudDischarged_Volume%Array(imud) <= St_EmptyVolume_inBackheadLocation%Array(imud)) then + St_Mud_Forehead_section%Array(imud)= St_Mud_Backhead_section%Array(imud) + St_Mud_Forehead_X%Array(imud)= St_Mud_Backhead_X%Array(imud)+ DirectionCoef*(St_MudDischarged_Volume%Array(imud)/7.48051948d0)/Area_PipeSectionFt(St_Mud_Backhead_section%Array(imud)) + ! 7.48 is for gal to ft^3 + else + + isection= St_Mud_Backhead_section%Array(imud)+1 + St_RemainedVolume_in_LastSection%Array(imud)= St_MudDischarged_Volume%Array(imud)- St_EmptyVolume_inBackheadLocation%Array(imud) + + do + if (isection > F_StringIntervalCounts) then ! last pipe section(string exit) F_StringIntervalCounts includes Horizontal line + St_MudDischarged_Volume%Array(imud)= St_MudDischarged_Volume%Array(imud)- St_RemainedVolume_in_LastSection%Array(imud) + St_Mud_Forehead_X%Array(imud)= Xend_PipeSection(F_StringIntervalCounts) + St_Mud_Forehead_section%Array(imud)= F_StringIntervalCounts + + if (St_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the string + call RemoveStringMudArrays(imud) + endif + + exit + endif + + xx= St_RemainedVolume_in_LastSection%Array(imud)/ PipeSection_VolumeCapacity(isection) !(gal) + + if (xx<= 1.0) then + St_Mud_Forehead_section%Array(imud)= isection + St_Mud_Forehead_X%Array(imud)= (xx * (Xend_PipeSection(isection)- Xstart_PipeSection(isection)))+ Xstart_PipeSection(isection) + exit + else + St_RemainedVolume_in_LastSection%Array(imud)= St_RemainedVolume_in_LastSection%Array(imud)- PipeSection_VolumeCapacity(isection) + isection= isection+ 1 + + + endif + + enddo + + endif + + enddo +!========================STRING END================= + +!========================== tripping in for OP remove =============================== + + !if (DeltaVolumeOp>0. .and. DeltaVolumeOp< Op_MudDischarged_Volume%Last()) then + ! Op_MudDischarged_Volume%Array(Op_MudDischarged_Volume%Length())= Op_MudDischarged_Volume%Array(Op_MudDischarged_Volume%Length()) - DeltaVolumeOp + !else + ! Op_MudDischarged_Volume%Array(Op_MudDischarged_Volume%Length()-1)= Op_MudDischarged_Volume%Array(Op_MudDischarged_Volume%Length()-1) - (DeltaVolumeOp-Op_MudDischarged_Volume%Last()) + ! + ! call Op_MudDischarged_Volume%Remove (Op_MudDischarged_Volume%Length()) + ! call Op_Mud_Backhead_X%Remove (Op_MudDischarged_Volume%Length()) + ! call Op_Mud_Backhead_section%Remove (Op_MudDischarged_Volume%Length()) + ! call Op_Mud_Forehead_X%Remove (Op_MudDischarged_Volume%Length()) + ! call Op_Mud_Forehead_section%Remove (Op_MudDischarged_Volume%Length()) + ! call Op_Density%Remove (Op_MudDischarged_Volume%Length()) + ! call Op_RemainedVolume_in_LastSection%Remove (Op_MudDischarged_Volume%Length()) + ! call Op_EmptyVolume_inBackheadLocation%Remove (Op_MudDischarged_Volume%Length()) + ! call Op_MudOrKick%Remove (Op_MudDischarged_Volume%Length()) + !endif + ! + +!============================= Bottom Hole ============================== + + !Op_MudDischarged_Volume%Array(1)= Op_MudDischarged_Volume%Array(1)+ ((GasKickPumpFlowRate/60.)*DeltaT_Mudline) !(gal) due to KickFlux +imud=0 + do while (imud < Op_Mud_Forehead_X%Length()) + imud = imud + 1 + + if (imud> 1) then + Op_Mud_Backhead_X%Array(imud)= Op_Mud_Forehead_X%Array(imud-1) + Op_Mud_Backhead_section%Array(imud)= Op_Mud_Forehead_section%Array(imud-1) + endif + + + DirectionCoef= (Xend_OpSection(Op_Mud_Backhead_section%Array(imud))-Xstart_OpSection(Op_Mud_Backhead_section%Array(imud))) & + / ABS(Xend_OpSection(Op_Mud_Backhead_section%Array(imud))-Xstart_OpSection(Op_Mud_Backhead_section%Array(imud))) + ! +1 for string , -1 for annulus + + + + Op_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (Xend_OpSection(Op_Mud_Backhead_section%Array(imud))- Op_Mud_Backhead_X%Array(imud))* & + Area_OpSectionFt(Op_Mud_Backhead_section%Array(imud)) !(ft^3) + Op_EmptyVolume_inBackheadLocation%Array(imud)= Op_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal + + + if ( Op_MudDischarged_Volume%Array(imud) <= Op_EmptyVolume_inBackheadLocation%Array(imud)) then + Op_Mud_Forehead_section%Array(imud)= Op_Mud_Backhead_section%Array(imud) + Op_Mud_Forehead_X%Array(imud)= Op_Mud_Backhead_X%Array(imud)+ DirectionCoef*(Op_MudDischarged_Volume%Array(imud)/7.48051948d0)/Area_OpSectionFt(Op_Mud_Backhead_section%Array(imud)) + ! 7.48 is for gal to ft^3 + + else + + isection= Op_Mud_Backhead_section%Array(imud)+1 + Op_RemainedVolume_in_LastSection%Array(imud)= Op_MudDischarged_Volume%Array(imud)- Op_EmptyVolume_inBackheadLocation%Array(imud) + + do + if (isection > F_BottomHoleIntervalCounts) then ! last pipe section(well exit) + if( imud==1) KickDeltaVinAnnulus= Op_RemainedVolume_in_LastSection%Array(imud) ! Kick enters Annulus space + Op_MudDischarged_Volume%Array(imud)= Op_MudDischarged_Volume%Array(imud)- Op_RemainedVolume_in_LastSection%Array(imud) + Op_Mud_Forehead_X%Array(imud)= Xend_OpSection(F_BottomHoleIntervalCounts) + Op_Mud_Forehead_section%Array(imud)= F_BottomHoleIntervalCounts + + if (Op_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the well + call RemoveOpMudArrays(imud) + endif + + exit + endif + + xx= Op_RemainedVolume_in_LastSection%Array(imud)/ OpSection_VolumeCapacity(isection) !(gal) + + if (xx<= 1.0) then + Op_Mud_Forehead_section%Array(imud)= isection + Op_Mud_Forehead_X%Array(imud)= (xx * (Xend_OpSection(isection)- Xstart_OpSection(isection)))+ Xstart_OpSection(isection) + exit + else + Op_RemainedVolume_in_LastSection%Array(imud)= Op_RemainedVolume_in_LastSection%Array(imud)- OpSection_VolumeCapacity(isection) + isection= isection+ 1 + + endif + + enddo + + endif + + + if (Op_Mud_Forehead_X%Array(imud)== Xend_OpSection(F_BottomHoleIntervalCounts)) then + totalLength = Op_MudDischarged_Volume%Length() + do while(imud < totalLength) + + !imud = imud + 1 + call RemoveOpMudArrays(totalLength) + totalLength = totalLength - 1 + + + enddo + + exit ! + + endif + + !WRITE(*,*) imud,'Op_MudDischarged_Volume%Array(imud)' , Op_MudDischarged_Volume%Array(imud), Op_Density%Array(imud) + + + + enddo + + + !write(*,*) 'Op_Mud_Forehead_X%Length()' , Op_Mud_Forehead_X%Length() + ! + ! WRITE(*,*) 'Xend_PipeSection(F_StringIntervalCounts)' , Xend_PipeSection(F_StringIntervalCounts) + ! WRITE(*,*) 'Op_Mud_Backhead_X%Array(1)' , Op_Mud_Backhead_X%Array(1) + ! WRITE(*,*) 'Op_Mud_Forehead_X%Array(1)' , Op_Mud_Forehead_X%Array(1) + ! WRITE(*,*) 'Op_Mud_Backhead_X%Array(2)' , Op_Mud_Backhead_X%Array(2) + ! WRITE(*,*) 'Op_Mud_Forehead_X%Array(2)' , Op_Mud_Forehead_X%Array(2) +!========================Bottom Hole END================= + + if (iLoc == 1) then + MudSection= F_StringIntervalCounts+1 + BackheadX= Xstart_PipeSection(F_StringIntervalCounts+1) + elseif (iLoc == 2) then + MudSection= Kick_Forehead_section + BackheadX= Kick_Forehead_X + endif + +!========================ANNULUS ENTRANCE==================== + + !write(*,*) 'iloc=====' , iLoc + if ((ABS(AnnulusSuctionDensity_Old - St_Density%Last()) >= DensityMixTol) .OR. (DeltaVolumeOp == 0.0 .and. ABS(Ann_Density%Array(iLoc)-St_Density%Last())>=DensityMixTol .and. AnnulusFlowRate/=0.0d0) ) then ! new mud is pumped + call Ann_Density%AddTo (iLoc,St_Density%Last()) + call Ann_MudDischarged_Volume%AddTo (iLoc,0.0d0) + call Ann_Mud_Forehead_X%AddTo (iLoc,BackheadX) + call Ann_Mud_Forehead_section%AddTo (iLoc,MudSection) + call Ann_Mud_Backhead_X%AddTo (iLoc,BackheadX) + call Ann_Mud_Backhead_section%AddTo (iLoc,MudSection) + call Ann_RemainedVolume_in_LastSection%AddTo (iLoc,0.0d0) + call Ann_EmptyVolume_inBackheadLocation%AddTo (iLoc,0.0d0) + call Ann_MudOrKick%AddTo (iLoc,0) + call Ann_CuttingMud%AddTo (iloc,0) + + AnnulusSuctionDensity_Old= St_Density%Last() + + MudIsChanged= .true. + endif + + Ann_MudDischarged_Volume%Array(iLoc)= Ann_MudDischarged_Volume%Array(iLoc)+ ((AnnulusFlowRate/60.0d0)*DeltaT_Mudline) !(gal) + +!========================Tripping In==================== + +!write(*,*) 'DeltaVolumeOp=' , DeltaVolumeOp + if (DeltaVolumeOp > 0.0 .and. MudIsChanged== .false.) then !.and. DrillingMode== .false.) then ! trip in mode(loole paeen) + + !write(*,*) 'Tripping In' + + NewDensity= (St_Density%Last()*((AnnulusFlowRate/60.)*DeltaT_Mudline)+Op_Density%Last()*DeltaVolumeOp)/(((AnnulusFlowRate/60.0d0)*DeltaT_Mudline)+DeltaVolumeOp) + NewVolume= ((AnnulusFlowRate/60.)*DeltaT_Mudline)+DeltaVolumeOp + + !write(*,*) 'Ann_MudDischarged_Volume%Array(1)=', Ann_MudDischarged_Volume%Array(1), 'NewVolume=', NewVolume + + if (abs(Ann_Density%Array(iLoc)-NewDensity)< DensityMixTol) then ! 1-Pockets are Merged - (ROP is 0) + Ann_Density%Array(iLoc)= (Ann_Density%Array(iLoc)*Ann_MudDischarged_Volume%Array(iLoc)+NewDensity*NewVolume)/(Ann_MudDischarged_Volume%Array(iLoc)+NewVolume) + Ann_MudDischarged_Volume%Array(iLoc)= Ann_MudDischarged_Volume%Array(iLoc)+DeltaVolumeOp + Ann_Mud_Forehead_X%Array(iLoc)= BackheadX + Ann_Mud_Forehead_section%Array(iLoc)= MudSection + Ann_Mud_Backhead_X%Array(iLoc)= BackheadX + Ann_Mud_Backhead_section%Array(iLoc)= MudSection + Ann_RemainedVolume_in_LastSection%Array(iLoc)= (0.0d0) + Ann_EmptyVolume_inBackheadLocation%Array(iLoc)= (0.0d0) + else ! 2-Merging conditions are not meeted, so new pocket + call Ann_Density%AddTo (iLoc,NewDensity) + call Ann_MudDischarged_Volume%AddTo (iLoc,NewVolume) + call Ann_Mud_Forehead_X%AddTo (iLoc,BackheadX) + call Ann_Mud_Forehead_section%AddTo (iLoc,MudSection) + call Ann_Mud_Backhead_X%AddTo (iLoc,BackheadX) + call Ann_Mud_Backhead_section%AddTo (iLoc,MudSection) + call Ann_RemainedVolume_in_LastSection%AddTo (iLoc,0.0d0) + call Ann_EmptyVolume_inBackheadLocation%AddTo (iLoc,0.0d0) + call Ann_MudOrKick%AddTo (iLoc,0) + call Ann_CuttingMud%AddTo (iLoc,0) + + endif + + + elseif (DeltaVolumeOp > 0.0 .and. MudIsChanged== .true. .and. Rate_of_Penetration==0.) then + Ann_Density%Array(iLoc)= NewDensity + Ann_MudDischarged_Volume%Array(iLoc)= NewVolume + Ann_Mud_Forehead_X%Array(iLoc)= BackheadX + Ann_Mud_Forehead_section%Array(iLoc)= MudSection + Ann_Mud_Backhead_X%Array(iLoc)= BackheadX + Ann_Mud_Backhead_section%Array(iLoc)= MudSection + Ann_RemainedVolume_in_LastSection%Array(iLoc)= (0.0d0) + Ann_EmptyVolume_inBackheadLocation%Array(iLoc)= (0.0d0) + endif + + +!========================Tripping In - End==================== + + +!======================== ANNULUS ==================== + + MudIsChanged= .false. + +imud= 0 + + do while (imud < Ann_Mud_Forehead_X%Length()) + imud = imud + 1 + + if (imud> 1) then + Ann_Mud_Backhead_X%Array(imud)= Ann_Mud_Forehead_X%Array(imud-1) + Ann_Mud_Backhead_section%Array(imud)= Ann_Mud_Forehead_section%Array(imud-1) + endif + + +! <<< Fracture Shoe Lost + IF ( ShoeLost .and. LostInTripOutIsDone== .false. .and. ShoeDepth < Ann_Mud_Backhead_X%Array(imud) .and. ShoeDepth >= Ann_Mud_Forehead_X%Array(imud) ) then + !write(*,*) 'ShoeLost imud,AnnVolume(imud), VolumeLost:' , imud,Ann_MudDischarged_Volume%Array(imud), (( Qlost/60.0d0)*DeltaT_Mudline) + Ann_MudDischarged_Volume%Array(imud)= Ann_MudDischarged_Volume%Array(imud)-((Qlost/60.0d0)*DeltaT_Mudline) !(gal) + if (Ann_MudDischarged_Volume%Array(imud) < 0.0) then + !write(*,*) 'mud is removed by shoe lost, imud=' , imud + call RemoveAnnulusMudArrays(imud) + imud= imud-1 + cycle + endif + ENDIF +! Fracture Shoe Lost >>> + + + + + + + + + DirectionCoef= (Xend_PipeSection(Ann_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(Ann_Mud_Backhead_section%Array(imud))) & + / ABS(Xend_PipeSection(Ann_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(Ann_Mud_Backhead_section%Array(imud))) + ! +1 for string , -1 for annulus + + + Ann_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (Xend_PipeSection(Ann_Mud_Backhead_section%Array(imud))- Ann_Mud_Backhead_X%Array(imud))* & + Area_PipeSectionFt(Ann_Mud_Backhead_section%Array(imud)) !(ft^3) + Ann_EmptyVolume_inBackheadLocation%Array(imud)= Ann_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal + + + if ( Ann_MudDischarged_Volume%Array(imud) <= Ann_EmptyVolume_inBackheadLocation%Array(imud)) then + Ann_Mud_Forehead_section%Array(imud)= Ann_Mud_Backhead_section%Array(imud) + Ann_Mud_Forehead_X%Array(imud)= Ann_Mud_Backhead_X%Array(imud)+ DirectionCoef*(Ann_MudDischarged_Volume%Array(imud)/7.48051948d0)/Area_PipeSectionFt(Ann_Mud_Backhead_section%Array(imud)) + ! 7.48 is for gal to ft^3 + + else + + isection= Ann_Mud_Backhead_section%Array(imud)+1 + Ann_RemainedVolume_in_LastSection%Array(imud)= Ann_MudDischarged_Volume%Array(imud)- Ann_EmptyVolume_inBackheadLocation%Array(imud) + + do + if (isection > NoPipeSections) then ! last pipe section(well exit) + Ann_MudDischarged_Volume%Array(imud)= Ann_MudDischarged_Volume%Array(imud)- Ann_RemainedVolume_in_LastSection%Array(imud) + Ann_Mud_Forehead_X%Array(imud)= Xend_PipeSection(NoPipeSections) + Ann_Mud_Forehead_section%Array(imud)= NoPipeSections + + if (Ann_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the well + call RemoveAnnulusMudArrays(imud) + endif + + exit + endif + + xx= Ann_RemainedVolume_in_LastSection%Array(imud)/ PipeSection_VolumeCapacity(isection) !(gal) + + if (xx<= 1.0) then + Ann_Mud_Forehead_section%Array(imud)= isection + Ann_Mud_Forehead_X%Array(imud)= (xx * (Xend_PipeSection(isection)- Xstart_PipeSection(isection)))+ Xstart_PipeSection(isection) + exit + else + Ann_RemainedVolume_in_LastSection%Array(imud)= Ann_RemainedVolume_in_LastSection%Array(imud)- PipeSection_VolumeCapacity(isection) + isection= isection+ 1 + + endif + + enddo + + endif + + enddo +!========================ANNULUS END================= + + !if ( WellisNOTFull == .false. ) then + ! write(*,*) 'AnnulusFlowRate==' , AnnulusFlowRate + ! call Set_FlowRate(real(100.*min(AnnulusFlowRate,PedalMeter)/(PedalMeter/10.), 8)) + ! + ! + !endif + + + +end subroutine Utube1_and_TripIn \ No newline at end of file diff --git a/Equipments/MudSystem/Utube2_and_Trip_In.f90 b/Equipments/MudSystem/Utube2_and_Trip_In.f90 new file mode 100644 index 0000000..2ad45a3 --- /dev/null +++ b/Equipments/MudSystem/Utube2_and_Trip_In.f90 @@ -0,0 +1,517 @@ +SUBROUTINE Utube2_and_TripIn ! is called in subroutine CirculationCodeSelect annulus to string + + Use UTUBEVARS + Use GeoElements_FluidModule + USE CMudPropertiesVariables + USE MudSystemVARIABLES + USE Pump_VARIABLES + use CDrillWatchVariables + use CTanksVariables, TripTankVolume2 => TripTankVolume, TripTankDensity2 => TripTankDensity + Use CShoeVariables + + implicit none + + write(*,*) 'Utube2 code' + +!===========================================================WELL============================================================ +!===========================================================WELL============================================================ + + UtubeMode2Activated= .true. + write(*,*) 'QUtubeOutput=' , QUtubeOutput + !QUTubeInput=5000. + StringFlowRate= QUtubeOutput ! (gpm) + AnnulusFlowRate= QUtubeOutput + StringFlowRateFinal= StringFlowRate + AnnulusFlowRateFinal= AnnulusFlowRate +!=========================================== + + if (FirstSetUtube2==0) then + ! call St_MudDischarged_Volume%AddToFirst (REAL(sum(F_Interval(1:F_StringIntervalCounts)%Volume))) !startup initial + ! call St_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(1)) + ! call St_Mud_Backhead_section%AddToFirst (1) + ! call St_Mud_Forehead_X%AddToFirst (Xend_PipeSection(F_StringIntervalCounts)) + ! call St_Mud_Forehead_section%AddToFirst (F_StringIntervalCounts) + ! call St_Density%AddToFirst (REAL(ActiveDensity)) ! initial(ppg) + ! call St_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + ! call St_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + ! + ! call Ann_MudDischarged_Volume%AddToFirst (REAL(sum(F_Interval((F_StringIntervalCounts+F_BottomHoleIntervalCounts+1):F_IntervalsTotalCounts)%Volume))) !startup initial + ! call Ann_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) + ! call Ann_Mud_Backhead_section%AddToFirst (F_StringIntervalCounts+1) + ! call Ann_Mud_Forehead_X%AddToFirst (Xend_PipeSection(NoPipeSections)) + ! call Ann_Mud_Forehead_section%AddToFirst (NoPipeSections) + ! call Ann_Density%AddToFirst (REAL(ActiveDensity)) ! initial(ppg) + ! call Ann_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + ! call Ann_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + !Hz_Density%Array(:)= 0.0 + !Hz_MudOrKick%Array(:)= 104 + + Hz_Density_Utube= 0.0 + Hz_MudOrKick_Utube= 104 + + FirstSetUtube2= 1 + endif + + + + +!========================Horizontal PIPE ENTRANCE================= + + !if (SuctionDensity_Old >= (ActiveDensity+0.05) .or. SuctionDensity_Old <= (ActiveDensity-0.05)) then ! new mud is pumped + ! !ImudCount= ImudCount+1 + ! !SuctionMud= ImudCount + ! call Hz_Density%AddToFirst (REAL(ActiveDensity)) !ActiveDensity : badan in moteghayer bayad avaz beshe + ! call Hz_MudDischarged_Volume%AddToFirst (0.0d0) + ! call Hz_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(1)) + ! call Hz_Mud_Forehead_section%AddToFirst (1) + ! call Hz_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(1)) + ! call Hz_Mud_Backhead_section%AddToFirst (1) + ! call Hz_RemainedVolume_in_LastSection%AddToFirst (0.0d0) + ! call Hz_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) + ! call Hz_MudOrKick%AddToFirst (0) + + ! deltaV= 0. + ! + ! SuctionDensity_Old= ActiveDensity + !endif + +!========================Horizontal PIPE STRING================= + + !commented + +! Hz_MudDischarged_Volume%Array(1)= Hz_MudDischarged_Volume%Array(1)+ ((StringFlowRate/60.)*DeltaT_Mudline) !(gal) +! +!imud=0 +! do while (imud < Hz_Mud_Forehead_X%Length()) +! imud = imud + 1 +! +! if (imud> 1) then +! Hz_Mud_Backhead_X%Array(imud)= Hz_Mud_Forehead_X%Array(imud-1) +! Hz_Mud_Backhead_section%Array(imud)= Hz_Mud_Forehead_section%Array(imud-1) +! endif +! +! +! DirectionCoef= (Xend_PipeSection(Hz_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(Hz_Mud_Backhead_section%Array(imud))) & +! / ABS(Xend_PipeSection(Hz_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(Hz_Mud_Backhead_section%Array(imud))) +! ! +1 for string , -1 for annulus +! +! +! Hz_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (Xend_PipeSection(Hz_Mud_Backhead_section%Array(imud))- Hz_Mud_Backhead_X%Array(imud))* & +! Area_PipeSectionFt(Hz_Mud_Backhead_section%Array(imud)) !(ft^3) +! Hz_EmptyVolume_inBackheadLocation%Array(imud)= Hz_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948 ! ft^3 to gal +! +! +! if ( Hz_MudDischarged_Volume%Array(imud) <= Hz_EmptyVolume_inBackheadLocation%Array(imud)) then +! Hz_Mud_Forehead_section%Array(imud)= Hz_Mud_Backhead_section%Array(imud) +! Hz_Mud_Forehead_X%Array(imud)= Hz_Mud_Backhead_X%Array(imud)+ DirectionCoef*(Hz_MudDischarged_Volume%Array(imud)/7.48051948)/Area_PipeSectionFt(Hz_Mud_Backhead_section%Array(imud)) +! ! 7.48051948 is for gal to ft^3 +! else +! +! isection= Hz_Mud_Backhead_section%Array(imud)+1 +! Hz_RemainedVolume_in_LastSection%Array(imud)= Hz_MudDischarged_Volume%Array(imud)- Hz_EmptyVolume_inBackheadLocation%Array(imud) +! +! do +! if (isection > 1) then ! (horizontal pipe exit) +! Hz_MudDischarged_Volume%Array(imud)= Hz_MudDischarged_Volume%Array(imud)- Hz_RemainedVolume_in_LastSection%Array(imud) +! Hz_Mud_Forehead_X%Array(imud)= Xend_PipeSection(1) +! Hz_Mud_Forehead_section%Array(imud)= 1 +! if (Hz_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the string +! call Hz_MudDischarged_Volume%Remove (imud) +! call Hz_Mud_Backhead_X%Remove (imud) +! call Hz_Mud_Backhead_section%Remove (imud) +! call Hz_Mud_Forehead_X%Remove (imud) +! call Hz_Mud_Forehead_section%Remove (imud) +! call Hz_Density%Remove (imud) +! call Hz_RemainedVolume_in_LastSection%Remove (imud) +! call Hz_EmptyVolume_inBackheadLocation%Remove (imud) +! call Hz_MudOrKick%Remove (imud) +! endif +! exit +! endif +! +! xx= Hz_RemainedVolume_in_LastSection%Array(imud)/ PipeSection_VolumeCapacity(isection) !(gal) +! +! if (xx<= 1.0) then +! Hz_Mud_Forehead_section%Array(imud)= isection +! Hz_Mud_Forehead_X%Array(imud)= (xx * (Xend_PipeSection(isection)- Xstart_PipeSection(isection)))+ Xstart_PipeSection(isection) +! exit +! else +! Hz_RemainedVolume_in_LastSection%Array(imud)= Hz_RemainedVolume_in_LastSection%Array(imud)- PipeSection_VolumeCapacity(isection) +! isection= isection+ 1 +! +! +! endif +! +! enddo +! +! endif +! +! enddo + + !commented + +!========================Horizontal PIPE END================= + +!========================ANNULUS ENTRANCE==================== + + if (ABS(AnnulusSuctionDensity_Old - Hz_Density_Utube) >= DensityMixTol ) then ! new mud is pumped + call Ann_Density%Add (Hz_Density_Utube) + call Ann_MudDischarged_Volume%Add (0.0d0) + call Ann_Mud_Forehead_X%Add (Xend_PipeSection(NoPipeSections)) + call Ann_Mud_Forehead_section%Add (NoPipeSections) + call Ann_Mud_Backhead_X%Add (Xstart_PipeSection(NoPipeSections)) + call Ann_Mud_Backhead_section%Add (NoPipeSections) + call Ann_RemainedVolume_in_LastSection%Add (0.0d0) + call Ann_EmptyVolume_inBackheadLocation%Add (0.0d0) + call Ann_MudOrKick%Add (Hz_MudOrKick_Utube) ! Hz_MudOrKick%Last() = 104 + call Ann_CuttingMud%Add (0) + + AnnulusSuctionDensity_Old= Hz_Density_Utube + endif + +!========================ANNULUS==================== + + Ann_MudDischarged_Volume%Array(Ann_MudDischarged_Volume%Length())= Ann_MudDischarged_Volume%Last()+ ((AnnulusFlowRate/60.)*DeltaT_Mudline) !(gal) + +imud= Ann_Mud_Forehead_X%Length() + 1 + + do while (imud > 1) + imud = imud - 1 + + if (imud< Ann_Mud_Forehead_X%Length()) then + Ann_Mud_Forehead_X%Array(imud)= Ann_Mud_Backhead_X%Array(imud+1) + Ann_Mud_Forehead_section%Array(imud)= Ann_Mud_Backhead_section%Array(imud+1) + endif + +! <<< Fracture Shoe Lost + IF ( ShoeLost .and. LostInTripOutIsDone== .false. .and. ShoeDepth < Ann_Mud_Backhead_X%Array(imud) .and. ShoeDepth >= Ann_Mud_Forehead_X%Array(imud) ) then + !write(*,*) 'ShoeLost imud,AnnVolume(imud), VolumeLost:' , imud,Ann_MudDischarged_Volume%Array(imud), (( Qlost/60.0d0)*DeltaT_Mudline) + Ann_MudDischarged_Volume%Array(imud)= Ann_MudDischarged_Volume%Array(imud)-((Qlost/60.0d0)*DeltaT_Mudline) !(gal) + if (Ann_MudDischarged_Volume%Array(imud) < 0.0) then + !write(*,*) 'mud is removed by shoe lost, imud=' , imud + call RemoveAnnulusMudArrays(imud) + imud= imud-1 + cycle + endif + ENDIF +! Fracture Shoe Lost >>> + + + DirectionCoef= (Xend_PipeSection(Ann_Mud_Forehead_section%Array(imud))-Xstart_PipeSection(Ann_Mud_Forehead_section%Array(imud))) & + / ABS(Xend_PipeSection(Ann_Mud_Forehead_section%Array(imud))-Xstart_PipeSection(Ann_Mud_Forehead_section%Array(imud))) + ! +1 for string , -1 for annulus + + + Ann_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (Ann_Mud_Forehead_X%Array(imud)- Xstart_PipeSection(Ann_Mud_Forehead_section%Array(imud)))* & + Area_PipeSectionFt(Ann_Mud_Forehead_section%Array(imud)) !(ft^3) + Ann_EmptyVolume_inBackheadLocation%Array(imud)= Ann_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal + + + if ( Ann_MudDischarged_Volume%Array(imud) <= Ann_EmptyVolume_inBackheadLocation%Array(imud)) then + Ann_Mud_Backhead_section%Array(imud)= Ann_Mud_Forehead_section%Array(imud) + Ann_Mud_Backhead_X%Array(imud)= Ann_Mud_Forehead_X%Array(imud)- DirectionCoef*(Ann_MudDischarged_Volume%Array(imud)/7.48051948d0)/Area_PipeSectionFt(Ann_Mud_Forehead_section%Array(imud)) + ! 7.48051948 is for gal to ft^3 + else + + isection= Ann_Mud_Forehead_section%Array(imud)-1 + Ann_RemainedVolume_in_LastSection%Array(imud)= Ann_MudDischarged_Volume%Array(imud)- Ann_EmptyVolume_inBackheadLocation%Array(imud) + + do + if (isection < F_StringIntervalCounts+1) then ! last pipe section(well exit) F_StringIntervalCounts+1 is the first section in Annulus + Ann_MudDischarged_Volume%Array(imud)= Ann_MudDischarged_Volume%Array(imud)- Ann_RemainedVolume_in_LastSection%Array(imud) + Ann_Mud_Backhead_X%Array(imud)= Xstart_PipeSection(F_StringIntervalCounts+1) + Ann_Mud_Backhead_section%Array(imud)= F_StringIntervalCounts+1 + + if (Ann_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the well + call RemoveAnnulusMudArrays(imud) + endif + + exit + endif + + xx= Ann_RemainedVolume_in_LastSection%Array(imud)/ PipeSection_VolumeCapacity(isection) !(gal) + + if (xx<= 1.0) then + Ann_Mud_Backhead_section%Array(imud)= isection + Ann_Mud_Backhead_X%Array(imud)= (xx * (Xstart_PipeSection(isection)- Xend_PipeSection(isection)))+ Xend_PipeSection(isection) + exit + else + Ann_RemainedVolume_in_LastSection%Array(imud)= Ann_RemainedVolume_in_LastSection%Array(imud)- PipeSection_VolumeCapacity(isection) + isection= isection- 1 + + + endif + + enddo + + endif + + enddo +!========================ANNULUS END================= + +!========================== tripping in for OP remove =============================== + + !if (DeltaVolumeOp>0. .and. DeltaVolumeOp< Op_MudDischarged_Volume%Last()) then + ! Op_MudDischarged_Volume%Array(Op_MudDischarged_Volume%Length())= Op_MudDischarged_Volume%Array(Op_MudDischarged_Volume%Length()) - DeltaVolumeOp + !else + ! Op_MudDischarged_Volume%Array(Op_MudDischarged_Volume%Length()-1)= Op_MudDischarged_Volume%Array(Op_MudDischarged_Volume%Length()-1) - (DeltaVolumeOp-Op_MudDischarged_Volume%Last()) + ! + ! call Op_MudDischarged_Volume%Remove (Op_MudDischarged_Volume%Length()) + ! call Op_Mud_Backhead_X%Remove (Op_MudDischarged_Volume%Length()) + ! call Op_Mud_Backhead_section%Remove (Op_MudDischarged_Volume%Length()) + ! call Op_Mud_Forehead_X%Remove (Op_MudDischarged_Volume%Length()) + ! call Op_Mud_Forehead_section%Remove (Op_MudDischarged_Volume%Length()) + ! call Op_Density%Remove (Op_MudDischarged_Volume%Length()) + ! call Op_RemainedVolume_in_LastSection%Remove (Op_MudDischarged_Volume%Length()) + ! call Op_EmptyVolume_inBackheadLocation%Remove (Op_MudDischarged_Volume%Length()) + ! call Op_MudOrKick%Remove (Op_MudDischarged_Volume%Length()) + !endif + ! + +!============================= Bottom Hole ============================== + + !Op_MudDischarged_Volume%Array(1)= Op_MudDischarged_Volume%Array(1)+ ((GasKickPumpFlowRate/60.)*DeltaT_Mudline) !(gal) due to KickFlux +imud=0 + do while (imud < Op_Mud_Forehead_X%Length()) + imud = imud + 1 + + if (imud> 1) then + Op_Mud_Backhead_X%Array(imud)= Op_Mud_Forehead_X%Array(imud-1) + Op_Mud_Backhead_section%Array(imud)= Op_Mud_Forehead_section%Array(imud-1) + endif + + + DirectionCoef= (Xend_OpSection(Op_Mud_Backhead_section%Array(imud))-Xstart_OpSection(Op_Mud_Backhead_section%Array(imud))) & + / ABS(Xend_OpSection(Op_Mud_Backhead_section%Array(imud))-Xstart_OpSection(Op_Mud_Backhead_section%Array(imud))) + ! +1 for string , -1 for annulus + + + + Op_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (Xend_OpSection(Op_Mud_Backhead_section%Array(imud))- Op_Mud_Backhead_X%Array(imud))* & + Area_OpSectionFt(Op_Mud_Backhead_section%Array(imud)) !(ft^3) + Op_EmptyVolume_inBackheadLocation%Array(imud)= Op_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal + + + if ( Op_MudDischarged_Volume%Array(imud) <= Op_EmptyVolume_inBackheadLocation%Array(imud)) then + Op_Mud_Forehead_section%Array(imud)= Op_Mud_Backhead_section%Array(imud) + Op_Mud_Forehead_X%Array(imud)= Op_Mud_Backhead_X%Array(imud)+ DirectionCoef*(Op_MudDischarged_Volume%Array(imud)/7.48051948d0)/Area_OpSectionFt(Op_Mud_Backhead_section%Array(imud)) + ! 7.48051948 is for gal to ft^3 + + else + + isection= Op_Mud_Backhead_section%Array(imud)+1 + Op_RemainedVolume_in_LastSection%Array(imud)= Op_MudDischarged_Volume%Array(imud)- Op_EmptyVolume_inBackheadLocation%Array(imud) + + do + if (isection > F_BottomHoleIntervalCounts) then ! last pipe section(well exit) + if( imud==1) KickDeltaVinAnnulus= Op_RemainedVolume_in_LastSection%Array(imud) ! Kick enters Annulus space + Op_MudDischarged_Volume%Array(imud)= Op_MudDischarged_Volume%Array(imud)- Op_RemainedVolume_in_LastSection%Array(imud) + Op_Mud_Forehead_X%Array(imud)= Xend_OpSection(F_BottomHoleIntervalCounts) + Op_Mud_Forehead_section%Array(imud)= F_BottomHoleIntervalCounts + + if (Op_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the well + call RemoveOpMudArrays(imud) + endif + + exit + endif + + xx= Op_RemainedVolume_in_LastSection%Array(imud)/ OpSection_VolumeCapacity(isection) !(gal) + + if (xx<= 1.0) then + Op_Mud_Forehead_section%Array(imud)= isection + Op_Mud_Forehead_X%Array(imud)= (xx * (Xend_OpSection(isection)- Xstart_OpSection(isection)))+ Xstart_OpSection(isection) + exit + else + Op_RemainedVolume_in_LastSection%Array(imud)= Op_RemainedVolume_in_LastSection%Array(imud)- OpSection_VolumeCapacity(isection) + isection= isection+ 1 + + endif + + enddo + + endif + + if (Op_Mud_Forehead_X%Array(imud)== Xend_OpSection(F_BottomHoleIntervalCounts)) then + totalLength = Op_MudDischarged_Volume%Length() + do while(imud < totalLength) + + !imud = imud + 1 + call RemoveOpMudArrays(totalLength) + totalLength = totalLength - 1 + + + enddo + + exit ! + + endif + + !WRITE(*,*) imud,'Op_MudDischarged_Volume%Array(imud)' , Op_MudDischarged_Volume%Array(imud), Op_Density%Array(imud) + + + + + + + enddo + + + !write(*,*) 'Op_Mud_Forehead_X%Length()' , Op_Mud_Forehead_X%Length() + ! + ! WRITE(*,*) 'Xend_PipeSection(F_StringIntervalCounts)' , Xend_PipeSection(F_StringIntervalCounts) + ! WRITE(*,*) 'Op_Mud_Backhead_X%Array(1)' , Op_Mud_Backhead_X%Array(1) + ! WRITE(*,*) 'Op_Mud_Forehead_X%Array(1)' , Op_Mud_Forehead_X%Array(1) + ! WRITE(*,*) 'Op_Mud_Backhead_X%Array(2)' , Op_Mud_Backhead_X%Array(2) + ! WRITE(*,*) 'Op_Mud_Forehead_X%Array(2)' , Op_Mud_Forehead_X%Array(2) +!========================Bottom Hole END================= + + + + + ! NO KICK + + + +!========================STRING ENTRANCE================= + + if ((ABS(St_Density%Last() - Ann_Density%First()) >= DensityMixTol) .OR. (DeltaVolumeOp == 0.0 .and. St_Density%Last() /= Ann_Density%Array(1) .and. StringFlowRate/=0.0d0)) then ! new mud is pumped + + !if ((ABS(StringDensity_Old - Ann_Density%First()) >= DensityMixTol) .OR. (DeltaVolumeOp == 0.0 .and. St_Density%Last() /= Ann_Density%Array(1) .and. StringFlowRate/=0.0d0)) then ! new mud is pumped + call St_Density%Add (Ann_Density%First()) + call St_MudDischarged_Volume%Add (0.0d0) + call St_Mud_Forehead_X%Add (Xend_PipeSection(F_StringIntervalCounts)) + call St_Mud_Forehead_section%Add (F_StringIntervalCounts) + call St_Mud_Backhead_X%Add (Xstart_PipeSection(F_StringIntervalCounts)) + call St_Mud_Backhead_section%Add (F_StringIntervalCounts) + call St_RemainedVolume_in_LastSection%Add (0.0d0) + call St_EmptyVolume_inBackheadLocation%Add (0.0d0) + call St_MudOrKick%Add (0) + + !StringDensity_Old= Ann_Density%First() + + MudIsChanged= .true. + endif + + St_MudDischarged_Volume%Array(St_MudDischarged_Volume%Length())= St_MudDischarged_Volume%Last()+ ((StringFlowRate/60.0d0)*DeltaT_Mudline) !(gal) + +!========================Tripping In==================== + +!write(*,*) 'DeltaVolumeOp=' , DeltaVolumeOp +write(*,*) 'DeltaVolumeOp=' , DeltaVolumeOp + if (DeltaVolumeOp > 0.0 .and. MudIsChanged== .false.) then !.and. DrillingMode== .false.) then ! trip in mode(loole paeen) + + !write(*,*) 'Tripping In' + + NewDensity= (Ann_Density%First()*((StringFlowRate/60.0d0)*DeltaT_Mudline)+Op_Density%Last()*DeltaVolumeOp)/(((StringFlowRate/60.0d0)*DeltaT_Mudline)+DeltaVolumeOp) + NewVolume= ((StringFlowRate/60.0d0)*DeltaT_Mudline)+DeltaVolumeOp + + !write(*,*) 'St_MudDischarged_Volume%Last()=', St_MudDischarged_Volume%Last(), 'NewVolume=', NewVolume + + if (abs(St_Density%Last()-NewDensity)< DensityMixTol) then ! .OR. (St_MudDischarged_Volume%Last()< 42.) ) then !+ NewVolume)< 42.) then ! 1-Pockets are Merged + St_Density%Array(St_Density%Length())= (St_Density%Last()*St_MudDischarged_Volume%Last()+NewDensity*NewVolume)/(St_MudDischarged_Volume%Last()+NewVolume) + St_MudDischarged_Volume%Array(St_Density%Length())= St_MudDischarged_Volume%Last()+DeltaVolumeOp + St_Mud_Forehead_X%Array(St_Density%Length())= (Xend_PipeSection(F_StringIntervalCounts)) + St_Mud_Forehead_section%Array(St_Density%Length())= (F_StringIntervalCounts) + St_Mud_Backhead_X%Array(St_Density%Length())= (Xstart_PipeSection(F_StringIntervalCounts)) + St_Mud_Backhead_section%Array(St_Density%Length())= (F_StringIntervalCounts) + St_RemainedVolume_in_LastSection%Array(St_Density%Length())= (0.0d0) + St_EmptyVolume_inBackheadLocation%Array(St_Density%Length())= (0.0d0) + else ! 2-Merging conditions are not meeted, so new pocket + call St_Density%Add (NewDensity) + call St_MudDischarged_Volume%Add (NewVolume) + call St_Mud_Forehead_X%Add (Xend_PipeSection(F_StringIntervalCounts)) + call St_Mud_Forehead_section%Add (F_StringIntervalCounts) + call St_Mud_Backhead_X%Add (Xstart_PipeSection(F_StringIntervalCounts)) + call St_Mud_Backhead_section%Add (F_StringIntervalCounts) + call St_RemainedVolume_in_LastSection%Add (0.0d0) + call St_EmptyVolume_inBackheadLocation%Add (0.0d0) + call St_MudOrKick%Add (0) + endif + + + elseif (DeltaVolumeOp > 0.0 .and. MudIsChanged== .true.) then + St_Density%Array(St_Density%Length())= NewDensity + St_MudDischarged_Volume%Array(St_Density%Length())= NewVolume + St_Mud_Forehead_X%Array(St_Density%Length())= (Xend_PipeSection(F_StringIntervalCounts)) + St_Mud_Forehead_section%Array(St_Density%Length())= (F_StringIntervalCounts) + St_Mud_Backhead_X%Array(St_Density%Length())= (Xstart_PipeSection(F_StringIntervalCounts)) + St_Mud_Backhead_section%Array(St_Density%Length())= (F_StringIntervalCounts) + St_RemainedVolume_in_LastSection%Array(St_Density%Length())= (0.0d0) + St_EmptyVolume_inBackheadLocation%Array(St_Density%Length())= (0.0d0) + endif + + +!========================Tripping In - End==================== + + +!======================== STRING ==================== + + MudIsChanged= .false. + + imud= St_Mud_Forehead_X%Length() + 1 + + do while (imud > 1) + imud = imud - 1 + + if (imud< St_Mud_Forehead_X%Length()) then + St_Mud_Forehead_X%Array(imud)= St_Mud_Backhead_X%Array(imud+1) + St_Mud_Forehead_section%Array(imud)= St_Mud_Backhead_section%Array(imud+1) + endif + + + DirectionCoef= (Xend_PipeSection(St_Mud_Forehead_section%Array(imud))-Xstart_PipeSection(St_Mud_Forehead_section%Array(imud))) & + / ABS(Xend_PipeSection(St_Mud_Forehead_section%Array(imud))-Xstart_PipeSection(St_Mud_Forehead_section%Array(imud))) + ! +1 for string , -1 for annulus + + + St_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (St_Mud_Forehead_X%Array(imud)- Xstart_PipeSection(St_Mud_Forehead_section%Array(imud)))* & + Area_PipeSectionFt(St_Mud_Backhead_section%Array(imud)) !(ft^3) + St_EmptyVolume_inBackheadLocation%Array(imud)= St_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal + + + if ( St_MudDischarged_Volume%Array(imud) <= St_EmptyVolume_inBackheadLocation%Array(imud)) then + St_Mud_Backhead_section%Array(imud)= St_Mud_Forehead_section%Array(imud) + St_Mud_Backhead_X%Array(imud)= St_Mud_Forehead_X%Array(imud)- DirectionCoef*(St_MudDischarged_Volume%Array(imud)/7.48051948d0)/Area_PipeSectionFt(St_Mud_Forehead_section%Array(imud)) + ! 7.48051948 is for gal to ft^3 + else + + isection= St_Mud_Backhead_section%Array(imud)-1 + St_RemainedVolume_in_LastSection%Array(imud)= St_MudDischarged_Volume%Array(imud)- St_EmptyVolume_inBackheadLocation%Array(imud) + + do + if (isection < 1) then ! last pipe section(string exit) + St_MudDischarged_Volume%Array(imud)= St_MudDischarged_Volume%Array(imud)- St_RemainedVolume_in_LastSection%Array(imud) + St_Mud_Backhead_X%Array(imud)= Xstart_PipeSection(2) + St_Mud_Backhead_section%Array(imud)= 2 + + if (St_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the string + call RemoveStringMudArrays(imud) + endif + + exit + endif + + xx= St_RemainedVolume_in_LastSection%Array(imud)/ PipeSection_VolumeCapacity(isection) !(gal) + + if (xx<= 1.0) then + St_Mud_Backhead_section%Array(imud)= isection + St_Mud_Backhead_X%Array(imud)= (xx * (Xstart_PipeSection(isection)- Xend_PipeSection(isection)))+ Xend_PipeSection(isection) + exit + else + St_RemainedVolume_in_LastSection%Array(imud)= St_RemainedVolume_in_LastSection%Array(imud)- PipeSection_VolumeCapacity(isection) + isection= isection- 1 + + endif + + enddo + + endif + + enddo +!========================STRING END================= + + + + +end subroutine Utube2_and_TripIn \ No newline at end of file diff --git a/Equipments/PowerLimits.f90 b/Equipments/PowerLimits.f90 new file mode 100644 index 0000000..ef3d414 --- /dev/null +++ b/Equipments/PowerLimits.f90 @@ -0,0 +1,44 @@ +subroutine PowerLimits + !subroutine PowerLimits(Power_sigma) + + USE Pump_VARIABLES, only: PUMP + USE Drawworks_VARIABLES, only: Drawworks + USE RTable_VARIABLES, only: RTable + USE CPowerVariables, only: NumberOfgenerators, GeneratorPowerRating + USE CDrillingConsoleVariables + USE equipments_PowerLimit + + IMPLICIT NONE + !integer :: ii + + + Power_sigma=2.d0*(PUMP(1)%Vt*PUMP(1)%ia_new)+2.d0*(PUMP(2)%Vt*PUMP(2)%ia_new)+2.d0*(PUMP(3)%Vt*PUMP(3)%ia_new)+(RTable%Vt*RTable%ia_new)+2.d0*(Drawworks%Vt*Drawworks%ia_new) + !write(*,*) 'Power_sigma=', Power_sigma + + + power_num_of_Jenerators=sngl(NumberOfgenerators) + Jenerator_power=GeneratorPowerRating + drilling_console_Jenerators(1)=GEN1BTNLED + drilling_console_Jenerators(2)=GEN2BTNLED + drilling_console_Jenerators(3)=GEN3BTNLED + drilling_console_Jenerators(4)=GEN4BTNLED + + drilling_num_of_Jenerators=0.d0 + !do ii=1,4 + ! if (drilling_console_Jenerators(ii)=1) then + ! drilling_num_of_Jenerators=drilling_num_of_Jenerators+1. + ! end if + !end do + drilling_num_of_Jenerators=sngl(sum(drilling_console_Jenerators)) + !drilling_num_of_Jenerators=1.d0 + + if (power_num_of_Jenerators>drilling_num_of_Jenerators) then + num_of_active_Jenerators=drilling_num_of_Jenerators + else if (power_num_of_Jenerators<=drilling_num_of_Jenerators) then + num_of_active_Jenerators=power_num_of_Jenerators + end if + + max_Power_sigma=num_of_active_Jenerators*Jenerator_power + + +end subroutine PowerLimits \ No newline at end of file diff --git a/Equipments/Pumps.old/ON_mode_simulation.f90 b/Equipments/Pumps.old/ON_mode_simulation.f90 new file mode 100644 index 0000000..b6efbd0 --- /dev/null +++ b/Equipments/Pumps.old/ON_mode_simulation.f90 @@ -0,0 +1,80 @@ +subroutine ON_mode_simulation(Pump_No) + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + use equipments_PowerLimit + + IMPLICIT NONE + INTEGER :: Pump_No + + Call Pump_INPUTS + + ! Torque unit = (in.lbf) + PUMP(Pump_No)%Torque = (63025./132000.)*(1./PUMP(Pump_No)%Trans_Ratio)*(PUMP(Pump_No)%Piston_Area*PUMP(Pump_No)%Stroke_Length*PUMP(Pump_No)%StandPipe_Pressure/PUMP(Pump_No)%Mech_Efficiency/PUMP(Pump_No)%Vol_Efficiency) + + !call PowerLimits + + Call Pump_Traction_Motor(Pump_No) + + if (PUMP(Pump_No)%N_ref<=0.) then + PUMP(Pump_No)%w_ref = 0. + PUMP(Pump_No)%w_old = 0. + PUMP(Pump_No)%w = 0. + PUMP(Pump_No)%w_new = 0. + PUMP(Pump_No)%ia_old = 0. + PUMP(Pump_No)%ia = 0. + PUMP(Pump_No)%ia_new = 0. + PUMP(Pump_No)%x_old = 0. + PUMP(Pump_No)%x = 0. + PUMP(Pump_No)%x_new = 0. + end if + + if (Power_sigma>max_Power_sigma) then + PUMP(Pump_No)%Vt_old = PUMP(Pump_No)%Vt_old + else + PUMP(Pump_No)%Vt_old = PUMP(Pump_No)%x_new+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi))-PUMP(Pump_No)%ia_new) + IF (PUMP(Pump_No)%Vt_old>810.) THEN + PUMP(Pump_No)%Vt_old = 810. + ELSE IF (PUMP(Pump_No)%Vt_old<0.) THEN + PUMP(Pump_No)%Vt_old = 0. + END IF + + end if + + !PUMP(Pump_No)%Vt=PUMP(Pump_No)%x_new+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi))-PUMP(Pump_No)%ia_new) + !IF (PUMP(Pump_No)%Vt>810.) THEN + ! PUMP(Pump_No)%Vt=810. + !ELSE IF (PUMP(Pump_No)%Vt<0.) THEN + ! PUMP(Pump_No)%Vt=0. + !END IF + + PUMP(Pump_No)%Speed = 30.*PUMP(Pump_No)%w_new/pi !Speed [RPM] + + Call Set_MP1SPMGauge( sngl(1-PUMP(1)%SPMGaugeMalf)*real((PUMP(1)%Speed/PUMP(1)%Trans_Ratio),8) ) + SPM1 = MP1SPMGauge + Call Set_MP2SPMGauge( sngl(1-PUMP(2)%SPMGaugeMalf)*real((PUMP(2)%Speed/PUMP(2)%Trans_Ratio),8) ) + SPM2 = MP2SPMGauge + + Call Pump_Solver(Pump_No) + Call Pump_Total_Counts + !print*, 'PUMP(1)%Flow_Rate=' , PUMP(1)%Flow_Rate + IF (PUMP(1)%Flow_Rate>0.) Then + Call OpenPump1() + !print*, 'open pump 1' + Else + Call ClosePump1() + !print*, 'close pump 1' + End if + + IF (PUMP(2)%Flow_Rate>0.) Then + Call OpenPump2() + Else + Call ClosePump2() + End if + + +end subroutine ON_mode_simulation \ No newline at end of file diff --git a/Equipments/Pumps.old/Off_mode_Simulation.f90 b/Equipments/Pumps.old/Off_mode_Simulation.f90 new file mode 100644 index 0000000..529ebf4 --- /dev/null +++ b/Equipments/Pumps.old/Off_mode_Simulation.f90 @@ -0,0 +1,51 @@ +subroutine Off_mode_Simulation(Pump_No) + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + + IMPLICIT NONE + INTEGER :: Pump_No + + CALL Pump_INPUTS + + !================================================================== + ! Rate limit for off Mode + + Do while (((PUMP(Pump_No)%N_old-0.0d0)/PUMP(Pump_No)%time_step)>386.) + PUMP(Pump_No)%N_ref = (-386.*PUMP(Pump_No)%time_step)+PUMP(Pump_No)%N_old + !else + ! PUMP(1)%N_ref=0.0d0 + !end if + + Call ON_mode_simulation(Pump_No) + + PUMP(Pump_No)%N_old = PUMP(Pump_No)%N_ref + Call sleepqq (80) !????????????????? + End Do + !================================================================== + + PUMP(Pump_No)%Speed = 0.0d0 + Call Set_MP1SPMGauge( sngl(1-PUMP(1)%SPMGaugeMalf)*real((PUMP(1)%Speed/PUMP(1)%Trans_Ratio),8) ) + SPM1 = MP1SPMGauge + Call Set_MP2SPMGauge( sngl(1-PUMP(2)%SPMGaugeMalf)*real((PUMP(2)%Speed/PUMP(2)%Trans_Ratio),8) ) + SPM2 = MP2SPMGauge + PUMP(Pump_No)%w = 0. + PUMP(Pump_No)%w_old = 0.0d0 + PUMP(Pump_No)%w_new = 0.0d0 + PUMP(Pump_No)%ia = 0.0d0 + PUMP(Pump_No)%ia_old = 0.0d0 + PUMP(Pump_No)%ia_new = 0.0d0 + PUMP(Pump_No)%x = 0.0d0 + PUMP(Pump_No)%x_old = 0.0d0 + PUMP(Pump_No)%x_new = 0.0d0 + + Call Pump_Solver(Pump_No) + + Call Pump_Total_Counts + + +end subroutine off_mode_simulation \ No newline at end of file diff --git a/Equipments/Pumps.old/Pump1_OffMode_Solver.f90 b/Equipments/Pumps.old/Pump1_OffMode_Solver.f90 new file mode 100644 index 0000000..16d4013 --- /dev/null +++ b/Equipments/Pumps.old/Pump1_OffMode_Solver.f90 @@ -0,0 +1,68 @@ +subroutine Pump1_OffMode_Solver(Pump_No) + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + use CSounds + + + IMPLICIT NONE + INTEGER :: Pump_No + + + + CALL Pump_INPUTS + + + + !================================================================== + ! Rate limit for off Mode + + Do while (((PUMP(Pump_No)%N_old-0.0d0)/PUMP(Pump_No)%time_step)>386.0d0) + PUMP(Pump_No)%N_ref = (-386.0d0*PUMP(Pump_No)%time_step)+PUMP(Pump_No)%N_old + !else + ! PUMP(1)%N_ref=0.0d0 + !end if + + Call Pump1_OnMode_Solver(Pump_No) + + PUMP(Pump_No)%N_old = PUMP(Pump_No)%N_ref + Call sleepqq (80) !????????????????? + End Do + !================================================================== + + + + PUMP(Pump_No)%Speed = 0.0d0 + PUMP(Pump_No)%w = 0.0d0 + PUMP(Pump_No)%w_old = 0.0d0 + PUMP(Pump_No)%w_new = 0.0d0 + PUMP(Pump_No)%ia = 0.0d0 + PUMP(Pump_No)%ia_old = 0.0d0 + PUMP(Pump_No)%ia_new = 0.0d0 + PUMP(Pump_No)%x = 0.0d0 + PUMP(Pump_No)%x_old = 0.0d0 + PUMP(Pump_No)%x_new = 0.0d0 + + + Call Pump_Solver(Pump_No) + + Call Pump_Total_Counts + + + + Call Set_MP1SPMGauge( sngl(1-PUMP(1)%SPMGaugeMalf)*real((PUMP(1)%Speed/PUMP(1)%Trans_Ratio),8) ) + SPM1 = MP1SPMGauge + PUMP(1)%SoundSPM = INT(PUMP(1)%Speed/PUMP(1)%Trans_Ratio) + Call SetSoundMP1( PUMP(1)%SoundSPM ) + !Call Set_MP2SPMGauge( real((PUMP(2)%Speed/PUMP(2)%Trans_Ratio),8) ) + !SPM2 = MP2SPMGauge + !print*, 'PUMP(1)%Speed2=', PUMP(1)%Speed + !print*, 'PUMP(Pump_No)%N_ref2=', PUMP(Pump_No)%N_ref + + + +end subroutine Pump1_OffMode_Solver \ No newline at end of file diff --git a/Equipments/Pumps.old/Pump1_OnMode_Solver.f90 b/Equipments/Pumps.old/Pump1_OnMode_Solver.f90 new file mode 100644 index 0000000..358ba54 --- /dev/null +++ b/Equipments/Pumps.old/Pump1_OnMode_Solver.f90 @@ -0,0 +1,120 @@ +subroutine Pump1_OnMode_Solver(Pump_No) + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + use equipments_PowerLimit + use CSounds + use CWarningsVariables + + + IMPLICIT NONE + INTEGER :: Pump_No + + + + Call Pump_INPUTS + + + ! Torque unit = [in.lbf] + PUMP(Pump_No)%Torque = (63025./132000.)*(1./PUMP(Pump_No)%Trans_Ratio)*(PUMP(Pump_No)%Piston_Area*PUMP(Pump_No)%Stroke_Length*PUMP(Pump_No)%StandPipe_Pressure/PUMP(Pump_No)%Mech_Efficiency/PUMP(Pump_No)%Vol_Efficiency) + + !call PowerLimits + + !print*, 'PUMP(1)%Torque=', PUMP(1)%Torque + Call Pump_Traction_Motor(Pump_No) + + !print*, 'PUMP(1)%w_new=', PUMP(1)%w_new + + if (PUMP(Pump_No)%N_ref<=0.) then + PUMP(Pump_No)%w_ref = 0. + PUMP(Pump_No)%w_old = 0. + PUMP(Pump_No)%w = 0. + PUMP(Pump_No)%w_new = 0. + PUMP(Pump_No)%ia_old = 0. + PUMP(Pump_No)%ia = 0. + PUMP(Pump_No)%ia_new = 0. + PUMP(Pump_No)%x_old = 0. + PUMP(Pump_No)%x = 0. + PUMP(Pump_No)%x_new = 0. + end if + + + + + if (Power_sigma>max_Power_sigma) then + PUMP(Pump_No)%Vt_old = PUMP(Pump_No)%Vt_old + else + PUMP(Pump_No)%Vt_old = PUMP(Pump_No)%x_new+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi))-PUMP(Pump_No)%ia_new) + IF (PUMP(Pump_No)%Vt_old>810.) THEN + PUMP(Pump_No)%Vt_old = 810. + ELSE IF (PUMP(Pump_No)%Vt_old<0.) THEN + PUMP(Pump_No)%Vt_old = 0. + END IF + end if + + + + + !PUMP(Pump_No)%Vt=PUMP(Pump_No)%x_new+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi))-PUMP(Pump_No)%ia_new) + !IF (PUMP(Pump_No)%Vt>810.) THEN + ! PUMP(Pump_No)%Vt=810. + !ELSE IF (PUMP(Pump_No)%Vt<0.) THEN + ! PUMP(Pump_No)%Vt=0. + !END IF + + + + PUMP(Pump_No)%Speed = 30.d0*PUMP(Pump_No)%w_new/pi !Speed [RPM] + + if ( Pump1Failure == .true. ) then + PUMP(1)%Speed = 0.d0 + PUMP(1)%w = 0.d0 + PUMP(1)%w_new = 0.d0 + PUMP(1)%w_old = 0.d0 + end if + + + + Call Pump_Solver(Pump_No) + Call Pump_Total_Counts + + + + Call Set_MP1SPMGauge( sngl(1-PUMP(1)%SPMGaugeMalf)*real((PUMP(1)%Speed/PUMP(1)%Trans_Ratio),8) ) + SPM1 = MP1SPMGauge + PUMP(1)%SoundSPM = INT(PUMP(1)%Speed/PUMP(1)%Trans_Ratio) + Call SetSoundMP1( PUMP(1)%SoundSPM ) + !Call Set_MP2SPMGauge( real((PUMP(2)%Speed/PUMP(2)%Trans_Ratio),8) ) + !SPM2 = MP2SPMGauge + + + + IF (PUMP(1)%Flow_Rate>0.) Then + Call OpenPump1() + Else + Call ClosePump1() + End if + + + !IF (PUMP(2)%Flow_Rate>0.) Then + ! Call OpenPump2() + !Else + ! Call ClosePump2() + !End if + + !print*, 'PUMP(1)%Speed=', PUMP(1)%Speed + !print*, 'PUMP(1)%Torque=', PUMP(1)%Torque + !print*, 'Power_sigma=', Power_sigma + !print*, 'power_num_of_Jenerators=', power_num_of_Jenerators + !print*, 'drilling_num_of_Jenerators=', drilling_num_of_Jenerators + !print*, 'max_Power_sigma=', max_Power_sigma + !print*, 'PUMP(1)%Vt=', PUMP(1)%Vt + !print*, 'PUMP(1)%SoundSPM=', PUMP(1)%SoundSPM + !print*, 'PUMP(1)%ia_new=', PUMP(1)%ia_new + + +end subroutine Pump1_OnMode_Solver \ No newline at end of file diff --git a/Equipments/Pumps.old/Pump2_OffMode_Solver.f90 b/Equipments/Pumps.old/Pump2_OffMode_Solver.f90 new file mode 100644 index 0000000..f74658c --- /dev/null +++ b/Equipments/Pumps.old/Pump2_OffMode_Solver.f90 @@ -0,0 +1,69 @@ +subroutine Pump2_OffMode_Solver(Pump_No) + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + use CSounds + + + IMPLICIT NONE + INTEGER :: Pump_No + + + + CALL Pump_INPUTS + + + + !================================================================== + ! Rate limit for off Mode + + Do while (((PUMP(Pump_No)%N_old-0.0d0)/PUMP(Pump_No)%time_step)>386.) + PUMP(Pump_No)%N_ref = (-386.*PUMP(Pump_No)%time_step)+PUMP(Pump_No)%N_old + !else + ! PUMP(1)%N_ref=0.0d0 + !end if + + Call Pump2_OnMode_Solver(Pump_No) + + PUMP(Pump_No)%N_old = PUMP(Pump_No)%N_ref + Call sleepqq (80) !????????????????? + End Do + !================================================================== + + + + + PUMP(Pump_No)%Speed = 0.0d0 + PUMP(Pump_No)%w = 0.0d0 + PUMP(Pump_No)%w_old = 0.0d0 + PUMP(Pump_No)%w_new = 0.0d0 + PUMP(Pump_No)%ia = 0.0d0 + PUMP(Pump_No)%ia_old = 0.0d0 + PUMP(Pump_No)%ia_new = 0.0d0 + PUMP(Pump_No)%x = 0.0d0 + PUMP(Pump_No)%x_old = 0.0d0 + PUMP(Pump_No)%x_new = 0.0d0 + + + + Call Pump_Solver(Pump_No) + + Call Pump_Total_Counts + + + + !Call Set_MP1SPMGauge( real((PUMP(1)%Speed/PUMP(1)%Trans_Ratio),8) ) + !SPM1 = MP1SPMGauge + Call Set_MP2SPMGauge( sngl(1-PUMP(2)%SPMGaugeMalf)*real((PUMP(2)%Speed/PUMP(2)%Trans_Ratio),8) ) + SPM2 = MP2SPMGauge + PUMP(2)%SoundSPM = INT(PUMP(2)%Speed/PUMP(2)%Trans_Ratio) + Call SetSoundMP2( PUMP(2)%SoundSPM ) + + + + +end subroutine Pump2_OffMode_Solver \ No newline at end of file diff --git a/Equipments/Pumps.old/Pump2_OnMode_Solver.f90 b/Equipments/Pumps.old/Pump2_OnMode_Solver.f90 new file mode 100644 index 0000000..eba9e2f --- /dev/null +++ b/Equipments/Pumps.old/Pump2_OnMode_Solver.f90 @@ -0,0 +1,108 @@ +subroutine Pump2_OnMode_Solver(Pump_No) + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + use equipments_PowerLimit + use CSounds + use CWarningsVariables + + + IMPLICIT NONE + INTEGER :: Pump_No + + + + + Call Pump_INPUTS + + ! Torque unit = [in.lbf] + PUMP(Pump_No)%Torque = (63025./132000.)*(1./PUMP(Pump_No)%Trans_Ratio)*(PUMP(Pump_No)%Piston_Area*PUMP(Pump_No)%Stroke_Length*PUMP(Pump_No)%StandPipe_Pressure/PUMP(Pump_No)%Mech_Efficiency/PUMP(Pump_No)%Vol_Efficiency) + + + !call PowerLimits + + + + Call Pump_Traction_Motor(Pump_No) + + if (PUMP(Pump_No)%N_ref<=0.) then + PUMP(Pump_No)%w_ref = 0. + PUMP(Pump_No)%w_old = 0. + PUMP(Pump_No)%w = 0. + PUMP(Pump_No)%w_new = 0. + PUMP(Pump_No)%ia_old = 0. + PUMP(Pump_No)%ia = 0. + PUMP(Pump_No)%ia_new = 0. + PUMP(Pump_No)%x_old = 0. + PUMP(Pump_No)%x = 0. + PUMP(Pump_No)%x_new = 0. + end if + + + + if (Power_sigma>max_Power_sigma) then + PUMP(Pump_No)%Vt_old = PUMP(Pump_No)%Vt_old + else + PUMP(Pump_No)%Vt_old = PUMP(Pump_No)%x_new+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi))-PUMP(Pump_No)%ia_new) + IF (PUMP(Pump_No)%Vt_old>810.) THEN + PUMP(Pump_No)%Vt_old = 810. + ELSE IF (PUMP(Pump_No)%Vt_old<0.) THEN + PUMP(Pump_No)%Vt_old = 0. + END IF + end if + + + + + !PUMP(Pump_No)%Vt=PUMP(Pump_No)%x_new+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi))-PUMP(Pump_No)%ia_new) + !IF (PUMP(Pump_No)%Vt>810.) THEN + ! PUMP(Pump_No)%Vt=810. + !ELSE IF (PUMP(Pump_No)%Vt<0.) THEN + ! PUMP(Pump_No)%Vt=0. + !END IF + + PUMP(Pump_No)%Speed = 30.*PUMP(Pump_No)%w_new/pi !Speed [RPM] + + if ( Pump2Failure == .true. ) then + PUMP(2)%Speed = 0.d0 + PUMP(2)%w = 0.d0 + PUMP(2)%w_new = 0.d0 + PUMP(2)%w_old = 0.d0 + end if + + + Call Pump_Solver(Pump_No) + Call Pump_Total_Counts + + + + !Call Set_MP1SPMGauge( real((PUMP(1)%Speed/PUMP(1)%Trans_Ratio),8) ) + !SPM1 = MP1SPMGauge + Call Set_MP2SPMGauge( sngl(1-PUMP(2)%SPMGaugeMalf)*real((PUMP(2)%Speed/PUMP(2)%Trans_Ratio),8) ) + SPM2 = MP2SPMGauge + PUMP(2)%SoundSPM = INT(PUMP(2)%Speed/PUMP(2)%Trans_Ratio) + Call SetSoundMP2( PUMP(2)%SoundSPM ) + + + + + !IF (PUMP(1)%Flow_Rate>0.) Then + ! Call OpenPump1() + !Else + ! Call ClosePump1() + !End if + + IF (PUMP(2)%Flow_Rate>0.) Then + Call OpenPump2() + Else + Call ClosePump2() + End if + + + + +end subroutine Pump2_OnMode_Solver \ No newline at end of file diff --git a/Equipments/Pumps.old/Pump3_OffMode_Solver.f90 b/Equipments/Pumps.old/Pump3_OffMode_Solver.f90 new file mode 100644 index 0000000..38c1370 --- /dev/null +++ b/Equipments/Pumps.old/Pump3_OffMode_Solver.f90 @@ -0,0 +1,55 @@ +subroutine Pump3_OffMode_Solver + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + use CSounds + + + IMPLICIT NONE + INTEGER :: Pump_No + + + + CALL Pump_INPUTS + + + + !================================================================== + ! Rate limit for off Mode + + Do while (((PUMP(3)%N_old-0.0d0)/PUMP(3)%time_step)>386.) + PUMP(3)%N_ref = (-386.*PUMP(3)%time_step)+PUMP(3)%N_old + !else + ! PUMP(1)%N_ref=0.0d0 + !end if + + Call Pump3_OnMode_Solver + + PUMP(3)%N_old = PUMP(3)%N_ref + Call sleepqq (80) !????????????????? + End Do + !================================================================== + + + + + PUMP(3)%Speed = 0.0 + + Call Pump_Solver(3) + + Call Pump_Total_Counts + + + Call Set_MP1SPMGauge( real((PUMP(3)%Speed/PUMP(3)%Trans_Ratio),8) ) + SPM1 = MP1SPMGauge + PUMP(3)%SoundSPM = INT(PUMP(3)%Speed/PUMP(3)%Trans_Ratio) + Call SetSoundMP3( PUMP(3)%SoundSPM ) + + + + +end subroutine Pump3_OffMode_Solver \ No newline at end of file diff --git a/Equipments/Pumps.old/Pump3_OnMode_Solver.f90 b/Equipments/Pumps.old/Pump3_OnMode_Solver.f90 new file mode 100644 index 0000000..98f1975 --- /dev/null +++ b/Equipments/Pumps.old/Pump3_OnMode_Solver.f90 @@ -0,0 +1,57 @@ +subroutine Pump3_OnMode_Solver + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + use equipments_PowerLimit + use CSounds + use CWarningsVariables + + + IMPLICIT NONE + INTEGER :: Pump_No + + + + Call Pump_INPUTS + + !! Torque unit = (in.lbf) + !PUMP(Pump_No)%Torque = (63025./132000.)*(1./PUMP(Pump_No)%Trans_Ratio)*(PUMP(Pump_No)%Piston_Area*PUMP(Pump_No)%Stroke_Length*PUMP(Pump_No)%StandPipe_Pressure/PUMP(Pump_No)%Mech_Efficiency/PUMP(Pump_No)%Vol_Efficiency) + + + + + + PUMP(3)%Speed = PUMP(3)%N_ref !Speed [RPM] + + if ( Pump3Failure == .true. ) then + PUMP(3)%Speed = 0.d0 + PUMP(3)%w = 0.d0 + PUMP(3)%w_new = 0.d0 + PUMP(3)%w_old = 0.d0 + end if + + Call Pump_Solver(3) + Call Pump_Total_Counts + + Call Set_MP1SPMGauge( real((PUMP(3)%Speed/PUMP(3)%Trans_Ratio),8) ) + SPM1 = MP1SPMGauge + PUMP(3)%SoundSPM = INT(PUMP(3)%Speed/PUMP(3)%Trans_Ratio) + Call SetSoundMP3( PUMP(3)%SoundSPM ) + + + + IF (PUMP(3)%Flow_Rate>0.) Then + Call OpenCementPump() + Else + Call CloseCementPump() + End if + + + + + +end subroutine Pump3_OnMode_Solver \ No newline at end of file diff --git a/Equipments/Pumps.old/Pump_INPUTS.f90 b/Equipments/Pumps.old/Pump_INPUTS.f90 new file mode 100644 index 0000000..2d018eb --- /dev/null +++ b/Equipments/Pumps.old/Pump_INPUTS.f90 @@ -0,0 +1,59 @@ +subroutine Pump_INPUTS + + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use Pump_VARIABLES + use MudSystem + + IMPLICIT NONE + + + +!>>>>>>>>>>>>>>>>>>>>>>> PUMP 1 <<<<<<<<<<<<<<<<<<<<<<<<<<< + + if ( PUMP(1)%BlowPopOffMalf==1 ) then ! Pump1 Malfunction ----> Blow Pop-offs (Relief Valves) + PUMP(1)%StandPipe_Pressure = 0.d0 + else + PUMP(1)%StandPipe_Pressure = PumpPressure1 ![psi] + if ( PUMP(1)%StandPipe_Pressure<=14. ) then + PUMP(1)%StandPipe_Pressure = 14. + end if + end if + + + + + +!>>>>>>>>>>>>>>>>>>>>>>> PUMP 2 <<<<<<<<<<<<<<<<<<<<<<<<<<< + + if ( PUMP(2)%BlowPopOffMalf==1 ) then ! Pump2 Malfunction ----> Blow Pop-offs (Relief Valves) + PUMP(2)%StandPipe_Pressure = 0.d0 + else + PUMP(2)%StandPipe_Pressure = PumpPressure2 ![psi] + if ( PUMP(2)%StandPipe_Pressure<=14. ) then + PUMP(2)%StandPipe_Pressure = 14. + end if + end if + + + + + +!>>>>>>>>>>>>>>>>>>>>>>> PUMP 3 <<<<<<<<<<<<<<<<<<<<<<<<<<< + + if ( PUMP(3)%BlowPopOffMalf==1 ) then ! Pump3 Malfunction ----> Blow Pop-offs (Relief Valves) + PUMP(3)%StandPipe_Pressure = 0.d0 + else + PUMP(3)%StandPipe_Pressure = PumpPressure3 ![psi] + if ( PUMP(3)%StandPipe_Pressure<=14. ) then + PUMP(3)%StandPipe_Pressure = 14. + end if + end if + + + + + +end subroutine Pump_INPUTS \ No newline at end of file diff --git a/Equipments/Pumps.old/Pump_Solver.f90 b/Equipments/Pumps.old/Pump_Solver.f90 new file mode 100644 index 0000000..2adb3f4 --- /dev/null +++ b/Equipments/Pumps.old/Pump_Solver.f90 @@ -0,0 +1,29 @@ +subroutine Pump_Solver(Pump_No) + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + + + IMPLICIT NONE + INTEGER :: Pump_No + + + + PUMP(Pump_No)%Flow_Rate = PUMP(Pump_No)%Piston_Area*PUMP(Pump_No)%Stroke_Length*(PUMP(Pump_No)%Speed/PUMP(Pump_No)%Trans_Ratio)*PUMP(Pump_No)%Vol_Efficiency/77.d0 ![gpm] + PUMP(Pump_No)%Hydraulic_HorsePower = PUMP(Pump_No)%Piston_Area*PUMP(Pump_No)%Stroke_Length*(PUMP(Pump_No)%Speed/PUMP(Pump_No)%Trans_Ratio)*PUMP(Pump_No)%StandPipe_Pressure/132000.d0 ![HHP] + PUMP(Pump_No)%TracMotor_Horsepower = PUMP(Pump_No)%Hydraulic_HorsePower/PUMP(Pump_No)%Mech_Efficiency/PUMP(Pump_No)%Vol_Efficiency ![HHP] + !PUMP(Pump_No)%Max_Pressure = (PUMP(Pump_No)%Max_Horsepower*1714.)/PUMP(Pump_No)%Flow_Rate ![psi] + + + if ( (PUMP(Pump_No)%StandPipe_Pressure*PUMP(Pump_No)%Flow_Rate)>(1714.d0*PUMP(Pump_No)%Max_Horsepower*PUMP(Pump_No)%Mech_Efficiency*PUMP(Pump_No)%Vol_Efficiency) ) then + PUMP(Pump_No)%Flow_Rate = (1714.d0*PUMP(Pump_No)%Max_Horsepower*PUMP(Pump_No)%Mech_Efficiency*PUMP(Pump_No)%Vol_Efficiency)/PUMP(Pump_No)%StandPipe_Pressure ![gpm] + PUMP(Pump_No)%Speed = ( (PUMP(Pump_No)%Flow_Rate*77.d0)/(PUMP(Pump_No)%Piston_Area*PUMP(Pump_No)%Stroke_Length) )*PUMP(Pump_No)%Trans_Ratio ![rpm] + end if + + + + +end subroutine Pump_Solver \ No newline at end of file diff --git a/Equipments/Pumps.old/Pump_StartUp.f90 b/Equipments/Pumps.old/Pump_StartUp.f90 new file mode 100644 index 0000000..98b9d2e --- /dev/null +++ b/Equipments/Pumps.old/Pump_StartUp.f90 @@ -0,0 +1,52 @@ +subroutine Pump_StartUp + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CPowerVariables + use Pump_VARIABLES + + IMPLICIT NONE + + !>>>>>>>>>>>>>>>>>>>>>>> PUMP 1 <<<<<<<<<<<<<<<<<<<<<<<<<<< + PUMP(1)%Stroke_Length = MudPump1Stroke + PUMP(1)%Piston_Diameter = MudPump1LinerDiameter + PUMP(1)%Piston_Area = pi*PUMP(1)%Piston_Diameter*PUMP(1)%Piston_Diameter/4. + PUMP(1)%Mech_Efficiency = MudPump1MechanicalEfficiency + PUMP(1)%Vol_Efficiency = MudPump1VolumetricEfficiency + PUMP(1)%Max_Horsepower = MudPump1 + PUMP(1)%Inertia_Moment = 23.261341 ! 23.261341 [kg.m^2] = 552 [lb.ft^2] + PUMP(1)%J_coef = PUMP(1)%Inertia_Moment+(4.*(PUMP(1)%Inertia_Moment)) + PUMP(1)%Trans_Ratio = 965.0/MudPump1Maximum + PUMP(1)%time_step = .10 + PUMP(1)%Flow_Rate = 0. + Call Pump1_OffMode_Solver(1) + +!>>>>>>>>>>>>>>>>>>>>>>> PUMP 2 <<<<<<<<<<<<<<<<<<<<<<<<<<< + PUMP(2)%Stroke_Length = MudPump2Stroke + PUMP(2)%Piston_Diameter = MudPump2LinerDiameter + PUMP(2)%Piston_Area = pi*PUMP(2)%Piston_Diameter*PUMP(2)%Piston_Diameter/4. + PUMP(2)%Mech_Efficiency = MudPump2MechanicalEfficiency + PUMP(2)%Vol_Efficiency = MudPump2VolumetricEfficiency + PUMP(2)%Max_Horsepower = MudPump2 + PUMP(2)%Inertia_Moment = 23.261341 ! 23.261341 [kg.m^2] = 552 [lb.ft^2] + PUMP(2)%J_coef = PUMP(2)%Inertia_Moment+(4.*(PUMP(2)%Inertia_Moment)) + PUMP(2)%Trans_Ratio = 965.0/MudPump2Maximum + PUMP(2)%time_step = .10 + PUMP(2)%Flow_Rate = 0. + Call Pump2_OffMode_Solver(2) + +!>>>>>>>>>>>>>>>>>>>>>>> PUMP 3 <<<<<<<<<<<<<<<<<<<<<<<<<<< + PUMP(3)%Stroke_Length = CementPumpStroke + PUMP(3)%Piston_Diameter = CementPumpLinerDiameter + PUMP(3)%Piston_Area = pi*PUMP(3)%Piston_Diameter*PUMP(3)%Piston_Diameter/4. + PUMP(3)%Mech_Efficiency = CementPumpMechanicalEfficiency + PUMP(3)%Vol_Efficiency = CementPumpVolumetricEfficiency + PUMP(3)%Max_Horsepower = CementPump + PUMP(3)%Inertia_Moment = 23.261341 ! 23.261341 [kg.m^2] = 552 [lb.ft^2] + PUMP(3)%Trans_Ratio = 965.0/CementPumpMaximum + PUMP(3)%time_step = .10 + PUMP(3)%Flow_Rate = 0. + Call Pump3_OffMode_Solver + +end subroutine Pump_StartUp \ No newline at end of file diff --git a/Equipments/Pumps.old/Pump_Total_Counts.f90 b/Equipments/Pumps.old/Pump_Total_Counts.f90 new file mode 100644 index 0000000..e140c45 --- /dev/null +++ b/Equipments/Pumps.old/Pump_Total_Counts.f90 @@ -0,0 +1,11 @@ +subroutine Pump_Total_Counts + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + + IMPLICIT NONE + Total_Pump_GPM = PUMP(1)%Flow_Rate+PUMP(2)%Flow_Rate+PUMP(3)%Flow_Rate + Total_Pump_SPM = (PUMP(1)%Speed/PUMP(1)%Trans_Ratio)+(PUMP(2)%Speed/PUMP(2)%Trans_Ratio)+(PUMP(3)%Speed/PUMP(3)%Trans_Ratio) +end subroutine \ No newline at end of file diff --git a/Equipments/Pumps.old/Pump_Traction_Motor.f90 b/Equipments/Pumps.old/Pump_Traction_Motor.f90 new file mode 100644 index 0000000..c050d8e --- /dev/null +++ b/Equipments/Pumps.old/Pump_Traction_Motor.f90 @@ -0,0 +1,124 @@ +subroutine Pump_Traction_Motor(Pump_No) + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + + + IMPLICIT NONE + INTEGER :: Pump_No + + + +!>>>>>>>>>>>>>>>>>>>>>>> DATA <<<<<<<<<<<<<<<<<<<<<<<<<<< + PUMP(Pump_No)%TL = 0.112985*PUMP(Pump_No)%Torque/2.d0 + + La = 1700.*1d-6 !170.*1d-6 !1700.*1d-6 + !Lf = 260.*1d-6 + Lf = 0.d0 + Ra = 9.5*1d-3 !0.1d0 !9.5*1d-3 + !Rf = 5.4*1d-3 + Rf = 0.d0 + + !******** controller ******* + Kpn = 11. !3. !=11. + !Kin = 50. + Kpi = 100. + Kii = 900. + + + PUMP(Pump_No)%time = PUMP(Pump_No)%time_step + PUMP(Pump_No)%dt = 1.d-5 + PUMP(Pump_No)%error = .001 + +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + PUMP(Pump_No)%n = PUMP(Pump_No)%time/PUMP(Pump_No)%dt + !PUMP(Pump_No)%w_ref = (pi*(PUMP(Pump_No)%N_ref+102.d0)/30.d0) + PUMP(Pump_No)%w_ref = (pi*(PUMP(Pump_No)%N_ref)/30.d0) + + !if (PUMP(Pump_No)%N_ref<=0.) then + ! PUMP(Pump_No)%w_ref = 0. + !end if + + + !if (PUMP(Pump_No)%N_ref<=0.) then + ! PUMP(Pump_No)%w_ref = 0. + ! PUMP(Pump_No)%w_old = 0. + ! PUMP(Pump_No)%w = 0. + !end if + + + PUMP(Pump_No)%ia_er = 1. + PUMP(Pump_No)%w_er = 1. + PUMP(Pump_No)%x_er = 1. + + + PUMP(Pump_No)%i = 1 + +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + DO WHILE (PUMP(Pump_No)%i<=PUMP(Pump_No)%n) + +!>>>>>>>>>>>> Runge-Kutta Method (4th order) <<<<<<<<<<<<<< + + call Pump_dx((PUMP(Pump_No)%i*PUMP(Pump_No)%dt),PUMP(Pump_No)%ia,PUMP(Pump_No)%w,PUMP(Pump_No)%x,Pump_No) + call Pump_dia((PUMP(Pump_No)%i*PUMP(Pump_No)%dt),PUMP(Pump_No)%ia,PUMP(Pump_No)%w,PUMP(Pump_No)%fii,PUMP(Pump_No)%x,Pump_No) + call Pump_dw((PUMP(Pump_No)%i*PUMP(Pump_No)%dt),PUMP(Pump_No)%ia,PUMP(Pump_No)%w,PUMP(Pump_No)%fii,PUMP(Pump_No)%TL,Pump_No) + PUMP(Pump_No)%K1x=PUMP(Pump_No)%dt*PUMP(Pump_No)%dx + PUMP(Pump_No)%K1ia=PUMP(Pump_No)%dt*PUMP(Pump_No)%dia + PUMP(Pump_No)%K1w=PUMP(Pump_No)%dt*PUMP(Pump_No)%dw + + call Pump_dx((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+(PUMP(Pump_No)%dt/2.),PUMP(Pump_No)%ia+(PUMP(Pump_No)%K1ia/2.),PUMP(Pump_No)%w+(PUMP(Pump_No)%K1w/2.),PUMP(Pump_No)%x+(PUMP(Pump_No)%K1x/2.),Pump_No) + call Pump_dia((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+(PUMP(Pump_No)%dt/2.),PUMP(Pump_No)%ia+(PUMP(Pump_No)%K1ia/2.),PUMP(Pump_No)%w+(PUMP(Pump_No)%K1w/2.),PUMP(Pump_No)%fii,PUMP(Pump_No)%x+(PUMP(Pump_No)%K1x/2.),Pump_No) + call Pump_dw((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+(PUMP(Pump_No)%dt/2.),PUMP(Pump_No)%ia+(PUMP(Pump_No)%K1ia/2.),PUMP(Pump_No)%w+(PUMP(Pump_No)%K1w/2.),PUMP(Pump_No)%fii,PUMP(Pump_No)%TL,Pump_No) + PUMP(Pump_No)%K2x=PUMP(Pump_No)%dt*PUMP(Pump_No)%dx + PUMP(Pump_No)%K2ia=PUMP(Pump_No)%dt*PUMP(Pump_No)%dia + PUMP(Pump_No)%K2w=PUMP(Pump_No)%dt*PUMP(Pump_No)%dw + + call Pump_dx((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+(PUMP(Pump_No)%dt/2.),PUMP(Pump_No)%ia+(PUMP(Pump_No)%K2ia/2.),PUMP(Pump_No)%w+(PUMP(Pump_No)%K2w/2.),PUMP(Pump_No)%x+(PUMP(Pump_No)%K2x/2.),Pump_No) + call Pump_dia((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+(PUMP(Pump_No)%dt/2.),PUMP(Pump_No)%ia+(PUMP(Pump_No)%K2ia/2.),PUMP(Pump_No)%w+(PUMP(Pump_No)%K2w/2.),PUMP(Pump_No)%fii,PUMP(Pump_No)%x+(PUMP(Pump_No)%K2x/2.),Pump_No) + call Pump_dw((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+(PUMP(Pump_No)%dt/2.),PUMP(Pump_No)%ia+(PUMP(Pump_No)%K2ia/2.),PUMP(Pump_No)%w+(PUMP(Pump_No)%K2w/2.),PUMP(Pump_No)%fii,PUMP(Pump_No)%TL,Pump_No) + PUMP(Pump_No)%K3x=PUMP(Pump_No)%dt*PUMP(Pump_No)%dx + PUMP(Pump_No)%K3ia=PUMP(Pump_No)%dt*PUMP(Pump_No)%dia + PUMP(Pump_No)%K3w=PUMP(Pump_No)%dt*PUMP(Pump_No)%dw + + call Pump_dx((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+PUMP(Pump_No)%dt,PUMP(Pump_No)%ia+PUMP(Pump_No)%K3ia,PUMP(Pump_No)%w+PUMP(Pump_No)%K3w,PUMP(Pump_No)%x+PUMP(Pump_No)%K3x,Pump_No) + call Pump_dia((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+PUMP(Pump_No)%dt,PUMP(Pump_No)%ia+PUMP(Pump_No)%K3ia,PUMP(Pump_No)%w+PUMP(Pump_No)%K3w,PUMP(Pump_No)%fii,PUMP(Pump_No)%x+PUMP(Pump_No)%K3x,Pump_No) + call Pump_dw((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+PUMP(Pump_No)%dt,PUMP(Pump_No)%ia+PUMP(Pump_No)%K3ia,PUMP(Pump_No)%w+PUMP(Pump_No)%K3w,PUMP(Pump_No)%fii,PUMP(Pump_No)%TL,Pump_No) + PUMP(Pump_No)%K4x=PUMP(Pump_No)%dt*PUMP(Pump_No)%dx + PUMP(Pump_No)%K4ia=PUMP(Pump_No)%dt*PUMP(Pump_No)%dia + PUMP(Pump_No)%K4w=PUMP(Pump_No)%dt*PUMP(Pump_No)%dw + + PUMP(Pump_No)%x_new = PUMP(Pump_No)%x_old+((PUMP(Pump_No)%K1x+(2.*PUMP(Pump_No)%K2x)+(2.*PUMP(Pump_No)%K3x)+PUMP(Pump_No)%K4x)/6.) + PUMP(Pump_No)%ia_new = PUMP(Pump_No)%ia_old+((PUMP(Pump_No)%K1ia+(2.*PUMP(Pump_No)%K2ia)+(2.*PUMP(Pump_No)%K3ia)+PUMP(Pump_No)%K4ia)/6.) + PUMP(Pump_No)%w_new = PUMP(Pump_No)%w_old+((PUMP(Pump_No)%K1w+(2.*PUMP(Pump_No)%K2w)+(2.*PUMP(Pump_No)%K3w)+PUMP(Pump_No)%K4w)/6.) + +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + + PUMP(Pump_No)%x_old = PUMP(Pump_No)%x_new + PUMP(Pump_No)%ia_old = PUMP(Pump_No)%ia_new + PUMP(Pump_No)%w_old = PUMP(Pump_No)%w_new + PUMP(Pump_No)%x = PUMP(Pump_No)%x_new + PUMP(Pump_No)%ia = PUMP(Pump_No)%ia_new + PUMP(Pump_No)%w = PUMP(Pump_No)%w_new + PUMP(Pump_No)%Te = PUMP(Pump_No)%fii*PUMP(Pump_No)%ia_new + + !PUMP(Pump_No)%Vt = PUMP(Pump_No)%x_new+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi))-PUMP(Pump_No)%ia_new) + !IF (PUMP(Pump_No)%Vt>810.) THEN + ! PUMP(Pump_No)%Vt = 810. + !ELSE IF (PUMP(Pump_No)%Vt<0.) THEN + ! PUMP(Pump_No)%Vt = 0. + !END IF + + PUMP(Pump_No)%i = PUMP(Pump_No)%i+1 + + END DO +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + + + +end subroutine Pump_Traction_Motor \ No newline at end of file diff --git a/Equipments/Pumps.old/Pump_VARIABLES.f90 b/Equipments/Pumps.old/Pump_VARIABLES.f90 new file mode 100644 index 0000000..41141ba --- /dev/null +++ b/Equipments/Pumps.old/Pump_VARIABLES.f90 @@ -0,0 +1,61 @@ +MODULE Pump_VARIABLES + + + IMPLICIT NONE + PUBLIC + + + REAL , PARAMETER :: pi=3.14159265 + REAL :: La, Lf, Ra, Rf + REAL :: Kpn, Kin, Kpi, Kii + REAL :: Total_Pump_GPM, Total_Pump_SPM, Total_Stroke_Counter_For_Plot + +!**************************************************************************************************** +!**************** Define PUMP Array ************************************************************ + TYPE, PUBLIC :: Pump_Var + +!***** Pump_VARIABLES *************************** + INTEGER :: j , AssignmentSwitchh + INTEGER :: PowerFailMalf , BlowPopOffMalf , SPMGaugeMalf + + REAL :: Stroke_Length, Piston_Area, Piston_Diameter, Inertia_Moment + REAL :: Mech_Efficiency, Vol_Efficiency, Trans_Ratio + REAL :: StandPipe_Pressure , Max_Pressure + REAL :: Torque, Speed + REAL :: Flow_Rate, Hydraulic_HorsePower, TracMotor_Horsepower , Max_Horsepower + REAL :: simulation_time, time_step + + REAL(8) :: START_TIME, END_TIME + INTEGER :: INT_CPU_TIME, Dt_ref + +!***** Traction Motor_VARIABLES ***************** + INTEGER :: i, n + + REAL :: TL, Vt, J_coef, Ea, fii, Te + REAL :: time, dt, zaman + REAL :: ia, w, ia_old, w_old, ia_new, w_new + REAL :: error, ia_er, w_er ,x_er, y_er + REAL :: K1ia, K1w, K2ia, K2w, K3ia, K3w, K4ia, K4w + REAL :: K1x, K1y, K2x, K2y, K3x, K3y, K4x, K4y + REAL :: ia_ref, w_ref, N_ref ! N(rpm) , w(rad/s) + REAL :: x, y, x_old, y_old, x_new, y_new + REAL :: dia, dw, dx + REAL :: N_new, N_old + REAL :: Vt_old + + +!************* Sound_VARIABLES ********************** + INTEGER :: SoundSPM + Logical :: SoundBlower + + + END TYPE Pump_Var + + TYPE(Pump_Var), DIMENSION(1:3) :: PUMP +!*********************************************************************************************** +!**************************************************************************************************** + + + + +END MODULE Pump_VARIABLES \ No newline at end of file diff --git a/Equipments/Pumps.old/PumpsMain.f90 b/Equipments/Pumps.old/PumpsMain.f90 new file mode 100644 index 0000000..3582d4b --- /dev/null +++ b/Equipments/Pumps.old/PumpsMain.f90 @@ -0,0 +1,719 @@ +module PumpsMain + + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use Pump_VARIABLES + use CSounds + + implicit none + public + + contains + + + +! **************************************** +! ***** subroutine Pump1MainBody ***** +! **************************** + + subroutine Pump1_Setup() + use CSimulationVariables + implicit none + call OnSimulationInitialization%Add(Pump1_Init) + call OnSimulationStop%Add(Pump1_Init) + call OnPump1Step%Add(Pump1_Step) + call OnPump1Output%Add(Pump1_Output) + call OnPump1Main%Add(Pump1MainBody) + end subroutine + + subroutine Pump1_Init + implicit none + end subroutine Pump1_Init + + !!Extracted from pump1MainBody + subroutine Pump1_Step + use CWarningsVariables + integer,dimension(8) :: MP_START_TIME, MP_END_TIME + INTEGER :: MP_SolDuration + + if (PUMP(1)%PowerFailMalf==1) then + !MP1BLWR=0 + Call Pump1_OffMode_Solver(1) + Call ClosePump1() + end if + ! Pump1 Warning ----> Failure + if (Pump1Failure==1) then + !MP1BLWR=0 + Call Pump1_OffMode_Solver(1) + Call ClosePump1() + end if + + ! Pump3 Malfunction ----> Power Failure + if (PUMP(3)%PowerFailMalf==1) then + Call Pump3_OffMode_Solver + !Call ClosePump3() + end if + ! Pump3 Warning ----> Failure + if (Pump3Failure==1) then + Call Pump3_OffMode_Solver + !Call ClosePump3() + end if + + + !print*, 'MP1Throttle=', MP1Throttle + if (IsPortable) then + PUMP(1)%AssignmentSwitchh = 1 + else + PUMP(1)%AssignmentSwitchh = AssignmentSwitch + end if + if((any(PUMP(1)%AssignmentSwitchh==(/1,2,3,4,9,10/))) .and. (MP1CPSwitch==-1) .and. (MP1Throttle==0.) .and. (PUMP(1)%PowerFailMalf==0)) then + !print*, 'pumps on' + !print*, 'PUMP(1)%AssignmentSwitchh=' , PUMP(1)%AssignmentSwitchh + PUMP(1)%SoundBlower = .true. + Call SetSoundBlowerMP1(PUMP(1)%SoundBlower) + MP1BLWR = 1 + + loop2: do + Call DrillingConsole_ScrLEDs + Call Pump_Total_Counts + + Call DATE_AND_TIME(values=MP_START_TIME) + + ! Pump1 Malfunction ----> Power Failure + if (PUMP(1)%PowerFailMalf==1) then + !MP1BLWR=0 + Call Pump1_OffMode_Solver(1) + Call ClosePump1() + exit loop2 + end if + + + ! Pump1 Warning ----> Failure + if (Pump1Failure==1) then + !MP1BLWR=0 + Call Pump1_OffMode_Solver(1) + Call ClosePump1() + exit loop2 + end if + + + PUMP(1)%N_new = MP1Throttle + if (((PUMP(1)%N_new-PUMP(1)%N_old)/PUMP(1)%time_step)>193.) then + PUMP(1)%N_ref =(193.*PUMP(1)%time_step)+PUMP(1)%N_old + else if (((PUMP(1)%N_old-PUMP(1)%N_new)/PUMP(1)%time_step)>193.) then + PUMP(1)%N_ref = (-193.*PUMP(1)%time_step)+PUMP(1)%N_old + else + PUMP(1)%N_ref = PUMP(1)%N_new + end if + !print*, 'PUMP(1)%N_ref=' , PUMP(1)%N_ref , MP1Throttle + Call Pump1_OnMode_Solver(1) + + !IF (PUMP(1)%Flow_Rate>0.) Then + ! Call OpenPump1() + !Else + ! Call ClosePump1() + !End if + + PUMP(1)%N_old = PUMP(1)%N_ref + + Call DATE_AND_TIME(values=MP_END_TIME) + MP_SolDuration = 100-(MP_END_TIME(5)*3600000+MP_END_TIME(6)*60000+MP_END_TIME(7)*1000+MP_END_TIME(8)-MP_START_TIME(5)*3600000-MP_START_TIME(6)*60000-MP_START_TIME(7)*1000-MP_START_TIME(8)) + !print*, 'MPtime=', MP_SolDuration + if(MP_SolDuration > 0.0) then + Call sleepqq(MP_SolDuration) + end if + + if (IsPortable) then + PUMP(1)%AssignmentSwitchh = 1 + else + PUMP(1)%AssignmentSwitchh = AssignmentSwitch + end if + if ((any(PUMP(1)%AssignmentSwitchh==(/5,6,7,8,11,12/))) .or. (MP1CPSwitch/=-1) .or. (IsStopped == .true.)) then + PUMP(1)%SoundBlower = .false. + Call SetSoundBlowerMP1(PUMP(1)%SoundBlower) + MP1BLWR = 0 + Call Pump1_OffMode_Solver(1) + Call ClosePump1() + exit loop2 + end if + end do loop2 + + else if( (MP1CPSwitch==1) .and. (MP1Throttle==0.) .and. (PUMP(3)%PowerFailMalf==0) ) then + + loop3: do + Call DATE_AND_TIME(values=MP_START_TIME) + !print*, 'PUMP(3) is on' + + ! Pump3 Malfunction ----> Power Failure + if (PUMP(3)%PowerFailMalf==1) then + Call Pump3_OffMode_Solver + !Call ClosePump3() + exit loop3 + end if + + + ! Pump3 Warning ----> Failure + if (Pump3Failure==1) then + !MP1BLWR=0 + Call Pump3_OffMode_Solver + !Call ClosePump3() !????????????? + exit loop3 + end if + + + PUMP(3)%N_new = MP1Throttle + if (((PUMP(3)%N_new-PUMP(3)%N_old)/PUMP(3)%time_step)>193.) then + PUMP(3)%N_ref =(193.*PUMP(3)%time_step)+PUMP(3)%N_old + else if (((PUMP(3)%N_old-PUMP(3)%N_new)/PUMP(3)%time_step)>193.) then + PUMP(3)%N_ref = (-193.*PUMP(3)%time_step)+PUMP(3)%N_old + else + PUMP(3)%N_ref = PUMP(3)%N_new + end if + + Call Pump3_OnMode_Solver + + IF (PUMP(3)%Flow_Rate>0.) Then + Call OpenCementPump() + Else + Call CloseCementPump() + End if + + PUMP(3)%N_old = PUMP(3)%N_ref + + Call DATE_AND_TIME(values=MP_END_TIME) + MP_SolDuration = 100-(MP_END_TIME(5)*3600000+MP_END_TIME(6)*60000+MP_END_TIME(7)*1000+MP_END_TIME(8)-MP_START_TIME(5)*3600000-MP_START_TIME(6)*60000-MP_START_TIME(7)*1000-MP_START_TIME(8)) + !print*, 'MPtime=', MP_SolDuration + if(MP_SolDuration > 0.0) then + Call sleepqq(MP_SolDuration) + end if + + if ((MP1CPSwitch/=1) .or. (IsStopped == .true.)) then + Call Pump3_OffMode_Solver + Call CloseCementPump() + exit loop3 + end if + end do loop3 + else + !print*, 'pumps off' + if (IsPortable) then + PUMP(1)%AssignmentSwitchh = 1 + !print*, 'PUMP(1)%AssignmentSwitchh2=' , PUMP(1)%AssignmentSwitchh + else + PUMP(1)%AssignmentSwitchh = AssignmentSwitch + !print*, 'PUMP(1)%AssignmentSwitchh22=' , PUMP(1)%AssignmentSwitchh , AssignmentSwitch + end if + if ((any(PUMP(1)%AssignmentSwitchh==(/1,2,3,4,9,10/))) .and. (MP1CPSwitch==-1)) then + PUMP(1)%SoundBlower = .true. + Call SetSoundBlowerMP1(PUMP(1)%SoundBlower) + MP1BLWR = 1 + else + PUMP(1)%SoundBlower = .false. + Call SetSoundBlowerMP1(PUMP(1)%SoundBlower) + MP1BLWR = 0 + end if + + + Call Pump1_OffMode_Solver(1) + Call ClosePump1() + Call Pump3_OffMode_Solver + Call CloseCementPump() + !print*, 'PUMP(1)%off=', PUMP(1)%dt , PUMP(1)%ia , PUMP(1)%w , PUMP(1)%n , PUMP(1)%x + end if + end subroutine Pump1_Step + + subroutine Pump1_Output + implicit none + end subroutine Pump1_Output + + subroutine Pump1MainBody + use ifport + use ifmt + use CWarningsVariables + !use equipments_PowerLimit + implicit none + + integer,dimension(8) :: MP_START_TIME, MP_END_TIME + INTEGER :: MP_SolDuration + + Call Pump_StartUp + loop1 : do + Call sleepqq(10) + Call DrillingConsole_ScrLEDs + !Call Pump_Total_Counts + ! Pump1 Malfunction ----> Power Failure + if (PUMP(1)%PowerFailMalf==1) then + !MP1BLWR=0 + Call Pump1_OffMode_Solver(1) + Call ClosePump1() + end if + ! Pump1 Warning ----> Failure + if (Pump1Failure==1) then + !MP1BLWR=0 + Call Pump1_OffMode_Solver(1) + Call ClosePump1() + end if + + + ! Pump3 Malfunction ----> Power Failure + if (PUMP(3)%PowerFailMalf==1) then + Call Pump3_OffMode_Solver + !Call ClosePump3() + end if + ! Pump3 Warning ----> Failure + if (Pump3Failure==1) then + Call Pump3_OffMode_Solver + !Call ClosePump3() + end if + + + !print*, 'MP1Throttle=', MP1Throttle + if (IsPortable) then + PUMP(1)%AssignmentSwitchh = 1 + else + PUMP(1)%AssignmentSwitchh = AssignmentSwitch + end if + if((any(PUMP(1)%AssignmentSwitchh==(/1,2,3,4,9,10/))) .and. (MP1CPSwitch==-1) .and. (MP1Throttle==0.) .and. (PUMP(1)%PowerFailMalf==0)) then + !print*, 'pumps on' + !print*, 'PUMP(1)%AssignmentSwitchh=' , PUMP(1)%AssignmentSwitchh + PUMP(1)%SoundBlower = .true. + Call SetSoundBlowerMP1(PUMP(1)%SoundBlower) + MP1BLWR = 1 + + loop2: do + Call DrillingConsole_ScrLEDs + Call Pump_Total_Counts + + Call DATE_AND_TIME(values=MP_START_TIME) + + ! Pump1 Malfunction ----> Power Failure + if (PUMP(1)%PowerFailMalf==1) then + !MP1BLWR=0 + Call Pump1_OffMode_Solver(1) + Call ClosePump1() + exit loop2 + end if + + + ! Pump1 Warning ----> Failure + if (Pump1Failure==1) then + !MP1BLWR=0 + Call Pump1_OffMode_Solver(1) + Call ClosePump1() + exit loop2 + end if + + + PUMP(1)%N_new = MP1Throttle + if (((PUMP(1)%N_new-PUMP(1)%N_old)/PUMP(1)%time_step)>193.) then + PUMP(1)%N_ref =(193.*PUMP(1)%time_step)+PUMP(1)%N_old + else if (((PUMP(1)%N_old-PUMP(1)%N_new)/PUMP(1)%time_step)>193.) then + PUMP(1)%N_ref = (-193.*PUMP(1)%time_step)+PUMP(1)%N_old + else + PUMP(1)%N_ref = PUMP(1)%N_new + end if + !print*, 'PUMP(1)%N_ref=' , PUMP(1)%N_ref , MP1Throttle + Call Pump1_OnMode_Solver(1) + + !IF (PUMP(1)%Flow_Rate>0.) Then + ! Call OpenPump1() + !Else + ! Call ClosePump1() + !End if + + PUMP(1)%N_old = PUMP(1)%N_ref + + Call DATE_AND_TIME(values=MP_END_TIME) + MP_SolDuration = 100-(MP_END_TIME(5)*3600000+MP_END_TIME(6)*60000+MP_END_TIME(7)*1000+MP_END_TIME(8)-MP_START_TIME(5)*3600000-MP_START_TIME(6)*60000-MP_START_TIME(7)*1000-MP_START_TIME(8)) + !print*, 'MPtime=', MP_SolDuration + if(MP_SolDuration > 0.0) then + Call sleepqq(MP_SolDuration) + end if + + if (IsPortable) then + PUMP(1)%AssignmentSwitchh = 1 + else + PUMP(1)%AssignmentSwitchh = AssignmentSwitch + end if + if ((any(PUMP(1)%AssignmentSwitchh==(/5,6,7,8,11,12/))) .or. (MP1CPSwitch/=-1) .or. (IsStopped == .true.)) then + PUMP(1)%SoundBlower = .false. + Call SetSoundBlowerMP1(PUMP(1)%SoundBlower) + MP1BLWR = 0 + Call Pump1_OffMode_Solver(1) + Call ClosePump1() + exit loop2 + end if + end do loop2 + + else if( (MP1CPSwitch==1) .and. (MP1Throttle==0.) .and. (PUMP(3)%PowerFailMalf==0) ) then + + loop3: do + Call DATE_AND_TIME(values=MP_START_TIME) + !print*, 'PUMP(3) is on' + + ! Pump3 Malfunction ----> Power Failure + if (PUMP(3)%PowerFailMalf==1) then + Call Pump3_OffMode_Solver + !Call ClosePump3() + exit loop3 + end if + + + ! Pump3 Warning ----> Failure + if (Pump3Failure==1) then + !MP1BLWR=0 + Call Pump3_OffMode_Solver + !Call ClosePump3() !????????????? + exit loop3 + end if + + + PUMP(3)%N_new = MP1Throttle + if (((PUMP(3)%N_new-PUMP(3)%N_old)/PUMP(3)%time_step)>193.) then + PUMP(3)%N_ref =(193.*PUMP(3)%time_step)+PUMP(3)%N_old + else if (((PUMP(3)%N_old-PUMP(3)%N_new)/PUMP(3)%time_step)>193.) then + PUMP(3)%N_ref = (-193.*PUMP(3)%time_step)+PUMP(3)%N_old + else + PUMP(3)%N_ref = PUMP(3)%N_new + end if + + Call Pump3_OnMode_Solver + + IF (PUMP(3)%Flow_Rate>0.) Then + Call OpenCementPump() + Else + Call CloseCementPump() + End if + + PUMP(3)%N_old = PUMP(3)%N_ref + + Call DATE_AND_TIME(values=MP_END_TIME) + MP_SolDuration = 100-(MP_END_TIME(5)*3600000+MP_END_TIME(6)*60000+MP_END_TIME(7)*1000+MP_END_TIME(8)-MP_START_TIME(5)*3600000-MP_START_TIME(6)*60000-MP_START_TIME(7)*1000-MP_START_TIME(8)) + !print*, 'MPtime=', MP_SolDuration + if(MP_SolDuration > 0.0) then + Call sleepqq(MP_SolDuration) + end if + + if ((MP1CPSwitch/=1) .or. (IsStopped == .true.)) then + Call Pump3_OffMode_Solver + Call CloseCementPump() + exit loop3 + end if + end do loop3 + + else + !print*, 'pumps off' + if (IsPortable) then + PUMP(1)%AssignmentSwitchh = 1 + !print*, 'PUMP(1)%AssignmentSwitchh2=' , PUMP(1)%AssignmentSwitchh + else + PUMP(1)%AssignmentSwitchh = AssignmentSwitch + !print*, 'PUMP(1)%AssignmentSwitchh22=' , PUMP(1)%AssignmentSwitchh , AssignmentSwitch + end if + if ((any(PUMP(1)%AssignmentSwitchh==(/1,2,3,4,9,10/))) .and. (MP1CPSwitch==-1)) then + PUMP(1)%SoundBlower = .true. + Call SetSoundBlowerMP1(PUMP(1)%SoundBlower) + MP1BLWR = 1 + else + PUMP(1)%SoundBlower = .false. + Call SetSoundBlowerMP1(PUMP(1)%SoundBlower) + MP1BLWR = 0 + end if + + + Call Pump1_OffMode_Solver(1) + Call ClosePump1() + Call Pump3_OffMode_Solver + Call CloseCementPump() + !print*, 'PUMP(1)%off=', PUMP(1)%dt , PUMP(1)%ia , PUMP(1)%w , PUMP(1)%n , PUMP(1)%x + + end if + + if (IsStopped == .true.) then + exit loop1 + end if + + end do loop1 + + + end subroutine Pump1MainBody + + + + + +! **************************************** +! ***** subroutine Pump2MainBody ***** +! **************************** + subroutine Pump2_Setup() + use CSimulationVariables + implicit none + call OnSimulationInitialization%Add(Pump2_Init) + call OnSimulationStop%Add(Pump2_Init) + call OnPump2Step%Add(Pump2_Step) + call OnPump2Output%Add(Pump2_Output) + call OnPump2Main%Add(Pump2MainBody) + end subroutine + + subroutine Pump2_Init + implicit none + end subroutine Pump2_Init + + subroutine Pump2_Step + implicit none + end subroutine Pump2_Step + + subroutine Pump2_Output + implicit none + end subroutine Pump2_Output + + subroutine Pump2MainBody + use ifport + use ifmt + use CWarningsVariables + implicit none + + integer,dimension(8) :: MP_START_TIME, MP_END_TIME + INTEGER :: MP_SolDuration + + Call Pump_StartUp + loop1 : do + + Call sleepqq(10) + + ! Pump2 Malfunction ----> Power Failure + if (PUMP(2)%PowerFailMalf==1) then + Call ClosePump2() + !MP2BLWR=0 + Call Pump2_OffMode_Solver(2) + end if + + + ! Pump2 Warning ----> Failure + if (Pump2Failure==1) then + !MP1BLWR=0 + Call Pump2_OffMode_Solver(2) + Call ClosePump2() + end if + + + if (IsPortable) then + PUMP(2)%AssignmentSwitchh = 1 + else + PUMP(2)%AssignmentSwitchh = AssignmentSwitch + end if + if((any(PUMP(2)%AssignmentSwitchh==(/1,2,3,4,5,7,8,11/))) .and. (MP2Switch==1) .and. (MP2Throttle==0.).and. (PUMP(2)%PowerFailMalf==0)) then + + PUMP(2)%SoundBlower = .true. + Call SetSoundBlowerMP2(PUMP(2)%SoundBlower) + MP2BLWR = 1 + + loop2: do + CALL DATE_AND_TIME(values=MP_START_TIME) + + ! Pump2 Malfunction ----> Power Failure + if (PUMP(2)%PowerFailMalf==1) then + Call ClosePump2() + !MP2BLWR=0 + Call Pump2_OffMode_Solver(2) + exit loop2 + end if + + + ! Pump2 Warning ----> Failure + if (Pump2Failure==1) then + Call ClosePump2() + !MP2BLWR=0 + Call Pump2_OffMode_Solver(2) + exit loop2 + end if + + + PUMP(2)%N_new = MP2Throttle + if (((PUMP(2)%N_new-PUMP(2)%N_old)/PUMP(2)%time_step)>193.) then + PUMP(2)%N_ref = (193.*PUMP(2)%time_step)+PUMP(2)%N_old + else if (((PUMP(2)%N_old-PUMP(2)%N_new)/PUMP(2)%time_step)>193.) then + PUMP(2)%N_ref = (-193.*PUMP(2)%time_step)+PUMP(2)%N_old + else + PUMP(2)%N_ref = PUMP(2)%N_new + end if + + Call Pump2_OnMode_Solver(2) + + !IF (PUMP(2)%Flow_Rate>0.) Then + ! Call OpenPump2() + !Else + ! Call ClosePump2() + !End if + + PUMP(2)%N_old=PUMP(2)%N_ref + + Call DATE_AND_TIME(values=MP_END_TIME) + MP_SolDuration = 100-(MP_END_TIME(5)*3600000+MP_END_TIME(6)*60000+MP_END_TIME(7)*1000+MP_END_TIME(8)-MP_START_TIME(5)*3600000-MP_START_TIME(6)*60000-MP_START_TIME(7)*1000-MP_START_TIME(8)) + !print*, 'MPtime=', MP_SolDuration + if(MP_SolDuration > 0.0d0) then + CALL sleepqq(MP_SolDuration) + end if + + if (IsPortable) then + PUMP(2)%AssignmentSwitchh = 1 + else + PUMP(2)%AssignmentSwitchh = AssignmentSwitch + end if + if ((any(PUMP(2)%AssignmentSwitchh==(/6,9,10,12/))) .or. (MP2Switch==0) .or. (IsStopped == .true.)) then + Call ClosePump2() + PUMP(2)%SoundBlower = .false. + Call SetSoundBlowerMP2(PUMP(2)%SoundBlower) + MP2BLWR = 0 + Call Pump2_OffMode_Solver(2) + exit loop2 + end if + + end do loop2 + + else + + if (IsPortable) then + PUMP(2)%AssignmentSwitchh = 1 + else + PUMP(2)%AssignmentSwitchh = AssignmentSwitch + end if + if((any(PUMP(2)%AssignmentSwitchh==(/1,2,3,4,5,7,8,11/))) .and. (MP2Switch==1)) then + PUMP(2)%SoundBlower = .true. + Call SetSoundBlowerMP2(PUMP(2)%SoundBlower) + MP2BLWR = 1 + else + PUMP(2)%SoundBlower = .false. + Call SetSoundBlowerMP2(PUMP(2)%SoundBlower) + MP2BLWR = 0 + end if + + PUMP(2)%N_ref = MP2Throttle + Call ClosePump2() + Call Pump2_OffMode_Solver(2) + + end if + + if (IsStopped == .true.) then + exit loop1 + end if + + end do loop1 + + + end subroutine Pump2MainBody + + + + +! **************************************** +! ***** subroutine Pump3MainBody ***** +! **************************** + subroutine Pump3_Setup() + use CSimulationVariables + implicit none + call OnSimulationInitialization%Add(Pump3_Init) + call OnSimulationStop%Add(Pump3_Init) + call OnPump3Step%Add(Pump3_Step) + call OnPump3Output%Add(Pump3_Output) + call OnPump3Main%Add(Pump3MainBody) + end subroutine + + subroutine Pump3_Init + implicit none + end subroutine Pump3_Init + + subroutine Pump3_Step + implicit none + end subroutine Pump3_Step + + subroutine Pump3_Output + implicit none + end subroutine Pump3_Output + + subroutine Pump3MainBody + use ifport + use ifmt + implicit none + + + integer,dimension(8) :: MP_START_TIME, MP_END_TIME + INTEGER :: MP_SolDuration + + !Call Pump_StartUp + !loop1 : do + ! + ! Call sleepqq(10) + ! + ! !!! Pump3 Malfunction ----> Power Failure + ! !!if (PUMP(1)%PowerFailMalf==1) then + ! !! !MP1BLWR=0 + ! !! Call Pump3_OffMode_Solver + ! !! Call ClosePump1() + ! !!end if + ! + ! !if( (MP1CPSwitch==1) .and. (MP1Throttle==0.) .and. (PUMP(3)%PowerFailMalf==0) ) then + !! + !! loop2: do + !! + !! Call DATE_AND_TIME(values=MP_START_TIME) + !! + !!!! ! Pump3 Malfunction ----> Power Failure + !!!! if (PUMP(1)%PowerFailMalf==1) then + !!!! !MP1BLWR=0 + !!!! Pump3_OffMode_Solver + !!!! Call ClosePump1() + !!!! exit loop2 + !!!! end if + !! + !! PUMP(3)%N_new = MP1Throttle + !! if (((PUMP(3)%N_new-PUMP(3)%N_old)/PUMP(3)%time_step)>193.) then + !! PUMP(3)%N_ref =(193.*PUMP(3)%time_step)+PUMP(3)%N_old + !! else if (((PUMP(3)%N_old-PUMP(3)%N_new)/PUMP(3)%time_step)>193.) then + !! PUMP(3)%N_ref = (-193.*PUMP(3)%time_step)+PUMP(3)%N_old + !! else + !! PUMP(3)%N_ref = PUMP(3)%N_new + !! end if + !! + !! Call Pump3_OnMode_Solver + !! + !! IF (PUMP(3)%Flow_Rate>0.) Then + !! Call OpenCementPump() + !! Else + !! Call CloseCementPump() + !! End if + !! + !! PUMP(3)%N_old = PUMP(3)%N_ref + !! + !! Call DATE_AND_TIME(values=MP_END_TIME) + !! MP_SolDuration = 100-(MP_END_TIME(6)*60000+MP_END_TIME(7)*1000+MP_END_TIME(8)-MP_START_TIME(6)*60000-MP_START_TIME(7)*1000-MP_START_TIME(8)) + !! !print*, 'MPtime=', MP_SolDuration + !! if(MP_SolDuration > 0.0) then + !! Call sleepqq(MP_SolDuration) + !! end if + !! + !! if ((MP1CPSwitch==0) .or. (IsStopped == .true.)) then + !! Call Pump3_OffMode_Solver + !! Call CloseCementPump() + !! exit loop2 + !! end if + !! end do loop2 + ! + ! else + ! + ! !Call Pump3_OffMode_Solver + ! !Call CloseCementPump() + ! + ! end if + ! + ! if (IsStopped == .true.) then + ! exit loop1 + ! end if + ! + !end do loop1 + + + end subroutine Pump3MainBody + +end module PumpsMain \ No newline at end of file diff --git a/Equipments/Pumps.old/pump_diff_eqs.f90 b/Equipments/Pumps.old/pump_diff_eqs.f90 new file mode 100644 index 0000000..091a1f3 --- /dev/null +++ b/Equipments/Pumps.old/pump_diff_eqs.f90 @@ -0,0 +1,105 @@ +subroutine Pump_dia(x1,x2,x3,x5,x6,Pump_No) + + use Pump_VARIABLES + use equipments_PowerLimit + + + IMPLICIT NONE + INTEGER :: Pump_No + REAL :: x1,x2,x3,x4,x5,x6 + + !Power_sigma=2.*(PUMP(1)%Vt*PUMP(1)%ia_new)+2.*(PUMP(2)%Vt*PUMP(2)%ia_new)+2.*(PUMP(3)%Vt*PUMP(3)%ia_new)+(RTable%Vt*RTable%ia_new)+2.*(Drawworks%Vt*Drawworks%ia_new) + + PUMP(Pump_No)%Vt = PUMP(Pump_No)%x_new+Kpi*((Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi)))+20.d0-PUMP(Pump_No)%ia_new) + IF (PUMP(Pump_No)%Vt>810.) THEN + PUMP(Pump_No)%Vt = 810.0 + ELSE IF (PUMP(Pump_No)%Vt<0.) THEN + PUMP(Pump_No)%Vt = 0.0d0 + END IF + + !call PowerLimits + ! + !if (Power_sigma>max_Power_sigma) then + ! PUMP(Pump_No)%Vt=PUMP(Pump_No)%Vt_old + !else + ! PUMP(Pump_No)%Vt=x6+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*x3/pi))-x2) + ! IF (PUMP(Pump_No)%Vt>810.) THEN + ! PUMP(Pump_No)%Vt=810. + !ELSE IF (PUMP(Pump_No)%Vt<0.) THEN + ! PUMP(Pump_No)%Vt=0. + !END IF + + + ! PUMP(Pump_No)%Vt_old=PUMP(Pump_No)%x_new+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi))-PUMP(Pump_No)%ia_new) + ! IF (PUMP(Pump_No)%Vt_old>810.) THEN + ! PUMP(Pump_No)%Vt_old=810. + !ELSE IF (PUMP(Pump_No)%Vt_old<0.) THEN + ! PUMP(Pump_No)%Vt_old=0. + !END IF + + + !end if + + !IF (PUMP(Pump_No)%Vt>810.) THEN + ! PUMP(Pump_No)%Vt=810. + !ELSE IF (PUMP(Pump_No)%Vt<0.) THEN + ! PUMP(Pump_No)%Vt=0. + !END IF + + !PUMP(Pump_No)%Vt_old=PUMP(Pump_No)%Vt + + + !IF (x2<=1150.) THEN + ! x5 = 6.3304d-3*x2 + !ELSE IF (x2>1150.) THEN + ! x5 = 2.8571d-7*(x2-1150.)+7.28 + !END IF + x5 = 6.3304d-3*1150.0 + + PUMP(Pump_No)%Ea = x5*x3 + PUMP(Pump_No)%dia = (PUMP(Pump_No)%Vt-(Ra+Rf)*x2-PUMP(Pump_No)%Ea)/(La+Lf) + +end subroutine + + + + + + +!------------------------------------------------------------ +subroutine Pump_dw(x1,x2,x3,x4,x5,Pump_No) + + use Pump_VARIABLES + + IMPLICIT NONE + INTEGER :: Pump_No + REAL :: x1,x2,x3,x4,x5 + + !IF (x2<=1150.) THEN + ! x4 = 6.3304d-3*x2 + !ELSE IF (x2>1150.) THEN + ! x4 = 2.8571d-7*(x2-1150.)+7.28 + !END IF + x4 = 6.3304d-3*1150.0 + + PUMP(Pump_No)%Te = x4*x2 + PUMP(Pump_No)%dw = (PUMP(Pump_No)%Te-x5)/PUMP(Pump_No)%J_coef + +end subroutine + + + + + +!------------------------------------------------------------ +subroutine Pump_dx(x1,x2,x3,x4,Pump_No) + + use Pump_VARIABLES + + IMPLICIT NONE + INTEGER :: Pump_No + REAL :: x1,x2,x3,x4 + + PUMP(Pump_No)%dx = Kii*((Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*x3/pi)))+20.d0-x2) + +end subroutine \ No newline at end of file diff --git a/Equipments/Pumps.rar b/Equipments/Pumps.rar new file mode 100644 index 0000000..a26a968 Binary files /dev/null and b/Equipments/Pumps.rar differ diff --git a/Equipments/Pumps.rar.old b/Equipments/Pumps.rar.old new file mode 100644 index 0000000..045fb7d Binary files /dev/null and b/Equipments/Pumps.rar.old differ diff --git a/Equipments/Pumps/ON_mode_simulation.f90 b/Equipments/Pumps/ON_mode_simulation.f90 new file mode 100644 index 0000000..b6efbd0 --- /dev/null +++ b/Equipments/Pumps/ON_mode_simulation.f90 @@ -0,0 +1,80 @@ +subroutine ON_mode_simulation(Pump_No) + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + use equipments_PowerLimit + + IMPLICIT NONE + INTEGER :: Pump_No + + Call Pump_INPUTS + + ! Torque unit = (in.lbf) + PUMP(Pump_No)%Torque = (63025./132000.)*(1./PUMP(Pump_No)%Trans_Ratio)*(PUMP(Pump_No)%Piston_Area*PUMP(Pump_No)%Stroke_Length*PUMP(Pump_No)%StandPipe_Pressure/PUMP(Pump_No)%Mech_Efficiency/PUMP(Pump_No)%Vol_Efficiency) + + !call PowerLimits + + Call Pump_Traction_Motor(Pump_No) + + if (PUMP(Pump_No)%N_ref<=0.) then + PUMP(Pump_No)%w_ref = 0. + PUMP(Pump_No)%w_old = 0. + PUMP(Pump_No)%w = 0. + PUMP(Pump_No)%w_new = 0. + PUMP(Pump_No)%ia_old = 0. + PUMP(Pump_No)%ia = 0. + PUMP(Pump_No)%ia_new = 0. + PUMP(Pump_No)%x_old = 0. + PUMP(Pump_No)%x = 0. + PUMP(Pump_No)%x_new = 0. + end if + + if (Power_sigma>max_Power_sigma) then + PUMP(Pump_No)%Vt_old = PUMP(Pump_No)%Vt_old + else + PUMP(Pump_No)%Vt_old = PUMP(Pump_No)%x_new+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi))-PUMP(Pump_No)%ia_new) + IF (PUMP(Pump_No)%Vt_old>810.) THEN + PUMP(Pump_No)%Vt_old = 810. + ELSE IF (PUMP(Pump_No)%Vt_old<0.) THEN + PUMP(Pump_No)%Vt_old = 0. + END IF + + end if + + !PUMP(Pump_No)%Vt=PUMP(Pump_No)%x_new+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi))-PUMP(Pump_No)%ia_new) + !IF (PUMP(Pump_No)%Vt>810.) THEN + ! PUMP(Pump_No)%Vt=810. + !ELSE IF (PUMP(Pump_No)%Vt<0.) THEN + ! PUMP(Pump_No)%Vt=0. + !END IF + + PUMP(Pump_No)%Speed = 30.*PUMP(Pump_No)%w_new/pi !Speed [RPM] + + Call Set_MP1SPMGauge( sngl(1-PUMP(1)%SPMGaugeMalf)*real((PUMP(1)%Speed/PUMP(1)%Trans_Ratio),8) ) + SPM1 = MP1SPMGauge + Call Set_MP2SPMGauge( sngl(1-PUMP(2)%SPMGaugeMalf)*real((PUMP(2)%Speed/PUMP(2)%Trans_Ratio),8) ) + SPM2 = MP2SPMGauge + + Call Pump_Solver(Pump_No) + Call Pump_Total_Counts + !print*, 'PUMP(1)%Flow_Rate=' , PUMP(1)%Flow_Rate + IF (PUMP(1)%Flow_Rate>0.) Then + Call OpenPump1() + !print*, 'open pump 1' + Else + Call ClosePump1() + !print*, 'close pump 1' + End if + + IF (PUMP(2)%Flow_Rate>0.) Then + Call OpenPump2() + Else + Call ClosePump2() + End if + + +end subroutine ON_mode_simulation \ No newline at end of file diff --git a/Equipments/Pumps/Off_mode_Simulation.f90 b/Equipments/Pumps/Off_mode_Simulation.f90 new file mode 100644 index 0000000..529ebf4 --- /dev/null +++ b/Equipments/Pumps/Off_mode_Simulation.f90 @@ -0,0 +1,51 @@ +subroutine Off_mode_Simulation(Pump_No) + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + + IMPLICIT NONE + INTEGER :: Pump_No + + CALL Pump_INPUTS + + !================================================================== + ! Rate limit for off Mode + + Do while (((PUMP(Pump_No)%N_old-0.0d0)/PUMP(Pump_No)%time_step)>386.) + PUMP(Pump_No)%N_ref = (-386.*PUMP(Pump_No)%time_step)+PUMP(Pump_No)%N_old + !else + ! PUMP(1)%N_ref=0.0d0 + !end if + + Call ON_mode_simulation(Pump_No) + + PUMP(Pump_No)%N_old = PUMP(Pump_No)%N_ref + Call sleepqq (80) !????????????????? + End Do + !================================================================== + + PUMP(Pump_No)%Speed = 0.0d0 + Call Set_MP1SPMGauge( sngl(1-PUMP(1)%SPMGaugeMalf)*real((PUMP(1)%Speed/PUMP(1)%Trans_Ratio),8) ) + SPM1 = MP1SPMGauge + Call Set_MP2SPMGauge( sngl(1-PUMP(2)%SPMGaugeMalf)*real((PUMP(2)%Speed/PUMP(2)%Trans_Ratio),8) ) + SPM2 = MP2SPMGauge + PUMP(Pump_No)%w = 0. + PUMP(Pump_No)%w_old = 0.0d0 + PUMP(Pump_No)%w_new = 0.0d0 + PUMP(Pump_No)%ia = 0.0d0 + PUMP(Pump_No)%ia_old = 0.0d0 + PUMP(Pump_No)%ia_new = 0.0d0 + PUMP(Pump_No)%x = 0.0d0 + PUMP(Pump_No)%x_old = 0.0d0 + PUMP(Pump_No)%x_new = 0.0d0 + + Call Pump_Solver(Pump_No) + + Call Pump_Total_Counts + + +end subroutine off_mode_simulation \ No newline at end of file diff --git a/Equipments/Pumps/Pump1_MainSolver.f90 b/Equipments/Pumps/Pump1_MainSolver.f90 new file mode 100644 index 0000000..3bb1ffb --- /dev/null +++ b/Equipments/Pumps/Pump1_MainSolver.f90 @@ -0,0 +1,109 @@ +subroutine Pump1_MainSolver + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + use equipments_PowerLimit + use CSounds + use CWarningsVariables + + + IMPLICIT NONE + + + Call DrillingConsole_ScrLEDs + Call Pump_Total_Counts + + if (MP1Throttle<=0.e0) then + PUMP(1)%K_throttle = 1 + end if + + if (IsPortable) then + PUMP(1)%AssignmentSwitchh = 1 + else + PUMP(1)%AssignmentSwitchh = AssignmentSwitch + end if + + if((any(PUMP(1)%AssignmentSwitchh==(/1,2,3,4,9,10/))) .and. (MP1CPSwitch==-1) .and. (PUMP(1)%K_throttle==1) .and. (PUMP(1)%PowerFailMalf==0) .and. (Pump1Failure==0) .and. (IsStopped == .false.)) then + + PUMP(1)%SoundBlower = .true. + Call SetSoundBlowerMP1(PUMP(1)%SoundBlower) + MP1BLWR = 1 + + !Call DrillingConsole_ScrLEDs + !Call Pump_Total_Counts + + + PUMP(1)%N_new = MP1Throttle + if (((PUMP(1)%N_new-PUMP(1)%N_old)/PUMP(1)%time_step)>193.) then + PUMP(1)%N_ref =(193.*PUMP(1)%time_step)+PUMP(1)%N_old + else if (((PUMP(1)%N_old-PUMP(1)%N_new)/PUMP(1)%time_step)>193.) then + PUMP(1)%N_ref = (-193.*PUMP(1)%time_step)+PUMP(1)%N_old + else + PUMP(1)%N_ref = PUMP(1)%N_new + end if + + Call Pump1_OnMode_Solver(1) + + !IF (PUMP(1)%Flow_Rate>0.) Then + ! Call OpenPump1() + !Else + ! Call ClosePump1() + !End if + + PUMP(1)%N_old = PUMP(1)%N_ref + + + + else if( (MP1CPSwitch==1) .and. (PUMP(1)%K_throttle==1) .and. (PUMP(3)%PowerFailMalf==0) .and. (Pump3Failure==0) .and. (IsStopped == .false.)) then + + + PUMP(3)%N_new = MP1Throttle + if (((PUMP(3)%N_new-PUMP(3)%N_old)/PUMP(3)%time_step)>193.) then + PUMP(3)%N_ref =(193.*PUMP(3)%time_step)+PUMP(3)%N_old + else if (((PUMP(3)%N_old-PUMP(3)%N_new)/PUMP(3)%time_step)>193.) then + PUMP(3)%N_ref = (-193.*PUMP(3)%time_step)+PUMP(3)%N_old + else + PUMP(3)%N_ref = PUMP(3)%N_new + end if + + Call Pump3_OnMode_Solver + + IF (PUMP(3)%Flow_Rate>0.) Then + Call OpenCementPump() + Else + Call CloseCementPump() + End if + + PUMP(3)%N_old = PUMP(3)%N_ref + + + + else + + if ((any(PUMP(1)%AssignmentSwitchh==(/1,2,3,4,9,10/))) .and. (MP1CPSwitch==-1) .and. (IsStopped == .false.)) then + PUMP(1)%SoundBlower = .true. + Call SetSoundBlowerMP1(PUMP(1)%SoundBlower) + MP1BLWR = 1 + else + PUMP(1)%SoundBlower = .false. + Call SetSoundBlowerMP1(PUMP(1)%SoundBlower) + MP1BLWR = 0 + end if + + + Call Pump1_OffMode_Solver(1) + Call ClosePump1() + Call Pump3_OffMode_Solver + Call CloseCementPump() + + PUMP(1)%K_throttle = 0 + + + end if + + +end subroutine Pump1_MainSolver \ No newline at end of file diff --git a/Equipments/Pumps/Pump1_OffMode_Solver.f90 b/Equipments/Pumps/Pump1_OffMode_Solver.f90 new file mode 100644 index 0000000..87d4b1d --- /dev/null +++ b/Equipments/Pumps/Pump1_OffMode_Solver.f90 @@ -0,0 +1,66 @@ +subroutine Pump1_OffMode_Solver(Pump_No) + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + use CSounds + + + IMPLICIT NONE + INTEGER :: Pump_No + + + + CALL Pump_INPUTS + + + + !================================================================== + ! Rate limit for off Mode + + if (((PUMP(Pump_No)%N_old-0.0d0)/PUMP(Pump_No)%time_step)>386.0d0) then + PUMP(Pump_No)%N_ref = (-386.0d0*PUMP(Pump_No)%time_step)+PUMP(Pump_No)%N_old + !else + ! PUMP(1)%N_ref=0.0d0 + !end if + + Call Pump1_OnMode_Solver(Pump_No) + + PUMP(Pump_No)%N_old = PUMP(Pump_No)%N_ref + + !================================================================== + else + + + PUMP(Pump_No)%Speed = 0.0d0 + PUMP(Pump_No)%w = 0.0d0 + PUMP(Pump_No)%w_old = 0.0d0 + PUMP(Pump_No)%w_new = 0.0d0 + PUMP(Pump_No)%ia = 0.0d0 + PUMP(Pump_No)%ia_old = 0.0d0 + PUMP(Pump_No)%ia_new = 0.0d0 + PUMP(Pump_No)%x = 0.0d0 + PUMP(Pump_No)%x_old = 0.0d0 + PUMP(Pump_No)%x_new = 0.0d0 + + + Call Pump_Solver(Pump_No) + + Call Pump_Total_Counts + + + + Call Set_MP1SPMGauge( sngl(1-PUMP(1)%SPMGaugeMalf)*real((PUMP(1)%Speed/PUMP(1)%Trans_Ratio),8) ) + SPM1 = MP1SPMGauge + PUMP(1)%SoundSPM = INT(PUMP(1)%Speed/PUMP(1)%Trans_Ratio) + Call SetSoundMP1( PUMP(1)%SoundSPM ) + !Call Set_MP2SPMGauge( real((PUMP(2)%Speed/PUMP(2)%Trans_Ratio),8) ) + !SPM2 = MP2SPMGauge + + + End if + +end subroutine Pump1_OffMode_Solver \ No newline at end of file diff --git a/Equipments/Pumps/Pump1_OnMode_Solver.f90 b/Equipments/Pumps/Pump1_OnMode_Solver.f90 new file mode 100644 index 0000000..358ba54 --- /dev/null +++ b/Equipments/Pumps/Pump1_OnMode_Solver.f90 @@ -0,0 +1,120 @@ +subroutine Pump1_OnMode_Solver(Pump_No) + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + use equipments_PowerLimit + use CSounds + use CWarningsVariables + + + IMPLICIT NONE + INTEGER :: Pump_No + + + + Call Pump_INPUTS + + + ! Torque unit = [in.lbf] + PUMP(Pump_No)%Torque = (63025./132000.)*(1./PUMP(Pump_No)%Trans_Ratio)*(PUMP(Pump_No)%Piston_Area*PUMP(Pump_No)%Stroke_Length*PUMP(Pump_No)%StandPipe_Pressure/PUMP(Pump_No)%Mech_Efficiency/PUMP(Pump_No)%Vol_Efficiency) + + !call PowerLimits + + !print*, 'PUMP(1)%Torque=', PUMP(1)%Torque + Call Pump_Traction_Motor(Pump_No) + + !print*, 'PUMP(1)%w_new=', PUMP(1)%w_new + + if (PUMP(Pump_No)%N_ref<=0.) then + PUMP(Pump_No)%w_ref = 0. + PUMP(Pump_No)%w_old = 0. + PUMP(Pump_No)%w = 0. + PUMP(Pump_No)%w_new = 0. + PUMP(Pump_No)%ia_old = 0. + PUMP(Pump_No)%ia = 0. + PUMP(Pump_No)%ia_new = 0. + PUMP(Pump_No)%x_old = 0. + PUMP(Pump_No)%x = 0. + PUMP(Pump_No)%x_new = 0. + end if + + + + + if (Power_sigma>max_Power_sigma) then + PUMP(Pump_No)%Vt_old = PUMP(Pump_No)%Vt_old + else + PUMP(Pump_No)%Vt_old = PUMP(Pump_No)%x_new+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi))-PUMP(Pump_No)%ia_new) + IF (PUMP(Pump_No)%Vt_old>810.) THEN + PUMP(Pump_No)%Vt_old = 810. + ELSE IF (PUMP(Pump_No)%Vt_old<0.) THEN + PUMP(Pump_No)%Vt_old = 0. + END IF + end if + + + + + !PUMP(Pump_No)%Vt=PUMP(Pump_No)%x_new+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi))-PUMP(Pump_No)%ia_new) + !IF (PUMP(Pump_No)%Vt>810.) THEN + ! PUMP(Pump_No)%Vt=810. + !ELSE IF (PUMP(Pump_No)%Vt<0.) THEN + ! PUMP(Pump_No)%Vt=0. + !END IF + + + + PUMP(Pump_No)%Speed = 30.d0*PUMP(Pump_No)%w_new/pi !Speed [RPM] + + if ( Pump1Failure == .true. ) then + PUMP(1)%Speed = 0.d0 + PUMP(1)%w = 0.d0 + PUMP(1)%w_new = 0.d0 + PUMP(1)%w_old = 0.d0 + end if + + + + Call Pump_Solver(Pump_No) + Call Pump_Total_Counts + + + + Call Set_MP1SPMGauge( sngl(1-PUMP(1)%SPMGaugeMalf)*real((PUMP(1)%Speed/PUMP(1)%Trans_Ratio),8) ) + SPM1 = MP1SPMGauge + PUMP(1)%SoundSPM = INT(PUMP(1)%Speed/PUMP(1)%Trans_Ratio) + Call SetSoundMP1( PUMP(1)%SoundSPM ) + !Call Set_MP2SPMGauge( real((PUMP(2)%Speed/PUMP(2)%Trans_Ratio),8) ) + !SPM2 = MP2SPMGauge + + + + IF (PUMP(1)%Flow_Rate>0.) Then + Call OpenPump1() + Else + Call ClosePump1() + End if + + + !IF (PUMP(2)%Flow_Rate>0.) Then + ! Call OpenPump2() + !Else + ! Call ClosePump2() + !End if + + !print*, 'PUMP(1)%Speed=', PUMP(1)%Speed + !print*, 'PUMP(1)%Torque=', PUMP(1)%Torque + !print*, 'Power_sigma=', Power_sigma + !print*, 'power_num_of_Jenerators=', power_num_of_Jenerators + !print*, 'drilling_num_of_Jenerators=', drilling_num_of_Jenerators + !print*, 'max_Power_sigma=', max_Power_sigma + !print*, 'PUMP(1)%Vt=', PUMP(1)%Vt + !print*, 'PUMP(1)%SoundSPM=', PUMP(1)%SoundSPM + !print*, 'PUMP(1)%ia_new=', PUMP(1)%ia_new + + +end subroutine Pump1_OnMode_Solver \ No newline at end of file diff --git a/Equipments/Pumps/Pump2_MainSolver.f90 b/Equipments/Pumps/Pump2_MainSolver.f90 new file mode 100644 index 0000000..e0976e1 --- /dev/null +++ b/Equipments/Pumps/Pump2_MainSolver.f90 @@ -0,0 +1,76 @@ +subroutine Pump2_MainSolver + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + use equipments_PowerLimit + use CSounds + use CWarningsVariables + + + IMPLICIT NONE + + + if (MP2Throttle<=0.e0) then + PUMP(2)%K_throttle = 1 + end if + + if (IsPortable) then + PUMP(2)%AssignmentSwitchh = 1 + else + PUMP(2)%AssignmentSwitchh = AssignmentSwitch + end if + + if((any(PUMP(2)%AssignmentSwitchh==(/1,2,3,4,5,7,8,11/))) .and. (MP2Switch==1) .and. (PUMP(2)%K_throttle==1) .and. (PUMP(2)%PowerFailMalf==0) .and. (Pump2Failure==0) .and. (IsStopped == .false.)) then + + PUMP(2)%SoundBlower = .true. + Call SetSoundBlowerMP2(PUMP(2)%SoundBlower) + MP2BLWR = 1 + + + PUMP(2)%N_new = MP2Throttle + if (((PUMP(2)%N_new-PUMP(2)%N_old)/PUMP(2)%time_step)>193.) then + PUMP(2)%N_ref = (193.*PUMP(2)%time_step)+PUMP(2)%N_old + else if (((PUMP(2)%N_old-PUMP(2)%N_new)/PUMP(2)%time_step)>193.) then + PUMP(2)%N_ref = (-193.*PUMP(2)%time_step)+PUMP(2)%N_old + else + PUMP(2)%N_ref = PUMP(2)%N_new + end if + + Call Pump2_OnMode_Solver(2) + + !IF (PUMP(2)%Flow_Rate>0.) Then + ! Call OpenPump2() + !Else + ! Call ClosePump2() + !End if + + PUMP(2)%N_old=PUMP(2)%N_ref + + + else + + + if((any(PUMP(2)%AssignmentSwitchh==(/1,2,3,4,5,7,8,11/))) .and. (MP2Switch==1) .and. (IsStopped == .false.)) then + PUMP(2)%SoundBlower = .true. + Call SetSoundBlowerMP2(PUMP(2)%SoundBlower) + MP2BLWR = 1 + else + PUMP(2)%SoundBlower = .false. + Call SetSoundBlowerMP2(PUMP(2)%SoundBlower) + MP2BLWR = 0 + end if + + !PUMP(2)%N_ref = MP2Throttle + Call Pump2_OffMode_Solver(2) + Call ClosePump2() + + PUMP(2)%K_throttle = 0 + + end if + + +end subroutine Pump2_MainSolver \ No newline at end of file diff --git a/Equipments/Pumps/Pump2_OffMode_Solver.f90 b/Equipments/Pumps/Pump2_OffMode_Solver.f90 new file mode 100644 index 0000000..88c5e2c --- /dev/null +++ b/Equipments/Pumps/Pump2_OffMode_Solver.f90 @@ -0,0 +1,67 @@ +subroutine Pump2_OffMode_Solver(Pump_No) + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + use CSounds + + + IMPLICIT NONE + INTEGER :: Pump_No + + + + CALL Pump_INPUTS + + + + !================================================================== + ! Rate limit for off Mode + + if (((PUMP(Pump_No)%N_old-0.0d0)/PUMP(Pump_No)%time_step)>386.) then + PUMP(Pump_No)%N_ref = (-386.*PUMP(Pump_No)%time_step)+PUMP(Pump_No)%N_old + !else + ! PUMP(1)%N_ref=0.0d0 + !end if + + Call Pump2_OnMode_Solver(Pump_No) + + PUMP(Pump_No)%N_old = PUMP(Pump_No)%N_ref + + !================================================================== + else + + + PUMP(Pump_No)%Speed = 0.0d0 + PUMP(Pump_No)%w = 0.0d0 + PUMP(Pump_No)%w_old = 0.0d0 + PUMP(Pump_No)%w_new = 0.0d0 + PUMP(Pump_No)%ia = 0.0d0 + PUMP(Pump_No)%ia_old = 0.0d0 + PUMP(Pump_No)%ia_new = 0.0d0 + PUMP(Pump_No)%x = 0.0d0 + PUMP(Pump_No)%x_old = 0.0d0 + PUMP(Pump_No)%x_new = 0.0d0 + + + + Call Pump_Solver(Pump_No) + + Call Pump_Total_Counts + + + + !Call Set_MP1SPMGauge( real((PUMP(1)%Speed/PUMP(1)%Trans_Ratio),8) ) + !SPM1 = MP1SPMGauge + Call Set_MP2SPMGauge( sngl(1-PUMP(2)%SPMGaugeMalf)*real((PUMP(2)%Speed/PUMP(2)%Trans_Ratio),8) ) + SPM2 = MP2SPMGauge + PUMP(2)%SoundSPM = INT(PUMP(2)%Speed/PUMP(2)%Trans_Ratio) + Call SetSoundMP2( PUMP(2)%SoundSPM ) + + + end if + +end subroutine Pump2_OffMode_Solver \ No newline at end of file diff --git a/Equipments/Pumps/Pump2_OnMode_Solver.f90 b/Equipments/Pumps/Pump2_OnMode_Solver.f90 new file mode 100644 index 0000000..eba9e2f --- /dev/null +++ b/Equipments/Pumps/Pump2_OnMode_Solver.f90 @@ -0,0 +1,108 @@ +subroutine Pump2_OnMode_Solver(Pump_No) + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + use equipments_PowerLimit + use CSounds + use CWarningsVariables + + + IMPLICIT NONE + INTEGER :: Pump_No + + + + + Call Pump_INPUTS + + ! Torque unit = [in.lbf] + PUMP(Pump_No)%Torque = (63025./132000.)*(1./PUMP(Pump_No)%Trans_Ratio)*(PUMP(Pump_No)%Piston_Area*PUMP(Pump_No)%Stroke_Length*PUMP(Pump_No)%StandPipe_Pressure/PUMP(Pump_No)%Mech_Efficiency/PUMP(Pump_No)%Vol_Efficiency) + + + !call PowerLimits + + + + Call Pump_Traction_Motor(Pump_No) + + if (PUMP(Pump_No)%N_ref<=0.) then + PUMP(Pump_No)%w_ref = 0. + PUMP(Pump_No)%w_old = 0. + PUMP(Pump_No)%w = 0. + PUMP(Pump_No)%w_new = 0. + PUMP(Pump_No)%ia_old = 0. + PUMP(Pump_No)%ia = 0. + PUMP(Pump_No)%ia_new = 0. + PUMP(Pump_No)%x_old = 0. + PUMP(Pump_No)%x = 0. + PUMP(Pump_No)%x_new = 0. + end if + + + + if (Power_sigma>max_Power_sigma) then + PUMP(Pump_No)%Vt_old = PUMP(Pump_No)%Vt_old + else + PUMP(Pump_No)%Vt_old = PUMP(Pump_No)%x_new+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi))-PUMP(Pump_No)%ia_new) + IF (PUMP(Pump_No)%Vt_old>810.) THEN + PUMP(Pump_No)%Vt_old = 810. + ELSE IF (PUMP(Pump_No)%Vt_old<0.) THEN + PUMP(Pump_No)%Vt_old = 0. + END IF + end if + + + + + !PUMP(Pump_No)%Vt=PUMP(Pump_No)%x_new+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi))-PUMP(Pump_No)%ia_new) + !IF (PUMP(Pump_No)%Vt>810.) THEN + ! PUMP(Pump_No)%Vt=810. + !ELSE IF (PUMP(Pump_No)%Vt<0.) THEN + ! PUMP(Pump_No)%Vt=0. + !END IF + + PUMP(Pump_No)%Speed = 30.*PUMP(Pump_No)%w_new/pi !Speed [RPM] + + if ( Pump2Failure == .true. ) then + PUMP(2)%Speed = 0.d0 + PUMP(2)%w = 0.d0 + PUMP(2)%w_new = 0.d0 + PUMP(2)%w_old = 0.d0 + end if + + + Call Pump_Solver(Pump_No) + Call Pump_Total_Counts + + + + !Call Set_MP1SPMGauge( real((PUMP(1)%Speed/PUMP(1)%Trans_Ratio),8) ) + !SPM1 = MP1SPMGauge + Call Set_MP2SPMGauge( sngl(1-PUMP(2)%SPMGaugeMalf)*real((PUMP(2)%Speed/PUMP(2)%Trans_Ratio),8) ) + SPM2 = MP2SPMGauge + PUMP(2)%SoundSPM = INT(PUMP(2)%Speed/PUMP(2)%Trans_Ratio) + Call SetSoundMP2( PUMP(2)%SoundSPM ) + + + + + !IF (PUMP(1)%Flow_Rate>0.) Then + ! Call OpenPump1() + !Else + ! Call ClosePump1() + !End if + + IF (PUMP(2)%Flow_Rate>0.) Then + Call OpenPump2() + Else + Call ClosePump2() + End if + + + + +end subroutine Pump2_OnMode_Solver \ No newline at end of file diff --git a/Equipments/Pumps/Pump3_OffMode_Solver.f90 b/Equipments/Pumps/Pump3_OffMode_Solver.f90 new file mode 100644 index 0000000..4a09826 --- /dev/null +++ b/Equipments/Pumps/Pump3_OffMode_Solver.f90 @@ -0,0 +1,54 @@ +subroutine Pump3_OffMode_Solver + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + use CSounds + + + IMPLICIT NONE + INTEGER :: Pump_No + + + + CALL Pump_INPUTS + + + + !================================================================== + ! Rate limit for off Mode + + if (((PUMP(3)%N_old-0.0d0)/PUMP(3)%time_step)>386.) then + PUMP(3)%N_ref = (-386.*PUMP(3)%time_step)+PUMP(3)%N_old + !else + ! PUMP(1)%N_ref=0.0d0 + !end if + + Call Pump3_OnMode_Solver + + PUMP(3)%N_old = PUMP(3)%N_ref + + !================================================================== + else + + + PUMP(3)%Speed = 0.0 + + Call Pump_Solver(3) + + Call Pump_Total_Counts + + + Call Set_MP1SPMGauge( real((PUMP(3)%Speed/PUMP(3)%Trans_Ratio),8) ) + SPM1 = MP1SPMGauge + PUMP(3)%SoundSPM = INT(PUMP(3)%Speed/PUMP(3)%Trans_Ratio) + Call SetSoundMP3( PUMP(3)%SoundSPM ) + + + end if + + +end subroutine Pump3_OffMode_Solver \ No newline at end of file diff --git a/Equipments/Pumps/Pump3_OnMode_Solver.f90 b/Equipments/Pumps/Pump3_OnMode_Solver.f90 new file mode 100644 index 0000000..98f1975 --- /dev/null +++ b/Equipments/Pumps/Pump3_OnMode_Solver.f90 @@ -0,0 +1,57 @@ +subroutine Pump3_OnMode_Solver + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + use equipments_PowerLimit + use CSounds + use CWarningsVariables + + + IMPLICIT NONE + INTEGER :: Pump_No + + + + Call Pump_INPUTS + + !! Torque unit = (in.lbf) + !PUMP(Pump_No)%Torque = (63025./132000.)*(1./PUMP(Pump_No)%Trans_Ratio)*(PUMP(Pump_No)%Piston_Area*PUMP(Pump_No)%Stroke_Length*PUMP(Pump_No)%StandPipe_Pressure/PUMP(Pump_No)%Mech_Efficiency/PUMP(Pump_No)%Vol_Efficiency) + + + + + + PUMP(3)%Speed = PUMP(3)%N_ref !Speed [RPM] + + if ( Pump3Failure == .true. ) then + PUMP(3)%Speed = 0.d0 + PUMP(3)%w = 0.d0 + PUMP(3)%w_new = 0.d0 + PUMP(3)%w_old = 0.d0 + end if + + Call Pump_Solver(3) + Call Pump_Total_Counts + + Call Set_MP1SPMGauge( real((PUMP(3)%Speed/PUMP(3)%Trans_Ratio),8) ) + SPM1 = MP1SPMGauge + PUMP(3)%SoundSPM = INT(PUMP(3)%Speed/PUMP(3)%Trans_Ratio) + Call SetSoundMP3( PUMP(3)%SoundSPM ) + + + + IF (PUMP(3)%Flow_Rate>0.) Then + Call OpenCementPump() + Else + Call CloseCementPump() + End if + + + + + +end subroutine Pump3_OnMode_Solver \ No newline at end of file diff --git a/Equipments/Pumps/Pump_INPUTS.f90 b/Equipments/Pumps/Pump_INPUTS.f90 new file mode 100644 index 0000000..2d018eb --- /dev/null +++ b/Equipments/Pumps/Pump_INPUTS.f90 @@ -0,0 +1,59 @@ +subroutine Pump_INPUTS + + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use Pump_VARIABLES + use MudSystem + + IMPLICIT NONE + + + +!>>>>>>>>>>>>>>>>>>>>>>> PUMP 1 <<<<<<<<<<<<<<<<<<<<<<<<<<< + + if ( PUMP(1)%BlowPopOffMalf==1 ) then ! Pump1 Malfunction ----> Blow Pop-offs (Relief Valves) + PUMP(1)%StandPipe_Pressure = 0.d0 + else + PUMP(1)%StandPipe_Pressure = PumpPressure1 ![psi] + if ( PUMP(1)%StandPipe_Pressure<=14. ) then + PUMP(1)%StandPipe_Pressure = 14. + end if + end if + + + + + +!>>>>>>>>>>>>>>>>>>>>>>> PUMP 2 <<<<<<<<<<<<<<<<<<<<<<<<<<< + + if ( PUMP(2)%BlowPopOffMalf==1 ) then ! Pump2 Malfunction ----> Blow Pop-offs (Relief Valves) + PUMP(2)%StandPipe_Pressure = 0.d0 + else + PUMP(2)%StandPipe_Pressure = PumpPressure2 ![psi] + if ( PUMP(2)%StandPipe_Pressure<=14. ) then + PUMP(2)%StandPipe_Pressure = 14. + end if + end if + + + + + +!>>>>>>>>>>>>>>>>>>>>>>> PUMP 3 <<<<<<<<<<<<<<<<<<<<<<<<<<< + + if ( PUMP(3)%BlowPopOffMalf==1 ) then ! Pump3 Malfunction ----> Blow Pop-offs (Relief Valves) + PUMP(3)%StandPipe_Pressure = 0.d0 + else + PUMP(3)%StandPipe_Pressure = PumpPressure3 ![psi] + if ( PUMP(3)%StandPipe_Pressure<=14. ) then + PUMP(3)%StandPipe_Pressure = 14. + end if + end if + + + + + +end subroutine Pump_INPUTS \ No newline at end of file diff --git a/Equipments/Pumps/Pump_Solver.f90 b/Equipments/Pumps/Pump_Solver.f90 new file mode 100644 index 0000000..2adb3f4 --- /dev/null +++ b/Equipments/Pumps/Pump_Solver.f90 @@ -0,0 +1,29 @@ +subroutine Pump_Solver(Pump_No) + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + + + IMPLICIT NONE + INTEGER :: Pump_No + + + + PUMP(Pump_No)%Flow_Rate = PUMP(Pump_No)%Piston_Area*PUMP(Pump_No)%Stroke_Length*(PUMP(Pump_No)%Speed/PUMP(Pump_No)%Trans_Ratio)*PUMP(Pump_No)%Vol_Efficiency/77.d0 ![gpm] + PUMP(Pump_No)%Hydraulic_HorsePower = PUMP(Pump_No)%Piston_Area*PUMP(Pump_No)%Stroke_Length*(PUMP(Pump_No)%Speed/PUMP(Pump_No)%Trans_Ratio)*PUMP(Pump_No)%StandPipe_Pressure/132000.d0 ![HHP] + PUMP(Pump_No)%TracMotor_Horsepower = PUMP(Pump_No)%Hydraulic_HorsePower/PUMP(Pump_No)%Mech_Efficiency/PUMP(Pump_No)%Vol_Efficiency ![HHP] + !PUMP(Pump_No)%Max_Pressure = (PUMP(Pump_No)%Max_Horsepower*1714.)/PUMP(Pump_No)%Flow_Rate ![psi] + + + if ( (PUMP(Pump_No)%StandPipe_Pressure*PUMP(Pump_No)%Flow_Rate)>(1714.d0*PUMP(Pump_No)%Max_Horsepower*PUMP(Pump_No)%Mech_Efficiency*PUMP(Pump_No)%Vol_Efficiency) ) then + PUMP(Pump_No)%Flow_Rate = (1714.d0*PUMP(Pump_No)%Max_Horsepower*PUMP(Pump_No)%Mech_Efficiency*PUMP(Pump_No)%Vol_Efficiency)/PUMP(Pump_No)%StandPipe_Pressure ![gpm] + PUMP(Pump_No)%Speed = ( (PUMP(Pump_No)%Flow_Rate*77.d0)/(PUMP(Pump_No)%Piston_Area*PUMP(Pump_No)%Stroke_Length) )*PUMP(Pump_No)%Trans_Ratio ![rpm] + end if + + + + +end subroutine Pump_Solver \ No newline at end of file diff --git a/Equipments/Pumps/Pump_StartUp.f90 b/Equipments/Pumps/Pump_StartUp.f90 new file mode 100644 index 0000000..3625200 --- /dev/null +++ b/Equipments/Pumps/Pump_StartUp.f90 @@ -0,0 +1,73 @@ +subroutine Pump_StartUp + + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CPowerVariables + use Pump_VARIABLES + + + IMPLICIT NONE + + + + +!>>>>>>>>>>>>>>>>>>>>>>> PUMP 1 <<<<<<<<<<<<<<<<<<<<<<<<<<< + PUMP(1)%Stroke_Length = MudPump1Stroke + PUMP(1)%Piston_Diameter = MudPump1LinerDiameter + PUMP(1)%Piston_Area = pi*PUMP(1)%Piston_Diameter*PUMP(1)%Piston_Diameter/4. + PUMP(1)%Mech_Efficiency = MudPump1MechanicalEfficiency + PUMP(1)%Vol_Efficiency = MudPump1VolumetricEfficiency + PUMP(1)%Max_Horsepower = MudPump1 + PUMP(1)%Inertia_Moment = 23.261341 ! 23.261341 [kg.m^2] = 552 [lb.ft^2] + PUMP(1)%J_coef = PUMP(1)%Inertia_Moment+(4.*(PUMP(1)%Inertia_Moment)) + PUMP(1)%Trans_Ratio = 965.0/MudPump1Maximum + PUMP(1)%time_step = .10 + + PUMP(1)%K_throttle = 0 + PUMP(1)%Flow_Rate = 0. + Call Pump1_OffMode_Solver(1) + + + + +!>>>>>>>>>>>>>>>>>>>>>>> PUMP 2 <<<<<<<<<<<<<<<<<<<<<<<<<<< + PUMP(2)%Stroke_Length = MudPump2Stroke + PUMP(2)%Piston_Diameter = MudPump2LinerDiameter + PUMP(2)%Piston_Area = pi*PUMP(2)%Piston_Diameter*PUMP(2)%Piston_Diameter/4. + PUMP(2)%Mech_Efficiency = MudPump2MechanicalEfficiency + PUMP(2)%Vol_Efficiency = MudPump2VolumetricEfficiency + PUMP(2)%Max_Horsepower = MudPump2 + PUMP(2)%Inertia_Moment = 23.261341 ! 23.261341 [kg.m^2] = 552 [lb.ft^2] + PUMP(2)%J_coef = PUMP(2)%Inertia_Moment+(4.*(PUMP(2)%Inertia_Moment)) + PUMP(2)%Trans_Ratio = 965.0/MudPump2Maximum + PUMP(2)%time_step = .10 + + PUMP(2)%K_throttle = 0 + PUMP(2)%Flow_Rate = 0. + Call Pump2_OffMode_Solver(2) + + + + + +!>>>>>>>>>>>>>>>>>>>>>>> PUMP 3 <<<<<<<<<<<<<<<<<<<<<<<<<<< + PUMP(3)%Stroke_Length = CementPumpStroke + PUMP(3)%Piston_Diameter = CementPumpLinerDiameter + PUMP(3)%Piston_Area = pi*PUMP(3)%Piston_Diameter*PUMP(3)%Piston_Diameter/4. + PUMP(3)%Mech_Efficiency = CementPumpMechanicalEfficiency + PUMP(3)%Vol_Efficiency = CementPumpVolumetricEfficiency + PUMP(3)%Max_Horsepower = CementPump + PUMP(3)%Inertia_Moment = 23.261341 ! 23.261341 [kg.m^2] = 552 [lb.ft^2] + PUMP(3)%Trans_Ratio = 965.0/CementPumpMaximum + PUMP(3)%time_step = .10 + + PUMP(3)%Flow_Rate = 0. + Call Pump3_OffMode_Solver + + + + + +end subroutine Pump_StartUp \ No newline at end of file diff --git a/Equipments/Pumps/Pump_Total_Counts.f90 b/Equipments/Pumps/Pump_Total_Counts.f90 new file mode 100644 index 0000000..c6efa9e --- /dev/null +++ b/Equipments/Pumps/Pump_Total_Counts.f90 @@ -0,0 +1,17 @@ +subroutine Pump_Total_Counts + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + + IMPLICIT NONE + + + Total_Pump_GPM = PUMP(1)%Flow_Rate+PUMP(2)%Flow_Rate+PUMP(3)%Flow_Rate + Total_Pump_SPM = (PUMP(1)%Speed/PUMP(1)%Trans_Ratio)+(PUMP(2)%Speed/PUMP(2)%Trans_Ratio)+(PUMP(3)%Speed/PUMP(3)%Trans_Ratio) + + + +end subroutine \ No newline at end of file diff --git a/Equipments/Pumps/Pump_Traction_Motor.f90 b/Equipments/Pumps/Pump_Traction_Motor.f90 new file mode 100644 index 0000000..c050d8e --- /dev/null +++ b/Equipments/Pumps/Pump_Traction_Motor.f90 @@ -0,0 +1,124 @@ +subroutine Pump_Traction_Motor(Pump_No) + + use Pump_VARIABLES + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + + + IMPLICIT NONE + INTEGER :: Pump_No + + + +!>>>>>>>>>>>>>>>>>>>>>>> DATA <<<<<<<<<<<<<<<<<<<<<<<<<<< + PUMP(Pump_No)%TL = 0.112985*PUMP(Pump_No)%Torque/2.d0 + + La = 1700.*1d-6 !170.*1d-6 !1700.*1d-6 + !Lf = 260.*1d-6 + Lf = 0.d0 + Ra = 9.5*1d-3 !0.1d0 !9.5*1d-3 + !Rf = 5.4*1d-3 + Rf = 0.d0 + + !******** controller ******* + Kpn = 11. !3. !=11. + !Kin = 50. + Kpi = 100. + Kii = 900. + + + PUMP(Pump_No)%time = PUMP(Pump_No)%time_step + PUMP(Pump_No)%dt = 1.d-5 + PUMP(Pump_No)%error = .001 + +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + PUMP(Pump_No)%n = PUMP(Pump_No)%time/PUMP(Pump_No)%dt + !PUMP(Pump_No)%w_ref = (pi*(PUMP(Pump_No)%N_ref+102.d0)/30.d0) + PUMP(Pump_No)%w_ref = (pi*(PUMP(Pump_No)%N_ref)/30.d0) + + !if (PUMP(Pump_No)%N_ref<=0.) then + ! PUMP(Pump_No)%w_ref = 0. + !end if + + + !if (PUMP(Pump_No)%N_ref<=0.) then + ! PUMP(Pump_No)%w_ref = 0. + ! PUMP(Pump_No)%w_old = 0. + ! PUMP(Pump_No)%w = 0. + !end if + + + PUMP(Pump_No)%ia_er = 1. + PUMP(Pump_No)%w_er = 1. + PUMP(Pump_No)%x_er = 1. + + + PUMP(Pump_No)%i = 1 + +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + DO WHILE (PUMP(Pump_No)%i<=PUMP(Pump_No)%n) + +!>>>>>>>>>>>> Runge-Kutta Method (4th order) <<<<<<<<<<<<<< + + call Pump_dx((PUMP(Pump_No)%i*PUMP(Pump_No)%dt),PUMP(Pump_No)%ia,PUMP(Pump_No)%w,PUMP(Pump_No)%x,Pump_No) + call Pump_dia((PUMP(Pump_No)%i*PUMP(Pump_No)%dt),PUMP(Pump_No)%ia,PUMP(Pump_No)%w,PUMP(Pump_No)%fii,PUMP(Pump_No)%x,Pump_No) + call Pump_dw((PUMP(Pump_No)%i*PUMP(Pump_No)%dt),PUMP(Pump_No)%ia,PUMP(Pump_No)%w,PUMP(Pump_No)%fii,PUMP(Pump_No)%TL,Pump_No) + PUMP(Pump_No)%K1x=PUMP(Pump_No)%dt*PUMP(Pump_No)%dx + PUMP(Pump_No)%K1ia=PUMP(Pump_No)%dt*PUMP(Pump_No)%dia + PUMP(Pump_No)%K1w=PUMP(Pump_No)%dt*PUMP(Pump_No)%dw + + call Pump_dx((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+(PUMP(Pump_No)%dt/2.),PUMP(Pump_No)%ia+(PUMP(Pump_No)%K1ia/2.),PUMP(Pump_No)%w+(PUMP(Pump_No)%K1w/2.),PUMP(Pump_No)%x+(PUMP(Pump_No)%K1x/2.),Pump_No) + call Pump_dia((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+(PUMP(Pump_No)%dt/2.),PUMP(Pump_No)%ia+(PUMP(Pump_No)%K1ia/2.),PUMP(Pump_No)%w+(PUMP(Pump_No)%K1w/2.),PUMP(Pump_No)%fii,PUMP(Pump_No)%x+(PUMP(Pump_No)%K1x/2.),Pump_No) + call Pump_dw((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+(PUMP(Pump_No)%dt/2.),PUMP(Pump_No)%ia+(PUMP(Pump_No)%K1ia/2.),PUMP(Pump_No)%w+(PUMP(Pump_No)%K1w/2.),PUMP(Pump_No)%fii,PUMP(Pump_No)%TL,Pump_No) + PUMP(Pump_No)%K2x=PUMP(Pump_No)%dt*PUMP(Pump_No)%dx + PUMP(Pump_No)%K2ia=PUMP(Pump_No)%dt*PUMP(Pump_No)%dia + PUMP(Pump_No)%K2w=PUMP(Pump_No)%dt*PUMP(Pump_No)%dw + + call Pump_dx((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+(PUMP(Pump_No)%dt/2.),PUMP(Pump_No)%ia+(PUMP(Pump_No)%K2ia/2.),PUMP(Pump_No)%w+(PUMP(Pump_No)%K2w/2.),PUMP(Pump_No)%x+(PUMP(Pump_No)%K2x/2.),Pump_No) + call Pump_dia((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+(PUMP(Pump_No)%dt/2.),PUMP(Pump_No)%ia+(PUMP(Pump_No)%K2ia/2.),PUMP(Pump_No)%w+(PUMP(Pump_No)%K2w/2.),PUMP(Pump_No)%fii,PUMP(Pump_No)%x+(PUMP(Pump_No)%K2x/2.),Pump_No) + call Pump_dw((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+(PUMP(Pump_No)%dt/2.),PUMP(Pump_No)%ia+(PUMP(Pump_No)%K2ia/2.),PUMP(Pump_No)%w+(PUMP(Pump_No)%K2w/2.),PUMP(Pump_No)%fii,PUMP(Pump_No)%TL,Pump_No) + PUMP(Pump_No)%K3x=PUMP(Pump_No)%dt*PUMP(Pump_No)%dx + PUMP(Pump_No)%K3ia=PUMP(Pump_No)%dt*PUMP(Pump_No)%dia + PUMP(Pump_No)%K3w=PUMP(Pump_No)%dt*PUMP(Pump_No)%dw + + call Pump_dx((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+PUMP(Pump_No)%dt,PUMP(Pump_No)%ia+PUMP(Pump_No)%K3ia,PUMP(Pump_No)%w+PUMP(Pump_No)%K3w,PUMP(Pump_No)%x+PUMP(Pump_No)%K3x,Pump_No) + call Pump_dia((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+PUMP(Pump_No)%dt,PUMP(Pump_No)%ia+PUMP(Pump_No)%K3ia,PUMP(Pump_No)%w+PUMP(Pump_No)%K3w,PUMP(Pump_No)%fii,PUMP(Pump_No)%x+PUMP(Pump_No)%K3x,Pump_No) + call Pump_dw((PUMP(Pump_No)%i*PUMP(Pump_No)%dt)+PUMP(Pump_No)%dt,PUMP(Pump_No)%ia+PUMP(Pump_No)%K3ia,PUMP(Pump_No)%w+PUMP(Pump_No)%K3w,PUMP(Pump_No)%fii,PUMP(Pump_No)%TL,Pump_No) + PUMP(Pump_No)%K4x=PUMP(Pump_No)%dt*PUMP(Pump_No)%dx + PUMP(Pump_No)%K4ia=PUMP(Pump_No)%dt*PUMP(Pump_No)%dia + PUMP(Pump_No)%K4w=PUMP(Pump_No)%dt*PUMP(Pump_No)%dw + + PUMP(Pump_No)%x_new = PUMP(Pump_No)%x_old+((PUMP(Pump_No)%K1x+(2.*PUMP(Pump_No)%K2x)+(2.*PUMP(Pump_No)%K3x)+PUMP(Pump_No)%K4x)/6.) + PUMP(Pump_No)%ia_new = PUMP(Pump_No)%ia_old+((PUMP(Pump_No)%K1ia+(2.*PUMP(Pump_No)%K2ia)+(2.*PUMP(Pump_No)%K3ia)+PUMP(Pump_No)%K4ia)/6.) + PUMP(Pump_No)%w_new = PUMP(Pump_No)%w_old+((PUMP(Pump_No)%K1w+(2.*PUMP(Pump_No)%K2w)+(2.*PUMP(Pump_No)%K3w)+PUMP(Pump_No)%K4w)/6.) + +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + + PUMP(Pump_No)%x_old = PUMP(Pump_No)%x_new + PUMP(Pump_No)%ia_old = PUMP(Pump_No)%ia_new + PUMP(Pump_No)%w_old = PUMP(Pump_No)%w_new + PUMP(Pump_No)%x = PUMP(Pump_No)%x_new + PUMP(Pump_No)%ia = PUMP(Pump_No)%ia_new + PUMP(Pump_No)%w = PUMP(Pump_No)%w_new + PUMP(Pump_No)%Te = PUMP(Pump_No)%fii*PUMP(Pump_No)%ia_new + + !PUMP(Pump_No)%Vt = PUMP(Pump_No)%x_new+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi))-PUMP(Pump_No)%ia_new) + !IF (PUMP(Pump_No)%Vt>810.) THEN + ! PUMP(Pump_No)%Vt = 810. + !ELSE IF (PUMP(Pump_No)%Vt<0.) THEN + ! PUMP(Pump_No)%Vt = 0. + !END IF + + PUMP(Pump_No)%i = PUMP(Pump_No)%i+1 + + END DO +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + + + +end subroutine Pump_Traction_Motor \ No newline at end of file diff --git a/Equipments/Pumps/Pump_VARIABLES.f90 b/Equipments/Pumps/Pump_VARIABLES.f90 new file mode 100644 index 0000000..25d8b14 --- /dev/null +++ b/Equipments/Pumps/Pump_VARIABLES.f90 @@ -0,0 +1,64 @@ +MODULE Pump_VARIABLES + + + IMPLICIT NONE + PUBLIC + + + REAL , PARAMETER :: pi=3.14159265 + REAL :: La, Lf, Ra, Rf + REAL :: Kpn, Kin, Kpi, Kii + REAL :: Total_Pump_GPM, Total_Pump_SPM, Total_Stroke_Counter_For_Plot + + + + +!**************************************************************************************************** +!**************** Define PUMP Array ************************************************************ + TYPE, PUBLIC :: Pump_Var + +!***** Pump_VARIABLES *************************** + INTEGER :: j , AssignmentSwitchh + INTEGER :: PowerFailMalf , BlowPopOffMalf , SPMGaugeMalf , K_throttle + + REAL :: Stroke_Length, Piston_Area, Piston_Diameter, Inertia_Moment + REAL :: Mech_Efficiency, Vol_Efficiency, Trans_Ratio + REAL :: StandPipe_Pressure , Max_Pressure + REAL :: Torque, Speed + REAL :: Flow_Rate, Hydraulic_HorsePower, TracMotor_Horsepower , Max_Horsepower + REAL :: simulation_time, time_step + + REAL(8) :: START_TIME, END_TIME + INTEGER :: INT_CPU_TIME, Dt_ref + +!***** Traction Motor_VARIABLES ***************** + INTEGER :: i, n + + REAL :: TL, Vt, J_coef, Ea, fii, Te + REAL :: time, dt, zaman + REAL :: ia, w, ia_old, w_old, ia_new, w_new + REAL :: error, ia_er, w_er ,x_er, y_er + REAL :: K1ia, K1w, K2ia, K2w, K3ia, K3w, K4ia, K4w + REAL :: K1x, K1y, K2x, K2y, K3x, K3y, K4x, K4y + REAL :: ia_ref, w_ref, N_ref ! N(rpm) , w(rad/s) + REAL :: x, y, x_old, y_old, x_new, y_new + REAL :: dia, dw, dx + REAL :: N_new, N_old + REAL :: Vt_old + + +!************* Sound_VARIABLES ********************** + INTEGER :: SoundSPM + Logical :: SoundBlower + + + END TYPE Pump_Var + + TYPE(Pump_Var), DIMENSION(1:3) :: PUMP +!*********************************************************************************************** +!**************************************************************************************************** + + + + +END MODULE Pump_VARIABLES \ No newline at end of file diff --git a/Equipments/Pumps/PumpsMain.f90 b/Equipments/Pumps/PumpsMain.f90 new file mode 100644 index 0000000..3c63fc9 --- /dev/null +++ b/Equipments/Pumps/PumpsMain.f90 @@ -0,0 +1,249 @@ +module PumpsMain + + use CPumpsVariables + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use Pump_VARIABLES + use CSounds + + implicit none + public + + contains + + + +! **************************************** +! ***** subroutine Pump1MainBody ***** +! **************************** + + subroutine Pump1_Setup() + use CSimulationVariables + implicit none + call OnSimulationInitialization%Add(Pump1_Init) + call OnSimulationStop%Add(Pump1_Init) + call OnPump1Step%Add(Pump1_Step) + call OnPump1Output%Add(Pump1_Output) + call OnPump1Main%Add(Pump1MainBody) + end subroutine + + subroutine Pump1_Init + implicit none + end subroutine Pump1_Init + + subroutine Pump1_Step + Call Pump1_MainSolver + end subroutine Pump1_Step + + subroutine Pump1_Output + implicit none + end subroutine Pump1_Output + + subroutine Pump1MainBody + use ifport + use ifmt + !use Pump1_MainSolver + use CWarningsVariables + !use equipments_PowerLimit + implicit none + + integer,dimension(8) :: MP_START_TIME, MP_END_TIME + INTEGER :: MP_SolDuration + + Call Pump_StartUp + + loop1 : do + + Call DATE_AND_TIME(values=MP_START_TIME) + + Call Pump1_MainSolver + + Call DATE_AND_TIME(values=MP_END_TIME) + MP_SolDuration = 100-(MP_END_TIME(5)*3600000+MP_END_TIME(6)*60000+MP_END_TIME(7)*1000+MP_END_TIME(8)-MP_START_TIME(5)*3600000-MP_START_TIME(6)*60000-MP_START_TIME(7)*1000-MP_START_TIME(8)) + if(MP_SolDuration > 0.0) then + Call sleepqq(MP_SolDuration) + end if + + if (IsStopped == .true.) then + exit loop1 + end if + + end do loop1 + + end subroutine Pump1MainBody + + + + + +! **************************************** +! ***** subroutine Pump2MainBody ***** +! **************************** + subroutine Pump2_Setup() + use CSimulationVariables + implicit none + call OnSimulationInitialization%Add(Pump2_Init) + call OnSimulationStop%Add(Pump2_Init) + call OnPump2Step%Add(Pump2_Step) + call OnPump2Output%Add(Pump2_Output) + call OnPump2Main%Add(Pump2MainBody) + end subroutine + + subroutine Pump2_Init + implicit none + end subroutine Pump2_Init + + subroutine Pump2_Step + call Pump2_MainSolver + end subroutine Pump2_Step + + subroutine Pump2_Output + implicit none + end subroutine Pump2_Output + + subroutine Pump2MainBody + use ifport + use ifmt + use CWarningsVariables + implicit none + + integer,dimension(8) :: MP_START_TIME, MP_END_TIME + INTEGER :: MP_SolDuration + + Call Pump_StartUp + + loop1 : do + + Call DATE_AND_TIME(values=MP_START_TIME) + + Call Pump2_MainSolver + + Call DATE_AND_TIME(values=MP_END_TIME) + MP_SolDuration = 100-(MP_END_TIME(5)*3600000+MP_END_TIME(6)*60000+MP_END_TIME(7)*1000+MP_END_TIME(8)-MP_START_TIME(5)*3600000-MP_START_TIME(6)*60000-MP_START_TIME(7)*1000-MP_START_TIME(8)) + if(MP_SolDuration > 0.0) then + Call sleepqq(MP_SolDuration) + end if + + if (IsStopped == .true.) then + exit loop1 + end if + + end do loop1 + + + end subroutine Pump2MainBody + + + + +! **************************************** +! ***** subroutine Pump3MainBody ***** +! **************************** + subroutine Pump3_Setup() + use CSimulationVariables + implicit none + call OnSimulationInitialization%Add(Pump3_Init) + call OnSimulationStop%Add(Pump3_Init) + call OnPump3Step%Add(Pump3_Step) + call OnPump3Output%Add(Pump3_Output) + call OnPump3Main%Add(Pump3MainBody) + end subroutine + + subroutine Pump3_Init + implicit none + end subroutine Pump3_Init + + subroutine Pump3_Step + implicit none + end subroutine Pump3_Step + + subroutine Pump3_Output + implicit none + end subroutine Pump3_Output + + subroutine Pump3MainBody + use ifport + use ifmt + implicit none + + + integer,dimension(8) :: MP_START_TIME, MP_END_TIME + INTEGER :: MP_SolDuration + + !Call Pump_StartUp + !loop1 : do + ! + ! Call sleepqq(10) + ! + ! !!! Pump3 Malfunction ----> Power Failure + ! !!if (PUMP(1)%PowerFailMalf==1) then + ! !! !MP1BLWR=0 + ! !! Call Pump3_OffMode_Solver + ! !! Call ClosePump1() + ! !!end if + ! + ! !if( (MP1CPSwitch==1) .and. (MP1Throttle==0.) .and. (PUMP(3)%PowerFailMalf==0) ) then + !! + !! loop2: do + !! + !! Call DATE_AND_TIME(values=MP_START_TIME) + !! + !!!! ! Pump3 Malfunction ----> Power Failure + !!!! if (PUMP(1)%PowerFailMalf==1) then + !!!! !MP1BLWR=0 + !!!! Pump3_OffMode_Solver + !!!! Call ClosePump1() + !!!! exit loop2 + !!!! end if + !! + !! PUMP(3)%N_new = MP1Throttle + !! if (((PUMP(3)%N_new-PUMP(3)%N_old)/PUMP(3)%time_step)>193.) then + !! PUMP(3)%N_ref =(193.*PUMP(3)%time_step)+PUMP(3)%N_old + !! else if (((PUMP(3)%N_old-PUMP(3)%N_new)/PUMP(3)%time_step)>193.) then + !! PUMP(3)%N_ref = (-193.*PUMP(3)%time_step)+PUMP(3)%N_old + !! else + !! PUMP(3)%N_ref = PUMP(3)%N_new + !! end if + !! + !! Call Pump3_OnMode_Solver + !! + !! IF (PUMP(3)%Flow_Rate>0.) Then + !! Call OpenCementPump() + !! Else + !! Call CloseCementPump() + !! End if + !! + !! PUMP(3)%N_old = PUMP(3)%N_ref + !! + !! Call DATE_AND_TIME(values=MP_END_TIME) + !! MP_SolDuration = 100-(MP_END_TIME(6)*60000+MP_END_TIME(7)*1000+MP_END_TIME(8)-MP_START_TIME(6)*60000-MP_START_TIME(7)*1000-MP_START_TIME(8)) + !! !print*, 'MPtime=', MP_SolDuration + !! if(MP_SolDuration > 0.0) then + !! Call sleepqq(MP_SolDuration) + !! end if + !! + !! if ((MP1CPSwitch==0) .or. (IsStopped == .true.)) then + !! Call Pump3_OffMode_Solver + !! Call CloseCementPump() + !! exit loop2 + !! end if + !! end do loop2 + ! + ! else + ! + ! !Call Pump3_OffMode_Solver + ! !Call CloseCementPump() + ! + ! end if + ! + ! if (IsStopped == .true.) then + ! exit loop1 + ! end if + ! + !end do loop1 + + + end subroutine Pump3MainBody + +end module PumpsMain \ No newline at end of file diff --git a/Equipments/Pumps/pump_diff_eqs.f90 b/Equipments/Pumps/pump_diff_eqs.f90 new file mode 100644 index 0000000..091a1f3 --- /dev/null +++ b/Equipments/Pumps/pump_diff_eqs.f90 @@ -0,0 +1,105 @@ +subroutine Pump_dia(x1,x2,x3,x5,x6,Pump_No) + + use Pump_VARIABLES + use equipments_PowerLimit + + + IMPLICIT NONE + INTEGER :: Pump_No + REAL :: x1,x2,x3,x4,x5,x6 + + !Power_sigma=2.*(PUMP(1)%Vt*PUMP(1)%ia_new)+2.*(PUMP(2)%Vt*PUMP(2)%ia_new)+2.*(PUMP(3)%Vt*PUMP(3)%ia_new)+(RTable%Vt*RTable%ia_new)+2.*(Drawworks%Vt*Drawworks%ia_new) + + PUMP(Pump_No)%Vt = PUMP(Pump_No)%x_new+Kpi*((Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi)))+20.d0-PUMP(Pump_No)%ia_new) + IF (PUMP(Pump_No)%Vt>810.) THEN + PUMP(Pump_No)%Vt = 810.0 + ELSE IF (PUMP(Pump_No)%Vt<0.) THEN + PUMP(Pump_No)%Vt = 0.0d0 + END IF + + !call PowerLimits + ! + !if (Power_sigma>max_Power_sigma) then + ! PUMP(Pump_No)%Vt=PUMP(Pump_No)%Vt_old + !else + ! PUMP(Pump_No)%Vt=x6+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*x3/pi))-x2) + ! IF (PUMP(Pump_No)%Vt>810.) THEN + ! PUMP(Pump_No)%Vt=810. + !ELSE IF (PUMP(Pump_No)%Vt<0.) THEN + ! PUMP(Pump_No)%Vt=0. + !END IF + + + ! PUMP(Pump_No)%Vt_old=PUMP(Pump_No)%x_new+Kpi*(Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*PUMP(Pump_No)%w_new/pi))-PUMP(Pump_No)%ia_new) + ! IF (PUMP(Pump_No)%Vt_old>810.) THEN + ! PUMP(Pump_No)%Vt_old=810. + !ELSE IF (PUMP(Pump_No)%Vt_old<0.) THEN + ! PUMP(Pump_No)%Vt_old=0. + !END IF + + + !end if + + !IF (PUMP(Pump_No)%Vt>810.) THEN + ! PUMP(Pump_No)%Vt=810. + !ELSE IF (PUMP(Pump_No)%Vt<0.) THEN + ! PUMP(Pump_No)%Vt=0. + !END IF + + !PUMP(Pump_No)%Vt_old=PUMP(Pump_No)%Vt + + + !IF (x2<=1150.) THEN + ! x5 = 6.3304d-3*x2 + !ELSE IF (x2>1150.) THEN + ! x5 = 2.8571d-7*(x2-1150.)+7.28 + !END IF + x5 = 6.3304d-3*1150.0 + + PUMP(Pump_No)%Ea = x5*x3 + PUMP(Pump_No)%dia = (PUMP(Pump_No)%Vt-(Ra+Rf)*x2-PUMP(Pump_No)%Ea)/(La+Lf) + +end subroutine + + + + + + +!------------------------------------------------------------ +subroutine Pump_dw(x1,x2,x3,x4,x5,Pump_No) + + use Pump_VARIABLES + + IMPLICIT NONE + INTEGER :: Pump_No + REAL :: x1,x2,x3,x4,x5 + + !IF (x2<=1150.) THEN + ! x4 = 6.3304d-3*x2 + !ELSE IF (x2>1150.) THEN + ! x4 = 2.8571d-7*(x2-1150.)+7.28 + !END IF + x4 = 6.3304d-3*1150.0 + + PUMP(Pump_No)%Te = x4*x2 + PUMP(Pump_No)%dw = (PUMP(Pump_No)%Te-x5)/PUMP(Pump_No)%J_coef + +end subroutine + + + + + +!------------------------------------------------------------ +subroutine Pump_dx(x1,x2,x3,x4,Pump_No) + + use Pump_VARIABLES + + IMPLICIT NONE + INTEGER :: Pump_No + REAL :: x1,x2,x3,x4 + + PUMP(Pump_No)%dx = Kii*((Kpn*((30.*PUMP(Pump_No)%w_ref/pi)-(30.*x3/pi)))+20.d0-x2) + +end subroutine \ No newline at end of file diff --git a/Equipments/RotaryTable/RTMalfunction_MotorFailure.f90 b/Equipments/RotaryTable/RTMalfunction_MotorFailure.f90 new file mode 100644 index 0000000..7a163a0 --- /dev/null +++ b/Equipments/RotaryTable/RTMalfunction_MotorFailure.f90 @@ -0,0 +1,17 @@ + subroutine RTMalfunction_MotorFailure + + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use RTable_VARIABLES + + IMPLICIT NONE + + + if ( RTable%MotorFaileMalf==1 ) then + RTable%N_new = 0.0 + end if + + + +END subroutine RTMalfunction_MotorFailure \ No newline at end of file diff --git a/Equipments/RotaryTable/RTTorqueLimit.f90 b/Equipments/RotaryTable/RTTorqueLimit.f90 new file mode 100644 index 0000000..ede42ec --- /dev/null +++ b/Equipments/RotaryTable/RTTorqueLimit.f90 @@ -0,0 +1,25 @@ +subroutine RTTorqueLimit + + Use equipments_PowerLimit + Use RTable_VARIABLES + + IMPLICIT NONE + + + + ! Rotary Table Malfunction ----> Drive Motor Limit Overide + if ( RTable%OverideTorqueLimitMalf==1 ) then + return + end if + + + + + IF (RTable%ia_ref>RTable%ia_ref_limit) THEN + RTable%ia_ref = RTable%ia_ref_limit + END IF + + + + +end subroutine \ No newline at end of file diff --git a/Equipments/RotaryTable/RTable_INPUTS.f90 b/Equipments/RotaryTable/RTable_INPUTS.f90 new file mode 100644 index 0000000..2f1dbc4 --- /dev/null +++ b/Equipments/RotaryTable/RTable_INPUTS.f90 @@ -0,0 +1,90 @@ +subroutine RTable_INPUTS + + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CTdsConnectionModesEnumVariables + use CTdsElevatorModesEnumVariables + use CHoistingVariables + use RTable_VARIABLES + use TD_DrillStemComponents + use CUnityInputs + use CSlipsEnumVariables + + IMPLICIT NONE + integer :: i + + + + !===> String Torque + !print* , 'TD_StringTorquert=' , TD_StringTorque + RTable%String_Torque = TD_StringTorque*12.d0 ![lb.ft]*12 ---> [lb.in] ????????? + !RTable%String_Torque = 20000. + RTable%String_Torque = 0.112984829*RTable%String_Torque ![N.m] + !print* , 'TD_StringTorquert2=' , RTable%String_Torque + + + + + !===> String_JCoef Calculation + if ( DriveType==0 ) then + if ( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_CONNECTION_NOTHING ) then + RT_RotaryMode = 1 + RTable%String_JCoef = 0.0 + Do i = 1,TD_StringConfigurationCount + RTable%String_JCoef = RTable%String_JCoef+( (TD_DrillStem(i)%TotalWeight*((TD_DrillStem(i)%Id**2)+(TD_DrillStem(i)%Od**2)))/8.0 ) ![lb.ft^2] , Jz=(1/2)*m*(r1^2+r2^2) + End Do + RTable%String_JCoef = RTable%String_JCoef*0.0421401 ![kg.m^2] + else if ( Get_Slips() /= SLIPS_SET_END ) then + RT_RotaryMode = 2 + RTable%String_JCoef = 0.0 + RTable%String_Torque = 0.0 + else + RT_RotaryMode = 3 + RTable%String_JCoef = 0.0 + RTable%String_Torque = 0.0 + end if + else if ( DriveType==1 ) then + if ( Get_IsKellyBushingSetInTable() .or. Get_Slips() == SLIPS_SET_END ) then !if rotary connected to string + RT_RotaryMode = 4 + RTable%String_JCoef = 0.0 + Do i = 1,TD_StringConfigurationCount + RTable%String_JCoef = RTable%String_JCoef+( (TD_DrillStem(i)%TotalWeight*((TD_DrillStem(i)%Id**2)+(TD_DrillStem(i)%Od**2)))/8.0 ) ![lb.ft^2] , Jz=(1/2)*m*(r1^2+r2^2) + End Do + RTable%String_JCoef = RTable%String_JCoef*0.0421401 ![kg.m^2] + else + RT_RotaryMode = 5 + RTable%String_JCoef = 0.0 + RTable%String_Torque = 0.0 + end if + end if + !print*, 'DriveType=', DriveType , RT_RotaryMode , Get_IsKellyBushingSetInTable() , Get_Slips() + !if ( Get_IsKellyBushingSetInTable() .or. Get_Slips() == SLIPS_SET_END ) then !if rotary connected to string + ! RTable%String_JCoef = 0.0 + ! Do i = 1,TD_StringConfigurationCount + ! RTable%String_JCoef = RTable%String_JCoef+( (TD_DrillStem(i)%TotalWeight*((TD_DrillStem(i)%Id**2)+(TD_DrillStem(i)%Od**2)))/8.0 ) ![lb.ft^2] , Jz=(1/2)*m*(r1^2+r2^2) + ! End Do + ! RTable%String_JCoef = RTable%String_JCoef*0.0421401 ![kg.m^2] + !else + ! RTable%String_JCoef = 0.0 + ! RTable%String_Torque = 0.0 + !end if + !RTable%String_JCoef = RTable%String_JCoef/10. !???????? /10: with no reason, check it + + + + + !===> Transmission Mode + if (RTTransmissionLever==1) then ! in high mode + RTable%Conv_Ratio = RTable%High_Conv_Ratio + else if (RTTransmissionLever==-1) then ! in low mode + RTable%Conv_Ratio = RTable%Low_Conv_Ratio + else if (RTTransmissionLever==0) then ! in low mode + RTable%Conv_Ratio = RTable%Low_Conv_Ratio + end if + + + + + +end subroutine RTable_INPUTS \ No newline at end of file diff --git a/Equipments/RotaryTable/RTable_OffMode.f90 b/Equipments/RotaryTable/RTable_OffMode.f90 new file mode 100644 index 0000000..8618e7e --- /dev/null +++ b/Equipments/RotaryTable/RTable_OffMode.f90 @@ -0,0 +1,81 @@ +subroutine RTable_OffMode + + use RTable_VARIABLES + use CDataDisplayConsoleVariables + use CDrillingConsoleVariables + use CSimulationVariables + use CWarningsVariables + use CSounds + + IMPLICIT NONE + + + !================================================================== + ! Rate limit for off Mode + + Do while (((RTable%N_old-0.0d0)/RTable%time_step)>386.0d0) + RTable%N_ref = (-386.0d0*RTable%time_step)+RTable%N_old + !else + ! RTable%N_ref=0.0d0 + !end if + + CALL RTable_INPUTS + CALL RTable_Solver + RTable%N_old = RTable%N_ref + if ( RT_OldTransMode==0 .and. RTTransmissionLever/=0 .and. RTable%w_new/=0.d0 ) then + Call Activate_RotaryGearsAbuse() + RTable%SoundGearCrash = .true. + Call SetSoundRtGearCrash(RTable%SoundGearCrash) + else + RTable%SoundGearCrash = .false. + Call SetSoundRtGearCrash(RTable%SoundGearCrash) + end if + RT_OldTransMode = RTTransmissionLever + if (IsPortable) then + RTable%AssignmentSwitch = 1 + else + RTable%AssignmentSwitch = AssignmentSwitch + end if + if ((any(RTable%AssignmentSwitch==(/6,7,12/))) .or. (RTSwitch==0) .or. (IsStopped == .true.)) then + RTBLWR = 0 + end if + + Call sleepqq (80) !????????????????? + End Do + !================================================================== + + + RTable%N_ref = 0. + RTable%N_new = 0. + RTable%N_old = 0. + + + RTable%ia = 0. + RTable%ia_old = 0. + RTable%ia_new = 0. + RTable%x = 0. + RTable%x_old = 0. + RTable%x_new = 0. + RTable%y = 0. + RTable%y_old = 0. + RTable%y_new = 0. + RTable%w = 0. + RTable%w_old = 0. + RTable%w_new = 0. + RTable%Speed = 0. + RT_wOld = 0. + Call Set_RotaryRPMGauge(sngl(1-RTable%RpmGaugeMalf)*real(RTable%Speed,8)) + RTable%SoundRPM = INT(RTable%Speed) + Call SetSoundRT( RTable%SoundRPM ) + + !RotaryRPMGauge=RTable%Speed + !RPM=RotaryRPMGauge + RTable%Output_Current = 0. + RotaryTorqueGauge = ( ((RTable%J_coef+RTable%String_JCoef)*(((RTable%w_new/RTable%Conv_Ratio)-RT_wOld)/RTable%time_step))+(RTable%String_Torque) )*0.73756215 ![N.m]*0.73756215 = [ft.lbf] + RTable%Torque = ( ((RTable%J_coef+RTable%String_JCoef)*(((RTable%w_new/RTable%Conv_Ratio)-RT_wOld)/RTable%time_step))+(RTable%String_Torque) )*0.73756215 ![N.m]*0.73756215 = [ft.lbf] + Call Set_RotaryTorque(sngl(1-RTable%TorqueGaugeMalf)*real(RTable%Torque,8)) + !RotaryTorqueGauge=(RTable%String_Torque)/12. + + + +end subroutine RTable_OffMode \ No newline at end of file diff --git a/Equipments/RotaryTable/RTable_Solver.f90 b/Equipments/RotaryTable/RTable_Solver.f90 new file mode 100644 index 0000000..66b99f7 --- /dev/null +++ b/Equipments/RotaryTable/RTable_Solver.f90 @@ -0,0 +1,128 @@ +subroutine RTable_Solver + + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use CDrillWatchVariables + use RTable_VARIABLES + use CSounds + use equipments_PowerLimit + + IMPLICIT NONE + + REAL :: const , RT_RpmGaugeOutput + + + !RTable%TracTorque = RTable%String_Torque/RTable%Conv_Ratio/RTable%Mech_Efficiency + RT_wOld = RTable%w_new/RTable%Conv_Ratio + CALL RTable_Traction_Motor + + + if (RTable%N_ref<=0.) then + Call RTable_OffMode + end if + + + + + + !IF (RTable%ia_new<=1150.) THEN + RTable%fii = 6.3304d-3*1150. + !ELSE IF (RTable%ia_new>1150.) THEN + ! RTable%fii = 2.8571d-7*(RTable%ia_new-1150.)+7.28 + !END IF + + RTable%Te = RTable%fii*RTable%ia_new + const = RTable%J_coef+(RTable%String_JCoef/(RTable%Mech_Efficiency*RTable%Conv_Ratio)) + RTable%dw = (RTable%Te-RTable%TL)/(const) + + + + + if ( any(RT_RotaryMode==(/1,4/)) ) then !if rotary connected to string + RT_RpmGaugeOutput = (30.d0*RTable%w_new/pi)/RTable%Conv_Ratio + RTable%Speed = min(RT_RpmGaugeOutput,200.d0) !Speed [RPM] + Call Set_RotaryRPMGauge(sngl(1-RTable%RpmGaugeMalf)*real(RTable%Speed,8)) + RTable%SoundRPM = INT(RTable%Speed) + Call SetSoundRT( RTable%SoundRPM ) + !RotaryRPMGauge = RTable%Speed + !RPM = RotaryRPMGauge + RotaryTorqueGauge = ( ((RTable%J_coef+RTable%String_JCoef)*(((RTable%w_new/RTable%Conv_Ratio)-RT_wOld)/RTable%time_step))+(RTable%String_Torque) )*0.73756215 ![N.m]*0.73756215 = [ft.lbf] + RTable%Torque = ( ((RTable%J_coef+RTable%String_JCoef)*(((RTable%w_new/RTable%Conv_Ratio)-RT_wOld)/RTable%time_step))+(RTable%String_Torque) )*0.73756215 ![N.m]*0.73756215 = [ft.lbf] + Call Set_RotaryTorque(sngl(1-RTable%TorqueGaugeMalf)*real(RTable%Torque,8)) + Torque = RotaryTorqueGauge + !print*, 'RTable%Speed=', RTable%Speed + !print*, 'RTable%String_JCoef=', RTable%String_JCoef + !print*, 'RTable%String_Torque=', RTable%String_Torque + else if ( any(RT_RotaryMode==(/2,5/)) ) then + RTable%Speed = 0.0 + RT_RpmGaugeOutput = (30.d0*RTable%w_new/pi)/RTable%Conv_Ratio + RT_RpmGaugeOutput = min(RT_RpmGaugeOutput,200.d0) + !print*, 'RT_RpmGaugeOutputif=', RT_RpmGaugeOutput + Call Set_RotaryRPMGauge(sngl(1-RTable%RpmGaugeMalf)*real(RT_RpmGaugeOutput,8)) + RTable%SoundRPM = INT((30.d0*RTable%w_new/pi)/RTable%Conv_Ratio) + Call SetSoundRT( RTable%SoundRPM ) + RTable%Torque = 0.0 + Call Set_RotaryTorque(sngl(1-RTable%TorqueGaugeMalf)*real( (((RTable%J_coef+RTable%String_JCoef)*(((RTable%w_new/RTable%Conv_Ratio)-RT_wOld)/RTable%time_step))+(RTable%String_Torque))*0.73756215,8 )) + !print*, 'RT_Rpmtorqueif=', RTable%Torque , sngl(1-RTable%TorqueGaugeMalf)*real( (((RTable%J_coef+RTable%String_JCoef)*(((RTable%w_new/RTable%Conv_Ratio)-RT_wOld)/RTable%time_step))+(RTable%String_Torque))*0.73756215,8 ) + else if ( RT_RotaryMode==3 ) then + RTable%Speed = 0.0 + RT_RpmGaugeOutput = 0.d0 + Call Set_RotaryRPMGauge(sngl(1-RTable%RpmGaugeMalf)*real(RT_RpmGaugeOutput,8)) + RTable%SoundRPM = 0 + Call SetSoundRT( RTable%SoundRPM ) + RTable%Torque = 0.0 + Call Set_RotaryTorque(sngl(1-RTable%TorqueGaugeMalf)*real( 0.d0,8 )) + end if + + + + + + + !if ( RTable%String_JCoef/=0.0 ) then !if rotary connected to string + ! RT_RpmGaugeOutput = (30.d0*RTable%w_new/pi)/RTable%Conv_Ratio + ! RTable%Speed = min(RT_RpmGaugeOutput,200.d0) !Speed [RPM] + ! Call Set_RotaryRPMGauge(real(RTable%Speed,8)) + ! RTable%SoundRPM = INT(RTable%Speed) + ! Call SetSoundRT( RTable%SoundRPM ) + ! !RotaryRPMGauge = RTable%Speed + ! !RPM = RotaryRPMGauge + ! RotaryTorqueGauge = ( ((RTable%J_coef+RTable%String_JCoef)*(((RTable%w_new/RTable%Conv_Ratio)-RT_wOld)/RTable%time_step))+(RTable%String_Torque) )*0.73756215 ![N.m]*0.73756215 = [ft.lbf] + ! RTable%Torque = ( ((RTable%J_coef+RTable%String_JCoef)*(((RTable%w_new/RTable%Conv_Ratio)-RT_wOld)/RTable%time_step))+(RTable%String_Torque) )*0.73756215 ![N.m]*0.73756215 = [ft.lbf] + ! Call Set_RotaryTorque(real(RTable%Torque,8)) + ! Torque = RotaryTorqueGauge + !else + ! RTable%Speed = 0.0 + ! RT_RpmGaugeOutput = (30.d0*RTable%w_new/pi)/RTable%Conv_Ratio + ! RT_RpmGaugeOutput = min(RT_RpmGaugeOutput,200.d0) + ! Call Set_RotaryRPMGauge(real(RT_RpmGaugeOutput,8)) + ! RTable%SoundRPM = INT((30.d0*RTable%w_new/pi)/RTable%Conv_Ratio) + ! Call SetSoundRT( RTable%SoundRPM ) + ! RTable%Torque = 0.0 + ! Call Set_RotaryTorque(real( (((RTable%J_coef+RTable%String_JCoef)*(((RTable%w_new/RTable%Conv_Ratio)-RT_wOld)/RTable%time_step))+(RTable%String_Torque))*0.73756215,8 )) + !end if + + +!****************************************************************** + + + !!!!!RTable%Output_Current = (RTable%TracTorque*RTable%w_new)/RTable%Vt !???????????? + !!print*, 'Power_sigma=', Power_sigma + !!print*, 'power_num_of_Jenerators=', power_num_of_Jenerators + !!print*, 'drilling_num_of_Jenerators=', drilling_num_of_Jenerators + !!!print*, 'Jenerator_power=', Jenerator_power + !print*, 'RT_RpmGaugeOutput=', RT_RpmGaugeOutput + !!!print*, 'RTable%Vt=', RTable%Vt + !print*, 'RTable%w=', RTable%w_new + !print*, 'RTable%String_Torque=', RTable%String_Torque + !print*, 'RTable%Speed=', RTable%Speed + !!print*, 'RTable%Speed2=', ((30.*RTable%w_new/pi)/RTable%Conv_Ratio) + !!!!!!!print*, 'RTable%Te=', RTable%Te + !print*, 'RTable%TL=', RTable%TL + !!print*, 'RTable%ia=', RTable%ia_new + !!print*, 'RTable%ia_ref=', RTable%ia_ref + !!print*, 'RTable%ia_ref_limit=', RTable%ia_ref_limit + + +END subroutine RTable_Solver \ No newline at end of file diff --git a/Equipments/RotaryTable/RTable_StartUp.f90 b/Equipments/RotaryTable/RTable_StartUp.f90 new file mode 100644 index 0000000..d25e788 --- /dev/null +++ b/Equipments/RotaryTable/RTable_StartUp.f90 @@ -0,0 +1,42 @@ +subroutine RTable_StartUp + + use CDrillingConsoleVariables + use RTable_VARIABLES + + IMPLICIT NONE + + + + !RTable%=0. + + RTable%Inertia_Moment = 23.261341 ! 23.261341 [kg.m^2] = 552 [lb.ft^2] + RTable%J_coef = RTable%Inertia_Moment+(1.*(RTable%Inertia_Moment)) ! [kg.m^2]??????????? + RTable%String_JCoef = 0. !??????????????? + RTable%Mech_Efficiency = 0.930 + RTable%ConstLoad = 2000. ![lb.in] + RTable%ConstLoad = 0.112984829*RTable%ConstLoad ![N.m] + RTable%Torque = 0.0 + + + RTable%High_Conv_Ratio = 4.8250 + RTable%Low_Conv_Ratio = 7.310 + RTable%Conv_Ratio = RTable%Low_Conv_Ratio + RTable%time_step = .10 + + + RTable%w = 0.0 + RTable%w_new = 0.0 + + + + + RT_OldTransMode = RTTransmissionLever + + + + call RTable_OffMode + + + + +end subroutine RTable_StartUp \ No newline at end of file diff --git a/Equipments/RotaryTable/RTable_Traction_Motor.f90 b/Equipments/RotaryTable/RTable_Traction_Motor.f90 new file mode 100644 index 0000000..518d6d0 --- /dev/null +++ b/Equipments/RotaryTable/RTable_Traction_Motor.f90 @@ -0,0 +1,141 @@ +subroutine RTable_Traction_Motor + + use CDrillingConsoleVariables + use CDataDisplayConsoleVariables + use CSimulationVariables + use RTable_VARIABLES + use equipments_PowerLimit + + IMPLICIT NONE + + !integer :: jnomb + !jnomb = 0 + + !>>>>>>>>>>>>>>>>>>>>>>> DATA <<<<<<<<<<<<<<<<<<<<<<<<<<< + RTable%TL = (RTable%String_Torque+RTable%ConstLoad)/(RTable%Mech_Efficiency*RTable%Conv_Ratio) + !RTable%TL = 5700. + !print*, 'RTable%TLtr=', RTable%TL , RTable%Te + !print*, 'RTable%String_JCoef=', RTable%String_JCoef , RTable%J_coef+(RTable%String_JCoef/(RTable%Mech_Efficiency*RTable%Conv_Ratio)) + La = 1700.*1d-6 + Lf = 260.*1d-6 + Ra = 9.5*1d-3 + !Rf = 5.4*1d-3 + Rf = 0. + + !******** controller ******* + Kpn = 50.d0 + Kin = 3.d0 + Kpi = 100.d0 + Kii = 900.d0 + + RTable%time = RTable%time_step + RTable%dt = 1.d-5 + RTable%error = .001 + +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + RTable%n = RTable%time/RTable%dt + RTable%w_ref = (pi*(RTable%N_ref)/30.d0) + RTable%ia_ref_limit = RTTorqueLimitKnob*100.d0 + !print* , 'N_ref=' , RTThrottle , RTable%w_ref , RTable%N_ref + + RTable%ia_er = 1. + RTable%w_er = 1. + RTable%x_er = 1. + RTable%y_er = 1. + + RTable%i = 1 + +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + DO WHILE (RTable%i<=RTable%n) + + + !>>>>>>>>>>>> Runge-Kutta Method (4th order) <<<<<<<<<<<<<< + + call RTable_dx((RTable%i*RTable%dt),RTable%ia,RTable%w,RTable%x,RTable%y) + call RTable_dy((RTable%i*RTable%dt),RTable%ia,RTable%w,RTable%x,RTable%y) + call RTable_dia((RTable%i*RTable%dt),RTable%ia,RTable%w,RTable%fii,RTable%x,RTable%y) + call RTable_dw((RTable%i*RTable%dt),RTable%ia,RTable%w,RTable%fii,RTable%TL) + RTable%K1x = RTable%dt*RTable%dx + RTable%K1y = RTable%dt*RTable%dy + RTable%K1ia = RTable%dt*RTable%dia + RTable%K1w = RTable%dt*RTable%dw + + call RTable_dx((RTable%i*RTable%dt)+(RTable%dt/2.),RTable%ia+(RTable%K1ia/2.),RTable%w+(RTable%K1w/2.),RTable%x+(RTable%K1x/2.),RTable%y+(RTable%K1y/2.)) + call RTable_dy((RTable%i*RTable%dt)+(RTable%dt/2.),RTable%ia+(RTable%K1ia/2.),RTable%w+(RTable%K1w/2.),RTable%x+(RTable%K1x/2.),RTable%y+(RTable%K1y/2.)) + call RTable_dia((RTable%i*RTable%dt)+(RTable%dt/2.),RTable%ia+(RTable%K1ia/2.),RTable%w+(RTable%K1w/2.),RTable%fii,RTable%x+(RTable%K1x/2.),RTable%y+(RTable%K1y/2.)) + call RTable_dw((RTable%i*RTable%dt)+(RTable%dt/2.),RTable%ia+(RTable%K1ia/2.),RTable%w+(RTable%K1w/2.),RTable%fii,RTable%TL) + RTable%K2x = RTable%dt*RTable%dx + RTable%K2y = RTable%dt*RTable%dy + RTable%K2ia = RTable%dt*RTable%dia + RTable%K2w = RTable%dt*RTable%dw + + call RTable_dx((RTable%i*RTable%dt)+(RTable%dt/2.),RTable%ia+(RTable%K2ia/2.),RTable%w+(RTable%K2w/2.),RTable%x+(RTable%K2x/2.),RTable%y+(RTable%K2y/2.)) + call RTable_dy((RTable%i*RTable%dt)+(RTable%dt/2.),RTable%ia+(RTable%K2ia/2.),RTable%w+(RTable%K2w/2.),RTable%x+(RTable%K2x/2.),RTable%y+(RTable%K2y/2.)) + call RTable_dia((RTable%i*RTable%dt)+(RTable%dt/2.),RTable%ia+(RTable%K2ia/2.),RTable%w+(RTable%K2w/2.),RTable%fii,RTable%x+(RTable%K2x/2.),RTable%y+(RTable%K2y/2.)) + call RTable_dw((RTable%i*RTable%dt)+(RTable%dt/2.),RTable%ia+(RTable%K2ia/2.),RTable%w+(RTable%K2w/2.),RTable%fii,RTable%TL) + RTable%K3x = RTable%dt*RTable%dx + RTable%K3y = RTable%dt*RTable%dy + RTable%K3ia = RTable%dt*RTable%dia + RTable%K3w = RTable%dt*RTable%dw + + call RTable_dx((RTable%i*RTable%dt)+RTable%dt,RTable%ia+RTable%K3ia,RTable%w+RTable%K3w,RTable%x+RTable%K3x,RTable%y+RTable%K3y) + call RTable_dy((RTable%i*RTable%dt)+RTable%dt,RTable%ia+RTable%K3ia,RTable%w+RTable%K3w,RTable%x+RTable%K3x,RTable%y+RTable%K3y) + call RTable_dia((RTable%i*RTable%dt)+RTable%dt,RTable%ia+RTable%K3ia,RTable%w+RTable%K3w,RTable%fii,RTable%x+RTable%K3x,RTable%y+RTable%K3y) + call RTable_dw((RTable%i*RTable%dt)+RTable%dt,RTable%ia+RTable%K3ia,RTable%w+RTable%K3w,RTable%fii,RTable%TL) + RTable%K4x = RTable%dt*RTable%dx + RTable%K4y = RTable%dt*RTable%dy + RTable%K4ia = RTable%dt*RTable%dia + RTable%K4w = RTable%dt*RTable%dw + + RTable%x_new = RTable%x_old+((RTable%K1x+(2.*RTable%K2x)+(2.*RTable%K3x)+RTable%K4x)/6.) + RTable%y_new = RTable%y_old+((RTable%K1y+(2.*RTable%K2y)+(2.*RTable%K3y)+RTable%K4y)/6.) + RTable%ia_new = RTable%ia_old+((RTable%K1ia+(2.*RTable%K2ia)+(2.*RTable%K3ia)+RTable%K4ia)/6.) + RTable%w_new = RTable%w_old+((RTable%K1w+(2.*RTable%K2w)+(2.*RTable%K3w)+RTable%K4w)/6.) + + !>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + RTable%x_old = RTable%x_new + RTable%y_old = RTable%y_new + RTable%ia_old = RTable%ia_new + RTable%w_old = RTable%w_new + RTable%x = RTable%x_new + RTable%y = RTable%y_new + RTable%ia = RTable%ia_new + RTable%w = RTable%w_new + RTable%Te = RTable%fii*RTable%ia_new + + !if (jnomb==0) then + ! print*, 'RTable%Vt0=', RTable%Vt + ! jnomb=1 + !end if + RTable%ia_ref = RTable%y_new+Kpn*((30.0*RTable%w_ref/pi)-(30.0*RTable%w_new/pi)) + call RTTorqueLimit + RTable%Vt = RTable%x_new+(Kpi*(RTable%ia_ref-RTable%ia_new)) + !call PowerLimits + !if (Power_sigma>max_Power_sigma) then + ! RTable%Vt = RTable%Vt + !else + ! RTable%Vt = RTable%x_new+(Kpi*(RTable%ia_ref-RTable%ia_new)) + !end if + + IF (RTable%Vt>810.) THEN + RTable%Vt = 810.0 + ELSE IF (RTable%Vt<0.) THEN + RTable%Vt = 0.0 + END IF + + + + + RTable%i = RTable%i+1 + + + END DO +!>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + !print*, 'RTable%wtr=', RTable%w_new , RTable%ia_new , RTable%dw , RTable%dia + + + + +END subroutine RTable_Traction_Motor \ No newline at end of file diff --git a/Equipments/RotaryTable/RTable_VARIABLES.f90 b/Equipments/RotaryTable/RTable_VARIABLES.f90 new file mode 100644 index 0000000..dfd507f --- /dev/null +++ b/Equipments/RotaryTable/RTable_VARIABLES.f90 @@ -0,0 +1,61 @@ +MODULE RTable_VARIABLES + + IMPLICIT NONE + PUBLIC + + REAL, PARAMETER :: pi=3.14159265 + REAL :: La, Lf, Ra, Rf + REAL :: Kpn, Kin, Kpi, Kii + REAL :: RT_wOld + + INTEGER :: RT_OldTransMode , RT_RotaryMode + REAL :: RT_RPMUnityOutput + + +!**************************************************************************************************** +!**************** Difine Rotary Table Array **************************************************** + TYPE, PUBLIC :: RTable_Var + +!***** RTable_VARIABLES ************************* + INTEGER :: j , AssignmentSwitch + INTEGER :: MotorFaileMalf , OverideTorqueLimitMalf , RpmGaugeMalf , TorqueGaugeMalf , TorqueLimitGaugeMalf + + REAL :: Horsepower, Speed, Output_Current, Inertia_Moment, Mech_Efficiency, Torque + REAL :: Conv_Ratio, High_Conv_Ratio, Low_Conv_Ratio + REAL :: String_Torque, String_JCoef + REAL :: TracTorque, ConstLoad + REAL :: simulation_time, time_step + + INTEGER :: Dt_ref + +!***** Traction Motor_VARIABLES ***************** + INTEGER :: i, n + + REAL :: TL, Vt, J_coef, Ea, fii, Te + REAL :: time, dt, zaman + REAL :: ia, w, ia_old, w_old, ia_new, w_new + REAL :: error, ia_er, w_er ,x_er, y_er + REAL :: K1ia, K1w, K2ia, K2w, K3ia, K3w, K4ia, K4w + REAL :: K1x, K1y, K2x, K2y, K3x, K3y, K4x, K4y + REAL :: ia_ref, ia_ref_limit, w_ref, N_ref ! N(rpm) , w(rad/s) + REAL :: x, y, x_old, y_old, x_new, y_new + REAL :: dia, dw, dx, dy + REAL :: N_new, N_old + + +!************* Sound_VARIABLES ********************** + INTEGER :: SoundRPM + Logical :: SoundBlower , SoundGearCrash + + + + END TYPE RTable_Var + + TYPE(RTable_Var) :: RTable +!*********************************************************************************************** +!**************************************************************************************************** + + + + +END MODULE RTable_VARIABLES \ No newline at end of file diff --git a/Equipments/RotaryTable/RTable_diff_eqs.f90 b/Equipments/RotaryTable/RTable_diff_eqs.f90 new file mode 100644 index 0000000..d5c78a3 --- /dev/null +++ b/Equipments/RotaryTable/RTable_diff_eqs.f90 @@ -0,0 +1,126 @@ + subroutine RTable_dia(x1,x2,x3,x5,x6,x7) + + use equipments_PowerLimit + use RTable_VARIABLES + + IMPLICIT NONE + + REAL :: x1,x2,x3,x5,x6,x7 + + + !RTable%Vt = x6+Kpi*(Kpn*((30.*RTable%w_ref/pi)-(30.*x3/pi))-x2) + + RTable%ia_ref = x7+Kpn*((30.*RTable%w_ref/pi)-(30.*x3/pi)) + + call RTTorqueLimit + !if (LimitOveride==1) then + ! goto TorqueLimit_Limitation1 + !end if + + !IF (RTable%ia_ref>RTable%ia_ref_limit) THEN + ! RTable%ia_ref = RTable%ia_ref_limit + !END IF + +!TorqueLimit_Elimination1: + + !call PowerLimits + !if (Power_sigma>max_Power_sigma) then + ! RTable%Vt = RTable%Vt + !else + RTable%Vt = x6+(Kpi*(RTable%ia_ref-x2)) + !end if + + IF (RTable%Vt>810.) THEN + RTable%Vt = 810.0 + ELSE IF (RTable%Vt<0.) THEN + RTable%Vt = 0.0 + END IF + + + !IF (x2<=1150.) THEN + x5 = (6.3304d-3)*1150. + !ELSE IF (x2>1150.) THEN + ! x5 = 2.8571d-7*(x2-1150.)+7.28 + !END IF + + RTable%Ea = x5*x3 + RTable%dia = (RTable%Vt-(Ra+Rf)*x2-RTable%Ea)/(La+Lf) + !call PowerLimits + !if (Power_sigma>max_Power_sigma) then + ! RTable%dia = 0.d0 + !end if + +end subroutine + + + + +!------------------------------------------------------------------------------- +subroutine RTable_dw(x1,x2,x3,x4,x5) + + use RTable_VARIABLES + + IMPLICIT NONE + REAL :: x1,x2,x3,x4,x5 + REAL :: const + + !IF (x2<=1150.) THEN + x4 = 6.3304d-3*1150. + !ELSE IF (x2>1150.) THEN + ! x4 = 2.8571d-7*(x2-1150.)+7.28 + !END IF + + RTable%Te = x4*x2 + !RTable%dw = (RTable%Te-x5)/RTable%J_coef + + const = RTable%J_coef+(RTable%String_JCoef/(RTable%Mech_Efficiency*RTable%Conv_Ratio)) + + !RTable%dw = (RTable%Te-((RTable%String_Torque)/(RTable%Mech_Efficiency*RTable%Conv_Ratio)))/(const) + RTable%dw = (RTable%Te-RTable%TL)/(const) + +end subroutine + + + + +!------------------------------------------------------------ +subroutine RTable_dx(x1,x2,x3,x4,x5) + + use RTable_VARIABLES + + IMPLICIT NONE + REAL :: x1,x2,x3,x4,x5 + + !RTable%dx = Kii*(Kpn*((30.*RTable%w_ref/pi)-(30.*x3/pi))-x2) + + RTable%ia_ref = x5+Kpn*((30.*RTable%w_ref/pi)-(30.*x3/pi)) + + call RTTorqueLimit + !if (LimitOveride==1) then + !goto TorqueLimit_Limitation2 + !end if + + !IF (RTable%ia_ref>RTable%ia_ref_limit) THEN + !RTable%ia_ref = RTable%ia_ref_limit + !END IF + +!TorqueLimit_Elimination2: + + RTable%dx = Kii*(RTable%ia_ref-x2) + +end subroutine + + + + +!------------------------------------------------------------ +subroutine RTable_dy(x1,x2,x3,x4,x5) + + use RTable_VARIABLES + + IMPLICIT NONE + REAL :: x1,x2,x3,x4,x5 + + RTable%dy = Kin*((30.0d0*RTable%w_ref/pi)-(30.0d0*x3/pi)) + +end subroutine \ No newline at end of file diff --git a/Equipments/RotaryTable/RotaryTableMain.f90 b/Equipments/RotaryTable/RotaryTableMain.f90 new file mode 100644 index 0000000..f83c8e2 --- /dev/null +++ b/Equipments/RotaryTable/RotaryTableMain.f90 @@ -0,0 +1,204 @@ +module RotaryTableMain + implicit none + public + contains + + ! subroutine RotaryTable_Setup() + ! use CSimulationVariables + ! implicit none + ! call OnSimulationInitialization%Add(RotaryTable_Init) + ! call OnSimulationStop%Add(RotaryTable_Init) + ! call OnRotaryTableStep%Add(RotaryTable_Step) + ! call OnRotaryTableOutput%Add(RotaryTable_Output) + ! call OnRotaryTableMain%Add(RotaryTableMainBody) + ! end subroutine + + subroutine RotaryTable_Init + implicit none + end subroutine RotaryTable_Init + + subroutine RotaryTable_Step + implicit none + end subroutine RotaryTable_Step + + subroutine RotaryTable_Output + implicit none + end subroutine RotaryTable_Output + + + subroutine RotaryTableMainBody + + use CDataDisplayConsoleVariables + use CDrillingConsoleVariables + use CSimulationVariables + use RTable_VARIABLES + use CDrillWatchVariables + use CWarningsVariables + use CSounds + + implicit none + + integer,dimension(8) :: RT_START_TIME, RT_END_TIME + INTEGER :: RT_SolDuration + + + Call RTable_StartUp + loopRtablestart : do + + call sleepqq(10) + + if (IsPortable) then + RTable%AssignmentSwitch = 1 + else + RTable%AssignmentSwitch = AssignmentSwitch + end if + if ( (any(RTable%AssignmentSwitch==(/1,2,3,4,5,8,9,10,11/))) .and. (RTSwitch == -1) ) then + + RTable%SoundBlower = .true. + Call SetSoundBlowerRT(RTable%SoundBlower) + RTBLWR = 1 + + loopRtableswitch: do + + CALL DATE_AND_TIME(values=RT_START_TIME) + + IF ( RTTransmissionLever /=0 .and. RotaryGearsAbuse==0 ) THEN !be in clutch mode ?????? + RTable%N_new = RTThrottle + + !===> Rotary Table Malfunction ----> Drive Motor Failure + call RTMalfunction_MotorFailure + + if (((RTable%N_new-RTable%N_old)/RTable%time_step)>193.) then + RTable%N_ref = (193.*RTable%time_step)+RTable%N_old + else if (((RTable%N_old-RTable%N_new)/RTable%time_step)>193.) then + RTable%N_ref = (-193.*RTable%time_step)+RTable%N_old + else + RTable%N_ref = RTable%N_new + end if + CALL RTable_INPUTS + CALL RTable_Solver + RT_RPMUnityOutput = RotaryRPMGauge + RTable%N_old = RTable%N_ref + Else IF ( RTTransmissionLever==0) THEN !be in brake mode ?????? + Call RTable_OffMode + RT_RPMUnityOutput = RotaryRPMGauge + End IF + RT_OldTransMode = RTTransmissionLever + + CALL DATE_AND_TIME(values=RT_END_TIME) + RT_SolDuration = 100-(RT_END_TIME(5)*3600000+RT_END_TIME(6)*60000+RT_END_TIME(7)*1000+RT_END_TIME(8)-RT_START_TIME(5)*3600000-RT_START_TIME(6)*60000-RT_START_TIME(7)*1000-RT_START_TIME(8)) + !print*, 'RTtime=', RT_SolDuration + if(RT_SolDuration > 0.0) then + CALL sleepqq(RT_SolDuration) + end if + + if (IsPortable) then + RTable%AssignmentSwitch = 1 + else + RTable%AssignmentSwitch = AssignmentSwitch + end if + if ((any(RTable%AssignmentSwitch==(/6,7,12/))) .or. (RTSwitch/=-1) .or. (IsStopped == .true.)) then + RTable%SoundBlower = .false. + Call SetSoundBlowerRT(RTable%SoundBlower) + RTBLWR = 0 + Call RTable_OffMode + RT_RPMUnityOutput = RotaryRPMGauge + exit loopRtableswitch + end if + + end do loopRtableswitch + + + + else if ( (any(RTable%AssignmentSwitch==(/1,2,3,4,5,8,9,10,11/))) .and. (RTSwitch == 1) .and. (RTThrottle==0.) ) then + + RTable%SoundBlower = .true. + Call SetSoundBlowerRT(RTable%SoundBlower) + RTBLWR = 1 + + loopRtableswitchREV: do + + CALL DATE_AND_TIME(values=RT_START_TIME) + + IF ( RTTransmissionLever /=0 .and. RotaryGearsAbuse==0 ) THEN !be in clutch mode ?????? + RTable%N_new = RTThrottle + + !===> Rotary Table Malfunction ----> Drive Motor Failure + call RTMalfunction_MotorFailure + + if (((RTable%N_new-RTable%N_old)/RTable%time_step)>193.) then + RTable%N_ref = (193.*RTable%time_step)+RTable%N_old + else if (((RTable%N_old-RTable%N_new)/RTable%time_step)>193.) then + RTable%N_ref = (-193.*RTable%time_step)+RTable%N_old + else + RTable%N_ref = RTable%N_new + end if + CALL RTable_INPUTS + CALL RTable_Solver + RT_RPMUnityOutput = -RotaryRPMGauge + RTable%N_old = RTable%N_ref + Else IF ( RTTransmissionLever==0) THEN !be in brake mode ?????? + Call RTable_OffMode + RT_RPMUnityOutput = -RotaryRPMGauge + End IF + RT_OldTransMode = RTTransmissionLever + + CALL DATE_AND_TIME(values=RT_END_TIME) + RT_SolDuration = 100-(RT_END_TIME(5)*3600000+RT_END_TIME(6)*60000+RT_END_TIME(7)*1000+RT_END_TIME(8)-RT_START_TIME(5)*3600000-RT_START_TIME(6)*60000-RT_START_TIME(7)*1000-RT_START_TIME(8)) + !print*, 'RTtime=', RT_SolDuration + if(RT_SolDuration > 0.0) then + CALL sleepqq(RT_SolDuration) + end if + + if (IsPortable) then + RTable%AssignmentSwitch = 1 + else + RTable%AssignmentSwitch = AssignmentSwitch + end if + if ((any(RTable%AssignmentSwitch==(/6,7,12/))) .or. (RTSwitch/=1) .or. (IsStopped == .true.)) then + RTable%SoundBlower = .false. + Call SetSoundBlowerRT(RTable%SoundBlower) + RTBLWR = 0 + Call RTable_OffMode + RT_RPMUnityOutput = -RotaryRPMGauge + exit loopRtableswitchREV + end if + + end do loopRtableswitchREV + + + else + + + if (IsPortable) then + RTable%AssignmentSwitch = 1 + else + RTable%AssignmentSwitch = AssignmentSwitch + end if + if((any(RTable%AssignmentSwitch==(/1,2,3,4,5,8,9,10,11/))) .and. (RTSwitch /= 0)) then + RTable%SoundBlower = .true. + Call SetSoundBlowerRT(RTable%SoundBlower) + RTBLWR = 1 + else + RTable%SoundBlower = .false. + Call SetSoundBlowerRT(RTable%SoundBlower) + RTBLWR = 0 + end if + Call RTable_OffMode + RT_RPMUnityOutput = RotaryRPMGauge + !exit loopRtableswitch + RT_OldTransMode = RTTransmissionLever + + + end if + + if (IsStopped == .true.) then + exit loopRtablestart + end if + + end do loopRtablestart + + + end subroutine RotaryTableMainBody + +end module RotaryTableMain \ No newline at end of file diff --git a/Equipments/RotaryTable/rtable_variables.mod b/Equipments/RotaryTable/rtable_variables.mod new file mode 100644 index 0000000..a558bec Binary files /dev/null and b/Equipments/RotaryTable/rtable_variables.mod differ diff --git a/Equipments/TopDrive/TopDriveMain.f90 b/Equipments/TopDrive/TopDriveMain.f90 new file mode 100644 index 0000000..390df53 --- /dev/null +++ b/Equipments/TopDrive/TopDriveMain.f90 @@ -0,0 +1,179 @@ +module TopDriveMain + use CLog4 + implicit none + public + contains + + subroutine TopDrive_Setup() + use CSimulationVariables + implicit none + call OnSimulationStop%Add(TopDrive_Stop) + call OnTopDriveStart%Add(TopDrive_Start) + call OnTopDriveStep%Add(TopDrive_Step) + call OnTopDriveMain%Add(TopDriveMainBody) + end subroutine + + subroutine TopDrive_Stop + implicit none + call Log_4('TopDrive_Stop') + end subroutine TopDrive_Stop + + subroutine TopDrive_Start + implicit none + call Log_4('TopDrive_Start') + end subroutine TopDrive_Start + + subroutine TopDrive_Step + implicit none + call Log_4('TopDrive_Step') + end subroutine TopDrive_Step + + + + + subroutine TopDriveMainBody + + !use CDataDisplayConsoleVariables + !use CDrillingConsoleVariables + use CSimulationVariables + use TopDrive_VARIABLES + use CDrillWatchVariables + use CWarningsVariables + use CSounds + use CTopDrivePanelVariables + + implicit none + + integer,dimension(8) :: TDS_START_TIME, TDS_END_TIME + INTEGER :: TDS_SolDuration + + call Log_4('TopDriveMainBody') + + Call TopDrive_StartUp + loopTopDrivestart : do + + call sleepqq(10) + + !if ( (TopDriveTdsPowerState==-1) .and. (RpmKnob==0.) ) then !FWD + if ( (TopDriveTdsPowerState==-1) ) then !FWD + + + TDS%SoundBlower = .true. + !Call SetSoundBlowerRT(TDS%SoundBlower) + TopDriveTdsPowerLed = 1 + + loopTopDriveswitchFWD: do + + CALL DATE_AND_TIME(values=TDS_START_TIME) + + !IF ( RTTransmissionLever /=0 .and. RotaryGearsAbuse==0 ) THEN !be in clutch mode ???? + TDS%N_new = (RpmKnob/250.d0)*965.d0 ! 0 0) THEN ! flowrate in choke line + ! FlowEl(NoHorizontalEl + NoStringEl + NoAnnulusEl + 1 : NoHorizontalEl + NoStringEl + NoAnnulusEl + NoWellToChokeEl)%FlowRate = AnnulusFlowRate + (DeltaVolumePipe * ConvMinToSec / dt) + !END IF + + IF (ShoeFractured) THEN ! reduction of flowrate due to formation fracture and lost circulation + + !WRITE (*,*) ' SHoe fractured', PressureGauges(5), FlowEl(ShoeFlowElNo)%FlowRate + IF (ShoeFlowElNo > AnnulusLastEl) THEN ! shoe is in openhole + FlowEl(ShoeFlowElNo : NumbEl)%FlowRate = - QLost + FlowEl(AnnulusFirstEl : OpenholeFirstEl - 1)%FlowRate = FlowEl(AnnulusFirstEl : OpenholeFirstEl - 1)%FlowRate - QLost + ELSE ! shoe is in annulus + FlowEl(ShoeFlowElNo : OpenholeFirstEl - 1)%FlowRate = FlowEl(ShoeFlowElNo : OpenholeFirstEl - 1)%FlowRate - QLost + END IF + END IF + + + !!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!! initial guess flowrates for opening BOP or choke line + IF (WellHeadWasOpen == .FALSE. .AND. NoGasPocket > 0 .AND. KickIteration == 1) THEN + IF (ChokeKroneckerDelta == 1) THEN ! flow on choke line + IF (TotalOpenChokeArea < 0.01 * ChokeAreaFullyOpen) THEN + WRITE (*,*) 'density , TotalOpenChokeArea' , density, TotalOpenChokeArea + TotalOpenChokeArea = 0.01 * ChokeAreaFullyOpen + END IF + Kchoke = (ChokeDensity / ((2.0 * 89158.0) * (0.26 * 0.61 * TotalOpenChokeArea)**2)) * 4.0 ! *4.d0: seyyed gofte + GasPocketFlowInduced%Array(:) = MIN((0.6 / NoGasPocket * SQRT(PressureGauges(2) / Kchoke)) , (0.05 * GasPocketNewVol%Array(:) * ConvFt3toUSgal / 60 / dt)) + WRITE (*,*) ' PressureGauges(2) , Kchoke' , PressureGauges(2) , Kchoke + WRITE (*,*) 'Initial guess after opening choke =', GasPocketFlowInduced%Array(1) + + WRITE (*,*) ' valve 49 ', Valve(49)%Status + WRITE (*,*) ' valve 47 ', Valve(47)%Status + WRITE (*,*) ' valve 26 ', Valve(26)%Status + WRITE (*,*) ' valve 30 ', Valve(30)%Status + WRITE (*,*) ' valve 34 ', Valve(34)%Status + WRITE (*,*) ' valve 63 ', Valve(63)%Status + WRITE (*,*) ' valve 28 ', Valve(28)%Status + WRITE (*,*) ' valve 33 ', Valve(33)%Status + WRITE (*,*) ' valve 62 ', Valve(62)%Status + WRITE (*,*) ' valve 36 ', Valve(36)%Status + WRITE (*,*) ' valve 38 ', Valve(38)%Status + + ELSE ! flow through bell nipple + k = NoHorizontalEl + NoStringEl + NoAnnulusEl + KBOP = FlowEl(AnnulusLastEl)%Density / ((2.0 * 89158.0) * (0.26 * 0.61 * MinimumOpenArea_InBOP)**2) + GasPocketFlowInduced%Array(:) = MIN((0.1 / NoGasPocket * SQRT(PressureGauges(6) / KBOP)) , (0.05 * GasPocketNewVol%Array(:) * ConvFt3toUSgal / 60 / dt)) + WRITE (*,*) 'PressureGauges(6), KBOP', PressureGauges(6), KBOP + WRITE (*,*) 'Initial guess after opening BOP =', GasPocketFlowInduced%Array(1) + END IF + END IF + !!!!!!!!!!!!!!!!!!!!!!!!! + + !!!!!!!!!!!!!!!!!!!!!!!!! flowrates due to expansion of gas pockets or kick influx + !i = AnnulusFirstEl + !j = OpenholeFirstEl - 1 + IF (NoGasPocket > 0) THEN + DO l = 1 , NoGasPocket !GasPocketFlowEl + k = GasPocketFlowEl(l , 1) + !WRITE (*,*) 'GasPocketFlowEl(l , 1)', l, k, j + IF (k == 0) CALL ERRORSTOP('GasPocketFlowEl(l , 1) == 0', l) + + IF (k >= OpenholeFirstEl) THEN ! gas pocket is in open hole only + FlowEl(k : NumbEl)%FlowRate = FlowEl(k : NumbEl)%FlowRate + GasPocketFlowInduced%Array(l) ! openhole elements above pocket + FlowEl(AnnulusFirstEl : OpenholeFirstEl - 1)%FlowRate = FlowEl(AnnulusFirstEl : OpenholeFirstEl - 1)%FlowRate + GasPocketFlowInduced%Array(l) ! annulus and choke line elements + ELSE IF (k < OpenholeFirstEl) THEN ! gas pocket is in annulus ond/or choke line only + FlowEl(k : OpenholeFirstEl - 1)%FlowRate = FlowEl(k : OpenholeFirstEl - 1)%FlowRate + GasPocketFlowInduced%Array(l) ! annulus or choke line elements above pocket + END IF + END DO + END IF + !IF (ChokeKroneckerDelta == 1 .AND. ABS(FlowEl(i + NoAnnulusEl)%FlowRate / 600.0 - Ann_Saved_MudDischarged_Volume_Final) > 0.05) THEN + ! WRITE (*,*) 'Difference between flowrates', FlowEl(i + NoAnnulusEl + 1)%FlowRate / 600.0, Ann_Saved_MudDischarged_Volume_Final + !END IF + + !!!!!!!!!!!!!!!!!!!!!!!!! + !!!!! END - Determining flow rate in each section + + !!!!!!!!!!!!!!!!!!!!!!!!! effect of surge and swab on frictional pressure drop direction + DO l = AnnulusFirstEl , OpenholeFirstEl - 1 + IF (FlowEl(l)%FlowRate < 0.0) THEN + FlowEl(l)%FrictionDirection = -1 + IF (FlowEl(l)%FlowRate > -1.0 * PressFlowrateTolerance .AND. ALLOCATED(GasPocketWeight%Array)) FlowEl(l)%FlowRate = - PressFlowrateTolerance + ELSE + FlowEl(l)%FrictionDirection = 1 + IF (FlowEl(l)%FlowRate < PressFlowrateTolerance .AND. ALLOCATED(GasPocketWeight%Array)) FlowEl(l)%FlowRate = PressFlowrateTolerance + END IF + END DO + !!!!!!!!!!!!!!!!!!!!!!!!! + + !!!!!!!!!!!!!!!!!!!!!!!!! Calculating Back Pressure, in well to pit path back pressure = 0 + ! in well to choke manifold path back pressure is equal to pressure before choke not casing pressure + IF (ChokeKroneckerDelta == 1) THEN + + IF (FlowEl(OpenholeFirstEl - 1)%FlowRate < 0.0) THEN + WRITE (*,*) ' Negative choke flowrate' + FlowEl(OpenholeFirstEl - 1)%FlowRate = MAX((REAL(MudVolume_InjectedToBH) * ConvMintoSec / dt) , 10.0) + END IF + !Kchoke = ChokeDensity / ((2. * 89158.0) * (0.26 * 0.61 * TotalOpenChokeArea)**2) + deltaPchoke = (Kchoke * FlowEl(OpenholeFirstEl - 1)%FlowRate * ABS(FlowEl(OpenholeFirstEl - 1)%FlowRate)) * 1.d0 + !WRITE (*,*) '**deltaPchoke , Kchoke, choke flowrate' , deltaPchoke , Kchoke, FlowEl(i)%FlowRate + !WRITE (*,*) '**TotalOpenChokeArea , Total Open Choke Area Percent' , TotalOpenChokeArea , TotalOpenChokeArea / 4.0 * ChokeAreaFullyOpen + IF (deltaPchoke < 0.d0) deltaPchoke = 0.d0 + BackPressure = REAL(deltaPchoke) + !WRITE (*,*) ' Choke inlet FlowRate, Density, pressure' , FlowEl(j)%FlowRate, FlowEl(j)%Density, FlowEl(j)%StartPress + !WRITE (*,*) ' Choke outlet Density' , FlowEl(i)%Density + !WRITE (*,*) ' deltaPchoke , choke flowrate' , deltaPchoke , FlowEl(i)%FlowRate + !WRITE (*,*) 'Total Open Choke Area Percent' , TotalOpenChokeArea / 4.0 * ChokeAreaFullyOpen + ELSE + BackPressure = 0.0 + END IF + IF (IEEE_IS_NaN(BackPressure)) CALL ErrorStop('NaN in calculating back pressure' , FlowEl(j)%FlowRate) + !write(*,*) 'BackPressure=' , BackPressure + + !!!!!!!!!!!!!!!!!!!!!!!!! when flow passes through choke manifold, solution process may be unstable + IF (ChokeKroneckerDelta == 1) THEN ! thus we should stabilize solution + IF (TotalOpenChokeArea > 0.5 * ChokeAreaFullyOpen) THEN + KickCorrectionUnderRelaxation = 0.6 + ELSE IF (TotalOpenChokeArea > 0.1 * ChokeAreaFullyOpen) THEN + KickCorrectionUnderRelaxation = 0.5 + ELSE ! TotalOpenChokeArea < 0.1 * ChokeAreaFullyOpen + KickCorrectionUnderRelaxation = 0.4 + END IF + ELSE + KickCorrectionUnderRelaxation = 0.6 + END IF + !!!!!!!!!!!!!!!!!!!!!!!!! + + !!!!!!!!!!!!!!!!!!!!!!!!! calculating frictional pressure drop in annulus, chooke line and open hole elements + DO ifric = AnnulusFirstEl , NumbEl + CALL FricPressDrop(ifric) + !WRITE (*,*) ' element No, FlowRate , Density, FricPressLoss', ifric, FlowEl(ifric)%FlowRate, FlowEl(ifric)%Density, FlowEl(ifric)%FricPressLoss + IF (IEEE_IS_NaN(FlowEl(ifric)%FricPressLoss)) THEN + WRITE (*,*) 'H, S, A, Ch, O', NoHorizontalEl , NoStringEl , NoAnnulusEl , NoWellToChokeEl , NoOpenHoleEl + WRITE (*,*) 'Ann/Op start, end, density, Q, mu, Type' , FlowEl(ifric)%StartX, FlowEl(ifric)%EndX, FlowEl(ifric)%Density, FlowEl(ifric)%FlowRate, FlowEl(ifric)%mueff, FlowEl(ifric)%MaterialType + CALL ErrorStop('NaN in calculating pressure drop' , ifric) + END IF + + END DO + !IF (ChokeKroneckerDelta == 1) THEN + !WRITE (*,*) ' velocity and flowrate', FlowEl(i)%vel, FlowEl(i)%flowrate + !WRITE (*,*) ' Theta600, Theta300', FlowEl(i)%Theta600 , FlowEl(i)%Theta300 + !WRITE (*,*) ' kIndex , nIndex', FlowEl(i)%kIndex, FlowEl(i)%nIndex + !WRITE (*,*) ' last el. mueff, gen. Rey.', i, FlowEl(i)%mueff, FlowEl(i)%GenRe + !END IF + + !!!!!!!!!!!!!!!!!!!!!!!!! Pressure distribution in annulus + j = OpenholeFirstEl - 1 + FlowEl(OpenholeFirstEl - 1)%EndPress = BackPressure + FlowEl(OpenholeFirstEl - 1)%StartPress = FlowEl(OpenholeFirstEl - 1)%EndPress + FlowEl(OpenholeFirstEl - 1)%FricPressLoss + FlowEl(OpenholeFirstEl - 1)%StaticPressDiff + + !write(*,*) 'FlowEl(j)%StartPress=' ,j, FlowEl(j)%StartPress + !write(*,*) 'FlowEl(j)%Length=' ,j, FlowEl(j)%Length, FlowEl(j)%EndX + !write(*,*) 'FlowEl(i)%dPdLFric=' ,i, FlowEl(i)%dPdLFric + + DO l = OpenholeFirstEl - 2 , AnnulusFirstEl , -1 + !WRITE (*,*) '123' + FlowEl(l)%EndPress = FlowEl(l + 1)%StartPress + FlowEl(l)%StartPress = FlowEl(l)%EndPress + FlowEl(l)%FricPressLoss + FlowEl(l)%StaticPressDiff + !WRITE(*,*) "ANNULUS: bottom , top Pressure", l , FlowEl(l)%StartPress , FlowEl(l)%EndPress , FlowEl(l)%fricPressLoss + !WRITE(*,*) "ANNULUS: Start , End X", FlowEl(l)%StartX , FlowEl(l)%EndX + + + !write(*,*) 'FlowEl(i)%StartPress=' ,i, FlowEl(i)%StartPress + !WRITE (*,*) ' FlowEl(i)%GenRe, FlowEl(i)%ReCritLam ' , FlowEl(i)%GenRe , FlowEl(i)%ReCritLam + END DO + + + !!!!!!!!!!!!!!!!! Pressure distribution in Open Hole + FlowEl(NumbEl)%EndPress = FlowEl(AnnulusFirstEl)%StartPress + FlowEl(NumbEl)%StartPress = FlowEl(NumbEl)%EndPress + FlowEl(NumbEl)%FricPressLoss + FlowEl(NumbEl)%StaticPressDiff + !WRITE (*,*) 'op top and op down' , FlowEl(NumbEl)%EndPress, FlowEl(j + 1)%StartPress + !write(*,*) 'FlowEl(NumbEl)%dPdLFric=' , FlowEl(NumbEl)%dPdLFric + !write(*,*) 'FlowEl(NumbEl)%dPdLGrav=' , FlowEl(NumbEl)%dPdLGrav + + DO l = NumbEl - 1 , OpenholeFirstEl , -1 + !WRITE(*,*) ' ope' + FlowEl(l)%EndPress = FlowEl(l + 1)%StartPress + !IF (FlowEl(i)%FlowRate < 0.0d0) THEN + ! FlowEl(i)%StartPress = FlowEl(i)%EndPress - FlowEl(i)%FricPressLoss + FlowEl(i)%StaticPressDiff + !ELSE + FlowEl(l)%StartPress = FlowEl(l)%EndPress + FlowEl(l)%FricPressLoss + FlowEl(l)%StaticPressDiff + !WRITE (*,*) ' Length, static, frictional open' , FlowEl(i)%Length, FlowEl(i)%StaticPressDiff, FlowEl(i)%FricPressLoss + + !END IF + END DO + +ELSE ! wellhead is closed and kick is in the well + !WRITE (*,*) ' well head is closed' + k = GasPocketFlowEl(NoGasPocket , 1) + !WRITE (*,*) 'k, Pocket Press', k, GasPocketOldPress%Array(NoGasPocket) - StandardPress + i = AnnulusFirstEl + j = OpenholeFirstEl - 1 + FlowEl(k)%StartPress = GasPocketOldPress%Array(NoGasPocket) - StandardPress + FlowEl(k)%EndPress = GasPocketOldPress%Array(NoGasPocket) - StandardPress + IF (k > OpenholeFirstEl - 1) THEN ! Top pocket StartX is in Open hole + !WRITE (*,*) 'here 1' + DO l = k - 1 , OpenholeFirstEl , -1 ! below elements in openhole + !WRITE (*,*) 'here 1-1' + FlowEl(l)%EndPress = FlowEl(l + 1)%StartPress + FlowEl(l)%StartPress = FlowEl(l)%EndPress + FlowEl(l)%StaticPressDiff + END DO + + DO l = k + 1 , NumbEl ! Above elements in openhole + !WRITE (*,*) 'here 1-2' + FlowEl(l)%StartPress = FlowEl(l - 1)%EndPress + FlowEl(l)%EndPress = FlowEl(l)%StartPress - FlowEl(l)%StaticPressDiff + END DO + + FlowEl(AnnulusFirstEl)%StartPress = FlowEl(NumbEl)%EndPress + FlowEl(AnnulusFirstEl)%EndPress = FlowEl(AnnulusFirstEl)%StartPress - FlowEl(AnnulusFirstEl)%StaticPressDiff + + DO l = AnnulusFirstEl + 1 , OpenholeFirstEl - 1 + FlowEl(l)%StartPress = FlowEl(l - 1)%EndPress + FlowEl(l)%EndPress = FlowEl(l)%StartPress - FlowEl(l)%StaticPressDiff + END DO + + ELSE ! Top pocket StartX is in annulus or choke line + + DO l = k - 1 , AnnulusFirstEl , -1 ! below elements in annnulus + FlowEl(l)%EndPress = FlowEl(l + 1)%StartPress + FlowEl(l)%StartPress = FlowEl(l)%EndPress + FlowEl(l)%StaticPressDiff + END DO + + DO l = k + 1 , OpenholeFirstEl - 1 ! Above elements in annulus + FlowEl(l)%StartPress = FlowEl(l - 1)%EndPress + FlowEl(l)%EndPress = FlowEl(l)%StartPress - FlowEl(l)%StaticPressDiff + END DO + + FlowEl(NumbEl)%EndPress = FlowEl(AnnulusFirstEl)%StartPress + FlowEl(NumbEl)%StartPress = FlowEl(NumbEl)%EndPress + FlowEl(NumbEl)%StaticPressDiff + + DO l = NumbEl - 1 , OpenholeFirstEl , -1 + FlowEl(l)%EndPress = FlowEl(l + 1)%StartPress + FlowEl(l)%StartPress = FlowEl(l)%EndPress + FlowEl(l)%StaticPressDiff + END DO + + END IF + + ! + ! !WRITE (*,*) ' first annulus bottom pressure ' , FlowEl(NoHorizontalEl + NoStringEl + 1)%StartPress + ! !WRITE (*,*) ' last OpenHole bottom pressure' , FlowEl(NumbEl)%StartPress + ! !WRITE (*,*) ' Gas Pocket pressure' , GasPocket%NewPress +END IF + + !!!!!!!!!!!!!!!!!!!!!! checking pressure for preventing NaN in pressures + DO l = OpenholeFirstEl - 1 , AnnulusFirstEl , -1 ! annulus or choke elements + !WRITE (*,*) 'start, end' , FlowEl(i)%StartX, FlowEl(i)%EndX + IF (IEEE_IS_NaN(FlowEl(l)%EndPress)) THEN + WRITE (*,*) 'H, S, A, Ch, O', NoHorizontalEl , NoStringEl , NoAnnulusEl , NoWellToChokeEl , NoOpenHoleEl + WRITE (*,*) 'Ann/Ch start, end, density, Q, mu' , FlowEl(l)%StartX, FlowEl(l)%EndX, FlowEl(l)%Density, FlowEl(l)%FlowRate, FlowEl(l)%mueff, FlowEl(l)%MaterialType + CALL ERRORSTOP('NaN in EndPress', l) + END IF + END DO + + DO l = NumbEl , OpenholeFirstEl - 1 , -1 ! op elements + !WRITE (*,*) 'start, end' , FlowEl(i)%StartX, FlowEl(i)%EndX + IF (IEEE_IS_NaN(FlowEl(l)%EndPress)) THEN + WRITE (*,*) 'H, S, A, Ch, O', NoHorizontalEl , NoStringEl , NoAnnulusEl , NoWellToChokeEl , NoOpenHoleEl + WRITE (*,*) 'Op start, end, density, Q, mu' , FlowEl(l)%StartX, FlowEl(l)%EndX, FlowEl(l)%Density, FlowEl(l)%FlowRate, FlowEl(l)%mueff, FlowEl(l)%MaterialType + CALL ERRORSTOP('NaN in EndPress', l) + END IF + END DO + !!!!!!!!!!!!!!!!!!!!!! + + !!!!!!!!!!!!!!!!!!!!!! + BottomHolePress = FlowEl(OpenholeFirstEl)%StartPress + !DO i = 1 , NoGasPocket + ! WRITE (*,*) ' Pocket, Pressure, Vol, Flow Induced, FlowElPress', i, REAL(GasPocketNewPress%Array(i)), REAL(GasPocketNewVol%Array(i)), GasPocketFlowInduced%Array(i), FlowEl(GasPocketFlowEl(i , 1))%StartPress + !END DO + !WRITE (*,*) ' BottomHolePress =' , BottomHolePress + !!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !IF (ChokeKroneckerDelta == 1) THEN + ! WRITE (*,*) ' ChokeLine flowrate' , FlowEl(NoHorizontalEl + NoStringEl + NoAnnulusEl + NoWellToChokeEl)%FlowRate , stringflowrate + ! !i = NoHorizontalEl + NoStringEl + NoAnnulusEl + ! !j = NoHorizontalEl + NoStringEl + NoAnnulusEl + NoWellToChokeEl + ! !WRITE (*,*) ' Well Outlet and Chokeline Outlet Pressure' , FlowEl(i)%EndPress, FlowEl(j)%EndPress + !END IF + + !IF (GasPocket%ElementNo == 0) THEN + ! KickUnknownVector(2) = BottomHolePress + !!ELSE + !! KickUnknownVector(2) = FlowEl(GasPocket%ElementNo)%StartPress + !END IF + !IF (WellHeadOpen) + ! GasPocket%NewPress = KickUnknownVector(2) + !END IF + !WRITE (*,*) 'Ann End' +END SUBROUTINE \ No newline at end of file diff --git a/FluidFlow/Flow_Startup.f90 b/FluidFlow/Flow_Startup.f90 new file mode 100644 index 0000000..a514684 --- /dev/null +++ b/FluidFlow/Flow_Startup.f90 @@ -0,0 +1,118 @@ +SUBROUTINE FlowStartup + + USE Fluid_Flow_Startup_Vars + USE CStringConfigurationVariables + USE CMudPropertiesVariables + USE FricPressDropVars + USE KickVariables + USE MudSystemVARIABLES + USE PressureDisplayVARIABLES + USE CShoeVariables + USE TD_DrillStemComponents + USE TD_WellGeometry, pi3 => pi + USE CPathGenerationVariables + USE CWellSurveyDataVariables + Use CHOKEVARIABLES, pi4 => pi + + + IMPLICIT NONE + + INTEGER :: i + + PressureGauges(:) = 0.0 + + KickSinglePocket = MakeKickSinglePacket + IF (KickSinglePocket) THEN + MaxGasPocket = 1 + ELSE + MaxGasPocket = 4 + END IF + MaxChokeDensityChange = 25.0 ! [ppg/min] + ChokeMinDensity = 2.0 + + ChokeDensity = ActiveDensity + + MinKickVol = 0.5 ! USGal + + SecondaryKickVol = 0.0 + SecondaryKickWeight = 0.0 + + NoGasPocket = 0 ! No Kick + WellHeadOpen = .TRUE. + WellHeadWasOpen = .TRUE. + BackPressure = 0.0 + GasKickPumpFlowRate = 0.0 + KickVolume = 0.0 + InfluxRate = 0.0 + ExitMass = 0.0 + MinAllowableKickVol = 1.0 * (42.0 / Convft3toUSgal) ! 1 bbl * 42 gal/bbl / 7.48 gal/ft^3 = ... ft^3 + StCompressedMudVol = 0.0 + AnnCompressedMudVol = 0.0 + KickFlux = .FALSE. + KickOffBottom = .FALSE. + KickWasExitingThroughChoke = .FALSE. + FloatValveOpen = .TRUE. + + ChokeAreaFullyOpen = 123.0 / 64.0 ! fully open area is 123/64 in^2 = 0.01334635 ft^2 + ChokeBypassArea = PI / 4.0 * ChokeLineID**2 + BHPSafetyMargin = 150.0 + AChBHPTol = 15.0 + + + ManChoke1Plug = 0 + ManChoke2Plug = 0 + ManChoke1Washout = 0 + ManChoke2Washout = 0 + BitJetsPlugged = 0 + BitJetsWashedOut = 0 + CasingPressure_DataDisplayMalF = 0 + + SoundSpeed = 1530.0 / Convfttom + PressureTimeStepDelay(1) = INT(2.0 * SUM(StringConfigurations(2:)%ComponentLength) / SoundSpeed / dt) + PressureTimeStepDelay(2) = INT(PathGenerations(SIZE(PathGenerations))%MeasuredDepth / SoundSpeed / dt) + PressureTimeStepDelay(3) = INT(ShoeDepth / SoundSpeed / dt) + + !WRITE (*,*) SUM(StringConfigurations(2:)%ComponentLength), PathGenerations(SIZE(PathGenerations))%TotalVerticalDepth!, WellSurveyData(SIZE(WellSurveyData))%TotalVerticalDepth + !WRITE (*,*) PathGenerations(SIZE(PathGenerations))%MeasuredDepth!, WellSurveyData(SIZE(WellSurveyData))%MeasuredDepth + WRITE (*,*) 'time step delay', PressureTimeStepDelay + + DO i = 1 , PressureTimeStepDelay(1) + CALL PumpPressureDelay%AddToFirst(0.0) + END DO + + DO i = 1 , PressureTimeStepDelay(2) + CALL BottomHolePressureDelay%AddToFirst(REAL(0.052 * ActiveDensity * PathGenerations(SIZE(PathGenerations))%TotalVerticalDepth)) + END DO + + DO i = 1 , PressureTimeStepDelay(3) + CALL ShoePressureDelay%AddToFirst(REAL(0.052 * ActiveDensity * ShoeDepth)) + END DO + + + !!!!!!! Methane Information + GasType(1)%CritPress = 673.0 + GasType(1)%CritTemp = 344.0 + GasType(1)%MolarWt = 16.04 + GasType(1)%StDensity = 0.04238 + GasType(1)%GasConstant = RUniversal / GasType(1)%MolarWt + + !!!!!!!! H2S Information + GasType(2)%CritPress = 1306.0 + GasType(2)%CritTemp = 673.0 + GasType(2)%MolarWt = 34.08 + GasType(2)%StDensity = 0.09087 + GasType(2)%GasConstant = RUniversal / GasType(2)%MolarWt + + !!!!!!!! CO2 Information + GasType(3)%CritPress = 1072.0 + GasType(3)%CritTemp = 548.0 + GasType(3)%MolarWt = 44.01 + !GasType(3)%StDensity = 00 + GasType(3)%GasConstant = RUniversal / GasType(2)%MolarWt + + !!!!!!!! Mud density and viscosity + Theta600Refrence = ActiveThetaSixHundred + Theta300Refrence = ActiveThetaThreeHundred + DensityRefrence = ActiveDensity + + END SUBROUTINE \ No newline at end of file diff --git a/FluidFlow/Flow_Startup_VARIABLES.f90 b/FluidFlow/Flow_Startup_VARIABLES.f90 new file mode 100644 index 0000000..79b8b63 --- /dev/null +++ b/FluidFlow/Flow_Startup_VARIABLES.f90 @@ -0,0 +1,62 @@ +MODULE Fluid_Flow_Startup_Vars + + !!! In this module constants and conversion factors are stated + + + REAL , PARAMETER :: RUniversal = 10.73159 ! [psia.ft^3/(lbmole.R)] + REAL , PARAMETER :: RUniversalSI = 8.314 * 10**6 ! [Pa.cm^3/(mole.K)] + REAL , PARAMETER :: PI = 3.141593 ! Pi number + REAL , PARAMETER :: StandardPress = 14.7 ! [psia] + REAL , PARAMETER :: StandardTemp = 519.67 ! 60 F [R] , Temp F = Temp R + 459.67 + REAL , PARAMETER :: dt = 0.1 ! time step = 0.1 [s] + REAL , PARAMETER :: GasDensityRefrence = 28.96 ! molar weight of air [lbm/lbmole] + + !! Tolerance and convergence or error criteria + REAL , PARAMETER :: UTubePressTolerance = 4 ! minimum pressure tolerance between two arms of U tube for which calculations will stop [psi] + !REAL , PARAMETER :: PressDensityTolerance = 2 ! Pressure Density Tolerance: for flow elements with density below this amount (usually gas pockets), + ! frictional and gravitional pressure gradients are neglected [ppg] + REAL , PARAMETER :: PressLengthTolerance = 0.0 ! Pressure Length Tolerance: for flow elements with length below this amount, + ! frictional and gravitional pressure gradients are neglected [ft] + REAL , PARAMETER :: PressFlowrateTolerance = 0.2 ! Pressure Flowrate Tolerance: for flow elements with flowrates below this amount, + ! frictional pressure gradients are neglected [gpm] + REAL , PARAMETER :: KickConvergenceTolerance = 0.05 ! absolute value of maximum error in calculation of gas kick pressure and flowrate + + !!!!!!!!!!!!!!!!!! Conversion factors + REAL , PARAMETER :: Convlbftolbm = 32.174 ! 1 lbf = 32.174 lbm*ft/s^2 + REAL , PARAMETER :: Convft3toUSgal = 7.48052 ! 1 ft^3 = 7.48052 US gal + REAL , PARAMETER :: Convfttom = 0.3048 ! 1 ft = 0.3048 m + REAL , PARAMETER :: Convfttoinch = 12.0 ! 1 ft = 12 inch + REAL , PARAMETER :: Convdaytohour = 24.0 ! 1 day = 24 hour + REAL , PARAMETER :: Convhourtomin = 60.0 ! 1 hour = 60 min + REAL , PARAMETER :: Convmintosec = 60.0 ! 1 min = 60 sec + REAL , PARAMETER :: ConvpsitoPa = 6894.76 ! 1 psi = 6894.76 pa + REAL , PARAMETER :: ConvRtoK = 0.555556 ! 1 R = 0.555556 K + REAL , PARAMETER :: Convpcftogpcm3 = 0.0160185 ! 1 lbm/ft^3 = 0.0160185 gr/cm^3 + !!!!!!!!!!!!!!!!! + + !!!!!!! Bit data !!!!!! + LOGICAL :: BitTrue ! bit may be present (.TRUE.) or may be absent(.FALSE.) + REAL :: BitNozzleArea ! area of a nozzle + INTEGER :: BitNozzleNum ! Number of bit nozzles + REAL :: BitNozzDia ! nozzle diameter in 1/32 in + REAL :: BitTotNozzArea ! Total bit area + REAL :: BitCd ! Discharge coefficient + REAL :: BitPressLoss ! bit pressure loss [psi] + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + REAL :: Theta600Refrence , Theta300Refrence ! Fann data (Theta600 and Theta300) of active tank (input from panel) + REAL :: DensityRefrence ! Density of active tank mud (input from panel) [gpm] + + + TYPE, PUBLIC :: GasData + REAL :: CritPress ! critical pressure [psia] + REAL :: CritTemp ! critical temperature [R] + REAL :: MolarWt ! molar weight [lbm/lbmole] + REAL :: StDensity ! density at standard pressure (14.7 psi) and temperature (60 F = 520 Ra) [lbm/ft^3] + REAL :: GasConstant ! Gas constant = RUniversal/MolarWt [psia.ft^3/(R.lbm)] + END TYPE GasData + TYPE(GasData) :: GasType(3) ! 1 = methane , 2 = Hydrogen sulfide , 3 = Carbon dioxid + + + END MODULE + \ No newline at end of file diff --git a/FluidFlow/FluidFlowMain.f90 b/FluidFlow/FluidFlowMain.f90 new file mode 100644 index 0000000..e400667 --- /dev/null +++ b/FluidFlow/FluidFlowMain.f90 @@ -0,0 +1,147 @@ +module FluidFlowMain + implicit none + public + contains +! + subroutine FluidFlow_Setup() + use CSimulationVariables + implicit none + !call OnSimulationInitialization%Add(FluidFlow_Init) + call OnSimulationStop%Add(FluidFlow_Stop) + call OnFluidFlowStart%Add(FluidFlow_Start) + call OnFluidFlowStep%Add(FluidFlow_Step) + !call OnFluidFlowOutput%Add(FluidFlow_Output) + call OnFluidFlowMain%Add(FluidFlowMainBody) + end subroutine + + subroutine FluidFlow_Stop + implicit none + !WRITE (*,*) ' fluid flow done_Stop' + call DEALLOCATE_ARRAYS_NormalCirculation() + CALL DeallocateFlowTypes + end subroutine FluidFlow_Stop + + subroutine FluidFlow_Start + USE Fluid_Flow_Startup_Vars + implicit none + !WRITE (*,*) ' fluid flow done_Start' + CALL NormalCirculation_StartUp() + CALL FlowStartup + + Call TD_StartUp + Call TD_WellReadData + Call TD_WellElementsReadData + Call TD_DrillStemReadData + Call TD_PipePropertiesReadData + end subroutine FluidFlow_Start + + subroutine FluidFlow_Step + implicit none + integer :: i, FlowDuration, SimulationStateOld + integer,dimension(8) :: FlowStartTime,FlowEndTime + + !WRITE (*,*) ' fluid flow done_Step' + !call Fluid_Flow_Solver + + + + + + + CALL DATE_AND_TIME(values=FlowStartTime) + call Fluid_Flow_Solver + + CALL DATE_AND_TIME(values=FlowEndTime) + + FlowDuration = 3600000 * (FlowEndTime(5) - FlowStartTime(5)) + 60000 * (FlowEndTime(6) - FlowStartTime(6)) + 1000 * (FlowEndTime(7) - FlowStartTime(7)) + (FlowEndTime(8) - FlowStartTime(8)) + + WRITE (*,*) 'FlowDuration (ms)=' , FlowDuration + + end subroutine FluidFlow_Step + + !subroutine FluidFlow_Output + ! implicit none + !end subroutine FluidFlow_Output + + subroutine FluidFlowMainBody +! + use ifport + use ifmt + use CSimulationVariables + USE Fluid_Flow_Startup_Vars + !use general_info, only : reset_data + !use well_info + !use drilling_info + use CLog1 +! + implicit none + + !integer :: i, FlowDuration, SimulationStateOld + !integer,dimension(8) :: FlowStartTime,FlowEndTime + ! + ! + !CALL NormalCirculation_StartUp() + !CALL FlowStartup + ! + !Call TD_StartUp + !Call TD_WellReadData + !Call TD_WellElementsReadData + !Call TD_DrillStemReadData + !Call TD_PipePropertiesReadData + ! + ! + !LoopSimulation: do + ! !WRITE (*,*) ' fluid flow done 0' + !! + ! CALL DATE_AND_TIME(values=FlowStartTime) + ! !WRITE (*,*) 'FlowStartTime=', FlowStartTime + !! + ! call Fluid_Flow_Solver + ! + !! + ! CALL DATE_AND_TIME(values=FlowEndTime) + !! + ! !WRITE (*,*) ' fluid flow done 1' + ! + ! + ! + ! FlowDuration = 3600000 * (FlowEndTime(5) - FlowStartTime(5)) + 60000 * (FlowEndTime(6) - FlowStartTime(6)) + 1000 * (FlowEndTime(7) - FlowStartTime(7)) + (FlowEndTime(8) - FlowStartTime(8)) + ! + ! + ! !call Log_1('FlowDuration=', FlowDuration) + ! !WRITE (*,*) 'FlowDuration (ms)=' , FlowDuration + ! + ! if ((100 - FlowDuration) > 0) then + ! !WRITE (*,*) 'fluid flow done 2' + ! call sleepqq(100 - FlowDuration) + ! !WRITE (*,*) ' fluid flow done 3' + ! + ! end if + ! !WRITE (*,*) ' fluid flow done 4' + ! + ! + ! + ! !WRITE (*,*) "FlowDuration", FlowDuration + ! !if(IsStopped) then + ! ! EXIT LoopSimulation + ! !ENDIF + ! !write(*,*) 'IsStopped=' , IsStopped + ! + ! if(IsStopped) then + ! !write(*,*) '44444444444' + ! + ! call DEALLOCATE_ARRAYS_NormalCirculation() + ! CALL DeallocateFlowTypes + ! call Quit() + ! end if + ! ! + ! ! if(IsStopped) exit LoopSimulation + ! ! + !end do LoopSimulation + !!call DEALLOCATE_ARRAYS_NormalCirculation() + !!CALL DeallocateFlowTypes + ! +! + end subroutine FluidFlowMainBody + +end module FluidFlowMain \ No newline at end of file diff --git a/FluidFlow/Fluid_Flow_Solver.f90 b/FluidFlow/Fluid_Flow_Solver.f90 new file mode 100644 index 0000000..55b0c3e --- /dev/null +++ b/FluidFlow/Fluid_Flow_Solver.f90 @@ -0,0 +1,58 @@ +subroutine Fluid_Flow_Solver + + Use GeoElements_FluidModule + Use UTUBEVARS + USE KickVariables + USE PressureDisplayVARIABLES + USE FricPressDropVars + USE MudSystemVARIABLES + USE Fluid_Flow_Startup_Vars + USE CError + + implicit none + INTEGER :: FlowDuration + Integer :: qwer + integer,dimension(8) :: FlowStartTime,FlowEndTime + + !WRITE (*,*) ' fluid flow pointer 1' + CALL TD_MainCalculations + + Call MeshGeneration_FluidModule + + !WRITE (*,*) ' fluid flow pointer 2' + + FluidFlowCounter = FluidFlowCounter + 1 + + call CirculationCodeSelect + + + CALL WellPressureDataTransfer + + CALL FormationInformationCalculator + + DO KickIteration = 1 , 40 + + !WRITE (*,*) ' Kick Iteration', KickIteration + + CALL PressureAnnAndOHDistribution + + IF (NoGasPocket > 0) THEN + !KickCorrectionVector(:) = 1. + CALL GasKickCalculator + END IF + + IF (NoGasPocket == 0 .OR. NOT(WellHeadOpen)) EXIT + IF(MAXVAL(ABS(KickVandPFunction(:))) < KickConvergenceTolerance) EXIT + !IF(MAXVAL(ABS(KickCorrectionVector(:))) < KickConvergenceTolerance) EXIT + + + END DO + + CALL PressureHorizAndStringDistribution + + IF (KickIteration == 41) THEN + WRITE (*,*) ' KickCorrectionVector ' , KickCorrectionVector + WRITE (*,*) ' Kick Jacobian = ', KickJacobian + END IF + +end subroutine \ No newline at end of file diff --git a/FluidFlow/Frictional_Press_Drop_Calc.f90 b/FluidFlow/Frictional_Press_Drop_Calc.f90 new file mode 100644 index 0000000..228b18a --- /dev/null +++ b/FluidFlow/Frictional_Press_Drop_Calc.f90 @@ -0,0 +1,230 @@ +SUBROUTINE FricPressDrop(iloc) + + + + !! Record of revisions + !! Date Programmer Discription of change + !! ------ ------------ ----------------------- + !! 1396/07/23 Sheikh Original code + !! + + + + USE FricPressDropVars + USE CMudPropertiesVariables + USE Fluid_Flow_Startup_Vars + USE CError + + IMPLICIT NONE + + INTEGER :: iloc + REAL :: TauZero + TauZero = 12.0 + !ActiveRheologyModel = Herschel_Bulkley_RheologyModel + + ! 0 = Power Law , 1 = Bingham Plastic , 2 = Newtonian + !TotFricPressLoss = 0.0 + + FlowEl(iloc)%alpha = 1 ! assume that all elements have annulus geometry + FlowEl(iloc)%dPdLfric = 0.0 + FlowEl(iloc)%f = 0.0 + FlowEl(iloc)%FlowRate = ABS(FlowEl(iloc)%FlowRate) + + + + IF ((FlowEl(iloc)%FlowRate >= PressFlowrateTolerance) & + .AND. (FlowEl(iloc)%MaterialType /= 1) & ! not gas kick + .AND. (ABS(FlowEl(iloc)%Length) >= PressLengthTolerance) & + .AND. (FlowEl(iloc)%MaterialType /= 4)) THEN ! not air + + IF (FlowEl(iloc)%Id==0) THEN + FlowEl(iloc)%alpha = 0 + END IF + + FlowEl(iloc)%muPlastic = FlowEl(iloc)%Theta600 - FlowEl(iloc)%Theta300 ! cp + FlowEl(iloc)%YieldP = 2.0 * FlowEl(iloc)%Theta300 - FlowEl(iloc)%Theta600 ! lbf/100ft**2 + FlowEl(iloc)%nIndex = 3.32 * log10(FlowEl(iloc)%Theta600 / FlowEl(iloc)%Theta300) + FlowEl(iloc)%kIndex = 510.0 * FlowEl(iloc)%Theta300 / (511.0**FlowEl(iloc)%nIndex) ! rabete fv2 + IF (ActiveRheologyModel == Herschel_Bulkley_RheologyModel .AND. FlowEl(iloc)%alpha == 0) THEN + FlowEl(iloc)%kIndex = 1.066 * FlowEl(iloc)%Theta300 / (511.0**FlowEl(iloc)%nIndex) + ELSE IF (ActiveRheologyModel == Herschel_Bulkley_RheologyModel .AND. FlowEl(iloc)%alpha == 1) THEN + FlowEl(iloc)%nIndex = 3.32 * log10((FlowEl(iloc)%Theta600 - TauZero) / (FlowEl(iloc)%Theta300 - TauZero)) + FlowEl(iloc)%kIndex = 1.066 * (FlowEl(iloc)%Theta300 - TauZero) / (511.0**FlowEl(iloc)%nIndex) + END IF + + + + + ! Calculating velocity + FlowEl(iloc)%vel = 0.408 * FlowEl(iloc)%FlowRate / (FlowEl(iloc)%Od**2 - FlowEl(iloc)%Id**2) ! velocity in ft/s + !FlowEl(iloc)%vel = 24.51 * FlowEl(iloc)%FlowRate / (FlowEl(iloc)%Od**2 - FlowEl(iloc)%Id**2) ! velocity in ft/min + + !IF (FlowModel == Bingham_RheologyModel) THEN ! Bingham Plastic + ! FlowEl(iloc)%Gf = (2. + FlowEl(iloc)%alpha) / 2. + !ELSE IF (FlowModel == PowerLow_RheologyModel) THEN + ! FlowEl(iloc)%Gf = ((3. - FlowEl(iloc)%alpha) * FlowEl(iloc)%nIndex + 1.) / FlowEl(iloc)%nIndex / (4. - FlowEl(iloc)%alpha) * (2. + FlowEl(iloc)%alpha) / 2. + !END IF + + !FlowEl(iloc)%gammaW = 1.6 * FlowEl(iloc)%Gf * FlowEl(iloc)%vel / FlowEl(iloc)%Dhyd + + !IF (FlowModel == Bingham_RheologyModel) THEN ! Bingham Plastic + ! FlowEl(iloc)%tauW = 1.067 * ((4. - FlowEl(iloc)%alpha) / (3. - FlowEl(iloc)%alpha) * FlowEl(iloc)%YieldP + FlowEl(iloc)%muPlastic * FlowEl(iloc)%gammaW) + ! !FlowEl(iloc)%tauW = 1.067*(FlowEl(iloc)%YieldP+FlowEl(iloc)%muPlastic*FlowEl(iloc)%gammaW) + !ELSE IF (FlowModel == PowerLow_RheologyModel) THEN ! Power law + ! FlowEl(iloc)%tauW = 1.067 * FlowEl(iloc)%kIndex * FlowEl(iloc)%gammaW**FlowEl(iloc)%nIndex + !END IF + + ! Calculating effective or apparent viscosity + IF (ActiveRheologyModel == Bingham_RheologyModel) THEN ! Bingham Plastic + FlowEl(iloc)%mueff = FlowEl(iloc)%muPlastic + 5. * FlowEl(iloc)%YieldP * FlowEl(iloc)%Dhyd / FlowEl(iloc)%vel + !write(*,*) 'pointer1' , FlowEl(iloc)%muPlastic , FlowEl(iloc)%YieldP , FlowEl(iloc)%Dhyd , FlowEl(iloc)%vel + ELSE IF (ActiveRheologyModel == PowerLaw_RheologyModel .OR. ActiveRheologyModel == Herschel_Bulkley_RheologyModel) THEN ! Power Law + FlowEl(iloc)%Gf = ((3. - FlowEl(iloc)%alpha) * FlowEl(iloc)%nIndex + 1.0) / FlowEl(iloc)%nIndex / (4.0 - FlowEl(iloc)%alpha) * (2.0 + FlowEl(iloc)%alpha) / 2.0 + FlowEl(iloc)%mueff = (FlowEl(iloc)%kIndex) / (1. + FlowEl(iloc)%alpha / 2.) * ((96. * FlowEl(iloc)%vel / FlowEl(iloc)%Dhyd)**(FlowEl(iloc)%nIndex - 1)) * FlowEl(iloc)%Gf**FlowEl(iloc)%nIndex + !write(*,*) 'pointer2' , FlowEl(iloc)%kIndex ,FlowEl(iloc)%alpha , FlowEl(iloc)%vel ,FlowEl(iloc)%Dhyd,FlowEl(iloc)%nIndex ,FlowEl(iloc)%Gf ,FlowEl(iloc)%nIndex + END IF + + FlowEl(iloc)%gammaW = 96.0 * FlowEl(iloc)%Gf * FlowEl(iloc)%vel / FlowEl(iloc)%Dhyd + + FlowEl(iloc)%tauW = ((4.0 - FlowEl(iloc)%alpha) / (3.0 - FlowEl(iloc)%alpha))**FlowEl(iloc)%nIndex * TauZero + FlowEl(iloc)%kIndex * FlowEl(iloc)%gammaW**FlowEl(iloc)%nIndex + + + ! Calculating Reynolds number + IF (FlowEl(iloc)%Od == FlowEl(iloc)%Dhyd) THEN + FlowEl(iloc)%GenRe = 928. * FlowEl(iloc)%density * FlowEl(iloc)%vel * FlowEl(iloc)%Dhyd / FlowEl(iloc)%mueff + ELSE + FlowEl(iloc)%GenRe = 757. * FlowEl(iloc)%density * FlowEl(iloc)%vel * FlowEl(iloc)%Dhyd / FlowEl(iloc)%mueff + END IF + + !FlowEl(iloc)%GenRe = 2997 * FlowEl(iloc)%density * FlowEl(iloc)%vel**2 / 19.36 / FlowEl(iloc)%tauW + + ! Calculating friction factor + IF (ActiveRheologyModel == Bingham_RheologyModel) THEN ! Bingham Plastic + IF (FlowEl(iloc)%GenRe <= 2000.0) THEN ! laminar regime + FlowEl(iloc)%f = 16.0 / FlowEl(iloc)%GenRe + ELSE IF (FlowEl(iloc)%GenRe >= 4000.0) THEN ! turbulent regime + FlowEl(iloc)%a = 0.0791 + FlowEl(iloc)%b = 0.25 + FlowEl(iloc)%f = FlowEl(iloc)%a / FlowEl(iloc)%GenRe**FlowEl(iloc)%b + ELSE !! transition from laminar to turbulent regime + FlowEl(iloc)%a = 0.0791 + FlowEl(iloc)%b = 0.25 + FlowEl(iloc)%f = (4000.0 - FlowEl(iloc)%GenRe) / 2000.0 * 16. / FlowEl(iloc)%GenRe & + + (FlowEl(iloc)%GenRe - 2000.0) / 2000.0 * FlowEl(iloc)%a / FlowEl(iloc)%GenRe**FlowEl(iloc)%b + END IF + + ELSE IF (ActiveRheologyModel == PowerLaw_RheologyModel) THEN ! Power law + FlowEl(iloc)%ReCritLam = 3470. - 1370. * FlowEl(iloc)%nIndex + FlowEl(iloc)%ReCritTurb = 4270. - 1370. * FlowEl(iloc)%nIndex + + IF (FlowEl(iloc)%GenRe <= FlowEl(iloc)%ReCritLam) THEN ! laminar regime + FlowEl(iloc)%f = 16.0 / FlowEl(iloc)%GenRe / (1 - 0.184 * FlowEl(iloc)%alpha) + ELSE IF (FlowEl(iloc)%GenRe >= FlowEl(iloc)%ReCritTurb) THEN ! turbulent regime + FlowEl(iloc)%a = (log10(FlowEl(iloc)%nIndex) + 3.93) / 50. + FlowEl(iloc)%b = (1.75 - log10(FlowEl(iloc)%nIndex)) / 7. + FlowEl(iloc)%f = FlowEl(iloc)%a / FlowEl(iloc)%GenRe**FlowEl(iloc)%b + ELSE + FlowEl(iloc)%a = (log10(FlowEl(iloc)%nIndex) + 3.93) / 50. + FlowEl(iloc)%b = (1.75 - log10(FlowEl(iloc)%nIndex)) / 7. + FlowEl(iloc)%f = (FlowEl(iloc)%ReCritTurb - FlowEl(iloc)%GenRe) / 800.0 * 16. / FlowEl(iloc)%GenRe & + + (FlowEl(iloc)%GenRe - FlowEl(iloc)%ReCritLam) / 800.0 * FlowEl(iloc)%a / FlowEl(iloc)%GenRe**FlowEl(iloc)%b + END IF + + END IF + + !WRITE (*,*) 'fric press drop', iloc + !WRITE (*,*) 'Length', ABS(REAL(FlowEl(iloc)%Length)) + !WRITE (*,*) 'FlowRate', FlowEl(iloc)%FlowRate + !WRITE (*,*) 'Theta600 , Theta300', FlowEl(iloc)%Theta600 , FlowEl(iloc)%Theta300 + !WRITE (*,*) 'Dhyd', FlowEl(iloc)%Dhyd + !WRITE (*,*) 'GenRe', FlowEl(iloc)%GenRe + !WRITE (*,*) 'f', FlowEl(iloc)%f + + + + + END IF + + ! Frictional pressure loss gradient calculation + ! FlowEl(iloc)%dPdLfric = 1.076 * FlowEl(iloc)%f * FlowEl(iloc)%vel**2 * FlowEl(iloc)%density / 10**5 / FlowEl(iloc)%Dhyd + FlowEl(iloc)%dPdLfric = FlowEl(iloc)%f * (FlowEl(iloc)%vel)**2 * FlowEl(iloc)%density / 25.81 / FlowEl(iloc)%Dhyd + FlowEl(iloc)%FricPressLoss = FlowEl(iloc)%dPdLfric * ABS(REAL(FlowEl(iloc)%Length)) + + IF (FlowEl(iloc)%FrictionDirection == -1) THEN + FlowEl(iloc)%FlowRate = - FlowEl(iloc)%FlowRate + FlowEl(iloc)%dPdLfric = - FlowEl(iloc)%dPdLfric + FlowEl(iloc)%FricPressLoss = - FlowEl(iloc)%FricPressLoss + END IF + + + + !END DO + + +END SUBROUTINE FricPressDrop + + +SUBROUTINE PartialDerivativeFricToFlowRate(iloc) + + USE FricPressDropVars + USE CMudPropertiesVariables + USE Fluid_Flow_Startup_Vars + USE KickVariables + USE CError + + + IMPLICIT NONE + + INTEGER :: iloc + + FlowEl(iloc)%FricToQPartialDiff = 0.0 + !FlowEl(iloc)%FlowRate = ABS(FlowEl(iloc)%FlowRate) + + + IF ((ABS(FlowEl(iloc)%FlowRate) >= PressFlowrateTolerance) & + .AND. (FlowEl(iloc)%MaterialType /= 1) & ! not gas kick + .AND. (ABS(FlowEl(iloc)%Length) >= PressLengthTolerance) & + .AND. (FlowEl(iloc)%MaterialType /= 4)) THEN ! not air + + IF (ActiveRheologyModel == PowerLaw_RheologyModel) THEN ! Power law + !IF (FlowEl(iloc)%Flowrate == 0.0) THEN + ! FlowEl(iloc)%Flowrate = 10.0 + ! CALL FricPressDrop(iloc) + !END IF + IF (FlowEl(iloc)%GenRe <= FlowEl(iloc)%ReCritLam) THEN ! laminar flow + FlowEl(iloc)%FricToQPartialDiff = FlowEl(iloc)%FricPressLoss / FlowEl(iloc)%FlowRate * FlowEl(iloc)%nIndex + + ELSE IF (FlowEl(iloc)%GenRe >= FlowEl(iloc)%ReCritTurb) THEN ! turbulent flow + FlowEl(iloc)%FricToQPartialDiff = FlowEl(iloc)%FricPressLoss / FlowEl(iloc)%FlowRate & + * (2. - FlowEl(iloc)%b * (2. - FlowEl(iloc)%nIndex)) + + ELSE ! transition from laminar to turbulent + FlowEl(iloc)%FricToQPartialDiff = FlowEl(iloc)%FricPressLoss / FlowEl(iloc)%FlowRate & + * (2. + (2. - FlowEl(iloc)%nIndex) & + * ((FlowEl(iloc)%a * FlowEl(iloc)%GenRe**(1. - FlowEl(iloc)%b) - 16.) / 800. / FlowEl(iloc)%f - 1.)) + END IF + + ELSE IF (ActiveRheologyModel == Bingham_RheologyModel) THEN ! Bingham Plastic + IF (FlowEl(iloc)%GenRe <= 2000.0 .OR. FlowEl(iloc)%f == 0.0) THEN ! laminar flow if f = 0.0, we have no flow in first time flowing + FlowEl(iloc)%FricToQPartialDiff = (16. * FlowEl(iloc)%muPlastic * REAL(FlowEl(iloc)%Length) * 2.224 * (10.)**(-3)) & + / (25.81 * 928. * (1 - 0.184 * FlowEl(iloc)%alpha) * FlowEl(iloc)%Dhyd**2 * FlowEl(iloc)%Area) + + ELSE IF (FlowEl(iloc)%GenRe >= 4000.0) THEN ! turbulent flow + FlowEl(iloc)%FricToQPartialDiff = FlowEl(iloc)%FricPressLoss / FlowEl(iloc)%FlowRate & + * (2. - FlowEl(iloc)%b * (2. - FlowEl(iloc)%muPlastic / FlowEl(iloc)%mueff)) + + ELSE ! transition from laminar to turbulent + FlowEl(iloc)%FricToQPartialDiff = FlowEl(iloc)%FricPressLoss / FlowEl(iloc)%FlowRate & + * (2. + (2. - FlowEl(iloc)%muPlastic / FlowEl(iloc)%mueff) & + * ((FlowEl(iloc)%a * FlowEl(iloc)%GenRe**(1. - FlowEl(iloc)%b) - 16.) / 2000. / FlowEl(iloc)%f - 1.)) + END IF + END IF + END IF + + + IF (FlowEl(iloc)%FricToQPartialDiff < 0.0) THEN + !WRITE (*,*) ' iloc, Re, FricPressLoss, FricToQPartialDiff' , iloc, FlowEl(iloc)%GenRe, FlowEl(iloc)%FricPressLoss, FlowEl(iloc)%FricToQPartialDiff + !CALL ERRORSTOP('Error in Calculating FricToQPartialDiff') + END IF + +END SUBROUTINE PartialDerivativeFricToFlowRate \ No newline at end of file diff --git a/FluidFlow/Horizontal_and_String_Pressure_Distribution.f90 b/FluidFlow/Horizontal_and_String_Pressure_Distribution.f90 new file mode 100644 index 0000000..5853c96 --- /dev/null +++ b/FluidFlow/Horizontal_and_String_Pressure_Distribution.f90 @@ -0,0 +1,799 @@ +SUBROUTINE PressureHorizAndStringDistribution + + + !! Record of revisions + !! Date Programmer Discription of change + !! ------ ------------ ----------------------- + !! 1396/07/30 Sheikh Original code + !! + + USE FricPressDropVars + USE PressureDisplayVARIABLES + USE MudSystemVARIABLES + USE GeoElements_FluidModule + USE Fluid_Flow_Startup_Vars + USE KickVariables + USE CMudPropertiesVariables + USE CDataDisplayConsoleVariables , StandPipePressureDataDisplay=> StandPipePressure + USE CDataDisplayConsoleVariables , CasingPressureDataDisplay=> CasingPressure + USE CDrillWatchVariables + USE CShoeVariables + USE CDownHoleVariables , CasingPressureDownhole => CasingPressure + USE TD_WellGeometry + USE CManifolds + USE VARIABLES + USE CError + USE UTUBEVARS + USE CKellyConnectionEnumVariables + USE Pump_VARIABLES + USE , INTRINSIC :: IEEE_ARITHMETIC + Use TD_DrillStemComponents + Use sROP_Variables + + + + IMPLICIT NONE + + INTEGER :: i , j , l + INTEGER :: ifric + INTEGER :: OldCasingPressure + REAL :: PressBelowFloatValve , PressAboveFloatValve ![psi] + REAL :: PumpMinDischargedVol = 0.0050 ! [gal] + REAL :: FloatValveBottomToUpAreaRatio = 1.1 ![-] + REAL :: ZeroHeight , StaticHeadOnBit + REAL(8) :: ShoeTVD + !REAL(8) , DIMENSION(5) :: MDObserve , TVDObserve , StPressObserve , AnnPressObserve , NomMD + + ExitMass = 0.0 + BitPressLoss = 0.0 + + WellHeadWasOpen = WellHeadOpen + WellToChokeManifoldWasOpen = WellToChokeManifoldOpen + KickWasExitingThroughChoke = .FALSE. + + + IF (UtubeMode1Activated .OR. FloatValveWasOpen == .FALSE.) THEN ! Horizontal line flow rate + FlowEl(1 : NoHorizontalEl)%FlowRate = 0.0 + ELSE ! connection and line is open + FlowEl(1 : NoHorizontalEl)%FlowRate = StringFlowRate ! pump flow rate [gpm] + END IF + + !WRITE (*,*) 'a)A/B P Bit', StaticHeadOnBit , FlowEl(AnnulusFirstEl)%StartPress , SUM(FlowEl(StringFirstEl : StringLastEl)%StaticPressDiff) + !IF (FloatValveIn == .FALSE.) FloatValveOpen = .TRUE. + FloatValveWasOpen = FloatValveOpen + + PressBelowFloatValve = FlowEl(AnnulusFirstEl)%StartPress + + StMudVol = SUM(FlowEl(1 : StringLastEl)%Volume) * Convft3toUSGal + StDeltaPtoDeltaVCompressibility = 1.0 / (MudCompressibility * StMudVol) + + AnnMudVol = SUM(FlowEl(AnnulusFirstEl : NumbEl)%Volume) * Convft3toUSGal + !StCompressedMudVol = StCompressedMudVol + REAL(St_Saved_MudDischarged_Volume_Final) + !WRITE (*,*) 'St_Saved_MudDischarged_Volume_Final', REAL(St_Saved_MudDischarged_Volume_Final) + !StDeltaPDueToCompressibility = StCompressedMudVol / (MudCompressibility * StMudVol) + !PressAboveFloatValve = StDeltaPDueToCompressibility + SUM(FlowEl(StringFirstEl : StringLastEl)%StaticPressDiff) !!FlowEl(StringLastEl)%EndPress + + !IF (NoGasPocket > 0) THEN ! mud exprience no comressibility + !IF (KickVolume > 2.0) THEN + IF ( (KickVolume > 2.0) .or. (NoGasPocket>1) .or. (any(FlowEl(OpenholeFirstEl:NumbEl)%Materialtype==1)) .or. (Rate_of_Penetration > 0.0) ) THEN + AnnCompressedMudVol = 0.0 + AnnDeltaPDueToCompressibility = 0.0 + + ELSE IF (WellHeadOpen) THEN + AnnDeltaPtoDeltaVCompressibility = 1.0 / (MudCompressibility * AnnMudVol) + + AnnCompressedMudVol = BackPressure / AnnDeltaPtoDeltaVCompressibility + AnnDeltaPDueToCompressibility = AnnCompressedMudVol / (MudCompressibility * AnnMudVol) + + ELSE ! No gas pocket, wellhead is closed and mud is compressed based on volume pumped into annulus + AnnDeltaPtoDeltaVCompressibility = 1.0 / (MudCompressibility * AnnMudVol) + AnnCompressedMudVol = AnnCompressedMudVol + REAL(Ann_Saved_MudDischarged_Volume_Final) !!!!!!!!! + AnnCompressedMudVol = MAX((AnnCompressedMudVol - REAL(Qlost / ConvMinToSec / dt)) , 0.0) + AnnDeltaPDueToCompressibility = AnnCompressedMudVol / (MudCompressibility * AnnMudVol) + END IF + + IF (FloatValveIn == .FALSE. .OR. NoGasPocket == 0 .OR. (FloatValveWasOpen .AND. REAL(St_Saved_MudDischarged_Volume_Final) >= PumpMinDischargedVol)) THEN ! float valve remains open + FloatValveOpen = .TRUE. + + FlowEl(StringFirstEl : StringLastEl)%FlowRate = REAL(St_Saved_MudDischarged_Volume_Final) / dt * ConvMinToSec !StringFlowRate ! String flow rate pump flow rate [gpm] + + !!!!!!!!!!!!!!! Calculating frictional pressure loss + IF (WellHeadOpen) THEN + DO ifric = 1 , StringLastEl + CALL FricPressDrop(ifric) + !WRITE (*,*) ' element No, FlowRate , Density, FricPressLoss', ifric, FlowEl(ifric)%FlowRate, FlowEl(ifric)%Density, FlowEl(ifric)%FricPressLoss + IF (IEEE_IS_NaN(FlowEl(ifric)%FricPressLoss)) THEN + WRITE (*,*) 'Hz/St start, end, density, Q, mu, Type' , FlowEl(ifric)%StartX, FlowEl(ifric)%EndX, FlowEl(ifric)%Density, FlowEl(ifric)%FlowRate, FlowEl(ifric)%mueff, FlowEl(ifric)%MaterialType + CALL ErrorStop('NaN in calculating pressure drop' , ifric) + END IF + END DO + END IF + + !!!!!!!!!!!!!!! + + + !IF (ABS(MudVolume_InjectedToBH - St_Saved_MudDischarged_Volume_Final)> PumpMinDischargedVol) WRITE (*,*) 'Injected to BH & St Saved Mud', MudVolume_InjectedToBH , St_Saved_MudDischarged_Volume_Final + IF (BitTotallyPluged) THEN + MudVolume_InjectedToBH = 0.d0 + StCompressedMudVol = StCompressedMudVol + REAL(St_Saved_MudDischarged_Volume_Final) + StDeltaPDueToCompressibility = StCompressedMudVol * StDeltaPtoDeltaVCompressibility + + ELSE IF (WellHeadOpen .OR. NoGasPocket > 0) THEN + IF (REAL(St_Saved_MudDischarged_Volume_Final) >= PumpMinDischargedVol) THEN + + MudVolume_InjectedToBH = St_Saved_MudDischarged_Volume_Final + !WRITE (*,*) 'MudVolume_InjectedToBH,BitTrue', MudVolume_InjectedToBH + + !IF (BitTrue .AND. UtubeMode1Activated == .FALSE.) THEN + IF (BitTrue) THEN + BitPressLoss = KBit * (MudVolume_InjectedToBH * ConvMinToSec / dt)**2 + !WRITE (*,*) 'BitPressLoss', BitPressLoss + END IF + + StCompressedMudVol = BitPressLoss / StDeltaPtoDeltaVCompressibility + + ELSE + MudVolume_InjectedToBH = MAX( 0.d0 , REAL((StDeltaPDueToCompressibility + SUM(FlowEl(StringFirstEl : StringLastEl)%StaticPressDiff - PressBelowFloatValve - AnnDeltaPDueToCompressibility - FloatValveMinOpenPressure) & + / StDeltaPtoDeltaVCompressibility ) * 1.d0)) + MudVolume_InjectedToBH = MIN(MudVolume_InjectedToBH , StCompressedMudVol) + StCompressedMudVol = StCompressedMudVol - MudVolume_InjectedToBH + + END IF + + StDeltaPDueToCompressibility = StCompressedMudVol / (MudCompressibility * StMudVol) + + ELSE ! IF (NoGasPocket == 0 .AND. WellHeadOpen == .FALSE.) THEN + StCompressedMudVol = StCompressedMudVol + REAL(St_Saved_MudDischarged_Volume_Final) + StDeltaPDueToCompressibility = StCompressedMudVol * StDeltaPtoDeltaVCompressibility + MudVolume_InjectedToBH = MAX( 0.d0 , REAL((StDeltaPDueToCompressibility - AnnDeltaPDueToCompressibility - FloatValveMinOpenPressure) & + / (StDeltaPtoDeltaVCompressibility + AnnDeltaPtoDeltaVCompressibility)) * 1.d0) + MudVolume_InjectedToBH = MIN(MudVolume_InjectedToBH , StCompressedMudVol) + StCompressedMudVol = StCompressedMudVol - REAL(MudVolume_InjectedToBH) + StDeltaPDueToCompressibility = StCompressedMudVol / (MudCompressibility * StMudVol) + FlowEl(AnnulusFirstEl : NumbEl)%StartPress = FlowEl(AnnulusFirstEl : NumbEl)%StartPress + StDeltaPDueToCompressibility + FlowEl(AnnulusFirstEl : NumbEl)%EndPress = FlowEl(AnnulusFirstEl : NumbEl)%EndPress + StDeltaPDueToCompressibility + + !WRITE (*,*) 'WellHeadOpen', WellHeadOpen + !WRITE (*,*) ' StCompressedMudVol, StDeltaPDueToCompressibility',StCompressedMudVol, StDeltaPDueToCompressibility + !WRITE (*,*) ' AnnCompressedMudVol, AnnDeltaPDueToCompressibility',AnnCompressedMudVol, AnnDeltaPDueToCompressibility + END IF + + + + FlowEl(StringLastEl)%EndPress = FlowEl(AnnulusFirstEl)%StartPress + BitPressLoss + FloatValveMinOpenPressure + !WRITE (*,*) 'BitPressLoss=', BitPressLoss + FlowEl(StringLastEl)%StartPress = FlowEl(StringLastEl)%EndPress + FlowEl(StringLastEl)%FricPressLoss - FlowEl(StringLastEl)%StaticPressDiff + DO i = StringLastEl - 1 , StringFirstEl , -1 + FlowEl(i)%EndPress = FlowEl(i + 1)%StartPress + FlowEl(i)%StartPress = FlowEl(i)%EndPress + FlowEl(i)%FricPressLoss - FlowEl(i)%StaticPressDiff + !WRITE(*,*) "STRING: Start , End Pressure", FlowEl(i)%StartPress , FlowEl(i)%EndPress + !WRITE(*,*) "STRING: Start , End X", FlowEl(i)%StartX , FlowEl(i)%EndX + END DO + + !FlowEl(NoHorizontalEl)%EndPress = FlowEl(StringFirstEl)%StartPress - FlowEl(NoHorizontalEl)%Density * FlowEl(StringFirstEl)%StartTVD + !WRITE (*,*) '- FlowEl(NoHorizontalEl)%Density * FlowEl(StringFirstEl)%StartTVD1=', - FlowEl(NoHorizontalEl)%Density * FlowEl(StringFirstEl)%StartTVD + !FlowEl(NoHorizontalEl)%StartPress = FlowEl(NoHorizontalEl)%EndPress + FlowEl(StringLastEl)%FricPressLoss + !DO i = NoHorizontalEl - 1 , 1 , -1 + ! FlowEl(i)%EndPress = FlowEl(i + 1)%StartPress + ! FlowEl(i)%StartPress = FlowEl(i)%EndPress + FlowEl(i)%FricPressLoss + ! !WRITE(*,*) "HORIZONTAL: Start , End Pressure", FlowEl(i)%StartPress , FlowEl(i)%EndPress + ! !WRITE(*,*) "HORIZONTAL: Start , End X", FlowEl(i)%StartX , FlowEl(i)%EndX + !END DO + + !!!!!!!!!!!!!!!!!!!!!!!!!!!! Float valve was open and remains open + + ELSE IF (REAL(St_Saved_MudDischarged_Volume_Final) < PumpMinDischargedVol) THEN ! NoGasPocket > 0 + FloatValveOpen = FloatValveWasOpen ! remains in its former status + + IF (FloatValveOpen) THEN + PressAboveFloatValve = MAX(FlowEl(AnnulusFirstEl)%StartPress , SUM(FlowEl(StringFirstEl : StringLastEl)%StaticPressDiff) + 0.052 * FlowEl(StringFirstEl)%Density * FlowEl(StringFirstEl)%StartTVD) + ELSE + PressAboveFloatValve = SUM(FlowEl(StringFirstEl : StringLastEl)%StaticPressDiff) + StDeltaPDueToCompressibility + MudVolume_InjectedToBH = 0.d0 + END IF + + + IF (PressBelowFloatValve >= PressAboveFloatValve .AND. KickFlux) THEN + FloatValveOpen = .FALSE. + IF (FloatValveOpen /= FloatValveWasOpen) THEN ! float valve was open and now closed + WRITE (*,*) 'Float valve was open and now closed' + WRITE (*,*) 'PressAboveFloatValve=', PressAboveFloatValve + WRITE (*,*) 'PressBelowFloatValve=', PressBelowFloatValve + END IF + + END IF + + IF (FloatValveOpen) THEN + MudVolume_InjectedToBH = MAX( 0.d0 , 0.1 * REAL((PressAboveFloatValve - PressBelowFloatValve - AnnDeltaPDueToCompressibility - FloatValveMinOpenPressure) & + / StDeltaPtoDeltaVCompressibility ) * 1.d0) + MudVolume_InjectedToBH = MIN(MudVolume_InjectedToBH , StCompressedMudVol) + !WRITE (*,*) 'MudVolume_InjectedToBH (No Pump)', MudVolume_InjectedToBH + + StCompressedMudVol = StCompressedMudVol - MudVolume_InjectedToBH + StDeltaPDueToCompressibility = StCompressedMudVol / (MudCompressibility * StMudVol) + !WRITE (*,*) 'StDeltaPDueToCompressibility(No Pump)', StDeltaPDueToCompressibility + + END IF + + IF (NoGasPocket == 0 .AND. WellHeadOpen == .FALSE.) THEN !*********** + FlowEl(AnnulusFirstEl : NumbEl)%StartPress = FlowEl(AnnulusFirstEl : NumbEl)%StartPress + AnnDeltaPDueToCompressibility + FlowEl(AnnulusFirstEl : NumbEl)%EndPress = FlowEl(AnnulusFirstEl : NumbEl)%EndPress + AnnDeltaPDueToCompressibility + END IF + + + + IF (FloatValveOpen) THEN + FlowEl(StringLastEl)%EndPress = MAX(FlowEl(AnnulusFirstEl)%StartPress , SUM(FlowEl(StringFirstEl : StringLastEl)%StaticPressDiff) + 0.052 * FlowEl(StringFirstEl)%Density * FlowEl(StringFirstEl)%StartTVD) + ELSE + FlowEl(StringLastEl)%EndPress = StDeltaPDueToCompressibility + SUM(FlowEl(StringFirstEl : StringLastEl)%StaticPressDiff) + END IF + + FlowEl(StringLastEl)%StartPress = FlowEl(StringLastEl)%EndPress - FlowEl(StringLastEl)%StaticPressDiff + DO i = StringLastEl - 1 , StringFirstEl , -1 + FlowEl(i)%EndPress = FlowEl(i + 1)%StartPress + FlowEl(i)%StartPress = FlowEl(i)%EndPress + FlowEl(i)%FricPressLoss - FlowEl(i)%StaticPressDiff + !WRITE(*,*) "STRING: Start , End Pressure", FlowEl(i)%StartPress , FlowEl(i)%EndPress + !WRITE(*,*) "STRING: Start , End X", FlowEl(i)%StartX , FlowEl(i)%EndX + END DO + + !FlowEl(NoHorizontalEl)%EndPress = FlowEl(StringFirstEl)%StartPress - FlowEl(NoHorizontalEl)%Density * FlowEl(StringFirstEl)%StartTVD + !WRITE (*,*) '- FlowEl(NoHorizontalEl)%Density * FlowEl(StringFirstEl)%StartTVD2=', - FlowEl(NoHorizontalEl)%Density * FlowEl(StringFirstEl)%StartTVD + !FlowEl(NoHorizontalEl)%StartPress = FlowEl(NoHorizontalEl)%EndPress + FlowEl(StringLastEl)%FricPressLoss + !DO i = NoHorizontalEl - 1 , 1 , -1 + ! FlowEl(i)%EndPress = FlowEl(i + 1)%StartPress + ! FlowEl(i)%StartPress = FlowEl(i)%EndPress + FlowEl(i)%FricPressLoss + ! !WRITE(*,*) "HORIZONTAL: Start , End Pressure", FlowEl(i)%StartPress , FlowEl(i)%EndPress + ! !WRITE(*,*) "HORIZONTAL: Start , End X", FlowEl(i)%StartX , FlowEl(i)%EndX + !END DO + + + !WRITE (*,*) ' StCompressedMudVol, StDeltaPDueToCompressibility',StCompressedMudVol, StDeltaPDueToCompressibility + !WRITE (*,*) ' AnnCompressedMudVol, AnnDeltaPDueToCompressibility',AnnCompressedMudVol, AnnDeltaPDueToCompressibility + !!!!!!!!!!!!!!!!!!!!!!!!!!!! Float valve was open (close) and maybe remains open (close) or maybe closed + + ELSE IF(FloatValveWasOpen == .FALSE. .AND. REAL(St_Saved_MudDischarged_Volume_Final) >= PumpMinDischargedVol) THEN + FloatValveOpen = .FALSE. + MudVolume_InjectedToBH = 0.d0 + + StCompressedMudVol = StCompressedMudVol + REAL(St_Saved_MudDischarged_Volume_Final) + StDeltaPDueToCompressibility = StCompressedMudVol * StDeltaPtoDeltaVCompressibility + PressAboveFloatValve = SUM(FlowEl(StringFirstEl : StringLastEl)%StaticPressDiff) + StDeltaPDueToCompressibility + + + + + IF (PressAboveFloatValve > FloatValveBottomToUpAreaRatio * PressBelowFloatValve) THEN ! float valve was open and now closed + FloatValveOpen = .TRUE. + WRITE (*,*) 'Float valve was closed and now opened' + WRITE (*,*) 'PressAboveFloatValve=', PressAboveFloatValve + WRITE (*,*) 'PressBelowFloatValve=', PressBelowFloatValve + END IF + + + FlowEl(StringLastEl)%EndPress = PressAboveFloatValve + FlowEl(StringLastEl)%StartPress = FlowEl(StringLastEl)%EndPress - FlowEl(StringLastEl)%StaticPressDiff + DO i = StringLastEl - 1 , StringFirstEl , -1 + FlowEl(i)%EndPress = FlowEl(i + 1)%StartPress + FlowEl(i)%StartPress = FlowEl(i)%EndPress - FlowEl(i)%StaticPressDiff + !WRITE(*,*) "STRING: Start , End Pressure", FlowEl(i)%StartPress , FlowEl(i)%EndPress + !WRITE(*,*) "STRING: Start , End X", FlowEl(i)%StartX , FlowEl(i)%EndX + END DO + + + + + END IF + + IF ((UtubePossibility == .TRUE. .AND. Get_KellyConnection() /= KELLY_CONNECTION_STRING) .OR. NewPipeFilling == 0) THEN + FlowEl(NoHorizontalEl)%EndPress = 0.0 + ELSE IF (WellHeadOpen == .FALSE.) THEN + FlowEl(NoHorizontalEl)%EndPress = FlowEl(StringFirstEl)%StartPress - 0.052 * FlowEl(NoHorizontalEl)%Density * FlowEl(StringFirstEl)%StartTVD + !WRITE (*,*) 'Density , StartX= , StartPress', FlowEl(NoHorizontalEl)%Density , FlowEl(StringFirstEl)%StartTVD + ELSE IF (WellHeadOpen) THEN + FlowEl(NoHorizontalEl)%EndPress = FlowEl(StringFirstEl)%StartPress - 2.0 * 0.052 * FlowEl(NoHorizontalEl)%Density * FlowEl(StringFirstEl)%StartTVD + END IF + + FlowEl(NoHorizontalEl)%StartPress = FlowEl(NoHorizontalEl)%EndPress + FlowEl(NoHorizontalEl)%FricPressLoss + DO i = NoHorizontalEl - 1 , 1 , -1 + FlowEl(i)%EndPress = FlowEl(i + 1)%StartPress + FlowEl(i)%StartPress = FlowEl(i)%EndPress + FlowEl(i)%FricPressLoss + !WRITE(*,*) "HORIZONTAL: Start , End Pressure", FlowEl(i)%StartPress , FlowEl(i)%EndPress + !WRITE(*,*) "HORIZONTAL: Start , End X", FlowEl(i)%StartX , FlowEl(i)%EndX + END DO + + + !WRITE (*,*) 'MudVolume_InjectedToBH==', MudVolume_InjectedToBH + !WRITE (*,*) 'Ann_Saved_MudDischarged_Volume_Final==', Ann_Saved_MudDischarged_Volume_Final + +!!!!!!!!!!!!!!!!!!!!! Pressure distribution in string and horizontal pump to string line + + + IF (ShearBop_Situation_forTD == 1) THEN + FlowEl(1 : NoHorizontalEl)%EndPress = 0.0 + FlowEl(1 : NoHorizontalEl)%StartPress = 0.0 + FlowEl(1 : NoHorizontalEl)%FricPressLoss = 0.0 + END IF + +!!!!!!!!!!!!!!!!!!!!!!!!! + + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + + !IF (NoGasPocket == 0 .AND. WellHeadOpen) THEN + ! FlowEl(1 : NoHorizontalEl + NoStringEl)%EndPress = FlowEl(1 : NoHorizontalEl + NoStringEl)%EndPress + StDeltaPDueToCompressibility + AnnDeltaPDueToCompressibility + ! FlowEl(1 : NoHorizontalEl + NoStringEl)%StartPress = FlowEl(1 : NoHorizontalEl + NoStringEl)%StartPress + StDeltaPDueToCompressibility + AnnDeltaPDueToCompressibility + ! FlowEl(NoHorizontalEl + NoStringEl +1 : NumbEl)%EndPress = FlowEl(NoHorizontalEl + NoStringEl +1 : NumbEl)%EndPress + AnnDeltaPDueToCompressibility + ! FlowEl(NoHorizontalEl + NoStringEl + 1 : NumbEl)%StartPress = FlowEl(NoHorizontalEl + NoStringEl + 1 : NumbEl)%StartPress + AnnDeltaPDueToCompressibility + !ELSE + !IF (NoGasPocket == 0 .AND. WellHeadOpen == .FALSE.) THEN + ! FlowEl(1 : StringLastEl)%EndPress = FlowEl(1 : StringLastEl)%EndPress + StDeltaPDueToCompressibility + 30.0 ! badan eslah shavad + ! FlowEl(1 : StringLastEl)%StartPress = FlowEl(1 : NoHorizontalEl + NoStringEl)%StartPress + StDeltaPDueToCompressibility + 30.0 + ! FlowEl(AnnulusFirstEl : NumbEl)%EndPress = FlowEl(AnnulusFirstEl : NumbEl)%EndPress + AnnDeltaPDueToCompressibility + ! FlowEl(AnnulusFirstEl : NumbEl)%StartPress = FlowEl(AnnulusFirstEl : NumbEl)%StartPress + AnnDeltaPDueToCompressibility + !END IF + + + IF (UtubePossibility== .true. .and. Get_KellyConnection() /= KELLY_CONNECTION_STRING .and. WellHeadOpen) THEN + MudVolume_InjectedToBH = 0.d0 + MudVolume_InjectedFromAnn = 0.d0 + + !ELSE + ! + ! IF (FloatValveOpen .AND. WellHeadOpen .AND. NoGasPocket == 0) THEN + ! MudVolume_InjectedToBH = MAX( 0.d0 , REAL((StDeltaPDueToCompressibility - FloatValveMinOpenPressure) / StDeltaPtoDeltaVCompressibility) * 1.d0) + ! !MudVolume_InjectedFromAnn = Ann_Saved_MudDischarged_Volume_Final !REAL((AnnDeltaPDueToCompressibility - BackPressure) / AnnDeltaPtoDeltaVCompressibility) * 1.d0 + ! !WRITE (*,*) 'Pressure above/under bit', FlowEl(NoHorizontalEl + NoStringEl)%EndPress, FlowEl(1 + NoHorizontalEl + NoStringEl)%StartPress + ! IF (MudVolume_InjectedToBH <= 0) MudVolume_InjectedToBH = 0.d0 + ! !IF (MudVolume_InjectedFromAnn <= 0) MudVolume_InjectedFromAnn = 0.d0 + ! ELSE IF (FloatValveOpen .AND. WellHeadOpen == .FALSE. .AND. NoGasPocket == 0) THEN + ! MudVolume_InjectedToBH = MAX( 0.d0 , REAL((PressAboveFloatValve + StDeltaPDueToCompressibility - AnnDeltaPDueToCompressibility - PressBelowFloatValve - FloatValveMinOpenPressure) & + ! / (StDeltaPtoDeltaVCompressibility - AnnDeltaPtoDeltaVCompressibility)) * 1.d0) + ! MudVolume_InjectedFromAnn = 0.d0 + ! ELSE IF (FloatValveOpen .AND. WellHeadOpen .AND. NoGasPocket > 0) THEN + ! MudVolume_InjectedToBH = MAX( 0.d0 , REAL((PressAboveFloatValve + StDeltaPDueToCompressibility - PressBelowFloatValve - FloatValveMinOpenPressure) / StDeltaPtoDeltaVCompressibility) * 1.d0) + ! ! MudVolume_InjectedFromAnn = REAL(Ann_Saved_MudDischarged_Volume_Final) * 1.d0 + ! ELSE IF (FloatValveOpen .AND. WellHeadOpen == .FALSE. .AND. NoGasPocket > 0) THEN + ! MudVolume_InjectedToBH = MAX( 0.d0 , REAL((PressAboveFloatValve + StDeltaPDueToCompressibility - AnnDeltaPDueToCompressibility - PressBelowFloatValve - FloatValveMinOpenPressure) & + ! / (StDeltaPtoDeltaVCompressibility - AnnDeltaPtoDeltaVCompressibility)) * 1.d0) + ! MudVolume_InjectedFromAnn = 0.d0 + ! END IF + !StCompressedMudVol = MAX(StCompressedMudVol - REAL(MudVolume_InjectedToBH) , 0.0) + !AnnCompressedMudVol = MAX(AnnCompressedMudVol - REAL(MudVolume_InjectedFromAnn) , 0.0) + !StDeltaPDueToCompressibility = StCompressedMudVol / (MudCompressibility * StMudVol) + !AnnDeltaPDueToCompressibility = AnnCompressedMudVol / (MudCompressibility * AnnMudVol) + END IF + + + !MudVolume_InjectedToBH = 0.0 + !MudVolume_InjectedToBH = St_Saved_MudDischarged_Volume_Final + !WRITE (*,*) 'CompMudVol, DeltaP, MudVolumeInjected' + !WRITE (*,*) StCompressedMudVol, StDeltaPDueToCompressibility, REAL(MudVolume_InjectedToBH) + !WRITE (*,*) AnnCompressedMudVol, AnnDeltaPDueToCompressibility, REAL(MudVolume_InjectedFromAnn) + !WRITE (*,*) 'Press above/Below Float valve ', FlowEl(NoHorizontalEl + NoStringEl)%EndPress , FlowEl(NoHorizontalEl + NoStringEl + 1)%StartPress + !write(*,*) 'MudVolume_InjectedFromAnn***=' , MudVolume_InjectedFromAnn, Ann_Saved_MudDischarged_Volume_Final + +110 FORMAT (I6 , 4X , F6.2 , 7X , F4.2 , 3X , F4.1 , 2X , F4.2) + + + !DO i = NumbEl , NumbEl - NoOpenHoleEl + 1 , -1 ! op elements + ! WRITE (*,*) 'el no, start, end' , i, FlowEl(i)%StartPress, FlowEl(i)%EndPress + !END DO + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!! Kick Information Reports + + +!!!!!!!!!!!!!!!!! 1- Stand pipe pressure gauge PressureGauges(1) + + !ElementTrueDepth = STpipeGauge_Height/Convfttom + !DistancetoRefrence = -170.7 ! 165 ft after pump and 100 ft before string + i = 1 + DO WHILE (NOT(FlowEl(i)%EndX >= -170 .AND. FlowEl(i)%StartX <= -170)) + i = i + 1 + IF (i > NoHorizontalEl) EXIT + END DO + CALL PumpPressureDelay%AddToFirst(REAL(FlowEl(i)%StartPress - 0.052 * (STpipeGauge_Height / Convfttom) * FlowEl(i)%Density + (FlowEl(i)%StartX + 170) * FlowEl(i)%dPdLFric)) + CALL PumpPressureDelay%Remove(PressureTimeStepDelay(1) + 1) + !IF (ANY(PUMP(:)%PowerFailMalf == 1)) PumpPressureDelay%Array(1 : PressureTimeStepDelay(1) / 2) = 0.0 !seyyed goft vaghti pumpfailure mishavad feshar dasti 0 nashavad, be in dalil in khat comment shod. + + DO j = PressureTimeStepDelay(1) , 1 , -1 + IF (NOT(IEEE_IS_NaN(PumpPressureDelay%Array(j)))) THEN + PressureGauges(1) = INT(PumpPressureDelay%Array(j)) + EXIT + END IF + END DO + + !PressureGauges(1) = INT(PumpPressureDelay%Array(PressureTimeStepDelay(1))) + + IF (i > NoHorizontalEl) THEN + WRITE (*,*) ' Error in calculating standpipe pressure ' + END IF + + IF (PressureGauges(1) < 0) THEN + !CALL Set_StandPipePressure(real(PressureGauges(1) , 8)) ! for display console + PressureGauges(1) = 0.0 + !CALL Set_StandPipePressure(0.0d0) !StandPipePressureGauge = 0 + END IF + DrillPipePressure = real(PressureGauges(1), 8) + !WRITE (*,*) 'Drillpipe Pressure', PressureGauges(1) + +!!!!!!!!!!!!!!!!! 2- Casing pressure gauge PressureGauge(2) + !WRITE (*,*) 'here 1', (WelltoPitsOpen == .FALSE. .AND. WellToChokeManifoldOpen) , (Valve(26)%Status == .TRUE. .AND. Valve(47)%Status == .TRUE. .AND. Valve(49)%Status == .TRUE.), BackPressure + !WRITE (*,*) Valve(26)%Status , Valve(47)%Status , Valve(49)%Status + !WRITE (*,*) (Valve(26)%Status == .TRUE.) , (Valve(47)%Status == .TRUE.) , (Valve(49)%Status == .TRUE.) + + !!! in normal mode changes in choke position immidiately observes in casing pressure + !! but when pumps off due to failure, casing pressure will drop after a delay time + IF (WellToChokeManifoldOpen .OR. WellToChokeLineGauge) THEN + !WRITE (*,*) 'Here 1' + CALL CasingPressureDelay%AddToFirst(FlowEl(NoHorizontalEl + NoStringEl + NoAnnulusEl + NoWellToChokeEl)%EndPress) + CALL CasingPressureDelay%Remove(PressureTimeStepDelay(1) + 1) + + DO j = 1 , PressureTimeStepDelay(1) + IF (NOT(IEEE_IS_NaN(CasingPressureDelay%Array(j)))) THEN + PressureGauges(2) = INT(CasingPressureDelay%Array(j)) + EXIT + END IF + END DO + + !PressureGauges(2) = INT(CasingPressureDelay%Array(1)) + IF (ANY(PUMP(:)%PowerFailMalf == 1)) THEN + DO j = PressureTimeStepDelay(1) , 1 , -1 + IF (NOT(IEEE_IS_NaN(CasingPressureDelay%Array(j)))) THEN + PressureGauges(2) = INT(CasingPressureDelay%Array(j)) + EXIT + END IF + END DO + END IF + + + + + !IF (ANY(PUMP(:)%PowerFailMalf == 1)) PressureGauges(2) = INT(CasingPressureDelay%Array(PressureTimeStepDelay(1))) + + ELSE !IF (ChokeLineGaugeToTanks) THEN + PressureGauges(2) = 0 + !WRITE (*,*) 'Here 2' + END IF + + + !WRITE (*,*) 'GaugePoint(2)%Pressure =' , GaugePoint(2)%Pressure + !IF (PressureGauges(2) < 0) THEN + ! PressureGauges(2) = 0.0 + !END IF + CALL Set_CasingPressure(real(PressureGauges(2) , 8)) ! for display console + CasingPressureDownhole = real(PressureGauges(2) , 8) + !IF (PressureGauges(2) > 3000.0) THEN + ! !CALL Error(' High Casing Pressure') + !END IF + !WRITE (*,*) 'Casing Pressure=' , PressureGauges(2) + + + +!!!!!!!!!!!!!!!!! 3- Bottom Hole Pressure PressureGauge(3) + + CALL BottomHolePressureDelay%AddToFirst(FlowEl(OpenholeFirstEl)%StartPress) + CALL BottomHolePressureDelay%Remove(PressureTimeStepDelay(2) + 1) + !PressureGauges(3) = INT(BottomHolePressureDelay%Array(PressureTimeStepDelay(2))) + + DO j = PressureTimeStepDelay(2) , 1 , -1 + IF (NOT(IEEE_IS_NaN(BottomHolePressureDelay%Array(j)))) THEN + PressureGauges(3) = INT(BottomHolePressureDelay%Array(j)) + EXIT + END IF + END DO + + + BottomHolePress = BottomHolePressureDelay%Array(PressureTimeStepDelay(2)) + + BottomHolePressure = REAL(PressureGauges(3) , 8) +!!!!!!!!!!!!!!!!! 4- Under Bit Pressure PressureGauges(4) + + PressureGauges(4) = FlowEl(AnnulusFirstEl)%StartPress + +!!!!!!!!!!!!!!!!! + + +!!!!!!!!!!!!!!!!! 5- Casing Shoe Pressure PressureGauges(5) + + !IF (ShoeDepth <= FlowEl(NoHorizontalEl + NoStringEl + 1)%StartX) THEN + DO ShoeFlowElNo = AnnulusFirstEl , NumbEl + IF (FlowEl(ShoeFlowElNo)%StartX >= ShoeDepth .AND. FlowEl(ShoeFlowElNo)%EndX < ShoeDepth) EXIT + END DO + CALL TVD_Calculator(ShoeDepth , ShoeTVD) + + IF (ShoeFlowElNo > NumbEl) THEN + WRITE (*,*) 'ShoeDepth =', ShoeDepth + DO i = AnnulusFirstEl , NumbEl + WRITE (*,*) 'i, StartX, EndX', i, FlowEl(i)%StartX, FlowEl(i)%EndX + END DO + + CALL ErrorSTOP ('Error in finding location of shoe') + END IF + + !ELSE + ! WRITE (*,*) ' Error in calculating shoe pressure ' + !END IF + + CALL ShoePressureDelay%AddToFirst(REAL(FlowEl(ShoeFlowElNo)%StartPress & + - (FlowEl(ShoeFlowElNo)%StartX - ShoeDepth) * FlowEl(ShoeFlowElNo)%dPdLfric & + - (FlowEl(ShoeFlowElNo)%StartTVD - ShoeTVD) * FlowEl(ShoeFlowElNo)%dPdLGrav)) + CALL ShoePressureDelay%Remove(PressureTimeStepDelay(3) + 1) + + !FlowrateNearShoe = FlowEl(ShoeFlowElNo)%FlowRate + DO j = PressureTimeStepDelay(3) , 1 , -1 + IF (NOT(IEEE_IS_NaN(ShoePressureDelay%Array(j)))) THEN + PressureGauges(5) = INT(ShoePressureDelay%Array(j)) + EXIT + END IF + END DO + + + !PressureGauges(5) = INT(ShoePressureDelay%Array(PressureTimeStepDelay(3))) + ShoePressure = real(PressureGauges(5), 8) + + + + !IF (PressureGauges(5) >= FormationLostPressure) WRITE (*,*) 'Near Shoe Flowrate', FlowEl(ShoeFlowElNo)%FlowRate + + ShoeMudViscosity = FlowEl(ShoeFlowElNo)%MuEff + ShoeMudDensity = FlowEl(ShoeFlowElNo)%Density + + !WRITE (*,*) 'Drillstring speed (ft/s)' , DrillStringSpeed + !WRITE (*,*) 'shoe mud speed ', FlowEl(ShoeFlowElNo - 1)%vel + !WRITE (*,*) 'Shoe pressure (psi)', ShoePressureDelay%Array(1) + + + + +!!!!!!!!!!!!!!!!! + +!!!!!!!!! 6- Pressure Before Bop + + PressureGauges(6) = FlowEl(NoHorizontalEl + NoStringEl + NoAnnulusEl)%EndPress + +!!!!!!!!!!!!!!!!! +101 FORMAT(4X, I2, 8X, (F8.1), 12X, (F8.3), 7X, (F8.2)) + + !WRITE (*,*) ' Pump Pressure Delay', PumpPressureDelay%Array(1) + !WRITE (*,*) ' Bottom Hole Pressure Delay', BottomHolePressureDelay%Array(1) + !WRITE (*,*) ' Shoe Pressure Delay', ShoePressureDelay%Array(1) + + !IF (ALLOCATED(GasPocketWeight%Array) .AND. ChokeKroneckerDelta == 1) THEN + !WRITE (*,*) 'Pocket No , Gas Pocket (psia) , Volume (gal) , Flow Induced (gpm) ' + + !DO i = 1 , NoGasPocket + ! WRITE (*,101) i, GasPocketNewPress%Array(i), GasPocketNewVol%Array(i) * ConvFt3toUSGal, GasPocketFlowInduced%Array(i) + !END DO + ! WRITE (*,*) 'Kchoke =', Kchoke, FlowEl(OpenholeFirstEl - 1)%FlowRate + + !DO i = 1 , NoGasPocket + ! WRITE (*,*) 'Gas Kick Vol (gal)=' , GasPocketNewVol%Array(i) * ConvFt3toUSGal , GasPocketDeltaVol%Array(i) * ConvFt3toUSGal , GasPocketNewPress%Array(i) + !END DO + + !WRITE (*,*) 'BHP (psig)=', BottomHolePress + + IF (ChokeKroneckerDelta == 1) THEN + !WRITE (*,*) 'Casing Pressure' , PressureGauges(2) + !WRITE (*,*) 'Below Bit' , FlowEl(AnnulusFirstEl)%StartPress + !WRITE (*,*) 'Above Bit' , FlowEl(StringLastEl)%EndPress + !WRITE (*,*) 'Pump Pressure' , PressureGauges(1) + + + + !WRITE (*,*) ' Kick Iteration', KickIteration + !WRITE (*,*) ' Kchoke, Q =', Kchoke, FlowEl(j)%Flowrate !, REAL((DeltaVolumePipe * ConvMinToSec / dt) + StringFlowRate) + !DO l = NoHorizontalEl + NoStringEl + 1 , NumbEl + ! WRITE (*,*) 'El No, Fric Press Loss, density , Q', l, FlowEl(l)%FricPressLoss, FlowEl(l)%StaticPressDiff, FlowEl(l)%Density, FlowEl(l)%Flowrate + !END DO + !write(*,*) 'BackPressure=' , BackPressure + + !WRITE (*,*) ' Kick Jacobian ', REAL(KickJacobian) + !WRITE (*,*) ' KickVandPFunction = ' , REAL(-KickVandPFunction) + !WRITE (*,*) ' Kick Unknown Vector = ' , REAL(KickUnknownVector) + !WRITE (*,*) 'SUM(StaticPressDiff) , SUM(FricPressLoss)', SUM(FlowEl(GasPocketElementNo(1) : i)%FricPressLoss) , SUM(FlowEl(GasPocketElementNo(1) : i)%StaticPressDiff) + !WRITE (*,*) 'Drillpipe, casing pressure', PressureGauges(1), PressureGauges(2) + END IF + + !IF (NoWelltoChokeEl > 0 .AND. FlowEl(OpenholeFirstEl - 1)%MaterialType == 1 .AND. WellHeadOpen) THEN ! kick is last element in choke line and does not exit. + ! KickWasExitingThroughChoke = .TRUE. + ! GasPocketDensity%Array(NoGasPocket) = (GasPocketweight%Array(NoGasPocket) / GasPocketModifiedVol%Array(NoGasPocket)) / convft3toUSgal ! [lbm/ft^3 to ppg] + ! ExitMass = (1.0 - (GasPocketModifiedVol%Array(NoGasPocket) / GasPocketNewVol%Array(NoGasPocket))) * GasPocketWeight%Array(NoGasPocket) ! exit mass due to expand + ! WRITE (*,*) ' ExitMass due to expand = ', GasPocketModifiedVol%Array(NoGasPocket) * Convft3ToUSgal , ExitMass + !END IF + + !WRITE (*,*) 'Horiz 1' + + KickInFluxConditions = (FormationTop < TD_WellTotalVerticalLength) .AND. (NOT(InactiveInflux)) .AND. (FormPressure > BottomHolePress + 5.0) + IF (KickInFluxConditions) THEN + KickFlux = .TRUE. + + CALL NewGasKick + + !WRITE (*,*) 'Kick Flux top' , KickFlux + !WRITE (*,*) 'FormPressure, BottomHolePress, FormationTop, TD_WellTotalVerticalLength' , FormPressure, BottomHolePress, FormationTop, TD_WellTotalVerticalLength + + ELSE + IF (ALLOCATED(GasPocketWeight%Array) .AND. KickFlux) THEN + KickOffBottom = .TRUE. + WRITE (*,*) 'Kick Off Bottom' + WRITE (*,*) 'FormPressure , BottomHolePress' , FormPressure , BottomHolePress + !WRITE (*,*) 'No Press(psia) Vol(gal) Weight(lbm) Flow Induced(gpm) Flow El Press(psia)' + DO i = 1 , NoGasPocket + WRITE (*,102) i , GasPocketNewPress%Array(i), GasPocketNewVol%Array(i) * Convft3toUSgal, GasPocketWeight%Array(i), GasPocketFlowInduced%Array(i), FlowEl(GasPocketFlowEl(i , 1))%StartPress + StandardPress + END DO + END IF + KickFlux = .FALSE. + END IF + + IF (ALLOCATED(KickJacobian)) OldKickJacobian = KickJacobian + +102 FORMAT (I2, 3X, (F8.1), 2X, (F8.2), 2X, (F8.3), 8X, (F8.2), 10X, (F8.1)) + + !!!!!!!! Auto Choke Procedure + ! DO i = 1 , 5 + ! AreaChange = -1.0 * (BottomHolePressure - (FormPressure + BHPSafetyMargin)) / FlowEl(OpenholeFirstEl - 1)%Flowrare**2 * 89158.0 & + ! * (0.26 * 0.61)**2 * TotalOpenChokeArea**3 / (4.0 * ChokeDensity) + ! CHOOKE(1)%AreaChokeFinal = CHOOKE(1)%AreaChokeFinal + AreaChange / * Convfttoinch**2 + ! + ! + ! + ! END DO + ! + ! + ! + ! + ! + + + !WRITE (*,*) ' SecondaryKickWeight', SecondaryKickWeight + !WRITE (*,*) ' SecondaryKickVol', SecondaryKickVol + SecondKickVolume = SecondaryKickVol + + + + IF (WellHeadOpen == .FALSE. .OR. (FlowEl(OpenholeFirstEl - 1)%Flowrate < PressFlowrateTolerance .AND. FlowEl(AnnulusLastEl)%Flowrate < PressFlowrateTolerance)) THEN + OnShakerDensity = 0.0 + ELSE IF (FlowEl(OpenholeFirstEl - 1)%MaterialType == 1 .AND. ChokeKroneckerDelta == 1) THEN + OnShakerDensity = 2.0 + ELSE IF (ChokeKroneckerDelta == 0) THEN + OnShakerDensity = FlowEl(AnnulusLastEl)%Density + ELSE IF (ChokeKroneckerDelta == 1) THEN !!!(FlowEl(OpenholeFirstEl - 1)%Flowrate > PressFlowrateTolerance .AND. FlowEl(AnnulusLastEl)%Flowrate < PressFlowrateTolerance) THEN + OnShakerDensity = FlowEl(OpenholeFirstEl - 1)%Density + ELSE + OnShakerDensity = (FlowEl(OpenholeFirstEl - 1)%Density * FlowEl(OpenholeFirstEl - 1)%Flowrate & + + FlowEl(AnnulusLastEl)%Density * FlowEl(AnnulusLastEl)%Flowrate) / (FlowEl(OpenholeFirstEl - 1)%Flowrate + FlowEl(AnnulusLastEl)%Flowrate) + END IF + !WRITE (*,*) 'ANINT(OnShakerDensity * 100) / 100', ANINT(OnShakerDensity * 100) / 100 , OnShakerDensity + CALL Set_MudWeightOut(ANINT(OnShakerDensity * 100) / 100) + + + IF (ALLOCATED(FinalFlowEl)) DEALLOCATE(FinalFlowEl) + ALLOCATE(FinalFlowEl(NumbEl)) + + FinalFlowEl(:)%StartX = FlowEl(:)%StartX + FinalFlowEl(:)%EndX = FlowEl(:)%EndX + FinalFlowEl(:)%StartTVD = FlowEl(:)%StartTVD + FinalFlowEl(:)%EndTVD = FlowEl(:)%EndTVD + FinalFlowEl(:)%Length = FlowEl(:)%Length + FinalFlowEl(:)%DepthDiff = FlowEl(:)%DepthDiff + FinalFlowEl(:)%density = FlowEl(:)%density + FinalFlowEl(:)%StartPress = FlowEl(:)%StartPress + FinalFlowEl(:)%EndPress = FlowEl(:)%EndPress + FinalFlowEl(:)%dPdLFric = FlowEl(:)%dPdLFric + FinalFlowEl(:)%dPdLGrav = FlowEl(:)%dPdLGrav + + !WRITE (*,*) 'FlowRate=', FlowEl(AnnulusFirstEl)%FlowRate + !WRITE (*,*) 'Pressure Loss in Drill String', SUM(FlowEl(StringFirstEl : StringLastEl)%FricPressLoss) + !WRITE (*,*) 'Pressure Loss in Annulus', SUM(FlowEl(AnnulusFirstEl : AnnulusLastEl)%FricPressLoss) + !MDObserve(:) = [3000.0 , 4349.0 , 11880.0 , 19880.0 , 21680.0] + !NomMd (:) = [3000 , 4298 , 11690 , 19690 , 21490] + !DO i = 1 , 5 + ! CALL TVD_Calculator(MDObserve(i) , TVDObserve(i)) + !END DO + ! + !DO i = 1 , 5 + ! + ! WRITE (*,*) 'MDObserve(i)', INT(NomMD(i)) + ! WRITE (*,*) 'TVDObserve(i)', INT(TVDObserve(i)) + ! + ! DO j = StringFirstEl , StringLastEl + ! IF (INT(MDObserve(i)) < INT(FinalFlowEl(j)%EndX)) EXIT + ! END DO + ! StPressObserve(i) = FlowEl(j)%StartPress - (MDObserve(i) - FlowEl(j)%StartX) * FlowEl(j)%dPdLfric + (TVDObserve(i) - FlowEl(j)%StartTVD) * FlowEl(j)%dPdLGrav + ! WRITE (*,*) 'String Pressure', INT(StPressObserve(i)) + ! + ! + ! + ! IF (INT(MDObserve(i)) <= INT(FlowEl(AnnulusFirstEl)%StartX)) THEN !! mouse pointer is in the annulus space + ! DO j = AnnulusFirstEl , AnnulusLastEl + ! IF (INT(FlowEl(j)%EndX) <= INT(MDObserve(i))) EXIT + ! END DO + ! ELSE IF (INT(MDObserve(i)) > INT(FinalFlowEl(NumbEl)%EndX)) THEN ! mouse pointer is in the open hole space + ! DO j = OpenholeFirstEl , NumbEl + ! IF (INT(FinalFlowEl(j)%EndX) <= INT(MDObserve(i))) EXIT + ! END DO + ! END IF + ! AnnPressObserve(i) = FlowEl(j)%StartPress - (FlowEl(j)%StartX - MDObserve(i)) * FlowEl(j)%dPdLfric & + ! - (FlowEl(j)%StartTVD - TVDObserve(i)) * FlowEl(j)%dPdLGrav + ! WRITE (*,*) 'Annulus Pressure', INT(AnnPressObserve(i)) + ! + ! + !END DO + + + + + END SUBROUTINE + + + +SUBROUTINE SOLVE_LINEAR_EQUATIONS(A , x , b , error, dim) + + !!! This subroutine solves a linear systems of equations Ax=b + !! if vaiable erorr changed its value to .FALSE. means that the system of equations cab not be solved + !! I use this subroutine to solve the linearized equations which uprising in calculation of volume and pressure of gas kick pockets + + USE KickVARIABLES + + IMPLICIT NONE + INTEGER , INTENT(IN) :: dim + REAL(8) , DIMENSION(dim,dim) , INTENT(in) :: A + REAL , DIMENSION(dim) , INTENT(OUT) :: x + REAL(8) , DIMENSION(dim) , INTENT(in) :: b + LOGICAL , INTENT(OUT) :: error + REAL(8) , DIMENSION(:,:) , ALLOCATABLE :: m + INTEGER , DIMENSION(1) :: max_loc + REAL(8) , DIMENSION(:) , ALLOCATABLE :: temp_row + INTEGER :: n , k + + !WRITE (*,*) 'SIZE(A , dim = 1), SIZE(A , dim = 2), SIZE(b)', SIZE(A , dim = 1), SIZE(A , dim = 2), SIZE(b) + error = (SIZE(A , dim = 1) /= SIZE(b)) .OR. (SIZE(A , dim = 2) /= SIZE(b)) + !WRITE (*,*) 'SOLVE_LINEAR_EQUATIONS 1' , error + + IF (error) THEN + x = 0.0d0 + RETURN + END IF + n = SIZE(b) + + ALLOCATE (m(n , n + 1) , temp_row(n + 1)) + m(1:n , 1:n) = A + m(1:n , n + 1) = b + !WRITE (*,*) 'SOLVE_LINEAR_EQUATIONS 2' , m + ! Triangularization phase + TRIANG_LOOP: DO k = 1 , n + max_loc = MAXLOC(ABS(m(k:n , k))) + temp_row(k:n + 1) = m(k , k:n + 1) + m(k , k:n+1) = m(k-1+max_loc(1) , k:n+1) + m(k - 1 + max_loc(1) , k:n + 1) = temp_row(k:n + 1) + !WRITE (*,*) 'SOLVE_LINEAR_EQUATIONS 3' , max_loc + + IF (m(k , k) == 0) THEN + error = .TRUE. + !WRITE (*,*) 'SOLVE_LINEAR_EQUATIONS 4' + EXIT TRIANG_LOOP + ELSE + !WRITE (*,*) 'SOLVE_LINEAR_EQUATIONS 5' + m(k , k : n + 1) = m(k , k : n + 1) / m(k , k) + m(k + 1 : n , k + 1 : n + 1) = m(k + 1 : n , k + 1 : n + 1) - SPREAD(m(k , k + 1:n + 1) , 1, n - k) * SPREAD(m(k + 1:n , k) , 2 , n - k + 1) + END IF + END DO TRIANG_LOOP + !WRITE (*,*) 'SOLVE_LINEAR_EQUATIONS 6' + + ! Back substitution phase + IF (error) THEN + x = 0.0 + ELSE + DO k = n , 1 , -1 + x(k) = REAL(m(k , n + 1) - SUM(m(k , k + 1 : n) * x(k + 1 : n))) + !WRITE (*,*) 'SOLVE_LINEAR_EQUATIONS 7' + END DO + END IF + + DEALLOCATE(m , temp_row) + +END SUBROUTINE solve_linear_equations + \ No newline at end of file diff --git a/FluidFlow/Pressure_Display_VARIABLES.f90 b/FluidFlow/Pressure_Display_VARIABLES.f90 new file mode 100644 index 0000000..dc7e9ce --- /dev/null +++ b/FluidFlow/Pressure_Display_VARIABLES.f90 @@ -0,0 +1,32 @@ +MODULE PressureDisplayVARIABLES + + USE DynamicRealArray + + IMPLICIT NONE + + + INTEGER :: NoGauges + REAL , DIMENSION(6) :: PressureGauges + INTEGER :: SoundSpeed ! speed of sound [ft/s] + INTEGER , DIMENSION(3) :: PressureTimeStepDelay + TYPE(DynamicRealArrayType) :: PumpPressureDelay + TYPE(DynamicRealArrayType) :: CasingPressureDelay + TYPE(DynamicRealArrayType) :: BottomHolePressureDelay + TYPE(DynamicRealArrayType) :: ShoePressureDelay + + + + TYPE :: ObservationAndGaugePointsInformations ! We have some gauges and may be have many observation points like casing shoe, bottomhole , etc. + ! This module stores information of these points to calculate pressure, density and other desired properties + ! at these points + ! Locations: 1: Stand Pipe , 2: Choke Manifold, 3: Botton Hole, 4: Under Bit, 5: Shoe, 6: Before BOP + INTEGER :: ElementNo ! Element Nubmer based on mud elements + REAL :: DistancetoRefrence ! Distance from pump or the end of fluid path [ft] + REAL :: ElementTrueDepth ! True depth of point or gauge [ft] + REAL :: Pressure ! Pressure [psi] + END TYPE + + !TYPE(ObservationAndGaugePointsInformations) , ALLOCATABLE :: GaugePoint(:) + TYPE(ObservationAndGaugePointsInformations) , ALLOCATABLE :: ObservationPoint(:) + + END MODULE \ No newline at end of file diff --git a/FluidFlow/Pressure_Distribution_VARIABLES.f90 b/FluidFlow/Pressure_Distribution_VARIABLES.f90 new file mode 100644 index 0000000..5cd2042 --- /dev/null +++ b/FluidFlow/Pressure_Distribution_VARIABLES.f90 @@ -0,0 +1,178 @@ +MODULE FricPressDropVars + + + !! Record of revisions + !! Date Programmer Discription of change + !! ------ ------------ ----------------------- + !! 1396/07/26 Sheikh Original code + !! + + IMPLICIT NONE + + + + REAL :: TotFricPressLoss ! Total Frictional Pressure Loss [psi] + REAL :: FlowrateNearShoe + INTEGER :: NoHorizontalEl ! number of elements in horizontal pump to string line + INTEGER :: NoStringEl ! number of elements in string + INTEGER :: NoAnnulusEl ! number of elements in annulus space + INTEGER :: NoWellToChokeEl ! number of elements in well head to choke manifold + INTEGER :: NoOpenHoleEl ! number of elements in openhole + INTEGER :: NumbEl ! number of flow elements in horizontal line, string, annulus and openhole + INTEGER :: StringFirstEl ! number of first string element + INTEGER :: StringLastEl ! number of last string element + INTEGER :: AnnulusFirstEl ! number of first annulus element + INTEGER :: AnnulusLastEl ! number of last annulus element + INTEGER :: ChokeFirstEl ! number of first choke element + INTEGER :: ChokeLastEl ! number of last choke element + INTEGER :: OpenholeFirstEl ! number of first openhole element + INTEGER :: ShoeFlowElNo ! the flow element that starts from shoe, in other word the number of upper element adjacent to shoe + REAL :: KBOP ! DeltaPBOP = KBOP * Q**2 [psi * min^2 / gal^2] + REAL :: KBit ! DeltaPBit = KBit * Q**2 [psi * min^2 / gal^2] + + !!!! Choke Variables + REAL :: BackPressure , NewBackPressure ! back pressure at riser or choke line [psi] + REAL :: Kchoke ! DeltaPchoke = Kchoke * Q**2 [psi * min^2 / gal^2] + REAL :: TotalOpenChokeArea , OldTotalOpenChokeArea , ChokeBypassArea , NewTotalOpenChokeArea , AreaChange + REAL :: BHPSafetyMargin , AChBHPTol ! BHP safety margin and BHP Tolerance in Auto Choke mode [psi] + REAL(8) :: OnShakerDensity ! Outlet Density of well for displaying in drillwatch and data [ppg] + + LOGICAL :: FloatValveIn + LOGICAL :: FloatValveOpen , FloatValveWasOpen + LOGICAL :: BitTotallyPluged + + REAL :: ClingingFactor = 0.45 ! in calculating surge and swab pressure changes + REAL :: MudCompressibility = 2.7E-6 ! Volumne change relative to Volume/1psi, for example for change of 1000 psi in pressure, volume changes 0.27% [1/psi] + REAL :: FloatValveMinOpenPressure = 1.0 ! minimum pressure that opens the float valve [psi] + REAL :: StMudVol ! Total mud volume of Horizontal and String that may be compressed [gal] + REAL :: AnnMudVol ! Total mud volume of Bottom hole, Annulus and Choke line that may be compressed [gal] + REAL :: PumpToManifoldMudVol + REAL :: StCompressedMudVol ! Compressed mud volume in Horizontal and String [gal] + REAL :: AnnCompressedMudVol ! Compressed mud volume in Bottom hole, Annulus and Choke line [gal] + REAL :: PumpToManifoldCompressedMudVol + REAL :: StDeltaPDueToCompressibility ! Pressure increase due to mud compressibility in Horizontal and String [psi] + REAL :: AnnDeltaPDueToCompressibility ! Pressure increase due to mud compressibility in Bottom hole, Annulus and Choke line [psi] (usually when wellhead is closed) + REAL :: PumpToManifoldDeltaPDueToCompressibility + REAL :: StDeltaPtoDeltaVCompressibility ! string pressure change due to compressibility [psi/gal] + REAL :: AnnDeltaPtoDeltaVCompressibility ! annulus and openhole pressure change due to compressibility [psi/gal] + + + !!!! Problem Variables (Choke and Bit) + + INTEGER :: ManChoke1Plug , ManChoke2Plug ! = 1 if choke is plugged , = 0 else + INTEGER :: ManChoke1Washout , ManChoke2Washout ! = 1 if choke is washed out , = 0 else + INTEGER :: BitJetsPlugged , BitJetsWashedOut + INTEGER :: CasingPressure_DataDisplayMalF, CasingPressure_ChokeMalF + + !!!!!! Note that bit is not an element in these calculations + + + TYPE, PUBLIC :: PressDropCalcElemInfo + + !! Geometrical variables + REAL(8) :: Length ! Length of a Flow element [ft] + REAL(8) :: DepthDiff ! Difference between depth of start and end of element [ft] + REAL(8) :: StartX , EndX ! start and end point (measured depth) of flow element [ft] + REAL(8) :: StartTVD , EndTVD ! Start and End point True Vertical Depth of flow element [ft] + REAL :: Od , Id , Dhyd ! Outer, Inner and hydraulic diameter of flow element [in] + REAL :: Area ! area of element [ft^2] + INTEGER :: alpha ! geometry factor: 0 = pipe (ID=0) , 1 = annulus + INTEGER :: FrictionDirection ! = 1 if flowrate is positive, so frictional pressure gradient is in direction of preassumed + ! flowrate, = -1 if not above condition usually in Swab conditions + !! Flow variables + INTEGER :: MaterialType ! = 0 for mud , = 2 for gas + REAL :: volume , vel , density , FlowRate ! volume [ft^3], velocity [ft/s], density of fluid flow [ppg], flow rate [gpm] + REAL :: Gf ! geometry shear rate correction [-] + !! Rheological and frictional variables + REAL :: Theta600 , Theta300 ! Fann data at 600 and 300 rpm as rheological data + ! REAL(8) :: VelCritBing , VelCritPow ! critical velocity in Bingham Plastic and Power law model [ft/min] + REAL :: muPlastic , YieldP ! plastic viscosity [cp] and yield point [lbf/(100*ft^2)] + REAL :: mueff ! Effective or apparent viscosity which is used in calculation of generalized Reynolds number + REAL :: nIndex , kIndex ! n: flow behaivior index [-] and k: consistency factor [lbf*s^n/(100*ft^2)] + REAL :: gammaW , tauW ! shear rate at the wall [1/s] and wall shear stress [lbf/(100*ft^2)] + REAL :: GenRe ! generalized Reynolds number in power law model [-] + REAL :: ReCrit = 2100.0 ! Critical Reynolds number for Newtonian model and Bingham plastic model + REAL :: ReCritLam , ReCritTurb ! laminar and turbulent critical Reynolds + REAL :: f ! Fanning friction factor [-] + REAL :: a , b ! parameters for calculationg friction factor in turbulent regime for power law model [-] + LOGICAL :: LaminarRegime ! = .TRUE. if flow regime is laminar and = .FALSE. if flowregime is not + LOGICAL :: TurbulentRegime ! = .TRUE. if flow regime is turbulent and = .FALSE. if flowregime is not + !! Pressure change variables + REAL :: StartPress , EndPress ! Pressure at start and end of an element [psi] + REAL :: dPdLFric ! frictional pressure drop gradient in each element [psi/ft] + REAL :: dPdLGrav ! gravitional pressure gradient = 0.052 * Density [psi/ft] + REAL :: FricPressLoss ! frictional pressure loss in each element [psi] + REAL :: StaticPressDiff ! static pressure difference between top and bottom of a pocket [psi] always positive + REAL :: FricToQPartialDiff ! partial differentiation of friction relative to volume flow rate + + + + END TYPE PressDropCalcElemInfo + + TYPE (PressDropCalcElemInfo) , ALLOCATABLE :: FlowEl(:) ! FlowEl: Pressure Drop Calculation Elements The dimension is equal to the number of flow elements + + + + + TYPE, PUBLIC :: FinalPressDropCalcElemInfo + + !!! for use in calculationg properties of a point in 'downhole view' page + + REAL(8) :: StartX , EndX , StartTVD , EndTVD , Length , DepthDiff ! start and end point of flow element [ft] + REAL :: density ! density of fluid flow [ppg], flow rate [gpm] + REAL :: StartPress ! Pressure at start of an element [psi] + REAL :: EndPress ! Pressure at end of an element [psi] + REAL :: dPdLFric ! frictional pressure drop gradient in each element [psi/ft] + REAL :: dPdLGrav ! gravitional pressure gradient = 0.052 * Density [psi/ft] + + END TYPE FinalPressDropCalcElemInfo + + TYPE (FinalPressDropCalcElemInfo) , ALLOCATABLE :: FinalFlowEl(:) ! FlowEl: Pressure Drop Calculation Elements The dimension is equal to the number of flow elements + + + + + END MODULE FricPressDropVars + + MODULE UTUBEVARS + + REAL :: QUTubeInput ! flow rate from string to annulus which caused by head difference at two sides of U-tube [gpm] + REAL :: QUtubeOutput ! flow rate from annulus to string which caused by head difference at two sides of U-tube [gpm] + REAL :: PressureDp ! pressure at bit or end of drill string from drill string path [psi] + REAL :: PressureAnn ! pressure at bit or end of drill string from annular path [psi] + + END MODULE + + SUBROUTINE DeallocateFlowTypes + + USE FricPressDropVars + USE PressureDisplayVARIABLES + USE KickVariables + + IMPLICIT NONE + + + IF (ALLOCATED(FlowEl)) DEALLOCATE(FlowEl) + IF (ALLOCATED(FinalFlowEl)) DEALLOCATE(FinalFlowEl) + IF (ALLOCATED(GasPocketWeight%Array)) CALL GasPocketWeight%Empty() + IF (ALLOCATED(GasPocketNewPress%Array)) CALL GasPocketNewPress%Empty() + IF (ALLOCATED(GasPocketOldPress%Array)) CALL GasPocketOldPress%Empty() + IF (ALLOCATED(GasPocketNewTemp%Array)) CALL GasPocketNewTemp%Empty() + IF (ALLOCATED(GasPocketOldTemp%Array)) CALL GasPocketOldTemp%Empty() + IF (ALLOCATED(GasPocketNewVol%Array)) CALL GasPocketNewVol%Empty() + IF (ALLOCATED(GasPocketOldVol%Array)) CALL GasPocketOldVol%Empty() + IF (ALLOCATED(GasPocketdeltaVol%Array)) CALL GasPocketdeltaVol%Empty() + IF (ALLOCATED(GasPocketModifiedVol%Array)) CALL GasPocketModifiedVol%Empty() + IF (ALLOCATED(GasPocketFlowInduced%Array)) CALL GasPocketFlowInduced%Empty() + IF (ALLOCATED(GasPocketDensity%Array)) CALL GasPocketDensity%Empty() + IF (ALLOCATED(GasPocketCompressibility%Array)) CALL GasPocketCompressibility%Empty() + IF (ALLOCATED(GasPocketFlowEl)) DEALLOCATE(GasPocketFlowEl) + IF (ALLOCATED(KickJacobian)) DEALLOCATE(KickJacobian) + IF (ALLOCATED(OldKickJacobian)) DEALLOCATE(OldKickJacobian) + IF (ALLOCATED(KickVandPFunction)) DEALLOCATE(KickVandPFunction) + IF (ALLOCATED(KickUnknownVector)) DEALLOCATE(KickUnknownVector) + IF (ALLOCATED(KickCorrectionVector)) DEALLOCATE(KickCorrectionVector) + + + END SUBROUTINE + \ No newline at end of file diff --git a/FluidFlow/String_Property_Calculator.f90 b/FluidFlow/String_Property_Calculator.f90 new file mode 100644 index 0000000..bbc0617 --- /dev/null +++ b/FluidFlow/String_Property_Calculator.f90 @@ -0,0 +1,31 @@ +SUBROUTINE StringPropertyCalculator (md, den, pre, tem) + + !!! This subroutine gets location of a guage or an observation point and determines information of that point such as pressure, density, velocity and temperature later. + USE PressureDisplayVARIABLES + USE Fluid_Flow_Startup_Vars + !USE MudSystemVARIABLES + USE FricPressDropVars + !USE CDataDisplayConsoleVariables , StandPipePressureDataDisplay=>StandPipePressure + !USE CDataDisplayConsoleVariables , CasingPressureDataDisplay=>CasingPressure!, StandPipePressureDataDisplay=>StandPipePressure + USE CDrillWatchVariables + + IMPLICIT NONE + INTEGER, intent(in) :: md ! input + REAL(8) :: TVD + real(8), intent(inout) :: den ! output + real(8), intent(inout) :: pre ! output + real(8), intent(inout) :: tem ! output + + INTEGER :: ilocal + + CALL TVD_Calculator(md * 1.d0 , TVD) + + DO ilocal = StringFirstEl , StringLastEl + IF (md < INT(FinalFlowEl(ilocal)%EndX)) EXIT + END DO + den = FinalFlowEl(ilocal)%Density + pre = FinalFlowEl(ilocal)%StartPress - (md - FinalFlowEl(ilocal)%StartX) * FinalFlowEl(ilocal)%dPdLfric & + + (TVD - FinalFlowEl(ilocal)%StartTVD) * FinalFlowEl(ilocal)%dPdLGrav + tem = 500 + + END SUBROUTINE \ No newline at end of file diff --git a/FluidFlow/Utube.f90 b/FluidFlow/Utube.f90 new file mode 100644 index 0000000..e45d758 --- /dev/null +++ b/FluidFlow/Utube.f90 @@ -0,0 +1,117 @@ +SUBROUTINE Utube + + !! This subroutine calculates flow rate when pump is off, pump is disconnected from drill pipe + !! and both annulus and drill pipe are exposed to atmosphere pressure and thus a U-tube situation is occurs + + !! Record of revisions + !! Date Programmer Discription of change + !! ------ ------------ ----------------------- + !! 1396/07/29 Sheikh Original code + !! 1396/08/09 Sheikh Two-side U-tube + !! + + USE FricPressDropVars + USE MudSystemVARIABLES + USE UTUBEVARS + USE Fluid_Flow_Startup_Vars + + IMPLICIT NONE + + + + INTEGER :: i ,j, ibit , ij , ijk + REAL :: AreaBeforeBit !!! Area of element before bit in U-Tube condition [in^2] + + QUTubeInput = 1.0 + QUTubeOutput = 1.0 + TotFricPressLoss = 0 + BitPressLoss = 0 + PressureDp = 0 + PressureAnn = 0 +!!!!!!!!!!!!!!!!!!!!!! Bit +!!!!!!!!!!!! Calculating Pressure at the bottom of drill string from mud columns in drill pipes and annulus space + + PressureDp = SUM(FlowEl(StringFirstEl : StringLastEl)%StaticPressDiff) + + PressureAnn = SUM(FlowEl(AnnulusFirstEl : AnnulusLastEl)%StaticPressDiff) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!! U tube:: flow from string to annulus + IF ((PressureDp - PressureAnn) > UTubePressTolerance) THEN + DO ijk = 1 , 10 + FlowEl(StringFirstEl : AnnulusLastEl)%Flowrate = QUTubeInput + !WRITE (*,*) 'QUTubeInput', FlowEl(AnnulusLastEl)%Flowrate + DO ij = StringFirstEl , AnnulusLastEl !!!!! Updating values of flowrates + CALL FricPressDrop(ij) + CALL PartialDerivativeFricToFlowRate(ij) + !WRITE (*,*) 'FricPressDrop, PartialDerivative', FlowEl(ij)%FricPressLoss, FlowEl(ij)%FricToQPartialDiff, FlowEl(ij)%Length + END DO + + !!!!!!!!!!!!!! Bit pressure drop calculation + IF (BitTrue) THEN + i = NoHorizontalEl + NoStringEl + AreaBeforeBit = FlowEl(i)%Area * Convfttoinch**2 + BitPressLoss = FlowEl(i)%density * Convft3toUSgal * (FlowEl(i)%vel**2 * ((AreaBeforeBit/BitTotNozzArea)**2 - 1.)) / 2. / Convlbftolbm / Convfttoinch**2 + END IF + + !!!!!!!!!!!!!!!!!!!!!!!!!!! + i = NoHorizontalEl + 1 + j = NoHorizontalEl + NoStringEl + NoAnnulusEl + !IF (ALLOCATED(FlowEl)) THEN + ! WRITE (*,*) ' H, S, A, Ch, O', NoHorizontalEl , NoStringEl , NoAnnulusEl , NoWellToChokeEl , NoOpenHoleEl + !END IF + + TotFricPressLoss = SUM(FlowEl(i : j)%FricPressLoss) + BitPressLoss + IF (ABS((PressureDp - PressureAnn) - TotFricPressLoss) <= UTubePressTolerance .OR. QUTubeInput < 1.0) EXIT ! tolerance set to 1.0 psi + IF ((PressureDp - PressureAnn) > TotFricPressLoss) THEN + QUTubeInput = QUTubeInput + ((PressureDp - PressureAnn) - TotFricPressLoss) / SUM(FlowEl(i : j)%FricToQPartialDiff) + ELSE IF ((PressureDp - PressureAnn) < TotFricPressLoss) THEN + QUTubeInput = QUTubeInput + ((PressureDp - PressureAnn) - TotFricPressLoss) / SUM(FlowEl(i : j)%FricToQPartialDiff) + END IF + !WRITE (*,*) 'QUTubeInput, TotFricPressLoss', QUTubeInput, TotFricPressLoss + !WRITE (*,*) '1) PressureDp, PressureAnn', PressureDp, PressureAnn, TotFricPressLoss, QUTubeInput + + END DO + QUTubeOutput = 0.0 +!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!! U tube:: flow from annulus to string + ELSE IF ((PressureAnn - PressureDp) > UTubePressTolerance) THEN + DO ijk = 1 , 10 + DO ij = NoHorizontalEl + 1 , NoHorizontalEl + NoStringEl + NoAnnulusEl !!!!! Updating values of flowrates + FlowEl(ij)%Flowrate = QUTubeOutput + CALL FricPressDrop(ij) + CALL PartialDerivativeFricToFlowRate(ij) + END DO + + !!!!!!!!!!!!!! Bit pressure drop calculation + IF (BitTrue) THEN + !DO i = NumbEl , 1 , -1 !! This loop starts from the first elements of string and check the elements to reach the bit at the bottom of string + ! IF (FlowEl(i)%Id==0) CYCLE + i = NoHorizontalEl + NoStringEl + 1 + AreaBeforeBit = FlowEl(i)%Area * Convfttoinch**2 + BitPressLoss = FlowEl(i)%density * Convft3toUSgal * (FlowEl(i)%vel**2 * ((AreaBeforeBit/BitTotNozzArea)**2 - 1.)) / 2. / Convlbftolbm / Convfttoinch**2 + !IF (FlowEl(i)%Id>0) EXIT + !END DO + END IF + !!!!!!!!!!!!!!!!!!!!!!!!!!! + i = NoHorizontalEl + 1 + j = NoHorizontalEl + NoStringEl + NoAnnulusEl + TotFricPressLoss = SUM(FlowEl(i : j)%FricPressLoss) + BitPressLoss + + IF (ABS((PressureDp - PressureAnn) - TotFricPressLoss) <= UTubePressTolerance) EXIT ! tolerance set to 1.0 psi + IF ((PressureAnn - PressureDp) > TotFricPressLoss) THEN + QUTubeOutput = QUTubeOutput - (((PressureAnn - PressureDp) - TotFricPressLoss) / SUM(FlowEl(i : j)%FricToQPartialDiff)) + ELSE IF ((PressureAnn - PressureDp) < TotFricPressLoss) THEN + QUTubeOutput = QUTubeOutput + (((PressureAnn - PressureDp) - TotFricPressLoss) / SUM(FlowEl(i : j)%FricToQPartialDiff)) + END IF + !WRITE (*,*) 'QUTubeOutput, TotFricPressLoss', QUTubeOutput, TotFricPressLoss + + WRITE (*,*) '2) PressureDp, PressureAnn', PressureDp, PressureAnn, TotFricPressLoss + END DO + QUTubeInput = 0.0 +!!!!!!!!!!!! No U-Tube + ELSE + QUTubeInput = 0.0 + QUTubeOutput = 0.0 + END IF + +END SUBROUTINE \ No newline at end of file diff --git a/FluidFlow/Well_Pressure_Data_Transfer.f90 b/FluidFlow/Well_Pressure_Data_Transfer.f90 new file mode 100644 index 0000000..d091c1c --- /dev/null +++ b/FluidFlow/Well_Pressure_Data_Transfer.f90 @@ -0,0 +1,776 @@ +SUBROUTINE WellPressureDataTransfer + + !! This subroutine calculates pressure distribution in well + !! We divide well hydraulic system to 4 zones. 1- pump to string zone; this zone is horizontal + !! 2- string zone; this zone includes drill pipes and collars and is vertical or neraly vertical + !! 3- annulus zone; this zone includes annulus space between string and openhole or casing + !! 4- Openhole zone; this zone includes spaces under bit to bottom of the wellbore + !! The last two zone includes annulus space and open hole, are influenced by kicks and have crucial role in + !! computing pressure distribution because reference point (back pressure in well head open condition + !! and bottomhole pressure in well head closed condition) are in one of them. because of this, pressure + !! distribution calculates in two subroutines : PressureAnnAndOHDistribution and PressurePumptoBitDistribution + !! pressure change through well consist of pressure change due to friction, change of elevation and acceleration + !! frictional pressure drop calculated by subroutine Sub_Press_Drop_Calculator + !! This subroutine includes hydrostatic pressure and later will include effect of corss-section area change + !! which causes acceleration or decceleration of flow + + USE FricPressDropVars + USE MudSystem + USE MudSystemVARIABLES + USE GeoElements_FluidModule + USE Fluid_Flow_Startup_Vars + USE KickVariables + USE CMudPropertiesVariables + USE CBopStackVariables + USE sROP_Variables + USE CHOKEVARIABLES, PI2 => PI + USE CChokeManifoldVariables + USE CBitProblemsVariables + USE CChokeProblemsVariables + USE CStringConfigurationVariables + USE CDrillWatchVariables + USE CDataDisplayConsoleVariables , MudWeightOutDataDisplay => MudWeightOut + + + + IMPLICIT NONE + + INTEGER :: i , j + REAL :: InstantaneousTotalOpenChokeArea , VolumeDensityProduct + + ChokeIsClosing = .FALSE. + Kchoke = 0.0 + KBit = 0.0 + + + !!!!!!!!!!!!!!!! bit is present + BitTrue = StringConfigurations(1)%ComponentType == Bit_ComponentType ! Bit_ComponentType = 0 + BitCd = 0.98 + BitNozzDia = 32.0 * BitDefinition%BitNozzleSize ! nozzle diameter in 1/32 in + BitNozzleArea = 7.6699E-4 * BitNozzDia**2 + BitNozzleNum = BitDefinition%BitNozzleNo - BitJetsPlugged * PlugJetsCount + BitTotNozzArea = BitNozzleNum * BitNozzleArea + 0.5 * BitJetsWashedOut * JetWashoutCount * BitNozzleArea + IF (BitNozzleNum == 0) THEN + BitTotallyPluged = .TRUE. + ELSE + BitTotallyPluged = .FALSE. + END IF + + FloatValveIn = BitDefinition%FloatValve + !FloatValveOpen = .TRUE. + !IF (JetWashoutCount > 0 .OR. PlugJetsCount > 0) THEN + ! WRITE (*,*) 'PlugJetsCount' , PlugJetsCount + ! WRITE (*,*) 'JetWashoutCount', JetWashoutCount + !END IF + + !WRITE (*,*) 'BitNozzleNum', BitNozzleNum + !WRITE (*,*) 'BitTotNozzArea', BitTotNozzArea + !WRITE (*,*) 'Float Valve??', BitDefinition%FloatValve + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + IF(ALLOCATED(GasPocketFlowEl)) DEALLOCATE(GasPocketFlowEl) + +!!!!!!!!!!!!!!!!!!!! Well Head Condition ( Open or Closed ) + ChokeKroneckerDelta = 0 + + + IF (WelltoPitsOpen == .FALSE. .AND. WellToChokeManifoldOpen == .FALSE.) THEN + + WellHeadOpen = .FALSE. + !WRITE (*,*) ' Well Head is closed ' + ELSE + WellHeadOpen = .TRUE. + END IF + + IF (WelltoPitsOpen == .FALSE. .AND. WellToChokeManifoldOpen) ChokeKroneckerDelta = 1 + !WRITE (*,*) ' WelltoPitsOpen=' , WelltoPitsOpen, 'WellToChokeManifoldOpen= ' , WellToChokeManifoldOpen + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + NoHorizontalEl = NoHorizontalMudElements + NoStringEl = NoStringMudElements + NoAnnulusEl = NoCasingMudElements + NoWellToChokeEl = 0 + IF (ChokeKroneckerDelta == 1) NoWellToChokeEl = ChokeLine_Density%Length() + NoOpenHoleEl = NoBottomHoleMudElements + NumbEl = NoHorizontalEl + NoStringEl + NoAnnulusEl + NoWellToChokeEl + NoOpenHoleEl + !WRITE (*,*) 'H, S, A, Ch, O', NoHorizontalEl , NoStringEl , NoAnnulusEl , NoWellToChokeEl , NoOpenHoleEl + IF(ALLOCATED(FlowEl)) DEALLOCATE(FlowEl) + ALLOCATE(FlowEl(NumbEl)) + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Transfering Data from module:MudSystemVARIABLES to module:FricPressDropVars to calculate Pressure distribution in flow path + !!!!!!!!!!!!!!!!!!!!!!! Horizontal line + !WRITE (*,*) 'H', NoHorizontalEl + DO i = 1 , NoHorizontalEl + FlowEl(i)%StartX = Xstart_MudElement%Array(i) + FlowEl(i)%EndX = Xend_MudElement%Array(i) + FlowEl(i)%StartTVD = 0.d0 + FlowEl(i)%EndTVD = 0.d0 + FlowEl(i)%Id = 0.0 + FlowEl(i)%Od = PipeOD_MudElement%Array(i) + FlowEl(i)%density = Density_MudElement%Array(i) + + FlowEl(i)%Dhyd = FlowEl(i)%Od + FlowEl(i)%Length = ABS(FlowEl(i)%EndX - FlowEl(i)%StartX) + FlowEl(i)%DepthDiff = 0.d0 + FlowEl(i)%Volume = PI / 4.0 * FlowEl(i)%Od**2 * REAL(FlowEl(i)%Length) / Convfttoinch**2 + IF (MudType_MudElement%Array(i) == 0) THEN ! = 0 for mud, = 1 for gas kick, = 4 for air + FlowEl(i)%MaterialType = 0 + ELSE IF (MudType_MudElement%Array(i) == 4) THEN + FlowEl(i)%MaterialType = 4 + ELSE + FlowEl(i)%MaterialType = 1 + END IF + + FlowEl(i)%dPdLgrav = 0.0 + FlowEl(i)%StaticPressDiff = 0.0 + + !WRITE (*,*) 'H density, length, Type of ith element' , i, FlowEl(i)%density , FlowEl(i)%length, FlowEl(i)%MaterialType + + + END DO + !WRITE (*,*) 'inlet and outlet mud theta600' , FlowEl(1)%Theta600 , FlowEl(NumbEl)%Theta600 + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + !!!!!!!!!!!!!!!!!!!!!!!!! String + !WRITE (*,*) 'S', NoStringEl + StringFirstEl = NoHorizontalEl + 1 + StringLastEl = NoHorizontalEl + NoStringEl + DO i = NoHorizontalEl + 1 , NoHorizontalEl + NoStringEl + !WRITE (*,*) 'ST , i' , i + FlowEl(i)%StartX = Xstart_MudElement%Array(i) + !WRITE (*,*) 'StartX', FlowEl(i)%StartX + FlowEl(i)%EndX = Xend_MudElement%Array(i) + !WRITE (*,*) 'EndX', FlowEl(i)%EndX + FlowEl(i)%StartTVD = TVDstart_MudElement%Array(i) + !WRITE (*,*) 'StartTVD', FlowEl(i)%StartTVD + FlowEl(i)%EndTVD = TVDend_MudElement%Array(i) + !WRITE (*,*) 'EndTVD', FlowEl(i)%EndTVD + FlowEl(i)%Id = 0.0 + !WRITE (*,*) 'Id', FlowEl(i)%Id + FlowEl(i)%Od = PipeOD_MudElement%Array(i) + !WRITE (*,*) 'Od', FlowEl(i)%Od + FlowEl(i)%Density = Density_MudElement%Array(i) + !WRITE (*,*) 'Density', FlowEl(i)%Density + + + FlowEl(i)%Dhyd = FlowEl(i)%Od + FlowEl(i)%Length = ABS(FlowEl(i)%EndX - FlowEl(i)%StartX) + !WRITE (*,*) 'Length', FlowEl(i)%Length + FlowEl(i)%DepthDiff = ABS(FlowEl(i)%StartTVD - FlowEl(i)%EndTVD) + !WRITE (*,*) 'DepthDiff', FlowEl(i)%DepthDiff + FlowEl(i)%Area = PI / 4.0 * FlowEl(i)%Od**2 / Convfttoinch**2 + FlowEl(i)%Volume = FlowEl(i)%Area * REAL(FlowEl(i)%Length) + IF (MudType_MudElement%Array(i) == 0) THEN ! = 0 for mud, = 1 for gas kick, = 4 for air + FlowEl(i)%MaterialType = 0 + ELSE IF (MudType_MudElement%Array(i) == 4) THEN + FlowEl(i)%MaterialType = 4 + ELSE + FlowEl(i)%MaterialType = 1 + END IF + + IF (FlowEl(i)%MaterialType == 1 .OR. FlowEl(i)%MaterialType == 4) THEN + FlowEl(i)%dPdLgrav = 0.0 + ELSE + FlowEl(i)%dPdLgrav = 0.052 * FlowEl(i)%Density + END IF + FlowEl(i)%StaticPressDiff = FlowEl(i)%dPdLgrav * REAL(FlowEl(i)%DepthDiff) + + !WRITE (*,*) 'S density, length, DeltaPStatic' , i, FlowEl(i)%density , FlowEl(i)%length, FlowEl(i)%StaticPressDiff, FlowEl(i)%MaterialType + + + + END DO + !WRITE (*,*) 'inlet and outlet mud theta600' , FlowEl(1)%Theta600 , FlowEl(NumbEl)%Theta600 + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + !!!!!!!!!!!!!!!!!!!!!!!!!!!! Annulus + !WRITE (*,*) 'A', NoAnnulusEl + AnnulusFirstEl = NoHorizontalEl + NoStringEl + 1 + AnnulusLastEl = NoHorizontalEl + NoStringEl + NoAnnulusEl + DO i = NoHorizontalEl + NoStringEl + 1 , NoHorizontalEl + NoStringEl + NoAnnulusEl + FlowEl(i)%StartX = Xstart_MudElement%Array(i) + FlowEl(i)%EndX = Xend_MudElement%Array(i) + FlowEl(i)%StartTVD = TVDstart_MudElement%Array(i) + FlowEl(i)%EndTVD = TVDend_MudElement%Array(i) + FlowEl(i)%Id = PipeID_MudElement%Array(i) + FlowEl(i)%Od = PipeOD_MudElement%Array(i) + FlowEl(i)%Density = Density_MudElement%Array(i) + + FlowEl(i)%Dhyd = FlowEl(i)%Od - FlowEl(i)%Id + FlowEl(i)%Length = ABS(FlowEl(i)%EndX - FlowEl(i)%StartX) + FlowEl(i)%DepthDiff = ABS(FlowEl(i)%StartTVD - FlowEl(i)%EndTVD) + FlowEl(i)%Area = PI / 4.0 * (FlowEl(i)%Od**2 - FlowEl(i)%Id**2) / Convfttoinch**2 + FlowEl(i)%Volume = FlowEl(i)%Area * REAL(FlowEl(i)%Length) + IF (MudType_MudElement%Array(i) == 0) THEN ! = 0 for mud, = 1 for gas kick, = 4 for air + FlowEl(i)%MaterialType = 0 + ELSE IF (MudType_MudElement%Array(i) == 4) THEN + FlowEl(i)%MaterialType = 4 + ELSE + FlowEl(i)%MaterialType = 1 + END IF + + IF (FlowEl(i)%MaterialType == 1 .OR. FlowEl(i)%MaterialType == 4) THEN + FlowEl(i)%dPdLgrav = 0.0 + ELSE + FlowEl(i)%dPdLgrav = 0.052 * FlowEl(i)%density + END IF + FlowEl(i)%StaticPressDiff = FlowEl(i)%dPdLgrav * REAL(FlowEl(i)%DepthDiff) + + !WRITE (*,*) 'A density, length, Type of ith element' , i, FlowEl(i)%density , FlowEl(i)%length, FlowEl(i)%MaterialType + + + END DO + !WRITE (*,*) 'inlet and outlet mud theta600' , FlowEl(1)%Theta600 , FlowEl(NumbEl)%Theta600 + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + !!!!!!!!!!!!!!! Well to choke manifold path + !ChokeFirstEl = AnnulusLastEl + 1 + !ChokeLastEl = OpenholeFirstEl - 1 + j = 1 + DO i = NoHorizontalEl + NoStringEl + NoAnnulusEl + 1 , NoHorizontalEl + NoStringEl + NoAnnulusEl + NoWelltoChokeEl + FlowEl(i)%StartX = ChokeLine_Mud_Backhead_X%Array(j) + FlowEl(i)%EndX = ChokeLine_Mud_Forehead_X%Array(j) + FlowEl(i)%StartTVD = 0.d0 + FlowEl(i)%EndTVD = 0.d0 + FlowEl(i)%Id = 0.0 + FlowEl(i)%Od = ChokeLineID + FlowEl(i)%density = ChokeLine_Density%Array(j) + + FlowEl(i)%Dhyd = FlowEl(i)%Od + FlowEl(i)%Length = ABS(FlowEl(i)%EndX - FlowEl(i)%StartX) + FlowEl(i)%DepthDiff = 0.d0 + FlowEl(i)%Area = PI / 4.0 * FlowEl(i)%Od**2 / Convfttoinch**2 + FlowEl(i)%Volume = FlowEl(i)%Area * REAL(FlowEl(i)%Length) + IF (ChokeLine_MudOrKick%Array(j) == 0 .OR. ChokeLine_MudOrKick%Array(j) == 4) THEN ! = 0 for mud, = 1 for gas kick, = 4 for air + FlowEl(i)%MaterialType = ChokeLine_MudOrKick%Array(j) + ELSE + FlowEl(i)%MaterialType = 1 + END IF + + + FlowEl(i)%dPdLgrav = 0.0 + FlowEl(i)%StaticPressDiff = 0.0 + + !WRITE (*,*) 'Ch density, length, Type' , i, FlowEl(i)%density , FlowEl(i)%length, FlowEl(i)%MaterialType + + j = j + 1 + + END DO + + !WRITE (*,*) 'inlet and outlet mud theta600' , FlowEl(1)%Theta600 , FlowEl(NumbEl)%Theta600 + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + !!!!!!!!!!!!!!! Open Hole + OpenholeFirstEl = NoHorizontalEl + NoStringEl + NoAnnulusEl + NoWelltoChokeEl + 1 + j = 1 + DO i = OpenholeFirstEl , NumbEl ! = NoHorizontalEl + NoStringEl + NoCasingEl + NoOpenHoleEl + FlowEl(i)%StartX = Xstart_OpMudElement%Array(j) + FlowEl(i)%EndX = Xend_OpMudElement%Array(j) + FlowEl(i)%StartTVD = TVDstart_OpMudElement%Array(j) + FlowEl(i)%EndTVD = TVDend_OpMudElement%Array(j) + FlowEl(i)%Id = 0.0 + FlowEl(i)%Od = PipeOD_OpMudElement%Array(j) + FlowEl(i)%density = Density_OpMudElement%Array(j) + FlowEl(i)%MaterialType = MudTypeOP_MudElement%Array(j) ! = 0 for mud, = 1 for gas kick, = 4 for air + + FlowEl(i)%Dhyd = FlowEl(i)%Od + FlowEl(i)%Length = ABS(FlowEl(i)%EndX - FlowEl(i)%StartX) + FlowEl(i)%DepthDiff = ABS(FlowEl(i)%StartTVD - FlowEl(i)%EndTVD) + FlowEl(i)%Area = PI / 4.0 * FlowEl(i)%Od**2 / Convfttoinch**2 + FlowEl(i)%Volume = FlowEl(i)%Area * REAL(FlowEl(i)%Length) + IF (MudTypeOp_MudElement%Array(j) == 0) THEN ! = 0 for mud, = 1 for gas kick, = 4 for air + FlowEl(i)%MaterialType = 0 + ELSE IF (MudTypeOp_MudElement%Array(j) == 4) THEN + FlowEl(i)%MaterialType = 4 + ELSE + FlowEl(i)%MaterialType = 1 + END IF + + j = j + 1 + IF (FlowEl(i)%MaterialType == 1) THEN + FlowEl(i)%dPdLgrav = 0.0 + ELSE + FlowEl(i)%dPdLgrav = 0.052 * FlowEl(i)%density + END IF + FlowEl(i)%StaticPressDiff = FlowEl(i)%dPdLgrav * REAL(FlowEl(i)%DepthDiff) + + !WRITE (*,*) 'O density, length, Type of ith element' , i, FlowEl(i)%density , FlowEl(i)%length, FlowEl(i)%MaterialType + + END DO + !WRITE (*,*) 'inlet and outlet mud theta600' , FlowEl(1)%Theta600 , FlowEl(NumbEl)%Theta600 + + !DO i = NoHorizontalEl + 1, NoHorizontalEl + NoStringEl + ! WRITE (*,*) 'element No, Start , Length, DeltaPSt', i, FlowEl(i)%StartX, FlowEl(i)%Length, FlowEl(i)%StaticPressDiff + !END DO +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!!!!!!!!!!!!!!!!!! Mud Element Viscosity Calculation + + DO i = 1 , NumbEl + IF (FlowEl(i)%MaterialType /= 0) CYCLE + IF (FlowEl(i)%density < 8.33) THEN + WRITE (*,*) 'H, S, A, Ch, O', NoHorizontalEl , StringFirstEl , AnnulusFirstEl , NoWellToChokeEl , OpenHoleFirstEl + + WRITE (*,*) 'Element No, Volume(gal), Density(ppg), Type' + DO j = 1 , NumbEl + WRITE (*,*) j, FlowEl(j)%Volume * ConvFt3toUSGal , FlowEl(j)%Density, FlowEl(j)%MaterialType + END DO + + CALL ErrorStop('Density below water density (8.33)', i) + CYCLE + END IF + + FlowEl(i)%Theta600 = Theta600Refrence + 11.0 * (MAX(FlowEl(i)%density , 8.33) - DensityRefrence) + FlowEl(i)%Theta300 = Theta300Refrence + 6.0 * (MAX(FlowEl(i)%density , 8.33) - DensityRefrence) + !WRITE (*,*) 'i, Theta600, Theta600', i, FlowEl(i)%Theta600, FlowEl(i)%Theta300 + END DO +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + FlowEl(:)%FlowRate = 0.0 + FlowEl(:)%StartPress = 0.0 + FlowEl(:)%EndPress = 0.0 + + !WRITE (*,*) 'NoGasPocket=' , SIZE(GasPocketWeight%Array) + + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + OpenArea32 = ((LeftManualChoke * (1.0 - ManChoke1Plug * REAL(ManualChoke1PluggedPercent)) / 100.0) + 0.5 * ManChoke1Washout) * ChokeAreaFullyOpen + OpenArea33 = CHOOKE(1)%AreaChokeFinal * Convfttoinch**2 ! (1.d0 - CHOOKE(1)%PercentClose) * ChokeAreaFullyOpen + OpenArea34 = CHOOKE(2)%AreaChokeFinal * Convfttoinch**2 ! (1.d0 - CHOOKE(2)%PercentClose) * ChokeAreaFullyOpen + OpenArea35 = ((RightManualChoke * (1.0 - ManChoke2Plug * REAL(ManualChoke2PluggedPercent)) / 100.0) + 0.5 * ManChoke2Washout) * ChokeAreaFullyOpen + !write(*,*) 'OpenArea32=' , OpenArea32, active32, ManChoke1Plug, ManualChoke1PluggedPercent, ManChoke1Washout + !write(*,*) 'OpenArea33=' , OpenArea33, active33 + !write(*,*) 'OpenArea34=' , OpenArea34, active34, !HydraulicChoke2PluggedPercent + !write(*,*) 'OpenArea35=' , OpenArea35, active35, ManChoke2Plug, ManualChoke2PluggedPercent, ManChoke2Washout + InstantaneousTotalOpenChokeArea = OpenArea32 * active32 + OpenArea33 * active33 + OpenArea34 * active34 + OpenArea35 * active35 + ChokeBypassArea * active29 + OldTotalOpenChokeArea = TotalOpenChokeArea + !WRITE (*,*) 'Instantaneous / Old TotalOpenChokeArea', InstantaneousTotalOpenChokeArea, OldTotalOpenChokeArea + IF (OldTotalOpenChokeArea <= 0.01 * ChokeAreaFullyOpen) OldTotalOpenChokeArea = 0.01 * ChokeAreaFullyOpen + IF (InstantaneousTotalOpenChokeArea <= 0.01 * ChokeAreaFullyOpen) THEN + WellToChokeManifoldOpen = .FALSE. + OldTotalOpenChokeArea = 0.01 * ChokeAreaFullyOpen + !WRITE (*,*) ' Choke Controler Here 2' + + ELSE IF (InstantaneousTotalOpenChokeArea > 0.5 * ChokeAreaFullyOpen .OR. WelltoPitsOpen) THEN + ! mud flows through well to bell nipple, or choke is rather open + TotalOpenChokeArea = InstantaneousTotalOpenChokeArea + !WRITE (*,*) ' Choke Controler Here 1' + ELSE + IF (InstantaneousTotalOpenChokeArea > OldTotalOpenChokeArea) THEN + TotalOpenChokeArea = MIN(1.1 * OldTotalOpenChokeArea , InstantaneousTotalOpenChokeArea) + WRITE (*,*) ' Choke is opening' !, TotalOpenChokeArea, OldTotalOpenChokeArea, InstantaneousTotalOpenChokeArea + ELSE IF (InstantaneousTotalOpenChokeArea < OldTotalOpenChokeArea) THEN + TotalOpenChokeArea = MAX(0.9 * OldTotalOpenChokeArea , InstantaneousTotalOpenChokeArea) + WRITE (*,*) ' Choke is closing' !, TotalOpenChokeArea, OldTotalOpenChokeArea, InstantaneousTotalOpenChokeArea + !ExitMass = 0.1 * ExitMass ! for decreasing mass exit due to expansion + ELSE + TotalOpenChokeArea = InstantaneousTotalOpenChokeArea + END IF + END IF + !WRITE (*,*) 'TotalOpenChokeArea=', TotalOpenChokeArea + + + + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!!!!!!!!!!!!!!!!!!!! Well Head Condition ( Open or Closed ) + ChokeKroneckerDelta = 0 + !WRITE (*,*) ' WelltoPitsOpen = ', WelltoPitsOpen + !WRITE (*,*) ' WellToChokeManifoldOpen = ', WellToChokeManifoldOpen + IF (WelltoPitsOpen == .FALSE. .AND. WellToChokeManifoldOpen == .FALSE.) THEN + !WRITE (*,*) ' WelltoPitsOpen = ', WelltoPitsOpen + !WRITE (*,*) ' WellToChokeManifoldOpen = ', WellToChokeManifoldOpen + + WellHeadOpen = .FALSE. + !WRITE (*,*) ' Well Head is closed ' + ELSE + WellHeadOpen = .TRUE. + END IF + + IF (WelltoPitsOpen == .FALSE. .AND. WellToChokeManifoldOpen) ChokeKroneckerDelta = 1 + !WRITE (*,*) ' WelltoPitsOpen=' , WelltoPitsOpen, 'WellToChokeManifoldOpen= ' , WellToChokeManifoldOpen + !WRITE (*,*) 'WellToChokeOpen , WellToChokeWasOpen', WellToChokeManifoldOpen, WellToChokeManifoldWasOpen +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + IF (NoGasPocket > 0) THEN + !IF (NoWelltoChokeEl > 0 .AND. (FlowEl(OpenholeFirstEl - 1)%MaterialType == 1 .OR. KickWasExitingThroughChoke) .AND. WellHeadOpen) THEN + IF (Choke_Kick_Saved_Volume_Final > 0.d0) THEN + !WRITE (*,*) 'Choke_Kick_Saved_Volume_Final=', Choke_Kick_Saved_Volume_Final, (GasPocketModifiedVol%Array(NoGasPocket) * Convft3ToUSgal) + ExitMass = REAL(Choke_Kick_Saved_Volume_Final / (GasPocketModifiedVol%Array(NoGasPocket) * Convft3ToUSgal)) * GasPocketWeight%Array(NoGasPocket) + !IF (NoGasPocket > 1) ExitMass = ExitMass + (SUM(GasPocketDeltaVol%Array(1 : NoGasPocket - 1)) / GasPocketNewVol%Array(NoGasPocket)) * GasPocketWeight%Array(NoGasPocket) + !WRITE (*,*) 'Total Exit mass=' , ExitMass !, DeltaVolumePipe, StringFlowRate * dt / ConvMinToSec + IF (FlowEl(OpenholeFirstEl - 1)%MaterialType /= 1) THEN + CALL RemoveGasPocket(NoGasPocket) + WRITE (*,*) 'Choke_Kick_Saved_Volume_Final=', Choke_Kick_Saved_Volume_Final + END IF + + END IF + + + !NoGasPocket = SIZE(GasPocketWeight%Array) + IF (NoGasPocket > 0) CALL GasPocketFlowElementTransformer + END IF + + IF (NoWelltoChokeEl > 0) THEN + OldChokeDensity = ChokeDensity + !ChokeDensity = SUM(FlowEl(AnnulusLastEl + 1 : OpenholeFirstEl - 1)%Density * FlowEl(AnnulusLastEl + 1 : OpenholeFirstEl - 1)%Volume) / SUM(FlowEl(AnnulusLastEl + 1 : OpenholeFirstEl - 1)%Volume) + !ChokeDensity = MAX(ChokeDensity , ChokeMinDensity) + VolumeDensityProduct = 0.0 + Do i = AnnulusLastEl + 1 , OpenholeFirstEl - 1 + VolumeDensityProduct = VolumeDensityProduct + ((MAX(FlowEl(i)%Density , ChokeMinDensity)) * FlowEl(i)%Volume) + End Do + ChokeDensity = VolumeDensityProduct / SUM(FlowEl(AnnulusLastEl + 1 : OpenholeFirstEl - 1)%Volume) + + !IF ((ChokeDensity - OldChokeDensity) > (MaxChokeDensityChange * dt / Convmintosec)) THEN + ! ChokeDensity = OldChokeDensity + (MaxChokeDensityChange * dt / Convmintosec) + !ELSE IF ((OldChokeDensity - ChokeDensity) > (MaxChokeDensityChange * dt / Convmintosec)) THEN + ! ChokeDensity = OldChokeDensity - (MaxChokeDensityChange * dt / Convmintosec) + !END IF + + !WRITE (*,*) 'ChokeDensity=', ChokeDensity + Kchoke = (ChokeDensity / ((2.0 * 89158.0) * (0.26 * 0.61 * TotalOpenChokeArea)**2)) * 4.d0 ! *4.d0: seyyed gofte + END IF + + IF (BitTotallyPluged == .FALSE.) THEN + KBit = FlowEl(StringLastEl)%density / 12042.0 / BitCd**2 / BitTotNozzArea**2 + END IF + + + +END SUBROUTINE WellPressureDataTransfer + + +SUBROUTINE GasPocketFlowElementTransformer + + !! This Subroutine makes relationship between fluid flow elements and gas pocket elements + !! The main variable of this subroutine is GasPocketFlowEl + !! For each gas pocket, GasPocketFlowEl has a row, which columns are numbers of flow elements which are contains that gas pocket + !! For example, if we have two gas pockets and they are in (7,8) and (12,3,4) flow elements respectively, + !! GasPocketFlowEl(1,:) = [12 , 3 , 4] and GasPocketFlowEl(2,:) = [7 , 8 , 0] + + + USE FricPressDropVars + USE MudSystemVARIABLES + USE GeoElements_FluidModule + USE Fluid_Flow_Startup_Vars + USE KickVariables + USE CMudPropertiesVariables + USE CBopStackVariables + USE CDownHoleVariables + USE CError + + IMPLICIT NONE + + INTEGER :: i , j , k + REAL :: PressureCorrection + PressureCorrection = 1.0 + + ALLOCATE(GasPocketFlowEl(NoGasPocket , 1)) + GasPocketFlowEl(:,:) = 0 + !WRITE (*,*) 'NoGasPocket=' , NoGasPocket + + i = 1 + j = 1 + DO k = OpenholeFirstEl , NumbEl + IF (FlowEl(k)%MaterialType == 1) THEN + IF (j > 1) THEN + IF (GasPocketFlowEl(i , j - 1) /= k - 1) THEN + i = i + 1 + j = 1 + END IF + END IF + + IF (SIZE(GasPocketFlowEl , dim = 2) < j) THEN + ALLOCATE(tempGasPocketFlowEl(SIZE(GasPocketFlowEl , dim = 1) , SIZE(GasPocketFlowEl , dim = 2))) + tempGasPocketFlowEl = GasPocketFlowEl + DEALLOCATE(GasPocketFlowEl) + ALLOCATE(GasPocketFlowEl(SIZE(tempGasPocketFlowEl , dim = 1) , SIZE(tempGasPocketFlowEl , dim = 2) + 1)) + GasPocketFlowEl(: , 1 : SIZE(tempGasPocketFlowEl , dim = 2)) = tempGasPocketFlowEl + GasPocketFlowEl(: , SIZE(GasPocketFlowEl , dim = 2)) = 0 + DEALLOCATE(tempGasPocketFlowEl) + END IF + + GasPocketFlowEl(i , j) = k + j = j + 1 + END IF + END DO + !WRITE (*,*) 'GasPocketFlowEl=' , GasPocketFlowEl + + DO k = AnnulusFirstEl , OpenholeFirstEl - 1 + IF (FlowEl(k)%MaterialType == 1) THEN + IF (j > 1) THEN + IF (k == AnnulusFirstEl .AND. GasPocketFlowEl(i , j - 1) == NumbEl) THEN + !WRITE (*,*) 'Kick is Around Bit' + ELSE IF (GasPocketFlowEl(i , j - 1) /= k - 1) THEN + i = i + 1 + j = 1 + !WRITE (*,*) 'i, j, k', i, j, k, FlowEl(k)%MaterialType + END IF + END IF + + IF (j > SIZE(GasPocketFlowEl , dim = 2)) THEN + ALLOCATE(tempGasPocketFlowEl(SIZE(GasPocketFlowEl , dim = 1) , SIZE(GasPocketFlowEl , dim = 2))) + tempGasPocketFlowEl = GasPocketFlowEl + DEALLOCATE(GasPocketFlowEl) + ALLOCATE(GasPocketFlowEl(SIZE(tempGasPocketFlowEl , dim = 1) , SIZE(tempGasPocketFlowEl , dim = 2) + 1)) + GasPocketFlowEl(: , 1 : SIZE(tempGasPocketFlowEl , dim = 2)) = tempGasPocketFlowEl + GasPocketFlowEl(: , SIZE(GasPocketFlowEl , dim = 2)) = 0 + DEALLOCATE(tempGasPocketFlowEl) + END IF + IF (i > NoGasPocket) THEN + WRITE (*,*) 'GasPocketFlowEl', GasPocketFlowEl + WRITE (*,*) 'i , j , k', i, j, k + WRITE (*,*) 'H, S, A, Ch, O', NoHorizontalEl , StringFirstEl , AnnulusFirstEl , NoWellToChokeEl , OpenHoleFirstEl + + WRITE (*,*) 'Element No, Volume(gal), Density(ppg), Type' + DO j = 1 , NumbEl + WRITE (*,*) j, FlowEl(j)%Volume * ConvFt3toUSGal , FlowEl(j)%Density, FlowEl(j)%MaterialType + END DO + !WRITE (*,*) 'Op Last: Volume(gal), Type', NumbEl, FlowEl(NumbEl)%Volume * ConvFt3ToUSgal , FlowEl(NumbEl)%MaterialType + !WRITE (*,*) 'Ann First: Volume(gal), Type', AnnulusFirstEl, FlowEl(AnnulusFirstEl)%Volume * ConvFt3ToUSgal , FlowEl(AnnulusFirstEl)%MaterialType + !IF (ChokeKroneckerDelta == 1) THEN + ! WRITE (*,*) 'Ann Last: Volume(gal), Type', AnnulusLastEl, FlowEl(AnnulusLastEl)%Volume * ConvFt3ToUSgal , FlowEl(AnnulusLastEl)%MaterialType + ! WRITE (*,*) 'Ch First: Volume(gal), Type', AnnulusLastEl + 1 , FlowEl(AnnulusLastEl + 1)%Volume * ConvFt3ToUSgal , FlowEl(AnnulusLastEl + 1)%MaterialType + !END IF + + CALL ErrorStop('Error in calculating GasPocketFlowEl') + END IF + + GasPocketFlowEl(i , j) = k + !WRITE (*,*) 'GasPocketFlowEl=' , GasPocketFlowEl + j = j + 1 + + END IF + !IF (i > NoGasPocket) CALL ErrorStop('Error in GasPocketFlowEl' , i) + END DO + + !i = SIZE(GasPocketFlowEl , dim = 1) + !j = SIZE(GasPocketFlowEl , dim = 2) + !WRITE(*,*) 'GasPocketFlowEl Data' , GasPocketFlowEl + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + GasPocketModifiedVol%Array(:) = 0.d0 + + DO i = 1 , NoGasPocket + !WRITE(*,*) 'GasPocketFlowEl Data' , i , GasPocketFlowEl(: , i) + DO j = 1 , SIZE(GasPocketFlowEl , dim = 2) + IF (GasPocketFlowEl(i , j) > 0) GasPocketModifiedVol%Array(i) = GasPocketModifiedVol%Array(i) + FlowEl(GasPocketFlowEl(i , j))%Volume + END DO + END DO + i = AnnulusLastEl + j = OpenholeFirstEl - 1 + !WRITE (*,*) ' b) GasPocketModifiedVol (ft3)=', GasPocketModifiedVol(1) + !WRITE (*,*) ' b) GasPocketModifiedVol (gal)=' , GasPocketModifiedVol(1) * 7.48 + !IF (NoWelltoChokeEl > 0 .AND. ANY(FlowEl(i : j)%MaterialType == 1) .AND. FlowEl(j)%MaterialType == 0) THEN + ! BehindKickMudDensity = FlowEl(GasPocketFlowEl(NoGasPocket , 1) - 1)%Density + ! FrontKickMudDensity = FlowEl(MAXVAL(GasPocketFlowEl(NoGasPocket , :)) + 1)%Density + ! KickVolBeforeChoke = REAL(GasPocketModifiedVol%Array(NoGasPocket)) + ! WRITE (*,*) 'BehindKickMudDensity', BehindKickMudDensity + ! WRITE (*,*) 'FrontKickMudDensity' , FrontKickMudDensity + ! WRITE (*,*) 'KickVolBeforeChoke', KickVolBeforeChoke + !END IF + + + GasPocketOldVol%Array(:) = GasPocketModifiedVol%Array(:) + + GasPocketOldPress%Array(:) = GasPocketNewPress%Array(:) + !WRITE (*,*) ' GasPocketweight%Array(1)', GasPocketweight%Array(1) + IF (GasPocketWeight%Array(1) < 0.0) CALL ErrorStop(' Error in Calculating Mass ' , KickmdotBCoef) + + + GasPocketDensity%Array(:) = (GasPocketweight%Array(:) / GasPocketModifiedVol%Array(:)) / convft3toUSgal ! [lbm/ft^3 to ppg] + DO i = 1 , SIZE(GasPocketFlowEl , dim = 1) + DO j = 1 , SIZE(GasPocketFlowEl , dim = 2) + IF (GasPocketFlowEl(i , j) > 0) FlowEl(GasPocketFlowEl(i , j))%Density = GasPocketDensity%Array(i) + END DO + END DO + + + !WRITE (*,*) 'Kick density (ppg)=' , GasPocketDensity(1) + InfluxRate = MAX(((KickmdotACoef * (KickmdotBCoef - GasPocketNewPress%Array(1))) / GasPocketDensity%Array(1) * ConvMinToSec) , 0.0) + !WRITE (*,*) ' InfluxRate (gpm) =', InfluxRate + + i = OpenholeFirstEl - 1 + !WRITE (*,*) 'MaterialType, NoWelltoChokeEl', FlowEl(i)%MaterialType , NoWelltoChokeEl + !IF (NoWelltoChokeEl > 0 .AND. FlowEl(OpenholeFirstEl - 1)%MaterialType == 1 .AND. WellHeadOpen) THEN ! kick is last element in choke line and does not exit. + IF (Choke_Kick_Saved_Volume_Final > 0.d0 .AND. WellHeadOpen) THEN + WRITE (*,*) 'Kick is exiting through the choke' + !ExitMass = GasPocketDensity%Array(NoGasPocket) * (SUM(GasPocketFlowInduced%Array(:)) + (DeltaVolumePipe * ConvMinToSec / dt) + StringFlowRate) / ConvMinToSec * dt + GasPocketWeight%Array(NoGasPocket) = GasPocketweight%Array(NoGasPocket) - ExitMass + IF (GasPocketWeight%Array(NoGasPocket) > 0.0) THEN + GasPocketOldPress%Array(NoGasPocket) = GasPocketWeight%Array(NoGasPocket) * GasType(KickGasType)%GasConstant * & + GasPocketCompressibility%Array(NoGasPocket) * GasPocketNewTemp%Array(NoGasPocket) / GasPocketModifiedVol%Array(NoGasPocket) + GasPocketDensity%Array(NoGasPocket) = (GasPocketweight%Array(NoGasPocket) / GasPocketModifiedVol%Array(NoGasPocket)) / convft3toUSgal + GasPocketNewVol%Array(:) = GasPocketOldVol%Array(:) + !FlowEl(i)%Density = GasPocketDensity%Array(NoGasPocket) ! for choke pressure drop calculation + !WRITE (*,*) 'kick weight, pressure & density', GasPocketWeight%Array(NoGasPocket), GasPocketOldPress%Array(NoGasPocket), FlowEl(i)%Density + ELSE ! gas pocket is escaped from the well completely + WRITE (*,*) ' Last Pocket Removed' + WRITE (*,*) ' GasPocketFlowEl', GasPocketFlowEl + CALL RemoveGasPocket(NoGasPocket) + + !WRITE (*,*) ' GasPocketFlowEl', GasPocketFlowEl + + END IF + + ELSE IF (NoGasPocket == 1 .OR. WellHeadOpen) THEN ! kick is not last element of choke line or well head is closed + !WRITE (*,*) ' Gas Kick Pressure (psi) (before) = ' , GasPocketNewPress(1) + !DO j = 1 , NoGasPocket + GasPocketNewPress%Array(:) = GasPocketNewPress%Array(:) * REAL(GasPocketNewVol%Array(:) / GasPocketOldVol%Array(:)) + GasPocketOldPress%Array(:) = GasPocketNewPress%Array(:) + GasPocketNewVol%Array(:) = GasPocketOldVol%Array(:) + !WRITE (*,*) ' Gas Kick Pressure (psi) (after) = ' , GasPocketOldPress(1), REAL(GasPocketNewVol(1) / GasPocketOldVol(1)) + !END DO + + ELSE ! Many gas pocket is in the well and well head is closed + +103 FORMAT (2I, 4X, (F9.3), 5X, (F9.3)) + + !WRITE (*,*) 'Before 0' + !DO i = 1 , NoGasPocket + ! WRITE (*,*) i, REAL(GasPocketNewPress%Array(i)), REAL(GasPocketNewVol%Array(i) * Convft3toUSgal), REAL(GasPocketOldVol%Array(i) * Convft3toUSgal) + !END DO + GasPocketNewPress%Array(NoGasPocket) = GasPocketOldPress%Array(NoGasPocket) + GasPocketNewVol%Array(NoGasPocket) = GasPocketCompressibility%Array(NoGasPocket) * GasType(KickGasType)%GasConstant * & + GasPocketNewTemp%Array(NoGasPocket) * GasPocketWeight%Array(NoGasPocket) / GasPocketNewPress%Array(NoGasPocket) + + + !GasPocketNewPress%Array(:) = GasPocketNewPress%Array(:) * REAL(GasPocketNewVol%Array(:) / GasPocketOldVol%Array(:)) + !GasPocketOldPress%Array(:) = GasPocketNewPress%Array(:) + + !WRITE (*,*) 'Before 1' + !DO i = 1 , NoGasPocket + ! WRITE (*,*) i, REAL(GasPocketNewPress%Array(i)), REAL((GasPocketNewVol%Array(i) * Convft3toUSgal)) + !END DO + + !WRITE (*,*) 'Mid' + DO WHILE (ABS(PressureCorrection * 10.0) > KickConvergenceTolerance) + DO j = NoGasPocket - 1 , 1 , -1 + CALL KickFunctionsCalculator(GasPocketNewPress%Array(j) , j , 5) + GasPocketNewVol%Array(j) = GasPocketCompressibility%Array(j) * GasType(KickGasType)%GasConstant * & + GasPocketNewTemp%Array(j) * GasPocketWeight%Array(j) / GasPocketNewPress%Array(j) + !WRITE (*,*) j, REAL(GasPocketNewPress%Array(j)), REAL(GasPocketNewVol%Array(j) * Convft3toUSgal) + END DO + PressureCorrection = (SUM(GasPocketNewVol%Array(:)) - SUM(GasPocketOldVol%Array(:))) / SUM(GasPocketNewVol%Array(:) / GasPocketNewPress%Array(:)) + GasPocketNewPress%Array(NoGasPocket) = GasPocketNewPress%Array(NoGasPocket) + PressureCorrection + GasPocketNewVol%Array(NoGasPocket) = GasPocketCompressibility%Array(NoGasPocket) * GasType(KickGasType)%GasConstant * & + GasPocketNewTemp%Array(NoGasPocket) * GasPocketWeight%Array(NoGasPocket) / GasPocketNewPress%Array(NoGasPocket) + j = NoGasPocket + !WRITE (*,*) j, REAL(GasPocketNewPress%Array(j)), REAL(GasPocketNewVol%Array(j) * Convft3toUSgal) + END DO + + !WRITE (*,*) 'Pressure Correction = ', PressureCorrection + WRITE (*,*) 'After' + DO i = 1 , NoGasPocket + WRITE (*,*) i, REAL(GasPocketNewPress%Array(i)), REAL((GasPocketNewVol%Array(i) * Convft3toUSgal)) + END DO + + GasPocketOldPress%Array(:) = GasPocketNewPress%Array(:) + + END IF + + + IF (GasPocketFlowEl(NoGasPocket , 1) == 0) THEN + CALL RemoveGasPocket(1) + + !WRITE (*,*) 'GasPocketFlowEl', GasPocketFlowEl + WRITE (*,*) 'First Pocket Removed' + !WRITE (*,*) 'GasPocketFlowEl', GasPocketFlowEl + END IF + + + + KickVolume = INT(SUM(GasPocketOldVol%Array(:)) * convft3toUSgal / 42. * 10.0) / 10.0 + + + !WRITE (*,*) ' Gas Kick Pressure (psi) = ' , GasPocketOldPress(1) , INT((GasPocketNewVol(1) / GasPocketOldVol(1)) * 1000.d0) / 1000.d0 + !WRITE (*,*) ' b) GasPocketNewVol (ft^3) = ' , GasPocketOldVol(1) + + + + END SUBROUTINE + + +SUBROUTINE RemoveGasPocket(ilocal) + + USE KickVARIABLES + USE MudSystemVARIABLES + + IMPLICIT NONE + + INTEGER :: ilocal + + DEALLOCATE(KickJacobian , OldKickJacobian , KickVandPFunction , KickUnknownVector , KickCorrectionVector) + + + WRITE (*,*) 'Gas Pocket Will be Removed', ilocal + call GasPocketOldPress%Remove(ilocal) + call GasPocketNewPress%Remove(ilocal) + call GasPocketOldTemp%Remove(ilocal) + call GasPocketNewTemp%Remove(ilocal) + call GasPocketOldVol%Remove(ilocal) + call GasPocketNewVol%Remove(ilocal) + call GasPocketDeltaVol%Remove(ilocal) + call GasPocketFlowInduced%Remove(ilocal) + call GasPocketModifiedVol%Remove(ilocal) + call GasPocketWeight%Remove(ilocal) + call GasPocketDensity%Remove(ilocal) + call GasPocketCompressibility%Remove(ilocal) + + NoGasPocket = NoGasPocket - 1 + + IF (NoGasPocket > 0) THEN + ALLOCATE(KickJacobian(2 * NoGasPocket , 2 * NoGasPocket) , OldKickJacobian(2 * NoGasPocket , 2 * NoGasPocket) , KickVandPFunction(2 * NoGasPocket)) + ALLOCATE(KickUnknownVector(2 * NoGasPocket) , KickCorrectionVector(2 * NoGasPocket)) + + IF (ALLOCATED(GasPocketFlowEl)) THEN + ALLOCATE(tempGasPocketFlowEl(NoGasPocket , SIZE(GasPocketFlowEl , dim = 2))) + tempGasPocketFlowEl = GasPocketFlowEl(1 : NoGasPocket , :) + DEALLOCATE(GasPocketFlowEl) + ALLOCATE(GasPocketFlowEl(SIZE(tempGasPocketFlowEl , dim = 1) , SIZE(tempGasPocketFlowEl , dim = 2))) + GasPocketFlowEl = tempGasPocketFlowEl + DEALLOCATE(tempGasPocketFlowEl) + END IF + + ELSE ! NoGasPocket = 0 + + + CALL GasPocketOldPress%Empty + CALL GasPocketNewPress%Empty + CALL GasPocketOldTemp%Empty + CALL GasPocketNewTemp%Empty + CALL GasPocketOldVol%Empty + CALL GasPocketNewVol%Empty + CALL GasPocketDeltaVol%Empty + CALL GasPocketFlowInduced%Empty + CALL GasPocketModifiedVol%Empty + CALL GasPocketWeight%Empty + CALL GasPocketDensity%Empty + + InfluxRate = 0.0 + KickVolume = 0.0 + + END IF + + !WRITE (*,*) 'Gas Pocket Removed', NoGasPocket + 1, ALLOCATED(GasPocketWeight%Array) + +END SUBROUTINE + + + + + + + \ No newline at end of file diff --git a/FluidFlow/fricpressdropvars.mod b/FluidFlow/fricpressdropvars.mod new file mode 100644 index 0000000..1300662 Binary files /dev/null and b/FluidFlow/fricpressdropvars.mod differ diff --git a/FluidFlow/kick/Formation_Information.f90 b/FluidFlow/kick/Formation_Information.f90 new file mode 100644 index 0000000..d9fa05b --- /dev/null +++ b/FluidFlow/kick/Formation_Information.f90 @@ -0,0 +1,124 @@ +SUBROUTINE FormationInformationCalculator + + USE KickVariables + Use TD_WellGeometry + Use CReservoirVariables + Use CFormationVariables + USE Fluid_Flow_Startup_Vars + USE CLog2 + USE CDownHoleVariables + USE MudSystemVARIABLES + + + IMPLICIT NONE + + INTEGER :: i + REAL(8) :: WellGeoTopTVD + + KickGasType = 1 ! methane + +!==================================================== +! Formation Length Calculation +!==================================================== + + WellGeoTopTVD = 0. + KickFormTopMD = 0. + KickFormDownMD = 0. + !===> Top Measured Depth of Formation + Do i = 1 , TD_WellIntervalsCount + if ( FormationTop >= TD_WellGeo(i)%VerticalDepth ) then + KickFormTopMD = KickFormTopMD + TD_WellGeo(i)%IntervalLength + !WRITE (*,*) ' here 11' , TD_WellGeo(i)%IntervalLength + !WRITE (*,*) ' here v11' , TD_WellGeo(i)%VerticalDepth + + WellGeoTopTVD = TD_WellGeo(i)%VerticalDepth + else if ( FormationTop < TD_WellGeo(i)%VerticalDepth ) then + if ( TD_WellGeo(i)%HoleType == 0 ) then + KickFormTopMD = KickFormTopMD + ((FormationTop - WellGeoTopTVD)& + / cos(TD_WellGeo(i)%StartAngle)) + !WRITE (*,*) ' here 12' , (FormationTop - WellGeoTopTVD) / cos(TD_WellGeo(i)%StartAngle) + + else + KickFormTopMD = KickFormTopMD + (TD_WellGeo(i)%RCurvature & + * Asin((FormationTop - WellGeoTopTVD) / TD_WellGeo(i)%RCurvature)) + !WRITE (*,*) ' here 13' , TD_WellGeo(i)%RCurvature * Asin((FormationTop - WellGeoTopTVD) / TD_WellGeo(i)%RCurvature) + + end if + exit + end if + End Do + + !!===> Down Measured Depth of Formation + WellGeoTopTVD = 0. + Do i = 1 , TD_WellIntervalsCount + if ( (FormationTop + Formations(FormationNo)%Thickness)>=TD_WellGeo(i)%VerticalDepth ) then + KickFormDownMD = KickFormDownMD + TD_WellGeo(i)%IntervalLength + WellGeoTopTVD = TD_WellGeo(i)%VerticalDepth + else if ( (FormationTop+Formations(FormationNo)%Thickness) Determination of Formation Length for Kick Modeling + if (TD_WellTotalVerticalLength >= FormationTop .AND. TD_WellTotalVerticalLength < (FormationTop+Formations(FormationNo)%Thickness)) then + KickFormLength = TD_WellTotalLength - KickFormTopMD ![ft] + else if ( TD_WellTotalVerticalLength >= (FormationTop + Formations(FormationNo)%Thickness) ) then + KickFormLength = KickFormDownMD - KickFormTopMD ![ft] + else + KickFormLength = 0. + end if + + !PermeabilityExposedHeight = KickFormLength * FormationPermeability + PermeabilityExposedHeight = FluidFlowCounter - MudSys_timeCounter +!==================================================== +! Reservoir Data +!==================================================== + FormPermeability = FormationPermeability ! [mD] + + FormPressure = TD_WellTotalVerticalLength * Formations(FormationNo)%PorePressureGradient ![psia] + FormationPressure = INT(FormPressure) + !CALL Log_2('FormPressure =' , FormPressure) + !print*, 'Formations(FormationNo)%PorePressureGradient=', Formations(FormationNo)%PorePressureGradient + !print * , 'FormationNo=' , FormationNo + !print * , 'TD_WellTotalVerticalLength=' , TD_WellTotalVerticalLength + FormTemperature = 600 ! [Ra] + !WRITE (*,*) ' Formation pressure ' , FormPressure + + +!==================================================== +! Gas Properties (Methane Gas) +!==================================================== + + GasResTemperature = FormTemperature + GasResPressure = FormPressure + + !!!! Methane , Gas type =1 + GasKickMolarMass = GasType(KickGasType)%MolarWt ! Methane Gas [gr/mol] + GasSpecGravity = GasKickMolarMass / GasDensityRefrence + + KickTc = GasType(KickGasType)%CritTemp + KickPc = GasType(KickGasType)%CritPress + + !!!!!!!! Calculating Compressibility, viscosity for influx condition (Average of reservoir and bottomhole) + KickTr = GasResTemperature / KickTc + KickPr = GasResPressure / KickPc + + K_A_Res = 3.53 * KickPr + K_B_Res = 10.0**(0.9813 * KickTr) + K_C_Res = 0.274 * (KickPr**2) + K_D_Res = 10.0**(0.8157 * KickTr) + + GasResCompressibility = 0.98 !1. - (K_A_Res / K_B_Res) + (K_C_Res / K_D_Res) + + GasReservoirDensity = GasResPressure / (GasResCompressibility * & + GasResTemperature * GasType(KickGasType)%GasConstant) / Convft3toUSgal ! [ppg] + +END SUBROUTINE + \ No newline at end of file diff --git a/FluidFlow/kick/Gas_Kick_Calculator.f90 b/FluidFlow/kick/Gas_Kick_Calculator.f90 new file mode 100644 index 0000000..29586a1 --- /dev/null +++ b/FluidFlow/kick/Gas_Kick_Calculator.f90 @@ -0,0 +1,566 @@ +SUBROUTINE GasKickCalculator + + USE KickVariables + Use TD_WellGeometry + Use CReservoirVariables + Use CFormationVariables + USE Fluid_Flow_Startup_Vars + USE PressureDisplayVARIABLES + USE FricPressDropVars + USE MudSystemVARIABLES + USE CMudPropertiesVariables + USE CError + USE , INTRINSIC :: IEEE_ARITHMETIC + + + !! Note: a subject that may be confusing is that when we use gauge pressure and when're using absolute pressure?! + !! all stated pressure are gauge pressure, so I do like this. + !! only when we want to use a state equation (like ideal gas equation), we should use absolute equation and so I do this. + !! Thus gas pocket pressure are all absolute pressure. + + IMPLICIT NONE + + INTEGER :: i , j , k , l + + SolvingEquationError = .FALSE. + KickVandPFunction(:) = 0.d0 + KickJacobian(: , :) = 0.d0 + +!==================================================== +! Gas Properties (Methane Gas) +!==================================================== + !GasPocketNewTemp%Array(1) = 600 + BottomHoleTemperature = 600 + KickFluxAvgPressure = (BottomHolePress + FormPressure) / 2 + StandardPress + KickFluxAvgTemperature = (FormTemperature + BottomHoleTemperature) / 2 + KickFluxAvgCompressibility = 0.98d0 + + K_Aa = (5.8742362 * 10.**(-3) * KickFluxAvgTemperature**1.2288) / (511.1728532 + KickFluxAvgTemperature) + K_Bb = 5.5565586 + (1000.01 / KickFluxAvgTemperature) + K_Cc = 2.47862 - 0.12294 * K_Bb + GasKickSIDensity = KickFluxAvgPressure / (KickFluxAvgCompressibility * & + KickFluxAvgTemperature * GasType(KickGasType)%GasConstant) * Convpcftogpcm3 + + GasKickViscosity = K_Aa * EXP(K_Bb * GasKickSIDensity**K_Cc) + !!!!!!!!!!!!!!!!!!!!!!!!! + + !!!!!!!!!!!!!! Calculating compressibility for bottom hole condition + !K_BHTpr = BottomHoleTemperature / KickTc + !K_BHPpr = (BottomHolePress + StandardPress) / KickPc + + !K_A_Bottomhole = 3.53 * K_BHPpr + !K_B_Bottomhole = 10.0**(0.9813 * K_BHTpr) + !K_C_Bottomhole = 0.274 * (K_BHPpr**2) + !K_D_Bottomhole = 10.0**(0.8157 * K_BHTpr) + + BottomHoleCompressibility = 0.98d0 !1. - (K_A_Bottomhole / K_B_Bottomhole) + (K_C_Bottomhole / K_D_Bottomhole) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + GasKickBg = 0.00504 * KickFluxAvgCompressibility * KickFluxAvgTemperature / KickFluxAvgPressure ![bbl/SCF] + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !WRITE (*,*) 'Gas Kick Top' +!===> Kick Flow Rate Calculation + IF (FormPressure > BottomHolePress) THEN + KickmdotACoef = 10.0**(-8) * 1.15741d0 * 7.080 * FormPermeability * REAL(KickFormLength) * GasType(KickGasType)%StDensity / & + (GasKickViscosity * GasKickBg * LOG(10000.0)) + !IF (WellHeadOpen .AND. NoGasPocket == 1) KickmdotACoef = (1.d0 + 2.d0) * KickmdotACoef + ELSE + KickmdotACoef = 0.0 + END IF + + i = StringLastEl + j = OpenholeFirstEl - 1 + k = GasPocketFlowEl(1 , 1) + KickmdotBCoef = FormPressure + StandardPress !! - Sum(static and friction pressure loss) of flow elements below gas pocket, see below + IF (FormPressure > BottomHolePress) THEN + + !WRITE (*,*) 'k , i, j' , k , i, j + IF (k >= OpenholeFirstEl) THEN ! Bottom of active kick is in openhole + KickmdotBCoef = KickmdotBCoef - (SUM(FlowEl(OpenholeFirstEl : k)%StaticPressDiff)) !+ SUM(FlowEl(j + 1 : GasPocketFlowEl(1 , 1) - 1)%FricPressLoss + !WRITE (*,*) '1 SUM(FlowEl(j + 1 : k)%FricPressLoss', k, SUM(FlowEl(j + 1 : k)%FricPressLoss) + ELSE IF (k < OpenholeFirstEl) THEN ! bottom of 1st gas pocket (active kick) is in annulus ond/or choke line only + KickmdotBCoef = KickmdotBCoef - SUM(FlowEl(OpenholeFirstEl : NumbEl)%StaticPressDiff) & + - (SUM(FlowEl(AnnulusFirstEl : k)%StaticPressDiff) + SUM(FlowEl(AnnulusFirstEl : k)%FricPressLoss)) + !WRITE (*,*) '2 SUM(FlowEl(j + 1 : NumbEl)%FricPressLoss', k, SUM(FlowEl(j + 1 : NumbEl)%FricPressLoss) + END IF + !WRITE (*,*) ' KickmdotBCoef=', KickmdotBCoef + END IF + !WRITE (*,*) 'Kick A, B', KickmdotACoef, KickmdotBCoef + + DO l = 1 , NoGasPocket + KickUnknownVector(2 * l - 1) = GasPocketNewVol%Array(l) + KickUnknownVector(2 * l) = GasPocketNewPress%Array(l) + END DO + + IF (WellHeadOpen) THEN + !!!!!!!!!! Calculation of functions of pocket Pressure and gas Volumes + !IF (GasPocketElementNo(1) > 0) WRITE (*,*) ' GasPocketElementNo(1) ' , GasPocketElementNo(1) + !WRITE (*,*) ' Kick Unknown Vector' , KickUnknownVector!(1) , KickUnknownVector(2) + IF (KickIteration == 1) THEN ! updating initial guess based on previous time step data + DO l = 1 , NoGasPocket + KickUnknownVector(2 * l - 1) = KickUnknownVector(2 * l - 1) + GasPocketDeltaVol%Array(l) + END DO + END IF + + KickVandPFunction(1) = KickUnknownVector(1) - GasPocketCompressibility%Array(1) * GasType(KickGasType)%GasConstant * & ! VandP(1) = V(1) + GasPocketNewTemp%Array(1) * (GasPocketWeight%Array(1) + KickmdotACoef * MAX(((KickmdotBCoef - KickUnknownVector(2)) * dt) , 0.0)) / KickUnknownVector(2) + !WRITE (*,*) 'KickVandPFunction(1)',KickVandPFunction(1) + l = 2 * NoGasPocket + CALL KickFunctionsCalculator(KickVandPFunction(l) , NoGasPocket , 2) ! VandP(last) = P(last) + !WRITE (*,*) 'KickVandPFunction(l)', l, KickVandPFunction(l) + DO l = 2 , NoGasPocket ! VandP(Odd) = V(l, l > 1) + KickVandPFunction(2 * l - 1) = KickUnknownVector(2 * l - 1) - GasPocketCompressibility%Array(l) * GasType(KickGasType)%GasConstant * & + GasPocketNewTemp%Array(l) * GasPocketWeight%Array(l) / KickUnknownVector(2 * l) + !WRITE(*,*) 'KickVandPFunction(V)', l, KickVandPFunction(2 * l - 1) + END DO + + DO l = NoGasPocket - 1 , 1 , -1 + CALL KickFunctionsCalculator(KickVandPFunction(2 * l) , l , 1) ! VandP(Even) = P(l, l < NoGasPocket) + !WRITE(*,*) 'KickVandPFunction(P)', l , KickVandPFunction(2 * l) + END DO + !!!!!!!!!! END - Calculation of functions of pocket Pressure and gas Volumes + + !!!!!!!!!! Calculation of Jacobian + DO k = 1 , 2 * NoGasPocket ! Main Diagonal + KickJacobian(k , k) = 1.d0 + END DO + + KickJacobian(1,2) = (GasPocketCompressibility%Array(1) * GasType(KickGasType)%GasConstant * GasPocketNewTemp%Array(1) & + * (GasPocketWeight%Array(1) + KickmdotACoef * KickmdotBCoef * dt) / KickUnknownVector(2)**2) ! Row 1 Finished + IF (KickJacobian(1,2) == 0.d0) THEN + CALL Error('KickJacobian(1,2) = 0.0') + KickJacobian(1,2) = OldKickJacobian(1,2) + END IF + + !WRITE(*,*) 'KickJacobian(1,2)', KickJacobian(1,2) + + l = NoGasPocket + CALL KickFunctionsCalculator(KickJacobian(2 * l , 2 * l - 1) , NoGasPocket , 4) ! for last Row + IF (KickJacobian(2 * l , 2 * l - 1) == 0.d0) THEN + CALL Error ('KickJacobian(Last,Odd) = 0.0') + KickJacobian(2 * l , 2 * l - 1) = OldKickJacobian(2 * l , 2 * l - 1) + END IF + + DO k = NoGasPocket - 1 , 1 , -1 + KickJacobian(2 * l , 2 * k - 1) = KickJacobian(2 * l , 2 * l - 1) + END DO ! Last Row Finished + !WRITE(*,*) 'KickJacobian(2,1)', KickJacobian(2,1) + + + DO k = 2 , NoGasPocket + KickJacobian(2 * k - 1 , 2 * k) = GasPocketCompressibility%Array(k) * GasType(KickGasType)%GasConstant * GasPocketNewTemp%Array(k) & + * GasPocketWeight%Array(k) / KickUnknownVector(2 * k)**2 + + END DO ! Odd Rows (V equations) Finished + + DO k = 1 , NoGasPocket - 1 + KickJacobian(2 * k , 2 * k + 2) = -1.d0 + END DO ! Even Rows (P equations) effect of upper pocket + + DO k = 2 , 2 * (NoGasPocket - 1) , 2 + DO l = 1 , k - 1 , 2 + CALL KickFunctionsCalculator(KickJacobian(k , l) , k / 2 , 3) + IF (KickJacobian(k , l) == 0.d0) THEN + WRITE (*,*) 'Jacobian Array = 0.0', k , l + CALL Error ('KickJacobian(k , l) = 0.0') + KickJacobian(k , l) = OldKickJacobian(k , l) + END IF + END DO + END DO + + IF (ANY(IEEE_IS_NaN(KickJacobian))) CALL ErrorStop ('NaN in calculating Kick Jacobian, Call your Service Provider') + + !!!!!!!!!! Solving linear equation in order to finding correction vector for correcting pocket pressure and gas induced flowrates + KickVandPFunction = -1.d0 * KickVandPFunction + !WRITE (*,*) 'Max Remainder', MAXVAL(ABS(KickVandPFunction)) , MAXLOC(ABS(KickVandPFunction)) + !WRITE (*,*) 'SIZE(A , dim = 1), SIZE(A , dim = 2), SIZE(b)', SIZE(KickJacobian , dim = 1), SIZE(KickJacobian , dim = 2), SIZE(KickVandPFunction) + CALL SOLVE_LINEAR_EQUATIONS(KickJacobian , KickCorrectionVector , KickVandPFunction , SolvingEquationError, SIZE(KickCorrectionVector)) + IF (SolvingEquationError) CALL ErrorStop( ' Error in solving kick equation ' ) + + KickUnknownVector = KickUnknownVector + KickCorrectionUnderRelaxation * KickCorrectionVector + + DO l = 1 , NoGasPocket + GasPocketNewVol%Array(l) = KickUnknownVector(2 * l - 1) + IF (IEEE_IS_NaN(GasPocketNewVol%Array(l))) CALL ErrorStop('Volume of this pocket is Not a Number:', l) + IF (GasPocketNewVol%Array(l) <= 0.d0) CALL Error('Volume of this pocket is Negative or Zero:', l) + GasPocketNewPress%Array(l) = KickUnknownVector(2 * l) + IF (IEEE_IS_NaN(GasPocketNewPress%Array(l))) CALL ErrorStop('Pressure of this Pocket is Not a Number:', l) + IF (GasPocketNewPress%Array(l) <= 0.d0) CALL ErrorStop('Pressure of this Pocket is Negative or Zero:', l) + END DO + + + !WRITE(*,*) 'GasPocketDeltaVol (gal)' , GasPocketDeltaVol(1) * 7.48 + !WRITE (*,*) 'GasPocketFlowInduced (gpm), GasPocketNewVol' , GasPocketFlowInduced(1), GasPocketNewVol(1) + !IF (Kchoke > 0.0) + !WRITE(*,*) ' New Vol (ft3), New Press (psi)', GasPocketNewVol(1), GasPocketNewPress(1) + + ELSE ! well haed is closed, so build up process or migration occurs + + !WRITE (*,*) 'GasPocketOldPress (before)' , GasPocketOldPress(1) + GasPocketNewPress%Array(1) = GasPocketOldPress%Array(1) * & + (REAL((GasPocketWeight%Array(1) + KickmdotACoef * KickmdotBCoef * dt) / (GasPocketWeight%Array(1) + KickmdotACoef * GasPocketOldPress%Array(1) * dt))) + !WRITE (*,*) 'GasPocketNewPress (after)' , GasPocketNewPress(1), ((GasPocketWeight(1) + KickmdotACoef * KickmdotBCoef * dt) / (GasPocketWeight(1) + KickmdotACoef * GasPocketOldPress(1) * dt)) + + + !WRITE (*,*) ' Well head is closed, GasPocketNewPress =' , GasPocketNewPress(1) + !WRITE (*,*) 'Old Press, Weight, A, B' , GasPocketOldPress(1), GasPocketWeight(1), KickmdotACoef, KickmdotBCoef + !WRITE (*,*) 'Numerator and denumerator Gas kick' , KickmdotACoef * KickmdotBCoef * dt , KickmdotACoef * GasPocketOldPress(1) * dt + + !WRITE (*,*) ' Gas Kick Volume (ft^3) = ' , GasPocketNewVol(1) + + END IF + + !DO l = 1 , NoGasPocket + GasPocketDeltaVol%Array(:) = GasPocketNewVol%Array(:) - GasPocketOldVol%Array(:) + GasPocketFlowInduced%Array(:) = (GasPocketDeltaVol%Array(:)) / dt * 448.8 ! gpm + !END DO + + GasKickPumpFlowRate = 0.0 + IF (NOT(KickOffBottom) .AND. WellHeadOpen) GasKickPumpFlowRate = GasPocketFlowInduced%Array(1) + + !WRITE (*,*) ' No Iteration, KickCorrectionVector =' , KickIteration , KickCorrectionVector(1) , KickCorrectionVector(2) + !WRITE (*,*) ' Kick Jacobian ', REAL(KickJacobian) + !WRITE (*,*) ' KickVandPFunction = ' , REAL(KickVandPFunction) + !WRITE (*,*) ' Kick Unknown Vector = ' , REAL(-KickUnknownVector) + + + + !WRITE (*,*) 'Gas Kick Bottom' + + + END SUBROUTINE + + + SUBROUTINE KickFunctionsCalculator(ExitValue , GasPocketNo , CalcMode) + + + USE KickVARIABLES + USE FricPressDropVars + USE Fluid_Flow_Startup_Vars + USE CError + USE , INTRINSIC :: IEEE_Arithmetic + + + IMPLICIT NONE + + REAL(8) :: ExitValue + INTEGER :: GasPocketNo , CalcMode + INTEGER :: x + INTEGER :: y + INTEGER :: z , i , j + + x = GasPocketFlowEl(GasPocketNo , 1) + IF (GasPocketNo < NoGasPocket) y = GasPocketFlowEl(GasPocketNo + 1 , 1) + i = StringLastEl + j = OpenholeFirstEl - 1 + + ! Case 1: gas pocket is completely in OP and STARTX of upper gas pocket is also + ! Case 2: gas pocket is completely in OP and STARTX of upper gas pocket is above Bit + ! Case 3: gas pocket is AROUNDBIT and so upper gas pocket is in ANN (or Choke line) + ! Case 4: gas pocket is completely in ANN and upper gas pocket is also + + ! CalcMode 1: KickVandPFunction between 2 pocket + ! CalcMode 2: KickVandPFunction for top gas pocket + ! CalcMode 3: KickJacobian between 2 Pocket + ! CalcMode 4: KickJacobian for top (last) gas pocket + ! CalcMode 5: Calculating pressure of bottom pocket based on upper pocket + + + IF (CalcMode == 1) THEN ! calculating pressure difference between two pocket, include static pressure difference and frictional + ! pressure difference, use in calculating 'KickVandPFunction' + ExitValue = KickUnknownVector(2 * GasPocketNo) - KickUnknownVector(2 * GasPocketNo + 2) + IF (x >= OpenholeFirstEl .AND. y < OpenholeFirstEl) THEN ! Case 2 , Case 3 + ExitValue = ExitValue - SUM(FlowEl(x : NumbEl)%StaticPressDiff) - SUM(FlowEl(x : NumbEl)%FricPressLoss) & + - SUM(FlowEl(AnnulusFirstEl : y)%StaticPressDiff) - SUM(FlowEl(AnnulusFirstEl : y)%FricPressLoss) + ELSE ! Case 1 , Case 4 + ExitValue = ExitValue - SUM(FlowEl(x : y)%StaticPressDiff) - SUM(FlowEl(x : y)%FricPressLoss) + END IF + + + ELSE IF (CalcMode == 2) THEN + ExitValue = KickUnknownVector(2 * GasPocketNo) - StandardPress - Kchoke * FlowEl(OpenholeFirstEl - 1)%Flowrate**2 + IF (x >= OpenholeFirstEl) THEN ! Gas Pocket is in Openhole + ExitValue = ExitValue - SUM(FlowEl(x : NumbEl)%StaticPressDiff) - SUM(FlowEl(x : NumbEl)%FricPressLoss) & + - SUM(FlowEl(AnnulusFirstEl : OpenholeFirstEl - 1)%StaticPressDiff) - SUM(FlowEl(AnnulusFirstEl : OpenholeFirstEl - 1)%FricPressLoss) + ELSE ! Gas Pocket is in Annulus + ExitValue = ExitValue - SUM(FlowEl(x : OpenholeFirstEl - 1)%StaticPressDiff) - SUM(FlowEl(x : OpenholeFirstEl - 1)%FricPressLoss) + END IF + + + ELSE IF (CalcMode == 3) THEN ! calculating derivative of pressure difference between two pocket, relative to change in flowrate + ! use in calculating 'KickJacobian' + IF (x >= OpenholeFirstEl .AND. y < OpenholeFirstEl) THEN ! Top kick STARTX is in Annulus + DO z = x , NumbEl ! open hole elements + CALL PartialDerivativeFricToFlowRate(z) + IF (IEEE_IS_NaN(FlowEl(z)%FricToQPartialDiff)) THEN + WRITE (*,*) ' FricToQPartialDiff , GenRe ' , x , FlowEl(z)%FricToQPartialDiff , FlowEl(z)%GenRe + WRITE (*,*) ' Op start, end, density, Q, mu' , FlowEl(z)%StartX, FlowEl(z)%EndX, FlowEl(z)%Density, FlowEl(z)%FlowRate, FlowEl(z)%mueff + CALL ErrorStop('NaN in calculating partial derivative') + END IF + END DO + DO z = AnnulusFirstEl , y ! Annulus elements + CALL PartialDerivativeFricToFlowRate(z) + IF (IEEE_IS_NaN(FlowEl(z)%FricToQPartialDiff)) THEN + WRITE (*,*) ' FricToQPartialDiff , GenRe ' , x , FlowEl(z)%FricToQPartialDiff , FlowEl(z)%GenRe + WRITE (*,*) ' Op start, end, density, Q, mu' , FlowEl(z)%StartX, FlowEl(z)%EndX, FlowEl(z)%Density, FlowEl(z)%FlowRate, FlowEl(z)%mueff + CALL ErrorStop('NaN in calculating partial derivative') + END IF + END DO + ExitValue = ExitValue - (SUM(FlowEl(x : NumbEl)%FricToQPartialDiff) + SUM(FlowEl(AnnulusFirstEl : y)%FricToQPartialDiff)) * 448.8 / dt + ELSE ! both pockets are one side of bit + DO z = x , y + CALL PartialDerivativeFricToFlowRate(z) + IF (IEEE_IS_NaN(FlowEl(z)%FricToQPartialDiff)) THEN + WRITE (*,*) ' FricToQPartialDiff , GenRe ' , x , FlowEl(z)%FricToQPartialDiff , FlowEl(z)%GenRe + WRITE (*,*) ' Op start, end, density, Q, mu' , FlowEl(z)%StartX, FlowEl(z)%EndX, FlowEl(z)%Density, FlowEl(z)%FlowRate, FlowEl(z)%mueff + CALL ErrorStop('NaN in calculating partial derivative') + END IF + END DO + ExitValue = ExitValue - SUM(FlowEl(x : y)%FricToQPartialDiff) * 448.8 / dt + END IF + + + ELSE IF (CalcMode == 4) THEN ! partial derivative of frictional pressure drop relative to flowrate for top gas pocket + ExitValue = - 2.d0 * Kchoke * FlowEl(OpenholeFirstEl - 1)%Flowrate * 448.8 / dt + IF (x >= OpenholeFirstEl) THEN ! kick STARTX is in openhole + DO z = x , NumbEl ! open hole elements + CALL PartialDerivativeFricToFlowRate(z) + IF (IEEE_IS_NaN(FlowEl(z)%FricToQPartialDiff)) THEN + WRITE (*,*) ' FricToQPartialDiff , GenRe ' , x , FlowEl(z)%FricToQPartialDiff , FlowEl(z)%GenRe + WRITE (*,*) ' Op start, end, density, Q, mu' , FlowEl(z)%StartX, FlowEl(z)%EndX, FlowEl(z)%Density, FlowEl(z)%FlowRate, FlowEl(z)%mueff + CALL ErrorStop('NaN in calculating partial derivative') + END IF + END DO + DO z = AnnulusFirstEl , OpenholeFirstEl - 1 ! Annulus elements + CALL PartialDerivativeFricToFlowRate(z) + IF (IEEE_IS_NaN(FlowEl(z)%FricToQPartialDiff)) THEN + WRITE (*,*) ' FricToQPartialDiff , GenRe ' , x , FlowEl(z)%FricToQPartialDiff , FlowEl(z)%GenRe + WRITE (*,*) ' Op start, end, density, Q, mu' , FlowEl(z)%StartX, FlowEl(z)%EndX, FlowEl(z)%Density, FlowEl(z)%FlowRate, FlowEl(z)%mueff + CALL ErrorStop('NaN in calculating partial derivative') + END IF + END DO + ExitValue = ExitValue - (SUM(FlowEl(x : NumbEl)%FricToQPartialDiff) + SUM(FlowEl(AnnulusFirstEl : OpenholeFirstEl - 1)%FricToQPartialDiff)) * 448.8 / dt + ELSE + DO z = x , OpenholeFirstEl - 1 ! Annulus elements + CALL PartialDerivativeFricToFlowRate(z) + IF (IEEE_IS_NaN(FlowEl(z)%FricToQPartialDiff)) THEN + WRITE (*,*) ' FricToQPartialDiff , GenRe ' , x , FlowEl(z)%FricToQPartialDiff , FlowEl(z)%GenRe + WRITE (*,*) ' Op start, end, density, Q, mu' , FlowEl(z)%StartX, FlowEl(z)%EndX, FlowEl(z)%Density, FlowEl(z)%FlowRate, FlowEl(z)%mueff + CALL ErrorStop('NaN in calculating partial derivative') + END IF + END DO + ExitValue = ExitValue - SUM(FlowEl(x : OpenholeFirstEl - 1)%FricToQPartialDiff) * 448.8 / dt + END IF + + + ELSE IF (CalcMode == 5) THEN + IF (x >= OpenholeFirstEl .AND. y < OpenholeFirstEl) THEN ! Gas Pocket is in Openhole and upper pocket is in annulus + !WRITE (*,*) 'x , y 1' , x, y + ExitValue = GasPocketNewPress%Array(GasPocketNo + 1) + SUM(FlowEl(x : NumbEl)%StaticPressDiff) + SUM(FlowEl(AnnulusFirstEl : y)%StaticPressDiff) + ELSE ! Both gas pockets are in Annulus or openhole + !WRITE (*,*) 'x , y 2' , x, y + ExitValue = GasPocketNewPress%Array(GasPocketNo + 1) + SUM(FlowEl(x : y)%StaticPressDiff) + END IF + END IF + + + + END SUBROUTINE + + + +SUBROUTINE NewGasKick + + USE KickVariables + Use TD_WellGeometry + Use CReservoirVariables + Use CFormationVariables + USE Fluid_Flow_Startup_Vars + USE PressureDisplayVARIABLES + USE FricPressDropVars + USE MudSystemVARIABLES + USE CMudPropertiesVariables + USE CError + USE , INTRINSIC :: IEEE_ARITHMETIC + + + !! Note: a subject that may be confusing is that when we use gauge pressure and when using absolute pressure?! + !! all stated pressure are gauge pressure, so I do like this. + !! only when we want to use a state equation (like ideal gas equation), we should use absolute equation and so I do this. + !! Thus gas pocket pressure are all absolute pressure. + + IMPLICIT NONE + + INTEGER :: i , j , k , l + + IF (NOT(ALLOCATED(GasPocketWeight%Array))) THEN ! 1st kick + WRITE (*,*) ' New Influx 1' + + NoGasPocket = 1 + NewInfluxNumber = NewInfluxNumber + 1 + + NewInfluxElementCreated = 0 + KickOffBottom = .FALSE. + + + CALL GasPocketOldPress%AddToFirst((BottomHolePress + StandardPress) * 1.d0) + CALL GasPocketNewPress%AddToFirst((BottomHolePress + StandardPress) * 1.d0) + CALL GasPocketOldTemp%AddToFirst(600.0) + CALL GasPocketNewTemp%AddToFirst(600.0) + CALL GasPocketOldVol%AddToFirst(0.d0) + CALL GasPocketNewVol%AddToFirst(0.d0) + CALL GasPocketdeltaVol%AddToFirst(0.0) + CALL GasPocketFlowInduced%AddToFirst(0.0) + CALL GasPocketModifiedVol%AddToFirst(0.0) + CALL GasPocketWeight%AddToFirst(0.0) + CALL GasPocketDensity%AddToFirst(2.0) + CALL GasPocketCompressibility%AddToFirst(0.98) + + ALLOCATE(KickJacobian(2 , 2) , OldKickJacobian(2 , 2) , KickVandPFunction(2) , KickUnknownVector(2) , KickCorrectionVector(2)) + + BottomHoleTemperature = 600 + KickFluxAvgPressure = (BottomHolePress + FormPressure) / 2 + StandardPress + KickFluxAvgTemperature = (FormTemperature + BottomHoleTemperature) / 2 + KickFluxAvgCompressibility = 0.98 + + !K_Aa = (5.8742362 * 10.**(-3) * KickFluxAvgTemperature**1.2288) / (511.1728532 + KickFluxAvgTemperature) + !K_Bb = 5.5565586 + (1000.01 / KickFluxAvgTemperature) + !K_Cc = 2.47862 - 0.12294 * K_Bb + GasKickSIDensity = KickFluxAvgPressure / (KickFluxAvgCompressibility * & + KickFluxAvgTemperature * GasType(KickGasType)%GasConstant) * Convpcftogpcm3 + GasKickDensity = GasKickSIDensity * 8.3523 + + !GasKickViscosity = K_Aa * EXP(K_Bb * GasKickSIDensity**K_Cc) + ! + !K_BHTpr = BottomHoleTemperature / KickTc + !K_BHPpr = (BottomHolePress + StandardPress) / KickPc + ! + !K_A_Bottomhole = 3.53 * K_BHPpr + !K_B_Bottomhole = 10.0**(0.9813 * K_BHTpr) + !K_C_Bottomhole = 0.274 * (K_BHPpr**2) + !K_D_Bottomhole = 10.0**(0.8157 * K_BHTpr) + ! + !BottomHoleCompressibility = 0.98 !1. - (K_A_Bottomhole / K_B_Bottomhole) + (K_C_Bottomhole / K_D_Bottomhole) + ! + !GasKickBg = 0.00504 * KickFluxAvgCompressibility * KickFluxAvgTemperature / KickFluxAvgPressure ![bbl/SCF] + + + !KickmdotACoef = 10.**(-8) * 1.15741d0 * 7.08d0 * FormPermeability * REAL(KickFormLength) * GasType(KickGasType)%StDensity / & + !(GasKickViscosity * GasKickBg * LOG(10000.d0)) + !IF (WellHeadOpen) KickmdotACoef = (1.0 + 2.0) * KickmdotACoef + + !KickmdotBCoef = FormPressure + StandardPress !! - Sum(static and friction pressure loss) of flow elements below gas pocket, see below + + !GasPocketWeight%Array(1) = GasKickDensity * 0.05 !KickmdotACoef * (KickmdotBCoef - GasPocketNewPress%Array(1)) * dt + GasPocketWeight%Array(1) = GasKickDensity * MinKickVol !1.0:seyyed gofte !KickmdotACoef * (KickmdotBCoef - GasPocketNewPress%Array(1)) * dt + + GasPocketNewVol%Array(1) = GasPocketCompressibility%Array(1) * GasType(KickGasType)%GasConstant * & + GasPocketNewTemp%Array(1) * GasPocketWeight%Array(1) / GasPocketNewPress%Array(1) + + GasPocketDeltaVol%Array(1) = 0.05 !GasPocketNewVol%Array(1) + GasPocketFlowInduced%Array(1) = (GasPocketDeltaVol%Array(1)) / dt * 448.8 ! gpm + GasKickPumpFlowRate = GasPocketFlowInduced%Array(1) + + WRITE (*,*) ' FormPressure , BottomHolePress' , FormPressure , BottomHolePress, GasKickDensity + WRITE (*,*) ' No Press(psia) Vol(gal) Weight(lbm) Flow Induced(gpm)' + DO i = 1 , NoGasPocket + WRITE (*,102) i , GasPocketNewPress%Array(i), GasPocketNewVol%Array(i) * Convft3toUSgal, GasPocketWeight%Array(i), GasPocketFlowInduced%Array(i) + END DO + + !ELSE IF (NoGasPocket < MaxGasPocket .AND. KickOffBottom .AND. (GasPocketNewVol%Array(1) > MinAllowableKickVol .OR. KickWasExitingThroughChoke)) THEN + ELSE IF (NoGasPocket < MaxGasPocket .AND. KickOffBottom .AND. (GasPocketNewVol%Array(1) > MinAllowableKickVol .OR. ANY(GasPocketFlowEl(1 , :) == OpenholeFirstEl - 1))) THEN + WRITE (*,*) ' New Influx', NoGasPocket + 1 + +102 FORMAT (I2, 4X, (F8.1), 3X, (F8.3), 2X, (F8.3), 8X, (F8.3)) + + + NoGasPocket = NoGasPocket + 1 + NewInfluxNumber = NewInfluxNumber + 1 + + NewInfluxElementCreated = 0 + KickOffBottom = .FALSE. + + CALL GasPocketOldPress%AddToFirst((BottomHolePress + StandardPress) * 1.d0) + CALL GasPocketNewPress%AddToFirst((BottomHolePress + StandardPress) * 1.d0) + CALL GasPocketOldTemp%AddToFirst(600.0) + CALL GasPocketNewTemp%AddToFirst(600.0) + CALL GasPocketOldVol%AddToFirst(0.d0) + CALL GasPocketNewVol%AddToFirst(0.d0) + CALL GasPocketdeltaVol%AddToFirst(0.0) + CALL GasPocketFlowInduced%AddToFirst(0.0) + CALL GasPocketModifiedVol%AddToFirst(0.0) + CALL GasPocketWeight%AddToFirst(0.0) + CALL GasPocketDensity%AddToFirst(2.0) + CALL GasPocketCompressibility%AddToFirst(0.98) + + DEALLOCATE(KickJacobian , OldKickJacobian , KickVandPFunction , KickUnknownVector , KickCorrectionVector) + + ALLOCATE(KickJacobian(2 * NoGasPocket , 2 * NoGasPocket) , OldKickJacobian(2 * NoGasPocket , 2 * NoGasPocket)) + ALLOCATE(KickUnknownVector(2 * NoGasPocket) , KickCorrectionVector(2 * NoGasPocket) , KickVandPFunction(2 * NoGasPocket)) + + + BottomHoleTemperature = 600 + KickFluxAvgPressure = (BottomHolePress + FormPressure) / 2 + StandardPress + KickFluxAvgTemperature = (FormTemperature + BottomHoleTemperature) / 2 + KickFluxAvgCompressibility = 0.98 + + !K_Aa = (5.8742362 * 10.**(-3) * KickFluxAvgTemperature**1.2288) / (511.1728532 + KickFluxAvgTemperature) + !K_Bb = 5.5565586 + (1000.01 / KickFluxAvgTemperature) + !K_Cc = 2.47862 - 0.12294 * K_Bb + GasKickSIDensity = KickFluxAvgPressure / (KickFluxAvgCompressibility * & + KickFluxAvgTemperature * GasType(KickGasType)%GasConstant) * Convpcftogpcm3 + GasKickDensity = GasKickSIDensity * 8.3523 + + !GasKickViscosity = K_Aa * EXP(K_Bb * GasKickSIDensity**K_Cc) + ! + !K_BHTpr = BottomHoleTemperature / KickTc + !K_BHPpr = (BottomHolePress + StandardPress) / KickPc + ! + !K_A_Bottomhole = 3.53 * K_BHPpr + !K_B_Bottomhole = 10.0**(0.9813 * K_BHTpr) + !K_C_Bottomhole = 0.274 * (K_BHPpr**2) + !K_D_Bottomhole = 10.0**(0.8157 * K_BHTpr) + ! + !BottomHoleCompressibility = 0.98 !1. - (K_A_Bottomhole / K_B_Bottomhole) + (K_C_Bottomhole / K_D_Bottomhole) + ! + !GasKickBg = 0.00504 * KickFluxAvgCompressibility * KickFluxAvgTemperature / KickFluxAvgPressure ![bbl/SCF] + ! + ! + !KickmdotACoef = 10.**(-8) * 1.15741d0 * 7.08d0 * FormPermeability * REAL(KickFormLength) * GasType(KickGasType)%StDensity / & + ! (GasKickViscosity * GasKickBg * LOG(10000.d0)) + !IF (WellHeadOpen) KickmdotACoef = (1.0 + 2.0) * KickmdotACoef + ! + !KickmdotBCoef = FormPressure + StandardPress !! - Sum(static and friction pressure loss) of flow elements below gas pocket, see below + + !GasPocketWeight%Array(1) = GasKickDensity * 0.05 !KickmdotACoef * (KickmdotBCoef - GasPocketNewPress%Array(1)) * dt + GasPocketWeight%Array(1) = GasKickDensity * MinKickVol !1.0:seyyed gofte !KickmdotACoef * (KickmdotBCoef - GasPocketNewPress%Array(1)) * dt + + GasPocketNewVol%Array(1) = GasPocketCompressibility%Array(1) * GasType(KickGasType)%GasConstant * & + GasPocketNewTemp%Array(1) * GasPocketWeight%Array(1) / GasPocketNewPress%Array(1) + + GasPocketDeltaVol%Array(1) = 0.05 !GasPocketNewVol%Array(1) + GasPocketFlowInduced%Array(1) = (GasPocketDeltaVol%Array(1)) / dt * 448.8 ! gpm + GasKickPumpFlowRate = GasPocketFlowInduced%Array(1) + + WRITE (*,*) ' FormPressure , BottomHolePress' , FormPressure , BottomHolePress, GasKickDensity + WRITE (*,*) ' No Press(psia) Vol(gal) Weight(lbm) Flow Induced(gpm)' + DO i = 1 , NoGasPocket + WRITE (*,102) i , GasPocketNewPress%Array(i), GasPocketNewVol%Array(i) * Convft3toUSgal, GasPocketWeight%Array(i), GasPocketFlowInduced%Array(i) + END DO + + ELSE ! no new kick, so mass of 1st kick should increase + GasPocketWeight%Array(1) = GasPocketweight%Array(1) + KickmdotACoef * (KickmdotBCoef - GasPocketNewPress%Array(1)) * dt + GasKickPumpFlowRate = GasPocketFlowInduced%Array(1) + + IF (NoGasPocket > 1 .OR. SecondaryKickWeight > 0.0) THEN + SecondaryKickWeight = SecondaryKickWeight + KickmdotACoef * (KickmdotBCoef - GasPocketNewPress%Array(1)) * dt + SecondaryKickVol = SecondaryKickWeight / GasReservoirDensity / 42.0 ! 42 USGal = 1bbl + END IF + + END IF + + +END SUBROUTINE + \ No newline at end of file diff --git a/FluidFlow/kick/Kick_VARIABLES.f90 b/FluidFlow/kick/Kick_VARIABLES.f90 new file mode 100644 index 0000000..b7efd7f --- /dev/null +++ b/FluidFlow/kick/Kick_VARIABLES.f90 @@ -0,0 +1,95 @@ +MODULE KickVARIABLES + + USE DynamicDoubleArray + USE DynamicIntegerArray + USE DynamicRealArray + + IMPLICIT NONE + + + REAL :: DrillStringSpeed ! drill string speed during surge and swab [ft/s] + + REAL :: ChokeDensity , OldChokeDensity ! density of fluid that exits through choke [ppg] + REAL :: ChokeMinDensity ! [ppg] + REAL :: MaxChokeDensityChange ! [ppg/min] + + + INTEGER :: TotalGasKicks ! Number of gas kicks enetered well + REAL :: GasKickMolarMass ! molar mass of gas kick [lbm/lbmole] + REAL :: GasKickBg ! Gas formation volume factor [bbl/SCF] + REAL :: GasResPressure , GasResTemperature , GasResCompressibility ! pressure [psi] , temperature [R] and compressibility [-] at reservoir condition + REAL :: GasReservoirDensity ! density of gas kick in reservoir condition [ppg] + REAL :: BottomHolePress , BottomHoleTemperature , BottomHoleCompressibility ! pressure [psi] , temperature [R] and compressibility [-] at bottom hole condition + REAL :: KickFluxAvgTemperature , KickFluxAvgPressure , KickFluxAvgCompressibility ! Average pressure [psia] and temperature [R] for calculating gas kick flux + REAL :: GasKickViscosity ! Gas kick viscosity at average condition [cp] + REAL :: GasKickSIDensity ! density of gas kick in average condition and in SI units [gr/cm^3] + REAL :: GasKickDensity ! [ppg] + REAL :: GasKickPumpFlowRate ! change of volume of gas kick in sense of flow rate [gpm] + REAL :: FormPressure , FormTemperature + REAL(8) :: KickFormLength , KickFormTopMD , KickFormDownMD ! [ft] + REAL :: FormPermeability ! formation permeability [mD] + REAL :: GasSpecGravity ! specific gravity of gas kick relative to air [-] + REAL :: KickTc , KickPc ! critical temperature [R] and pressure [psi] of gas kick + REAL :: KickTr , KickPr ! Reduced temperature and pressure of gas kick at reservoir condition + REAL :: K_BHTpr , K_BHPpr ! Reduced temperature and pressure of gas kick at bottom hole condition + REAL :: K_A_Res , K_B_Res , K_C_Res , K_D_Res ! Coefficients in calculating compressibility at reservoir condition + REAL :: K_A_Bottomhole , K_B_Bottomhole , K_C_Bottomhole , K_D_Bottomhole + ! Coefficients in calculating compressibility at bottomhole condition + REAL :: K_Aa , K_Bb , K_Cc ! Coefficient in calculating gas viscosity at reservoir condition + REAL :: MinKickVol ! minimum of kick volume at the beginning of entrance to wellbore [gal] + REAL :: MinAllowableKickVol ! minimum allowable kick volume [ft^3] + REAL :: SecondaryKickVol ! Volume of kicks other than first kick in reservoir condition [bbl] + REAL :: SecondaryKickWeight ! Weight of kicks other than first kick in reservoir condition [lbm] + + + REAL :: Kickmdot ! mass flow rate of kick [lbm/sec] + REAL :: ExitMass ! escaped mass from choke [lbm] + REAL :: KickmdotACoef ! coefficient in calculating mdot of kick, Eqn. 5 handnote [lbm/(sec.psi)] + REAL :: KickmdotBCoef ! coefficient in calculating mdot of kick, Eqn. 5 handnote [psi] + + LOGICAL :: KickFlux ! .TRUE. = Bottomhole pressure is lower than reservoir pressure and thus gas + ! enters the bottomhole. + LOGICAL :: KickInFluxConditions ! a set of conditions, when all are true, this variable will become true + LOGICAL :: WellHeadOpen ! .TRUE. = wellhead is open or flow on choke line + ! .FALSE. = wellhead is close and no fluid flow out + LOGICAL :: WellHeadWasOpen ! well Head Condition in last time step + LOGICAL :: WellToChokeManifoldWasOpen + LOGICAL :: KickOffBottom ! .TRUE. = kick starts to rise up + LOGICAL :: KickSinglePocket ! when 'MakeKickSinglePacket' is active, only one pocket of kick exists in the well. + LOGICAL :: SolvingEquationError + LOGICAL :: KickWasExitingThroughChoke + LOGICAL :: ChokeIsClosing + + INTEGER :: NoGasPocket ! number of gas pockets (not gas kick) in wellbore which may migrate or expand + INTEGER :: KickIteration ! the number of itertion for calculating pressure and flowrate, when kick is in the well + INTEGER :: KickType ! = 0 for gas kicks , = 1 for oil kicks and = 2 for water kicks + INTEGER :: KickGasType ! = 1 for methane , = 2 for Hydrogen sulfide + INTEGER :: ChokeKroneckerDelta ! if well to choke manifold is open and well to pit is closed ChokeKroneckerDelta = 1 + INTEGER :: MaxGasPocket ! = 1 if 'single pocket model' is on and = 15 if 'single pocket model' is off + + !!!!!!!!!!!!!!!!!!!!!!! Gas Pockets Data + TYPE(DynamicDoubleArrayType) :: GasPocketOldPress , GasPocketOldVol ! pressure and volume of gas pocket at the beginning of time step [psia , ft^3] + TYPE(DynamicDoubleArrayType) :: GasPocketNewPress , GasPocketNewVol ! pressure and volume of gas pocket at the end of time step [psia , ft^3] + TYPE(DynamicRealArrayType) :: GasPocketOldTemp , GasPocketNewTemp ! temperature at the beginning (old) and at the end of time step [R] + TYPE(DynamicRealArrayType) :: GasPocketFlowInduced , GasPocketDeltaVol ! flowrate in elements above gas pocket due to mass influx and expansion [gpm] + TYPE(DynamicRealArrayType) :: GasPocketModifiedVol ! in some situation in migration process, or entering kick in a new space type + ! such as entering annulus from openhole, or entering ckokeline from annulus, + ! volume of gas pocket changes due to calculation process, and thus volume of + ! gas pocket should be modified [10^-3 ft^3] + TYPE(DynamicRealArrayType) :: GasPocketWeight ! weight of pocket [lbm] + TYPE(DynamicRealArrayType) :: GasPocketDensity ! density of gas pocket [ppg] + TYPE(DynamicRealArrayType) :: GasPocketCompressibility ! compressibility as a measure of deviation from ideal gas behavior [-] + INTEGER , DIMENSION(:,:) , ALLOCATABLE :: GasPocketFlowEl ! This matrix makes relationship between gas pockets and flow elements, + ! Further information in SUBROUTINE GasPocketFlowElementTransformer + INTEGER , DIMENSION(:,:) , ALLOCATABLE :: tempGasPocketFlowEl ! a temperorary matrix using for data saving during GasPocketFlowEl manipulation + !INTEGER , DIMENSION(:) , ALLOCATABLE :: GasPocketGasType ! = 1 for methane , = 2 for Hydrogen Sulfide + + REAL(8) , DIMENSION(:,:) , ALLOCATABLE :: KickJacobian , OldKickJacobian ! a matrix in which jacibian elements stored + REAL(8) , DIMENSION(:) , ALLOCATABLE :: KickVandPFunction + REAL(8) , DIMENSION(:) , ALLOCATABLE :: KickUnknownVector ! (2*n - 1) elements are flowrate and (2*n) elements are pressure of pockets (n >= 1) + REAL , DIMENSION(:) , ALLOCATABLE :: KickCorrectionVector + REAL :: KickCorrectionUnderRelaxation ! under relaxation parameter for correcting gas Kick Unknown Vector (0,1) + ! = 0 means no correction between two step + ! = 1 for direct correcting and no under relaxation + + END MODULE \ No newline at end of file diff --git a/FluidFlow/utubevars.mod b/FluidFlow/utubevars.mod new file mode 100644 index 0000000..389ee95 Binary files /dev/null and b/FluidFlow/utubevars.mod differ diff --git a/Geo/GeoMain.f90 b/Geo/GeoMain.f90 new file mode 100644 index 0000000..27e3e17 --- /dev/null +++ b/Geo/GeoMain.f90 @@ -0,0 +1,297 @@ +module GeoMain + use CLog4 + implicit none + + public + + integer :: SampleValue, TestValue + + contains + + !========================== START - SAMPLE MODULE =================== + subroutine Sample_Setup() + use CSimulationVariables + implicit none + !call OnSimulationInitialization%Add(Sample_Init) + call OnSimulationStop%Add(Sample_Stop) + call OnSampleStart%Add(Sample_Start) + call OnSampleStep%Add(Sample_Step) + !call OnSampleOutput%Add(Sample_Output) + call OnSampleMain%Add(Sample_Main) + end subroutine + + subroutine Sample_Stop + implicit none + !call Log_3('****************Sample-Init') + !print*, '****************Sample-Init' + SampleValue = 0 + end subroutine Sample_Stop + + subroutine Sample_Start + use CSimulationVariables + implicit none + !print*, '****************Sample_Start****************' + !call Log_3( '****************Sample_Start****************' ) + end subroutine Sample_Start + + subroutine Sample_Step + use CSimulationVariables + implicit none + !CALL DATE_AND_TIME(values=EndTime) + !call time%Finish() + + + SampleValue = SampleValue + 1 + !print*, '****************Sample_Step' , SampleValue + !call Log_3( '****************Sample_Step' , SampleValue) + + end subroutine Sample_Step + + subroutine Sample_Output + implicit none + + !call Log_4('****************Sample_Output:', SampleValue) + !print*, '****************Sample_Output:', SampleValue, ((EndTime(6)*60000+EndTime(7)*1000+EndTime(8)) - & + ! (StartTime(6)*60000+StartTime(7)*1000+StartTime(8))) + + !print*, 'timeElapsed=', ((EndTime(6)*60000+EndTime(7)*1000+EndTime(8)) - & + !(StartTime(6)*60000+StartTime(7)*1000+StartTime(8))) + !CALL DATE_AND_TIME(values=StartTime) + + !print*, 'timeElapsed=', time%ElapsedTimeMs(), SampleValue + + !call time%Start() + end subroutine Sample_Output + + subroutine Sample_Main + use CSimulationVariables + implicit none + !loop: do + ! !call Log_4('****************Sample-Mainnnnn:', SampleValue) + ! !print*, '****************Sample-Mainnnnn:', SampleValue + ! call sleepqq(300) + ! if(IsStopped) call Quit() + !end do loop + end subroutine Sample_Main + !========================== END - SAMPLE MODULE =================== + + + +!M_BopStack +!M_Pump1 +!M_Pump2 +!M_Pump3 +!M_ChokeControl +!M_Rop +!M_RotaryTable +!M_Drawworks +!M_FluidFlow +!M_TorqueDrag +!M_MudSystem +!M_PipeRams1 +!M_PipeRams2 +!M_KillLine +!M_ChokeLine +!M_BlindRams +!M_Annular +!M_Geo + + + + + + + + + !========================== END - TEST MODULE =================== + subroutine SetupTest() + use CSimulationVariables + implicit none + call OnSimulationInitialization%Add(TestInit) + call OnSimulationStop%Add(TestOnStop) + call OnSimulationPause%Add(TestOnPaused) + end subroutine + + integer(4) function TestThread(arg) + !DEC$ ATTRIBUTES STDCALL, ALIAS:"_testthread" :: TestThread + use ifport + use ifmt + implicit none + integer(4), pointer :: arg + !call TestMain() + TestThread = 0; + call ExitThread(0) + end function TestThread + + subroutine TestInit + implicit none + + !print*, 'Test Module Init...' + !TestValue = 1 + + end subroutine TestInit + + subroutine TestMain + use CSimulationVariables + implicit none + + !loop: do + ! + ! print*, 'Test-Main:', TestValue + ! TestValue = TestValue + 1 + ! + ! call sleep(1) + ! if(IsStopped) call Quit() + !end do loop + + end subroutine TestMain + + subroutine TestOnStop + use CSimulationVariables + implicit none + + !print*, 'Test Module Stopped!' + !TestValue = 1 + + end subroutine TestOnStop + + subroutine TestOnPaused + use CSimulationVariables + implicit none + + !print*, 'Test Module Paused!' + + end subroutine TestOnPaused + !========================== END - TEST MODULE =================== + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + subroutine Setup() + use CPathChangeEvents + implicit none + + call BeforeTraverse%Add(InitialVarsBeforePathsChanges) + call OnPathOpen%Add(WhenPathOpen) + !call OnPathClose%Add(WhenPathClose) + + end subroutine + + subroutine InitialVarsBeforePathsChanges() + implicit none + +#ifdef deb + print*, "ValveOne: FALSE (init)" +#endif + + end subroutine + + subroutine WhenPathOpen(valves) + implicit none + integer, allocatable, intent (in) :: valves(:) + +! if ( any(valves == 1)) then +!#ifdef deb +! print*, "ValveOne: TRUE" +!#endif +! endif + + end subroutine + + subroutine Geo_Setup() + use CSimulationVariables + implicit none + !call OnSimulationInitialization%Add(Geo_Init) + call OnSimulationStop%Add(Geo_Stop) + call OnGeoStart%Add(Geo_Start) + call OnGeoStep%Add(Geo_Step) + !call OnGeoOutput%Add(Geo_Output) + call OnGeoMain%Add(GeoMainBody) + end subroutine + + subroutine Geo_Stop + implicit none + !print*, 'Geo_Stop' + end subroutine Geo_Stop + + subroutine Geo_Start + implicit none + !print*, '****************Geo_Start****************' + end subroutine Geo_Start + + subroutine Geo_Step + implicit none + end subroutine Geo_Step + + !subroutine Geo_Output + ! implicit none + ! !print*, 'Geo_Output' + !end subroutine Geo_Output + + subroutine GeoMainBody + implicit none + end subroutine GeoMainBody + +end module GeoMain \ No newline at end of file diff --git a/ReadMe.txt b/ReadMe.txt new file mode 100644 index 0000000..f8a8e78 --- /dev/null +++ b/ReadMe.txt @@ -0,0 +1,25 @@ +======================================================================== + Fortran Console Application : "SimulationCore2" Project Overview +======================================================================== + +Intel(R) Fortran Console Application Wizard has created this +"SimulationCore2" project for you as a starting point. + +This file contains a summary of what you will find in each of the files +that make up your project. + +SimulationCore2.vfproj + This is the main project file for Fortran projects generated using an + Application Wizard. It contains information about the version of + Intel(R) Fortran that generated the file, and information about the + platforms, configurations, and project features selected with the + Application Wizard. + +SimulationCore2.f90 + This is the main source file for the Fortran Console application. + It contains the program entry point. + +///////////////////////////////////////////////////////////////////////////// +Other notes: + +///////////////////////////////////////////////////////////////////////////// diff --git a/Rop/Bit_Database.txt b/Rop/Bit_Database.txt new file mode 100644 index 0000000..426a9e0 --- /dev/null +++ b/Rop/Bit_Database.txt @@ -0,0 +1,15 @@ +Bit Class H1 H2 H3 (w/d)max +11 , 1.9 , 7. , 1. , 7. +12 , 1.9 , 7. , 1. , 7. +13 , 1.84 , 6. , 0.8 , 8. +14 , 1.84 , 6. , 0.8 , 8. +21 , 1.8 , 5. , 0.6 , 8.5 +22 , 1.8 , 5. , 0.6 , 8.5 +23 , 1.76 , 4. , 0.48 , 9. +24 , 1.76 , 4. , 0.48 , 9. +31 , 1.7 , 3. , 0.36 , 10. +32 , 1.65 , 2. , 0.26 , 10. +33 , 1.6 , 2. , 0.2 , 10. +34 , 1.6 , 2. , 0.2 , 10. +41 , 1.5 , 2. , 0.18 , 10. +10 , 1.5 , 1. , 0.02 , 10. \ No newline at end of file diff --git a/Rop/Bit_Specification.f90 b/Rop/Bit_Specification.f90 new file mode 100644 index 0000000..6626ef8 --- /dev/null +++ b/Rop/Bit_Specification.f90 @@ -0,0 +1,77 @@ +subroutine Bit_Specification + + use sROP_Other_Variables + use sROP_Variables + use CStringConfigurationVariables + + implicit none + + INTEGER :: io + integer :: i , BitClass_name + real(8) :: rd + + !H1=1.9 + !H2=7. + !H3=1. + !w_d_max=7. + + + + Bit_Class = (BitDefinition%BitCodeHundreds*100)+(BitDefinition%BitCodeTens*10)+BitDefinition%BitCodeOnes + rd = SNGL(Bit_Class)/10.d0 + Br_Coef = ( (SNGL(Bit_Class)/10.d0)-(DINT(rd)) )*10.d0 + + BitClass_name = (Bit_Class)/10 + + + + + + if ( (any(BitClass_name==(/11,12,13,14,21,22,23,24,31,32,33,34,41/))) ) then + open(unit=233,file="Bit_Database.TXT") + READ (233,*) + DO i=1,13!(14-1(/=10)) + READ (233,*) name, H1, H2, H3, w_d_max + if ( name==BitClass_name ) then + exit + end if + END DO + close (233) + else + H1=1.50d0 + H2=1.0d0 + H3=.020d0 + w_d_max=10.0d0 + end if + + + + + + !print*, 'H1=' , H1 + !print*, 'H2=' , H2 + !print*, 'H3=' , H3 + !print*, 'w_d_max=' , w_d_max + !print*, 'name=' , name + + + + + + + ! filename = 'Bit_Database.TXT' + !open (UNIT=3, FILE=filename ) + !!print*, 'w_d_max1=' , w_d_max + ! !print*, 'name1=' , name + !!openif: if ( status == 0 ) then + ! read (3,*,IOSTAT=status) ! Get next value + ! readloop: do i=1,14 + ! read (3,*,IOSTAT=status) name, H1, H2, H3, w_d_max ! Get next value + ! !print*, 'w_d_max=' , w_d_max + ! !print*, 'name=' , name + ! if ( status /= 0 ) exit ! EXIT if not valid. + ! if ( name == bit_Class/10) exit + ! end do readloop + !!endif openif + +end subroutine \ No newline at end of file diff --git a/Rop/JetImpactForce.f90 b/Rop/JetImpactForce.f90 new file mode 100644 index 0000000..a1bc5e3 --- /dev/null +++ b/Rop/JetImpactForce.f90 @@ -0,0 +1,31 @@ +subroutine JetImpactForce + + use sROP_Other_Variables + use sROP_Variables + use CStringConfigurationVariables + use CformationVariables + use CSimulationVariables + use CmudPropertiesVariables + use MudSystemVARIABLES + + implicit none + + Real(8) :: DeltaPb , NozzleTotalArea , Cd=0.95d0 + + + + + Bit_Flowrate = StringFlowRateFinal ![gpm] + !print*, 'Bit_Flowrate=' , Bit_Flowrate + !check :: Mud_Density [ppg] ?????????? + + NozzleTotalArea = Number_of_Bit_Nozzles*(Diameter_of_Bit_Nozzle**2)*(PI/4.d0) + + DeltaPb = (8.311d-5*Mud_Density*(Bit_Flowrate**2))/((Cd**2)*(NozzleTotalArea**2)) + + JetImpact_Force = 0.01823d0*Cd*Bit_Flowrate*sqrt(Mud_Density*DeltaPb) + + + + +end subroutine \ No newline at end of file diff --git a/Rop/ROP_MainCalculation.f90 b/Rop/ROP_MainCalculation.f90 new file mode 100644 index 0000000..e52d3aa --- /dev/null +++ b/Rop/ROP_MainCalculation.f90 @@ -0,0 +1,239 @@ +subroutine ROP_MainCalculation + + use sROP_Other_Variables + use sROP_Variables + use CStringConfigurationVariables + use CformationVariables + use CSimulationVariables + use CDataDisplayConsoleVariables + use CDrillingConsoleVariables + use CmudPropertiesVariables + use CHoistingVariables + use CDrillingConsole + use CPathGenerationVariables + use RTable_VARIABLES, only: RTable + use TD_DrillStemComponents + use TD_WellGeometry + use PressureDisplayVARIABLES + use MudSystemVARIABLES + use FricPressDropVars + use CReservoirVariables + use CWarningsVariables + use TopDrive_VARIABLES, only: TDS + use TD_GeneralData + + implicit none + + Integer :: i , zero_ROPcount + !Real(8) :: Set_ROPGauge + + zero_ROPcount = 0 + No_of_Formations = FormationCount + Drilling_verticalDepth = TD_WellTotalVerticalLength + + + + !===> MaximumWellDepthExceeded Warning + if ( Drilling_verticalDepth>=(Formations(FormationCount)%Top+Formations(FormationCount)%Thickness) ) then + Rate_of_Penetration = 0.0d0 + Call Set_ROP(Rate_of_Penetration) + Call Activate_MaximumWellDepthExceeded() + return + end if + !===================================== + + + + if ( FormationNumber/=0 .and. HideDrillingBrake==1 ) then ! Hide Drilling Brake Mode + FormationNumber = FormationNumber + else + do i= 1,No_of_Formations + FormationTopDepth = Formations(i)%Top + if (Drilling_verticalDepth>=FormationTopDepth) then + FormationNumber = i + end if + end do + end if + + + + + !!===> Hide Drilling Brake Mode + !if ( FormationNumber==FormationNo .and. HideDrillingBrake==1 ) then !???????????? + ! FormationNumber = FormationNo-1 + !end if + !!============================= + + + + + !Bit_Class = BitDefinition%BitCode !???????????? + call Bit_Specification + + + + + ! $$$$$**$$$$$**$$$$$**$$$$$**$$$$$** Variables Initialization: *$$$$$**$$$$$**$$$$$**$$$$$**$$$$$ + Diameter_of_Bit = BitDefinition%BitSize ! unit : [in.] (Typical Range: 3.0 to 30.0) + Number_of_Bit_Nozzles = BitDefinition%BitNozzleNo ! (Typical Values: 1 to 10) + Diameter_of_Bit_Nozzle = BitDefinition%BitNozzleSize ! unit : [inch] *** basic input: [1/32 in.] (Typical Range: 8.0 to 32.0) + Critical_Mud_Density = Formations(FormationNumber)%PorePressureGradient/.465d0*9.d0 ! ????????? delete ,unit : [ppg] or [lb/gal] (Typical Range: 0 to 10.0) + FormationMud_Density = Formations(FormationNumber)%PorePressureGradient/0.052d0 + BottomHole_Pressure = PressureGauges(3) !5200 [psi] + ECD = BottomHole_Pressure/(0.052*Drilling_verticalDepth) + Critical_Weight_on_Bit = (Formations(FormationNumber)%ThresholdWeight/5.d0)-(.06d0*(Formations(FormationNumber)%ThresholdWeight-10.d0)) ! unit : [klb/in] (Typical Range: 0 to 10 ----> 0.6 to 2) + !IF (ALLOCATED(FlowEl)) THEN + ! Mud_Viscosity = FlowEl(NoHorizontalEl + NoStringEl)%mueff !13.5 [cP] + Mud_Density = BitMudDensity ! [ppg] + !ELSE + Mud_Viscosity = 13.5 ! [cP] + !Mud_Density = 9.2 ! [ppg] + !END IF + Mud_Flowrate = StringFlowRateFinal ! [gpm] + Reynolds_Number = Mud_Flowrate*Mud_Density/(Mud_Viscosity*Number_of_Bit_Nozzles*Diameter_of_Bit_Nozzle) ! unit : [dimensionless] (Typical Range: 0.1 to 1000.0) + ! $$$$$**$$$$$**$$$$$**$$$$$**$$$$ End of Variable Initialization $$$$$**$$$$$**$$$$$**$$$$$**$$$$$ + + + + + + ! -----**-----**-----**-----**-----* Rate_of_Penetration Model Coefficients: *-----**-----**-----**-----**----- + a1 = log(Formations(FormationNumber)%Drillablity) + a2 = 1.2799d-04 + a3 = 1.7952d-04 + a4 = 4.0656d-05 + a5 = 2.9021d-01 + a6 = 9.4882d-02 + a7 = 2.1837d-01 + a8 = 4.4915d-01 + dt = 0.1d0 ![s] + Tou_H = Formations(FormationNumber)%Abrasiveness*3600.d0 ! [hr]--->[s] ( Typical Range: 1=0.d0 ) then + f4 = exp(2.303d0*a4*Drilling_verticalDepth*(FormationMud_Density-ECD)) ! Underbalance Drilling Variable + else + f4 = 1.0d0 + end if + + + if (TD_WeightOnBit>0.d0) then + Weight_on_Bit = TD_WeightOnBit/1000.d0 ![klb] + else + Weight_on_Bit = 0.d0 + end if + + if ( (Weight_on_Bit/Diameter_of_Bit)0.d0) then + Rotary_Speed = RTable%Speed ![rpm] + else if (DriveType==0 .and. (TDS%Speed>0. .or. RTable%Speed>0.)) then + Rotary_Speed = TDS%Speed+RTable%Speed ![rpm] + else + Rotary_Speed = 0.0d0 + end if + f6 = (Rotary_Speed/100.d0)**a6 + + + f7 = exp(-a7*Bit_Wearing) + + + Call JetImpactForce + f8 = JetImpact_Force/1000.d0 + + + + + Rate_of_Penetration = (f1*f2*f3*f4*f5*f6*f7*f8) ![ft/h] + Rate_of_Penetration = (DINT(Rate_of_Penetration*10.d0))/10.d0 + + if ( (TD_WellTotalLength==PathGenerations(PathGenerationCount)%MeasuredDepth) ) then + Set_ROPGauge = Rate_of_Penetration + Call Set_ROP(Set_ROPGauge) ![ft/h] + Old_ROPValue(4) = Rate_of_Penetration + !print* , 'first rop=' , Old_ROPValue , Rate_of_Penetration ,& + ! zero_ROPcount , Set_ROPGauge , Old_ROPDepth , TD_WellTotalLength , PathGenerations(PathGenerationCount)%MeasuredDepth + else if ( ((TD_WellTotalLength+(Rate_of_Penetration*TD_TimeStep/3600.d0))-Old_ROPDepth)>=0.1 ) then + do i= 1,4 + if ( Old_ROPValue(i)==0. ) then + zero_ROPcount = zero_ROPcount+1 + end if + end do + Set_ROPGauge = (Rate_of_Penetration+Old_ROPValue(1)+Old_ROPValue(2)+Old_ROPValue(3)+Old_ROPValue(4))/sngl(5-zero_ROPcount) + Call Set_ROP(Set_ROPGauge) ![ft/h] + do i= 2,4 + Old_ROPValue(i-1) = Old_ROPValue(i) + end do + Old_ROPValue(4) = Rate_of_Penetration + Old_ROPDepth = TD_WellTotalLength+(Rate_of_Penetration*TD_TimeStep/3600.d0) + !print* , 'new rop=' , Old_ROPValue , Rate_of_Penetration ,& + ! zero_ROPcount , Set_ROPGauge , Old_ROPDepth , TD_WellTotalLength , PathGenerations(PathGenerationCount)%MeasuredDepth + else + Call Set_ROP(Set_ROPGauge) ![ft/h] + !print* , 'old rop=' , Old_ROPValue , Rate_of_Penetration ,& + ! zero_ROPcount , Set_ROPGauge , Old_ROPDepth , TD_WellTotalLength , PathGenerations(PathGenerationCount)%MeasuredDepth + end if + + + + + + + if (Rotary_Speed > 0.d0) THEN + Bit_Torque = ( 3.79d0 + 19.17d0*sqrt( Rate_of_Penetration / (Rotary_Speed*Diameter_of_Bit)) ) * Diameter_of_Bit * Weight_on_Bit * ( 1.d0 / ( 1.d0 + 0.00021d0*Drilling_verticalDepth) ) + !Bit_Torque = Bit_Torque/3. !bi dalil taghsim bar 3 shode(chon adad bozorg bude), baadan az rabete check shavad (seyyed gofte) + else + Bit_Torque = 0.d0 + end if + + + + if ( (Weight_on_Bit/Diameter_of_Bit)<(w_d_max) ) then + Bit_Wearing = Bit_Wearing +( (dt*H3/Tou_H)*((Rotary_Speed/100.d0)**H1)*((w_d_max-4.d0)/(w_d_max-(Weight_on_Bit/Diameter_of_Bit)))*((1.d0+(H2/2.d0))/(1.d0+(H2*Bit_Wearing))) ) + else + Bit_Wearing = 1.0d0 !( Typical Range: 0<=Bit_Wearing<=1 ) + end if + + + + Bearing_Wear = Bearing_Wear+(dt/3600.d0)*(Rotary_Speed/100.d0/Br_Coef)*((Weight_on_Bit/4.d0/Diameter_of_Bit)**1.5d0) + + + !print*, 'Rate_of_Penetration=', Rate_of_Penetration + !!print*, 'FormationMud_Density=', FormationMud_Density + !!print*, 'ECD=', ECD + !!print*, 'Drilling_verticalDepth=', Drilling_verticalDepth + !!print*, 'power=', (2.303*a4*Drilling_verticalDepth*(FormationMud_Density-ECD)) + !print*, 'Rotary_Speed=', Rotary_Speed + !! + !print*, 'f1=', f1 + !print*, 'f2=', f2 + !print*, 'f3=', f3 + !print*, 'f4=', f4 + !print*, 'f5=', f5 + !print*, 'f6=', f6 + !print*, 'f7=', f7 + !print*, 'f8=', f8 + !print*, '***********************' + + + + + +end subroutine \ No newline at end of file diff --git a/Rop/ROP_StartUp.f90 b/Rop/ROP_StartUp.f90 new file mode 100644 index 0000000..8c939de --- /dev/null +++ b/Rop/ROP_StartUp.f90 @@ -0,0 +1,12 @@ +subroutine ROP_StartUp + + + use sROP_Other_Variables + use sROP_Variables + + + !Rate_of_Penetration = 0. + + +end subroutine + \ No newline at end of file diff --git a/Rop/RopMain.f90 b/Rop/RopMain.f90 new file mode 100644 index 0000000..1c1ac7e --- /dev/null +++ b/Rop/RopMain.f90 @@ -0,0 +1,38 @@ +module RopMain + implicit none + public + contains + + subroutine Rop_Setup() + use CSimulationVariables + implicit none + call OnSimulationInitialization%Add(Rop_Init) + call OnSimulationStop%Add(Rop_Init) + call OnRopStep%Add(Rop_Step) + call OnRopOutput%Add(Rop_Output) + call OnRopMain%Add(RopMainBody) + end subroutine + + subroutine Rop_Init + implicit none + end subroutine Rop_Init + + subroutine Rop_Step + implicit none + end subroutine Rop_Step + + subroutine Rop_Output + implicit none + end subroutine Rop_Output + + + subroutine RopMainBody + implicit none + !loop1: do + !call sleep(1) + !call Calculate_ROP + !write(*,*) 'ROP main reached' + !end do loop1 + end subroutine RopMainBody + +end module RopMain \ No newline at end of file diff --git a/Rop/sROP_Module.f90 b/Rop/sROP_Module.f90 new file mode 100644 index 0000000..82264fc --- /dev/null +++ b/Rop/sROP_Module.f90 @@ -0,0 +1,187 @@ +!module sROP_Module +! +!use sROP_Variables +! +!contains + +subroutine Calculate_ROP + + use sROP_Other_Variables + use sROP_Variables + use CStringConfigurationVariables + use CformationVariables + Use CSimulationVariables + use CmudPropertiesVariables + Use RTable_VARIABLES, only: RTable + use TD_DrillStemComponents + use TD_WellGeometry + + implicit none + + Integer :: i , ROP_SolDuration + + + !TD_WellTotalLength = 10000. !from T&D module ?????????????????????delete this line + Bit_Wearing = 0.0d0 + + + loop1: do + CALL DATE_AND_TIME(values=ROP_StartTime) + + + + No_of_Formations = FormationCount !??????????????????????????????????????????? + Drilling_Depth = TD_WellTotalLength !????????????????????????? change to vertical depth of well + + + do i= 1,No_of_Formations !??????????????????????????????????????? + FormationTopDepth = Formations(i)%Top !??????????????????????????????????????? + if (Drilling_Depth>=FormationTopDepth) then !??????????????????????????????????????? + FormationNumber = i !??????????????????????????????????????? + end if !??????????????????????????????????????? + end do !??????????????????????????????????????? + + !do while (FormationTopDepth < Drilling_Depth) + ! FormationNumber = FormationNumber + 1 + ! FormationTopDepth = FormationTopDepth + Formations(FormationNumber)%Thickness + !end do + + !Bit_Class = BitDefinition%BitCode + !call bit_spec + + + ! $$$$$**$$$$$**$$$$$**$$$$$**$$$$$** Variables Initialization: *$$$$$**$$$$$**$$$$$**$$$$$**$$$$$ + Diameter_of_Bit = BitDefinition%BitSize ! unit : [in.] (Typical Range: 3.0 to 30.0) + Number_of_Bit_Nozzles = BitDefinition%BitNozzleNo ! (Typical Values: 1 to 10) + Diameter_of_Bit_Nozzle = BitDefinition%BitNozzleSize ! unit : [1/32 in.] (Typical Range: 8.0 to 32.0) + Critical_Mud_Density = Formations(FormationNumber)%PorePressureGradient/.465*9. ! unit : [ppg] or [lb/gal] (Typical Range: 0 to 10.0) + Critical_Weight_on_Bit = (Formations(FormationNumber)%ThresholdWeight/5.)-(.06*(Formations(FormationNumber)%ThresholdWeight-10.)) ! unit : [klb/in] (Typical Range: 0 to 10 ----> 0.6 to 2) + Mud_Viscosity = ActivePlasticViscosity !????????????????????????????????? + Mud_Density = ActiveDensity !????????????????????????????????? + Mud_Flowrate = 10. ![ppg]??????????????????????????????????????????????? from fluid module + Reynolds_Number = Mud_Flowrate*Mud_Density/(Mud_Viscosity*Number_of_Bit_Nozzles*Diameter_of_Bit_Nozzle) ! unit : [dimensionless] (Typical Range: 0.1 to 1000.0) + ! $$$$$**$$$$$**$$$$$**$$$$$**$$$$ End of Variable Initialization $$$$$**$$$$$**$$$$$**$$$$$**$$$$$ + + ! $$$$$**$$$$$**$$$$$**$$$$$**$$$$$** Main Calculations: *$$$$$**$$$$$**$$$$$**$$$$$**$$$$$ + x1 = 1. ! Drillability Variable + x2 = 10000. - Drilling_Depth ! First Compaction Vairable + x3 = (Drilling_Depth**0.69) * (Mud_Density - 9.) ! Second Compaction Vairable + x4 = Drilling_Depth * (Mud_Density - Critical_Mud_Density) ! Underbalance Drilling Variable + Condition = 1. + + Weight_on_Bit = TD_WeightOnBit/1000. ![klb] + !Weight_on_Bit = 10. + if ( Weight_on_Bit > Critical_Weight_on_Bit ) then + x5 = log( ( Weight_on_Bit - Critical_Weight_on_Bit ) / (4.*Diameter_of_Bit - Critical_Weight_on_Bit) ) + else + x5 = 0. + Condition = 0. + end if + + Rotary_Speed = RTable%Speed ![rpm] + !Rotary_Speed = 20. + Rotary_Speed = abs(Rotary_Speed) + if ( Rotary_Speed > 0. ) then + x6 = log(Rotary_Speed/100.) + else + x6 = 0. + Condition = 0. + end if + x7 = -Bit_Wearing + x8 = Reynolds_Number + ! -----**-----**-----**-----**-----** Rate_of_Penetration Model Coefficients: *-----**-----**-----**-----**----- + a1 = log(Formations(FormationNumber)%Drillablity) !3.0643e+00 + a2 = 1.2799e-04 + a3 = 1.7952e-04 + a4 = 4.0656e-05 + a5 = 2.9021e-01 + a6 = 9.4882e-02 + a7 = 2.1837e-01 + a8 = 4.4915e-01 + dt = 0.1 ![s] + Tou_H = Formations(FormationNumber)%Abrasiveness ! hr + ! -----**-----**-----**-----**--- End of Rate_of_Penetration Model Coefficients: ---**-----**-----**-----**----- + + !if ( Weight_on_Bit>0. .and. Rotary_Speed>0. .and. TD_DrillStems(1)%ComponentType==0 ) then !??????????????????????????????????????? + Rate_of_Penetration = Condition*exp( a1*x1+a2*x2+a3*x3+a4*x4+a5*x5+a6*x6+a7*x7+a8*x8 ) + !end if !??????????????????????????????????????? + + IF (Rotary_Speed > 0.) THEN + Bit_Torque = ( 3.79 + 19.17*sqrt( Rate_of_Penetration / (Rotary_Speed*Diameter_of_Bit)) ) * Diameter_of_Bit * Weight_on_Bit * ( 1. / ( 1 + 0.00021*Drilling_Depth) ) + else + Bit_Torque = 0. + endif + + if ( (Weight_on_Bit/Diameter_of_Bit)<(w_d_max) ) then + Bit_Wearing = Bit_Wearing +( (dt*H3/Tou_H)*((Rotary_Speed/100.)**H1)*((w_d_max-4.)/(w_d_max-(Weight_on_Bit/Diameter_of_Bit)))*((1.+(H2/2.))/(1.+(H2*Bit_Wearing))) ) + else + Bit_Wearing = 0.0d0 !( Typical Range: 0<=Bit_Wearing<=1 ) + end if + + !Drilling_Depth = Drilling_Depth + (Rate_of_Penetration*dt) + + + !print*, 'exp=' , exp( a1*x1 + a2*x2 + a3*x3 + a4*x4 + a5*x5 + a6*x6 + a7*x7 + a8*x8 ) + ! + !print*, 'Bit_Torque=' , Bit_Torque + !print*, 'Weight_on_Bit=' , Weight_on_Bit + ! + !print*, 'Critical_Weight_on_Bit=' , Critical_Weight_on_Bit + !print*, 'Condition=' , Condition + !print*, 'FormationNumber=' , FormationNumber + !print*, 'No_of_Formations=' , No_of_Formations + !print*, 'Bit_Wearing=' , Bit_Wearing + + + if(IsStopped == .true.) then + EXIT loop1 + end if + + CALL DATE_AND_TIME(values=ROP_EndTime) + ROP_SolDuration=100-(ROP_EndTime(6)*60000+ROP_EndTime(7)*1000+ROP_EndTime(8)-ROP_StartTime(6)*60000-ROP_StartTime(7)*1000-ROP_StartTime(8)) + if(ROP_SolDuration > 0.0d0) then + CALL sleepqq(ROP_SolDuration) + end if + + + end do loop1 + + +end subroutine Calculate_ROP + + + + + + + + + + subroutine bit_spec + + use sROP_Other_Variables + use sROP_Variables + + !H1=1.9 + !H2=7. + !H3=1. + !w_d_max=7. + + filename = 'Bit_Database.TXT' + open (UNIT=3, FILE=filename ) + !print*, 'w_d_max1=' , w_d_max + !print*, 'name1=' , name + !openif: if ( status == 0 ) then + read (3,*,IOSTAT=status) ! Get next value + readloop: do i=1,14 + read (3,*,IOSTAT=status) name, H1, H2, H3, w_d_max ! Get next value + !print*, 'w_d_max=' , w_d_max + !print*, 'name=' , name + if ( status /= 0 ) exit ! EXIT if not valid. + if ( name == bit_Class/10) exit + end do readloop + !endif openif + +end subroutine bit_spec + +!end module sROP_Module \ No newline at end of file diff --git a/Rop/sROP_Other_Variables.f90 b/Rop/sROP_Other_Variables.f90 new file mode 100644 index 0000000..d979fd2 --- /dev/null +++ b/Rop/sROP_Other_Variables.f90 @@ -0,0 +1,31 @@ +module sROP_Other_Variables + +implicit none +integer :: FormationNumber +real(8) :: FormationTopDepth, Condition +CHARACTER(len=20) :: filename ! Name of file to open +INTEGER :: name , status ! I/O status +REAL(8) :: H1, H2, H3, w_d_max ! The real value read in +! $$$$$**$$$$$**$$$$$**$$$$$**$$ End of Introduction of Module Inputs $$**$$$$$**$$$$$**$$$$$**$$$$$ +character(len = 20) :: Formation_Type = 'Shale' ! Default = Shale +! -----**-----**-----**-----**-----** Bit Type: *-----**-----**-----**-----**----- +Integer :: Bit_Class ! Default = Rollar Cone +real(8) :: Diameter_of_Bit ! unit : [in.] (Typical Range: 3.0 to 30.0) +Integer :: Number_of_Bit_Nozzles ! (Typical Range: 1 to 10) +real(8) :: Diameter_of_Bit_Nozzle ! unit : [1/32 in.] (Typical Values: 8.0 to 32.0) +! -----**-----**-----**-----**-----** End of Bit Type: *-----**-----**-----**-----**----- +real(8) :: Critical_Mud_Density ! unit : [ppg] or [lb/gal] (Typical Range: 0 to 10.0) +real(8) :: Critical_Weight_on_Bit ! unit : [klb] (Typical Range: 0 to 10) +real(8) :: Reynolds_Number ! unit : [klb] (Typical Range: 0.1 to 1000.0) +! -----**-----**-----**-----**-----** Other Rate_of_Penetration Model Variables: *-----**-----**-----**-----**----- +real(8) :: x1, x2, x3, x4, x5, x6, x7, x8 +real(8) :: f1, f2, f3, f4, f5, f6, f7, f8 +real(8) :: a1, a2, a3, a4, a5, a6, a7, a8 +real(8) :: Br_Coef +real(8) :: dt , Tou_H +integer,dimension(8) :: ROP_StartTime , ROP_EndTime +! -----**-----**-----**-----**--- End of Other Rate_of_Penetration Model Variables ---**-----**-----**-----**----- +real(8), parameter :: PI = 3.1415926 ! PI Number +! $$$$$**$$$$$**$$$$$**$$$$$**$$$$$** End of Variable Definition *$$$$$**$$$$$**$$$$$**$$$$$**$$$$$ + +end module sROP_Other_Variables \ No newline at end of file diff --git a/Rop/sROP_Variables.f90 b/Rop/sROP_Variables.f90 new file mode 100644 index 0000000..540acf6 --- /dev/null +++ b/Rop/sROP_Variables.f90 @@ -0,0 +1,10 @@ +module sROP_Variables + +implicit none +real(8) :: Time_Interval_Ratio , Weight_on_Bit , Rotary_Speed , Mud_Density , FormationMud_Density , Mud_Viscosity , Mud_Flowrate, Bit_Flowrate , Drilling_verticalDepth , Bit_Wearing , Rate_of_Penetration, Bit_Torque , ECD , BottomHole_Pressure , Drilling_Depth +real(8) :: Bearing_Wear , JetImpact_Force +real(8) :: Old_ROPDepth , Old_ROPValue(4) , Set_ROPGauge +integer :: Formation_Number , Bit_Number , No_of_Formations + + +end module sROP_Variables \ No newline at end of file diff --git a/Rop/srop_other_variables.mod b/Rop/srop_other_variables.mod new file mode 100644 index 0000000..b7afed5 Binary files /dev/null and b/Rop/srop_other_variables.mod differ diff --git a/Rop/srop_variables.mod b/Rop/srop_variables.mod new file mode 100644 index 0000000..1564023 Binary files /dev/null and b/Rop/srop_variables.mod differ diff --git a/SimulationCore2.f90 b/SimulationCore2.f90 new file mode 100644 index 0000000..485dbf9 --- /dev/null +++ b/SimulationCore2.f90 @@ -0,0 +1,30 @@ +! SimulationCore2.f90 +! +! FUNCTIONS: +! SimulationCore2 - Entry point of console application. +! + +!**************************************************************************** +! +! PROGRAM: SimulationCore2 +! +! PURPOSE: Entry point for the console application. +! +!**************************************************************************** + +program SimulationCore2 + + use Simulator + + implicit none + + ! Variables + + ! Body of SimulationCore2 + ! print *, 'Hello World' + call read_variables() + + ! Initialise the json_file object. + !pause +end program SimulationCore2 + diff --git a/SimulationCore2.sln b/SimulationCore2.sln new file mode 100644 index 0000000..6ab4f6c --- /dev/null +++ b/SimulationCore2.sln @@ -0,0 +1,31 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio Version 17 +VisualStudioVersion = 17.4.33110.190 +MinimumVisualStudioVersion = 10.0.40219.1 +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SimulationCore2", "SimulationCore2.vfproj", "{E3158744-D6C5-4AE8-A6D7-5AE434B07AB3}" +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug|x64 = Debug|x64 + Debug|x86 = Debug|x86 + Release|x64 = Release|x64 + Release|x86 = Release|x86 + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {E3158744-D6C5-4AE8-A6D7-5AE434B07AB3}.Debug|x64.ActiveCfg = Debug|x64 + {E3158744-D6C5-4AE8-A6D7-5AE434B07AB3}.Debug|x64.Build.0 = Debug|x64 + {E3158744-D6C5-4AE8-A6D7-5AE434B07AB3}.Debug|x86.ActiveCfg = Debug|Win32 + {E3158744-D6C5-4AE8-A6D7-5AE434B07AB3}.Debug|x86.Build.0 = Debug|Win32 + {E3158744-D6C5-4AE8-A6D7-5AE434B07AB3}.Release|x64.ActiveCfg = Release|x64 + {E3158744-D6C5-4AE8-A6D7-5AE434B07AB3}.Release|x64.Build.0 = Release|x64 + {E3158744-D6C5-4AE8-A6D7-5AE434B07AB3}.Release|x86.ActiveCfg = Release|Win32 + {E3158744-D6C5-4AE8-A6D7-5AE434B07AB3}.Release|x86.Build.0 = Release|Win32 + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection + GlobalSection(ExtensibilityGlobals) = postSolution + SolutionGuid = {FCA3F260-A308-4D16-ABEE-CF641D466AC7} + EndGlobalSection +EndGlobal diff --git a/SimulationCore2.u2d b/SimulationCore2.u2d new file mode 100644 index 0000000..e15c77e Binary files /dev/null and b/SimulationCore2.u2d differ diff --git a/SimulationCore2.vfproj b/SimulationCore2.vfproj new file mode 100644 index 0000000..d51b161 --- /dev/null +++ b/SimulationCore2.vfproj @@ -0,0 +1,511 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Simulator.f90 b/Simulator.f90 new file mode 100644 index 0000000..d61501e --- /dev/null +++ b/Simulator.f90 @@ -0,0 +1,150 @@ +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 GeoMain + use COperationScenariosMain + use :: json_module, rk => json_rk + + implicit none + real :: t0, dt, tf, mu + real(kind=rk), allocatable :: x0(:) + type(json_file) :: json + logical :: is_found + +contains + subroutine Simulate + integer :: t + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + t=0 + do while (t<10) + !!read variable from shared file + call read_variables() + + !!Location: ./bop + !! Variables: + !! Nothing exist in rop_step or even ropMainBody! + !! Tarmigh, Now merged with FluidFlow + call Rop_Step() + + !!Location: ./Equipment/BopStack + !! Rafiee, nothing changed + call BopStack_Step() + + !! Location: /Equipment/Pumps + !! Variables: + !! Does not have step function + !! Call Pump_StartUp in the start + !! Why we have a infinite loop (loop2) in step? Must be rewritten + !! Tarmigh, now is rewritten + call Pump1_Step() + call Pump2_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 2 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() + + !! Sheikh + call FluidFlow_Step() + + !! Ahmadi + call OperationScenarios_Step() + + !! Write variables to shared files + call write_variables() + + print *,"t=",t + t = t + 1 + end do + end subroutine Simulate + + subroutine write_variables + + end subroutine + + subroutine read_variables + call json%initialize() + + ! Load the file. + call json%load_file('config.json'); if (json%failed()) stop + + call json%get('t0', t0, is_found); if (.not. is_found) return + call json%get('dt', dt, is_found); if (.not. is_found) return + call json%get('tf', tf, is_found); if (.not. is_found) return + call json%get('mu', mu, is_found); if (.not. is_found) return + call json%get('x0', x0, is_found); if (.not. is_found) return + + ! Output values. + if (is_found) then + print *, t0, dt, tf, mu + print *, x0 + end if + + ! Clean up. + call json%destroy() + end subroutine + +end module Simulator diff --git a/Text1.txt b/Text1.txt new file mode 100644 index 0000000..7c3628c --- /dev/null +++ b/Text1.txt @@ -0,0 +1 @@ +1- \ No newline at end of file diff --git a/TorqueDrag/TD_DrillingSubs/MeshGeneration_FluidModule.f90 b/TorqueDrag/TD_DrillingSubs/MeshGeneration_FluidModule.f90 new file mode 100644 index 0000000..2669f0e --- /dev/null +++ b/TorqueDrag/TD_DrillingSubs/MeshGeneration_FluidModule.f90 @@ -0,0 +1,516 @@ +subroutine MeshGeneration_FluidModule + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_StringConnectionData + Use GeoElements_FluidModule + Use CPumpsVariables + Use CStringConfigurationVariables + Use CBopStackVariables + !Use Drawworks_VARIABLES , only: Drawworks + + implicit none + + Integer :: ii , jj , semijj , kk , k , m , s + Integer :: ElementsCount , StringConfigCount + REAL(8) :: mm , nn , dl , StartAngle , EndAngle + REAL(8) :: A(30) !?????????10 + REAL(8) :: TD_ElementLength + + + + + A = 0.d0 + A(1) = AboveAnnularHeight ! WellHead[ft] + jj = 1 + + + + + + + +!==================================================== +! Mesh Generation of DrillStem Components +!==================================================== + + !TD_StringConfigurationCount = StringConfigurationCount !??????????? + StringConfigCount = TD_StringConfigurationCount + if (allocated(F_String)) Deallocate(F_String) + if (TD_DrillStem(1)%ComponentType==0) then + Allocate (F_String(StringConfigCount-1)) + else + Allocate (F_String(StringConfigCount)) + end if + + + if (TD_DrillStem(1)%ComponentType==0) then + ElementsCount = 1 + Do ii=1,(StringConfigCount-1) + F_String(ii)%ID = TD_DrillStem(ii+1)%Id*12.d0 ![inch] + F_String(ii)%OD = TD_DrillStem(ii+1)%Od*12.d0 ![inch] + F_String(ii)%FirstElement = ElementsCount+1 + F_String(ii)%LastElement = F_String(ii)%FirstElement+(TD_DrillStem(ii+1)%Numbs-1) + F_String(ii)%ElType = TD_DrillStem(ii+1)%ComponentType + ElementsCount = F_String(ii)%LastElement + End Do + StringConfigCount = StringConfigCount-1 + else + ElementsCount = 0 + Do ii=1,StringConfigCount + F_String(ii)%ID = TD_DrillStem(ii)%Id*12.d0 ![inch] + F_String(ii)%OD = TD_DrillStem(ii)%Od*12.d0 ![inch] + F_String(ii)%FirstElement = ElementsCount+1 + F_String(ii)%LastElement = F_String(ii)%FirstElement+(TD_DrillStem(ii)%Numbs-1) + F_String(ii)%ElType = TD_DrillStem(ii)%ComponentType + ElementsCount = F_String(ii)%LastElement + End Do + end if + + + Do ii=1,StringConfigCount + F_String(ii)%TopDepth = TD_DrillStems(F_String(ii)%LastElement)%TopDepthIni ![ft] + F_String(ii)%DownDepth = TD_DrillStems(F_String(ii)%FirstElement)%DownDepthIni ![ft] + + if (F_String(ii)%DownDepth>A(1)) then + jj = jj+1 + A(jj) = F_String(ii)%DownDepth + end if + End Do + + + + !=========> Removed Volume Calculation in DrillStem + TD_ElementLength = F_String(StringConfigCount)%DownDepth-F_String(StringConfigCount)%TopDepth + if ( StringConfigCount==TD_PreCount ) then + if ( TD_PreElementLength>TD_ElementLength ) then + TD_RemoveVolume = (TD_PreElementLength-TD_ElementLength)*((pi*((F_String(StringConfigCount)%ID/12.d0)**2))/4.d0) ![ft^3] + else + TD_RemoveVolume = 0.d0 + end if + else if ( StringConfigCount Out of Well Intervals + F_Interval(1)%StartTVD = 0.0d0 !?????????????? + F_Interval(1)%EndTVD = -TD_ConnectionHeight + F_Interval(1)%StartAngle = 0.d0 !??????????????????????? + F_Interval(1)%EndAngle = 0.d0 !??????????????????????? + OutOfWellIntervalCounts = 1 + Do ii= 2 , StringConfigCount+1 + if ( F_Interval(ii)%StartDepth<=0.d0 ) then + F_Interval(ii)%StartTVD = F_Interval(ii)%StartDepth + F_Interval(ii)%StartAngle = 0.0d0 + end if + if ( F_Interval(ii)%EndDepth<=0.d0 ) then + F_Interval(ii)%EndTVD = F_Interval(ii)%EndDepth + F_Interval(ii)%EndAngle = 0.0d0 + OutOfWellIntervalCounts = OutOfWellIntervalCounts+1 + end if + End Do + + + !=========> + if (allocated(TVD)) Deallocate(TVD) + Allocate (TVD(jj)) + if (allocated(Angle)) Deallocate(Angle) + Allocate (Angle(jj)) + TVD(1) = TD_WellTotalVerticalLength !????? + !print*, 'TD_WellTotalVerticalLength=' ,TD_WellTotalVerticalLength + TVD(jj) = AboveAnnularHeight ! WellHead[ft] !0.d0 ???????????????? + + k = 1 + mm = 0.d0 + nn = 0.d0 + EndAngle = TD_WellGeo(1)%StartAngle !??????????????? + Angle(jj) = EndAngle + Do ii = jj-1,1,-1 !???1or2 + do kk = k, TD_WellIntervalsCount + StartAngle = EndAngle + if ( MD(ii)>TD_WellGeo(kk)%TopDepth ) then + if ( MD(ii)>TD_WellGeo(kk)%DownDepth ) then + dl = TD_WellGeo(kk)%DownDepth-nn ![ft] + nn = TD_WellGeo(kk)%DownDepth + if ( TD_WellGeo(kk)%HoleType==0 ) then + EndAngle = StartAngle + !print*, 'StartAngle1=' ,ii , kk, StartAngle + !print*, 'EndAngle1=' ,ii , kk, EndAngle + TVD(ii) = mm+(dl*cos(TD_WellGeo(kk)%StartAngle)) ![ft] + Angle(ii) = EndAngle + !print*, 'TVD(ii)1=' ,ii , kk, TVD(ii) + else if ( TD_WellGeo(kk)%HoleType==1 ) then + EndAngle = StartAngle+(dl/TD_WellGeo(kk)%RCurvature) !????????????????? + !print*, 'StartAngle2=' ,ii , kk, StartAngle + !print*, 'EndAngle2=' ,ii , kk, EndAngle + TVD(ii) = mm+(TD_WellGeo(kk)%RCurvature*sin(abs(EndAngle)-abs(StartAngle))*cos(abs(StartAngle)))-(TD_WellGeo(kk)%RCurvature*(1.-cos(abs(EndAngle)-abs(StartAngle)))*sin(abs(StartAngle))) + !TVD(ii) = mm+(TD_WellGeo(kk)%RCurvature*sin(abs(EndAngle)-abs(StartAngle))) + Angle(ii) = EndAngle + !print*, 'TVD(ii)2=' , ii , kk, TVD(ii) + else if ( TD_WellGeo(kk)%HoleType==2 ) then + EndAngle = StartAngle-(dl/TD_WellGeo(kk)%RCurvature) !????????????????? + !print*, 'StartAngle22=' ,ii , kk, StartAngle + !print*, 'EndAngle22=' ,ii , kk, EndAngle + TVD(ii) = mm+(TD_WellGeo(kk)%RCurvature*sin(abs(abs(EndAngle)-abs(StartAngle)))*cos(abs(StartAngle)))+(TD_WellGeo(kk)%RCurvature*(1.-cos(abs(abs(EndAngle)-abs(StartAngle))))*sin(abs(StartAngle))) + !TVD(ii) = mm+(TD_WellGeo(kk)%RCurvature*sin(abs(EndAngle)-abs(StartAngle))) + Angle(ii) = EndAngle + !print*, 'TVD(ii)22=' , ii , kk, TVD(ii) + end if + mm = TVD(ii) + else + dl = MD(ii)-nn + nn = MD(ii) + if ( TD_WellGeo(kk)%HoleType==0 ) then + EndAngle = StartAngle + !print*, 'StartAngle3=' ,ii , kk, StartAngle + !print*, 'EndAngle3=' ,ii , kk, EndAngle + TVD(ii) = mm+(dl*cos(TD_WellGeo(kk)%StartAngle)) + Angle(ii) = EndAngle + !print*, 'TVD(ii)3=' ,ii , kk, TVD(ii) + else if ( TD_WellGeo(kk)%HoleType==1 ) then + EndAngle = StartAngle+(dl/TD_WellGeo(kk)%RCurvature) !??????????????????? + !print*, 'StartAngle4=' ,ii , kk, StartAngle + !print*, 'EndAngle4=' ,ii , kk, EndAngle + TVD(ii) = mm+(TD_WellGeo(kk)%RCurvature*sin(abs(EndAngle)-abs(StartAngle))*cos(abs(StartAngle)))-(TD_WellGeo(kk)%RCurvature*(1.-cos(abs(EndAngle)-abs(StartAngle)))*sin(abs(StartAngle))) + Angle(ii) = EndAngle + !TVD(ii) = mm+(TD_WellGeo(kk)%RCurvature*sin(abs(EndAngle)-abs(StartAngle))) + !print*, 'mm=' ,mm + !print*, 'TVD(ii)4=' ,ii , kk, TVD(ii) + else if ( TD_WellGeo(kk)%HoleType==2 ) then + EndAngle = StartAngle-(dl/TD_WellGeo(kk)%RCurvature) !??????????????????? + !print*, 'StartAngle44=' ,ii , kk, StartAngle + !print*, 'EndAngle44=' ,ii , kk, EndAngle + TVD(ii) = mm+(TD_WellGeo(kk)%RCurvature*sin(abs(abs(EndAngle)-abs(StartAngle)))*cos(abs(StartAngle)))+(TD_WellGeo(kk)%RCurvature*(1.-cos(abs(abs(EndAngle)-abs(StartAngle))))*sin(abs(StartAngle))) + Angle(ii) = EndAngle + !TVD(ii) = mm+(TD_WellGeo(kk)%RCurvature*sin(abs(EndAngle)-abs(StartAngle))) + !print*, 'mm=' ,mm , (TD_WellGeo(kk)%RCurvature*sin(abs(abs(EndAngle)-abs(StartAngle)))*cos(abs(StartAngle)))+(TD_WellGeo(kk)%RCurvature*(1.-cos(abs(abs(EndAngle)-abs(StartAngle))))*sin(abs(StartAngle))) + !print*, 'TVD(ii)44=' ,ii , kk, TVD(ii) + end if + mm = TVD(ii) + k = kk + exit + end if + end if + end do + End Do + + + + !if (OutOfWellIntervalCounts==1) then + ! s = 2 + !else + ! s = OutOfWellIntervalCounts + !end if + ! + + Do ii = (OutOfWellIntervalCounts+1),F_IntervalsTotalCounts + do kk = jj,1,-1 + if ( F_Interval(ii)%StartDepth==MD(kk) ) then + F_Interval(ii)%StartTVD = TVD(kk) ![ft] + F_Interval(ii)%StartAngle = Angle(kk) ![rad] + end if + if ( F_Interval(ii)%EndDepth==MD(kk) ) then + F_Interval(ii)%EndTVD = TVD(kk) ![ft] + F_Interval(ii)%EndAngle = Angle(kk) ![rad] + end if + end do + End Do + + + + !Do ii=1,(F_IntervalsTotalCounts) + ! print*, 'F_Interval(ii)%StartTVD=' , ii , F_Interval(ii)%StartTVD + ! print*, 'F_Interval(ii)%EndTVD=' , ii , F_Interval(ii)%EndTVD + ! print*, 'F_Interval(ii)%StartAngle=' , ii , F_Interval(ii)%StartAngle + ! print*, 'F_Interval(ii)%EndAngle=' , ii , F_Interval(ii)%EndAngle + !end do + ! + ! + !Do ii=1,TD_WellIntervalsCount + ! print*, 'TD_WellGeo(kk)%TopDepth=' , ii , TD_WellGeo(ii)%TopDepth + ! print*, 'TD_WellGeo(kk)%DownDepth=' , ii , TD_WellGeo(ii)%DownDepth + ! print*, 'TD_WellGeo(kk)%HoleType=' , ii , TD_WellGeo(ii)%HoleType + ! print*, 'TD_WellGeo(kk)%RCurvature=' , ii , TD_WellGeo(ii)%RCurvature + ! print*, 'TD_WellGeo(kk)%EndAngle=' , ii , TD_WellGeo(ii)%EndAngle + ! print*, 'TD_WellGeo(kk)%StartAngle=' , ii , TD_WellGeo(ii)%StartAngle + !end do + + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_DrillingSubs/TD_AddComponents.f90 b/TorqueDrag/TD_DrillingSubs/TD_AddComponents.f90 new file mode 100644 index 0000000..5246b34 --- /dev/null +++ b/TorqueDrag/TD_DrillingSubs/TD_AddComponents.f90 @@ -0,0 +1,314 @@ +subroutine TD_AddComponents + + Use CStringConfigurationVariables + Use CStringUpdateVariables + Use CSafetyValveEnumVariables + Use CIbopEnumVariables + Use COperationConditionEnumVariables + Use CKellyConnectionEnumVariables + Use CElevatorConnectionEnumVariables + Use CHoistingVariables + Use CTdsConnectionModesEnumVariables + Use CTdsElevatorModesEnumVariables + Use TD_DrillStemComponents + Use TD_WellGeometry + Use TD_GeneralData + Use TD_StringConnectionData + + + + implicit none + + integer :: i , kk , TD_NumOfAddedComponents + + + + + + + +!==================================================== +! Add Single +!==================================================== + + if ( Get_StringUpdate() == STRING_UPDATE_ADD_SINGLE ) then + kk = 0 + Do i= TD_DrillStemComponentsNumbs , 1 , -1 + if (TD_DrillStems(i)%ComponentType==3) then + kk = i + exit + end if + End Do + ! DrillStems Array: + TD_NumOfAddedComponents = 1 + Do i= (TD_DrillStemComponentsNumbs+1) , (TD_DrillStemComponentsNumbs+TD_NumOfAddedComponents) + TD_DrillStems(i)%ComponentType = 3 + TD_DrillStems(i)%Id = TD_DrillStems(kk)%Id + TD_DrillStems(i)%Od = TD_DrillStems(kk)%Od + TD_DrillStems(i)%Area = (pi*((TD_DrillStems(i)%Od**2)-(TD_DrillStems(i)%Id**2)))/4.d0 + TD_DrillStems(i)%RtoolJoint = TD_DrillStems(i)%Od*1.3d0/2.d0 + TD_DrillStems(i)%ToolJointRange = TD_ToolJointRange + TD_DrillStems(i)%Length = TD_DrillStems(kk)%LengthIni + TD_DrillStems(i)%LengthIni = TD_DrillStems(kk)%LengthIni + TD_DrillStems(i)%WeightperLength = TD_DrillStems(kk)%WeightperLength + TD_DrillStems(i)%Weight = TD_DrillStems(i)%WeightperLength*TD_DrillStems(i)%Length + TD_DrillStems(i)%Density = TD_DrillStems(kk)%Density + TD_DrillStems(i)%ElasticModule = TD_DrillStems(kk)%ElasticModule + End Do + TD_DrillStemComponentsNumbs = TD_DrillStemComponentsNumbs+TD_NumOfAddedComponents + ! DrillStem Array: + i = TD_StringConfigurationCount+1 + TD_DrillStem(i)%ComponentType = 3 + TD_DrillStem(i)%Numbs = 1 + TD_DrillStem(i)%Id = TD_DrillStems(kk)%Id ! [ft] + TD_DrillStem(i)%Od = TD_DrillStems(kk)%Od ! [ft] + TD_DrillStem(i)%Length = TD_DrillStems(kk)%LengthIni + TD_DrillStem(i)%WeightperLength = TD_DrillStems(kk)%WeightperLength + TD_DrillStem(i)%TotalLength = TD_DrillStem(i)%Numbs*TD_DrillStem(i)%Length + TD_DrillStem(i)%TotalWeight = TD_DrillStem(i)%TotalLength*TD_DrillStem(i)%WeightperLength + TD_StringConfigurationCount = TD_StringConfigurationCount+1 + + + Call Set_StringUpdate(STRING_UPDATE_NEUTRAL) + end if + + + + + +!==================================================== +! Add Stand +!==================================================== + + if ( Get_StringUpdate() == STRING_UPDATE_ADD_STAND ) then + kk = 0 + Do i= TD_DrillStemComponentsNumbs , 1 , -1 + if (TD_DrillStems(i)%ComponentType==3) then + kk = i + exit + end if + End Do + ! DrillStems Array: + TD_NumOfAddedComponents = 3 + Do i= (TD_DrillStemComponentsNumbs+1) , (TD_DrillStemComponentsNumbs+TD_NumOfAddedComponents) + TD_DrillStems(i)%ComponentType = 3 + TD_DrillStems(i)%Id = TD_DrillStems(kk)%Id + TD_DrillStems(i)%Od = TD_DrillStems(kk)%Od + TD_DrillStems(i)%Area = (pi*((TD_DrillStems(i)%Od**2)-(TD_DrillStems(i)%Id**2)))/4.0d0 + TD_DrillStems(i)%RtoolJoint = TD_DrillStems(i)%Od*1.30d0/2.0d0 + TD_DrillStems(i)%ToolJointRange = TD_ToolJointRange + TD_DrillStems(i)%Length = TD_DrillStems(kk)%LengthIni + TD_DrillStems(i)%LengthIni = TD_DrillStems(kk)%LengthIni + TD_DrillStems(i)%WeightperLength = TD_DrillStems(kk)%WeightperLength + TD_DrillStems(i)%Weight = TD_DrillStems(i)%WeightperLength*TD_DrillStems(i)%Length + TD_DrillStems(i)%Density = TD_DrillStems(kk)%Density + TD_DrillStems(i)%ElasticModule = TD_DrillStems(kk)%ElasticModule + End Do + TD_DrillStemComponentsNumbs = TD_DrillStemComponentsNumbs+TD_NumOfAddedComponents + + ! DrillStem Array: + i = TD_StringConfigurationCount+1 + TD_DrillStem(i)%ComponentType = 3 + TD_DrillStem(i)%Numbs = 3 + TD_DrillStem(i)%Id = TD_DrillStems(kk)%Id ! [ft] + TD_DrillStem(i)%Od = TD_DrillStems(kk)%Od ! [ft] + TD_DrillStem(i)%Length = TD_DrillStems(kk)%LengthIni + TD_DrillStem(i)%WeightperLength = TD_DrillStems(kk)%WeightperLength + TD_DrillStem(i)%TotalLength = TD_DrillStem(i)%Numbs*TD_DrillStem(i)%Length + TD_DrillStem(i)%TotalWeight = TD_DrillStem(i)%TotalLength*TD_DrillStem(i)%WeightperLength + TD_StringConfigurationCount = TD_StringConfigurationCount+1 + + + Call Set_StringUpdate(STRING_UPDATE_NEUTRAL) + end if + + + + + + +!==================================================== +! Add IBOP +!==================================================== + + !if ( Get_Ibop()==IBOP_INSTALL ) then + ! TD_IBOPNewAdd = 1 + !else + ! TD_IBOPNewAdd = 0 + ! TD_IBOPOldAdd = 0 + ! end if + + if ( Get_Ibop()==IBOP_INSTALL .and. TD_IBOPOldAdd==0 ) then + kk = 0 + Do i= TD_DrillStemComponentsNumbs , 1 , -1 + if (TD_DrillStems(i)%ComponentType==3) then + kk = i + exit + end if + End Do + ! DrillStems Array: + TD_NumOfAddedComponents = 1 + Do i= (TD_DrillStemComponentsNumbs+1) , (TD_DrillStemComponentsNumbs+TD_NumOfAddedComponents) + TD_DrillStems(i)%ComponentType = 5 + TD_DrillStems(i)%Id = TD_DrillStems(kk)%Id + TD_DrillStems(i)%Od = TD_DrillStems(kk)%RtoolJoint + TD_DrillStems(i)%Area = (pi*((TD_DrillStems(i)%Od**2)-(TD_DrillStems(i)%Id**2)))/4.0d0 + TD_DrillStems(i)%RtoolJoint = TD_DrillStems(kk)%RtoolJoint + TD_DrillStems(i)%ToolJointRange = 0.0d0 + TD_DrillStems(i)%Length = TD_IBOPLength ! [ft] + TD_DrillStems(i)%LengthIni = TD_IBOPLength ! [ft] + TD_DrillStems(i)%WeightperLength = 55.0d0 ! [lb/ft] + TD_DrillStems(i)%Weight = TD_DrillStems(i)%WeightperLength*TD_DrillStems(i)%Length + TD_DrillStems(i)%Density = TD_DrillStems(kk)%Density !???????????? + TD_DrillStems(i)%ElasticModule = TD_DrillStems(kk)%ElasticModule !???????????? + End Do + TD_DrillStemComponentsNumbs = TD_DrillStemComponentsNumbs+TD_NumOfAddedComponents + + ! DrillStem Array: + i = TD_StringConfigurationCount+1 + TD_DrillStem(i)%ComponentType = 5 + TD_DrillStem(i)%Numbs = 1 + TD_DrillStem(i)%Id = TD_DrillStems(kk)%Id ! [ft] + TD_DrillStem(i)%Od = TD_DrillStems(kk)%RtoolJoint ! [ft] + TD_DrillStem(i)%Length = 1.540d0 ! [ft] + TD_DrillStem(i)%WeightperLength = 55.0d0 ! [lb/ft] + TD_DrillStem(i)%TotalLength = TD_DrillStem(i)%Numbs*TD_DrillStem(i)%Length + TD_DrillStem(i)%TotalWeight = TD_DrillStem(i)%TotalLength*TD_DrillStem(i)%WeightperLength + TD_StringConfigurationCount = TD_StringConfigurationCount+1 + + + !TD_IBOPOldAdd = TD_IBOPNewAdd + + if ( Get_ElevatorConnection() /= ELEVATOR_CONNECTION_STRING .or. (Get_TdsConnectionModes()/=TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()/=TDS_ELEVATOR_CONNECTION_STRING) ) then + TD_ConnectionHeight = TD_ConnectionHeight+TD_DrillStem(i)%Length + end if + + end if + + if ( Get_Ibop()==IBOP_INSTALL ) then + TD_IBOPOldAdd = 1 + else + TD_IBOPOldAdd = 0 + end if + + + + +!==================================================== +! Add Safety Valve & Kelly (OPERATION_DRILL) +!==================================================== + + if ( DriveType==1 .and. Get_OperationCondition()==OPERATION_DRILL .and. Get_KellyConnection() == KELLY_CONNECTION_STRING ) then + TD_KellyNewAdd = 1 + else + TD_KellyNewAdd = 0 + TD_KellyOldAdd = 0 + end if + + if ( DriveType==1 .and. Get_OperationCondition()==OPERATION_DRILL .and. Get_KellyConnection() == KELLY_CONNECTION_STRING .and. TD_KellyNewAdd/=TD_KellyOldAdd ) then + ! DrillStems Array: + TD_NumOfAddedComponents = 1 + Do i= (TD_DrillStemComponentsNumbs+1) , (TD_DrillStemComponentsNumbs+TD_NumOfAddedComponents) + TD_DrillStems(i)%ComponentType = 6 + TD_DrillStems(i)%Id = TD_KellyElementID ! [ft] + TD_DrillStems(i)%Od = TD_KellyElementOD ! [ft] + TD_DrillStems(i)%Area = (pi*((TD_DrillStems(i)%Od**2)-(TD_DrillStems(i)%Id**2)))/4.0d0 + TD_DrillStems(i)%RtoolJoint = TD_DrillStems(i)%Od*1.30d0/2.0d0 + TD_DrillStems(i)%ToolJointRange = 0.0d0 + TD_DrillStems(i)%Length = TD_KellyElementConst ! [ft] + TD_DrillStems(i)%LengthIni = TD_KellyElementConst ! [ft] + TD_DrillStems(i)%WeightperLength = 55.0d0 ! [lb/ft] + TD_DrillStems(i)%Weight = TD_DrillStems(i)%WeightperLength*TD_DrillStems(i)%Length + TD_DrillStems(i)%Density = 7850.d0*0.06242796d0 ! [kg/m3]*0.06242796=[lb/ft3] + TD_DrillStems(i)%ElasticModule = 200.0d9*0.02088543d0 ! [lb/ft2] !200GPa=29Mpsi (steel) + End Do + TD_DrillStemComponentsNumbs = TD_DrillStemComponentsNumbs+TD_NumOfAddedComponents + + ! DrillStem Array: + i = TD_StringConfigurationCount+1 + TD_DrillStem(i)%ComponentType = 6 + TD_DrillStem(i)%Numbs = 1 + TD_DrillStem(i)%Id = 3.0d0/12.d0 ! [ft] + TD_DrillStem(i)%Od = 5.90d0/12.d0 ! [ft] + TD_DrillStem(i)%Length = TD_KellyElementConst ! [ft] + TD_DrillStem(i)%WeightperLength = 55.0d0 ! [lb/ft] + TD_DrillStem(i)%TotalLength = TD_DrillStem(i)%Numbs*TD_DrillStem(i)%Length + TD_DrillStem(i)%TotalWeight = TD_DrillStem(i)%TotalLength*TD_DrillStem(i)%WeightperLength + TD_StringConfigurationCount = TD_StringConfigurationCount+1 + + + TD_KellyOldAdd = TD_KellyNewAdd + + end if + + + + + +!==================================================== +! Add Safety Valve (OPERATION_TRIP) +!==================================================== + + !if ( Get_OperationCondition()==OPERATION_TRIP .and. Get_SafetyValve()==SAFETY_VALVE_INSTALL ) then + ! TD_SafetyValveNewAdd = 1 + !else + ! TD_SafetyValveNewAdd = 0 + ! TD_SafetyValveOldAdd = 0 + !end if + + if ( TD_KellyDriveTypeMode/=0 .and. TD_OldOperationCondition/=0 .and. Get_SafetyValve()==SAFETY_VALVE_INSTALL .and. TD_SafetyValveOldAdd==0 ) then + kk = 0 + Do i= TD_DrillStemComponentsNumbs , 1 , -1 + if (TD_DrillStems(i)%ComponentType==3) then + kk = i + exit + end if + End Do + ! DrillStems Array: + TD_NumOfAddedComponents = 1 + Do i= (TD_DrillStemComponentsNumbs+1) , (TD_DrillStemComponentsNumbs+TD_NumOfAddedComponents) + TD_DrillStems(i)%ComponentType = 7 + TD_DrillStems(i)%Id = TD_DrillStems(kk)%Id + TD_DrillStems(i)%Od = TD_DrillStems(kk)%RtoolJoint + TD_DrillStems(i)%Area = (pi*((TD_DrillStems(i)%Od**2)-(TD_DrillStems(i)%Id**2)))/4.0d0 + TD_DrillStems(i)%RtoolJoint = TD_DrillStems(kk)%RtoolJoint + TD_DrillStems(i)%ToolJointRange = 0.0d0 + TD_DrillStems(i)%Length = TD_SafetyValveLength ! [ft] + TD_DrillStems(i)%LengthIni = TD_SafetyValveLength ! [ft] + TD_DrillStems(i)%WeightperLength = 55.0d0 ! [lb/ft] + TD_DrillStems(i)%Weight = TD_DrillStems(i)%WeightperLength*TD_DrillStems(i)%Length + TD_DrillStems(i)%Density = TD_DrillStems(kk)%Density !???????????? + TD_DrillStems(i)%ElasticModule = TD_DrillStems(kk)%ElasticModule !???????????? + End Do + TD_DrillStemComponentsNumbs = TD_DrillStemComponentsNumbs+TD_NumOfAddedComponents + + ! DrillStem Array: + i = TD_StringConfigurationCount+1 + TD_DrillStem(i)%ComponentType = 7 + TD_DrillStem(i)%Numbs = 1 + TD_DrillStem(i)%Id = TD_DrillStems(kk)%Id ! [ft] + TD_DrillStem(i)%Od = TD_DrillStems(kk)%RtoolJoint ! [ft] + TD_DrillStem(i)%Length = 1.540d0 ! [ft] + TD_DrillStem(i)%WeightperLength = 55.0d0 ! [lb/ft] + TD_DrillStem(i)%TotalLength = TD_DrillStem(i)%Numbs*TD_DrillStem(i)%Length + TD_DrillStem(i)%TotalWeight = TD_DrillStem(i)%TotalLength*TD_DrillStem(i)%WeightperLength + TD_StringConfigurationCount = TD_StringConfigurationCount+1 + + + !TD_SafetyValveOldAdd = TD_SafetyValveNewAdd + + if ( Get_ElevatorConnection() /= ELEVATOR_CONNECTION_STRING .or. (Get_TdsConnectionModes()/=TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()/=TDS_ELEVATOR_CONNECTION_STRING) ) then + TD_ConnectionHeight = TD_ConnectionHeight+TD_DrillStem(i)%Length + end if + + end if + + if ( Get_SafetyValve()==SAFETY_VALVE_INSTALL ) then + TD_SafetyValveOldAdd = 1 + else + TD_SafetyValveOldAdd = 0 + end if + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_DrillingSubs/TD_BOPDiamCalculation.f90 b/TorqueDrag/TD_DrillingSubs/TD_BOPDiamCalculation.f90 new file mode 100644 index 0000000..695ee38 --- /dev/null +++ b/TorqueDrag/TD_DrillingSubs/TD_BOPDiamCalculation.f90 @@ -0,0 +1,180 @@ +subroutine TD_BOPDiamCalculation + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + Use TD_StringConnectionData + Use CBopStackVariables + Use VARIABLES + + + Integer :: i , j , n , m , TD_Numbs + Real(8) :: TD_LimitUp , TD_LimitDown , TD_OldFillingValue , TD_AnnTjDiff , TD_AnnularFilling + Real(8) :: TD_ElToolJoints(2,2) + + + + + + !TD_ToolJointRange = 0.4005d0*3.28 ! [ft] + +!==================================================== +! Read BOP Data +!==================================================== + + TD_BOPHeight(5) = AboveAnnularHeight + TD_BOPHeight(1) = AnnularPreventerHeight + TD_BOPHeight(2) = UpperRamHeight + TD_BOPHeight(3) = BlindRamHeight + TD_BOPHeight(6) = KillHeight + TD_BOPHeight(4) = LowerRamHeight + + + TD_BOPRamDiam(1) = IDAnnularfinal + TD_BOPRamDiam(2) = IDPipeRam1final + TD_BOPRamDiam(3) = IDshearBopfinal + TD_BOPRamDiam(4) = IDPipeRam2final + + + + + + +!==================================================== +! Element Counts in BOPStack Domain +!==================================================== + + !if (TD_DrillStemComponentsNumbs>5) then + TD_Numbs = TD_DrillStemComponentsNumbs-7 ! 7 Elements from the Top of DrillStem + !else + ! TD_Numbs = 1 + !end if + + + + + + + + + +!==================================================== +! Determination of Elements Diameter in BOPStack Domain +!==================================================== + + TD_BOPDiam = 0.d0 + TD_OldFillingValue = 0.d0 + Do i = TD_DrillStemComponentsNumbs,TD_Numbs,-1 + + TD_LimitUp = TD_DrillStems(i)%TopDepth+TD_DrillStems(i)%ToolJointRange + TD_LimitDown = TD_DrillStems(i)%DownDepth-TD_DrillStems(i)%ToolJointRange + TD_ElToolJoints(1,1) = TD_DrillStems(i)%TopDepth ! TD_ElToolJoints(i,j) , i=top & down tooljoints of element , j=top & down tooljoints Depth + TD_ElToolJoints(1,2) = TD_LimitUp + TD_ElToolJoints(2,1) = TD_LimitDown + TD_ElToolJoints(2,2) = TD_DrillStems(i)%DownDepth + + + !===> che meghdar az fazaye annular ba tooljoint por mishavad (for BOP Module) + Do m = 1,2 + TD_AnnTjDiff = min(TD_ElToolJoints(m,2),(TD_BOPHeight(1)+TD_BOPThickness))-max(TD_ElToolJoints(m,1),(TD_BOPHeight(1)-TD_BOPThickness)) + if (TD_AnnTjDiff<0.) then ! tooljoint is not in the annular range + TD_AnnTjDiff = 0.d0 + end if + TD_AnnularFilling = TD_OldFillingValue+(TD_AnnTjDiff/(TD_BOPThickness*2.d0)) ! 0=TD_LimitUp .and. (TD_BOPHeight(j)+TD_BOPThickness)3 ) then + TD_DrillStem(i)%ComponentType = 3 + TD_DrillStem(i)%Numbs = TD_DrillStem(i)%Numbs-3 + TD_DrillStem(i)%Id = TD_DrillStem(i)%Id ![ft] + TD_DrillStem(i)%Od = TD_DrillStem(i)%Od ![ft] + TD_DrillStem(i)%Length = TD_DrillStem(i)%Length + TD_DrillStem(i)%WeightperLength = TD_DrillStem(i)%WeightperLength + TD_DrillStem(i)%TotalLength = TD_DrillStem(i)%Numbs*TD_DrillStem(i)%Length + TD_DrillStem(i)%TotalWeight = TD_DrillStem(i)%TotalLength*TD_DrillStem(i)%WeightperLength + TD_StringConfigurationCount = TD_StringConfigurationCount + else if ( TD_DrillStem(i)%Numbs==3 ) then + TD_DrillStem(i)%ComponentType = 3 + TD_DrillStem(i)%Numbs = 0 + TD_DrillStem(i)%Id = 0. + TD_DrillStem(i)%Od = 0. + TD_DrillStem(i)%Length = 0. + TD_DrillStem(i)%WeightperLength = 0. + TD_DrillStem(i)%TotalLength = 0. + TD_DrillStem(i)%TotalWeight = 0. + TD_StringConfigurationCount = TD_StringConfigurationCount-1 + end if + + + + Call Set_StringUpdate(STRING_UPDATE_NEUTRAL) + !print* , 'Remove Stand' + end if + + + + + + + + +!==================================================== +! Remove IBOP +!==================================================== + + !if ( Get_Ibop() == IBOP_REMOVE ) then + ! TD_IBOPNewRemove = 1 + !else + ! TD_IBOPNewRemove = 0 + ! TD_IBOPOldRemove = 0 + !end if + if ( Get_Ibop() == IBOP_REMOVE .and. TD_IBOPOldRemove==0 ) then + + TD_NumOfRemovedComponents = 1 + Do i= TD_DrillStemComponentsNumbs , (TD_DrillStemComponentsNumbs-TD_NumOfRemovedComponents+1) , -1 + TD_DrillStems(i)%ComponentType = 0 !???????????? + TD_DrillStems(i)%Id = 0. + TD_DrillStems(i)%Od = 0. + TD_DrillStems(i)%Area = 0. + TD_DrillStems(i)%RtoolJoint = 0. + TD_DrillStems(i)%ToolJointRange = 0. + TD_DrillStems(i)%Length = 0. + TD_DrillStems(i)%LengthIni = 0. + TD_DrillStems(i)%WeightperLength = 0. + TD_DrillStems(i)%Weight = 0. + End Do + TD_DrillStemComponentsNumbs = TD_DrillStemComponentsNumbs-TD_NumOfRemovedComponents + + + i = TD_StringConfigurationCount + if ( TD_DrillStem(i)%Numbs>1 ) then + TD_DrillStem(i)%ComponentType = 5 + TD_DrillStem(i)%Numbs = TD_DrillStem(i)%Numbs-1 + TD_DrillStem(i)%Id = TD_DrillStem(i)%Id ![ft] + TD_DrillStem(i)%Od = TD_DrillStem(i)%Od ![ft] + TD_DrillStem(i)%Length = TD_DrillStem(i)%Length ![ft] + TD_DrillStem(i)%WeightperLength = TD_DrillStem(i)%WeightperLength + TD_DrillStem(i)%TotalLength = TD_DrillStem(i)%Numbs*TD_DrillStem(i)%Length + TD_DrillStem(i)%TotalWeight = TD_DrillStem(i)%TotalLength*TD_DrillStem(i)%WeightperLength + TD_StringConfigurationCount = TD_StringConfigurationCount + else if ( TD_DrillStem(i)%Numbs==1 ) then + TD_DrillStem(i)%ComponentType = 5 + TD_DrillStem(i)%Numbs = 0 + TD_DrillStem(i)%Id = 0. + TD_DrillStem(i)%Od = 0. + TD_DrillStem(i)%Length = 0. + TD_DrillStem(i)%WeightperLength = 0. + TD_DrillStem(i)%TotalLength = 0. + TD_DrillStem(i)%TotalWeight = 0. + TD_StringConfigurationCount = TD_StringConfigurationCount-1 + end if + + + !TD_IBOPOldRemove = TD_IBOPNewRemove + + if ( Get_ElevatorConnection() /= ELEVATOR_CONNECTION_STRING .or. (Get_TdsConnectionModes()/=TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()/=TDS_ELEVATOR_CONNECTION_STRING) ) then + TD_ConnectionHeight = TD_ConnectionHeight-TD_IBOPLength + end if + !print* , 'Remove IBOP' + end if + + if ( Get_Ibop() == IBOP_REMOVE ) then + TD_IBOPOldRemove = 1 + else + TD_IBOPOldRemove = 0 + end if + + + + + + + + +!==================================================== +! Remove Safety Valve (OPERATION_TRIP) +!==================================================== + + !if ( TD_OldOperationCondition==1 .and. TD_KellyDriveTypeMode==1 .and. Get_SafetyValve() == SAFETY_VALVE_REMOVE ) then + ! TD_SafetyValveNewRemove = 1 + !else + ! TD_SafetyValveNewRemove = 0 + ! TD_SafetyValveOldRemove = 0 + !end if + !print* , 'Get_SafetyValve()=' , Get_SafetyValve() + if ( TD_KellyDriveTypeMode/=0 .and. TD_OldOperationCondition/=0 .and. Get_SafetyValve() == SAFETY_VALVE_REMOVE .and. TD_SafetyValveOldRemove==0 ) then + + TD_NumOfRemovedComponents = 1 + Do i= TD_DrillStemComponentsNumbs , (TD_DrillStemComponentsNumbs-TD_NumOfRemovedComponents+1) , -1 + TD_DrillStems(i)%ComponentType = 0 !???????????? + TD_DrillStems(i)%Id = 0. + TD_DrillStems(i)%Od = 0. + TD_DrillStems(i)%Area = 0. + TD_DrillStems(i)%RtoolJoint = 0. + TD_DrillStems(i)%ToolJointRange = 0. + TD_DrillStems(i)%Length = 0. + TD_DrillStems(i)%LengthIni = 0. + TD_DrillStems(i)%WeightperLength = 0. + TD_DrillStems(i)%Weight = 0. + End Do + TD_DrillStemComponentsNumbs = TD_DrillStemComponentsNumbs-TD_NumOfRemovedComponents + + + i = TD_StringConfigurationCount + if ( TD_DrillStem(i)%Numbs>1 ) then + TD_DrillStem(i)%ComponentType = 7 + TD_DrillStem(i)%Numbs = TD_DrillStem(i)%Numbs-1 + TD_DrillStem(i)%Id = TD_DrillStem(i)%Id ![ft] + TD_DrillStem(i)%Od = TD_DrillStem(i)%Od ![ft] + TD_DrillStem(i)%Length = TD_DrillStem(i)%Length ![ft] + TD_DrillStem(i)%WeightperLength = TD_DrillStem(i)%WeightperLength + TD_DrillStem(i)%TotalLength = TD_DrillStem(i)%Numbs*TD_DrillStem(i)%Length + TD_DrillStem(i)%TotalWeight = TD_DrillStem(i)%TotalLength*TD_DrillStem(i)%WeightperLength + TD_StringConfigurationCount = TD_StringConfigurationCount + else if ( TD_DrillStem(i)%Numbs==1 ) then + TD_DrillStem(i)%ComponentType = 7 + TD_DrillStem(i)%Numbs = 0 + TD_DrillStem(i)%Id = 0. + TD_DrillStem(i)%Od = 0. + TD_DrillStem(i)%Length = 0. + TD_DrillStem(i)%WeightperLength = 0. + TD_DrillStem(i)%TotalLength = 0. + TD_DrillStem(i)%TotalWeight = 0. + TD_StringConfigurationCount = TD_StringConfigurationCount-1 + end if + !print* , 'Get_OperationCondition()=' , Get_OperationCondition() + !print* , 'TD_OldOperationCondition=' , TD_OldOperationCondition + !print* , 'TD_SafetyValveNewRemove=' , TD_SafetyValveNewRemove + !print* , 'TD_SafetyValveOldRemove=' , TD_SafetyValveOldRemove + !TD_SafetyValveOldRemove = TD_SafetyValveNewRemove + + if ( Get_ElevatorConnection() /= ELEVATOR_CONNECTION_STRING .or. (Get_TdsConnectionModes()/=TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()/=TDS_ELEVATOR_CONNECTION_STRING) ) then + TD_ConnectionHeight = TD_ConnectionHeight-TD_SafetyValveLength + end if + + end if + + if ( Get_SafetyValve() == SAFETY_VALVE_REMOVE ) then + TD_SafetyValveOldRemove = 1 + else + TD_SafetyValveOldRemove = 0 + end if + + if ( TD_KellyDriveTypeMode==1 ) then + TD_OldOperationCondition = 1 + else + TD_OldOperationCondition = 0 + end if + + !print* , 'TD_KellyDriveTypeMode2=' , TD_KellyDriveTypeMode + !print* , 'TD_OldOperationCondition2=' , TD_OldOperationCondition + !print* , 'TD_SafetyValveNewRemove2=' , TD_SafetyValveNewRemove + !print* , 'TD_SafetyValveOldRemove2=' , TD_SafetyValveOldRemove + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_DrillingSubs/TD_StringConnectionModes.f90 b/TorqueDrag/TD_DrillingSubs/TD_StringConnectionModes.f90 new file mode 100644 index 0000000..762aa4b --- /dev/null +++ b/TorqueDrag/TD_DrillingSubs/TD_StringConnectionModes.f90 @@ -0,0 +1,828 @@ +subroutine TD_StringConnectionModes + + Use CHoistingVariables + Use CDrillingConsoleVariables + Use CKellyConnectionEnumVariables + Use CElevatorConnectionEnumVariables + Use CSlipsEnumVariables + Use COperationConditionEnumVariables + Use CZeroStringSpeed + Use CTdsConnectionModesEnumVariables + Use CTdsElevatorModesEnumVariables + Use COperationScenariosVariables + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + Use TD_StringConnectionData + Use Drawworks_VARIABLES!, only: Drawworks + + + + implicit none + integer :: i , kk + Real(8) :: LengthSum + + + + + + + + !!=====> Read Data + !kk = 0 + !LengthSum = 0.d0 + ! + !Do i = TD_DrillStemComponentsNumbs , 1 , -1 + ! if (TD_DrillStems(i)%ComponentType==3) then + ! kk = i + ! exit + ! else if (TD_DrillStems(i)%ComponentType==5 .or. TD_DrillStems(i)%ComponentType==7) then + ! LengthSum = LengthSum+TD_DrillStems(i)%LengthIni + ! end if + !End Do + + + + + + + + !####C_Program -----> DriveType = + ! = 0 TopDrive_DriveType + ! = 1 Kelly_DriveType + + !####C_Program -----> TD_KellyDriveTypeMode = + ! = 0 Drill Mode (Kelly) + ! = 1 Trip Mode (Elevator) + ! = 2 TopDrive Mode + + if ( DriveType==1 .and. Get_OperationCondition()==OPERATION_DRILL ) then + TD_KellyDriveTypeMode = 0 + else if ( DriveType==1 .and. Get_OperationCondition()==OPERATION_TRIP ) then + TD_KellyDriveTypeMode = 1 + else if ( DriveType==0 ) then + TD_KellyDriveTypeMode = 2 + end if + + TD_HookHeight = DW_TDHookHeight ! unit: [ft] + TD_ElevatorConst = 17.985 ! [ft] Elevator Length(14.84) ????????????????? adad ha daghigh shavand + TD_ElevatorECG = ECG ! [ft] + TD_KellyConst = 63.280d0 ! [ft] Kelly Length(61.74) + Safety Valve Length(1.54) + TD_KellyElementConst = 41.840d0 ! [ft] Kelly Element Length(40.3) + Safety Valve Length(1.54) + TD_TDSLength = 24.08d0 !??????????????????? ! [ft] + TD_TDSToolJointLength = 0.77d0 !??????????????????? ! [ft] + TD_TDSElevatorLength = 26.837d0 !?????? ! TDS with Elevator Length [ft] + TD_TDSElevatorToolLength= 0.859d0 !??????????????????? ! [ft] + TD_TDSElevatorECG = 2.454 ! [ft] + TD_NumOfCables = NumberOfLine + TD_WeightTB = TravelingBlockWeight ! [lb] + TD_WeightTD = TopDriveWeight ! [lb] + TD_KellyWeight = KellyWeight ! [lb] + + + + + + + + + !=====> Velocity Calculation + TD_HookVelocity = (TD_HookHeight-TD_HookHeightOld)/TD_TimeStep ! [ft/s] + + + + + + + + + +!==================================================== +! Add or Remove DrillStem Components +!==================================================== + Call TD_AddComponents + + Call TD_RemoveComponents + + + !=====> Read Data + kk = 0 + LengthSum = 0.d0 + + Do i = TD_DrillStemComponentsNumbs , 1 , -1 + if (TD_DrillStems(i)%ComponentType==3) then + kk = i + exit + else if (TD_DrillStems(i)%ComponentType==5 .or. TD_DrillStems(i)%ComponentType==7) then + LengthSum = LengthSum+TD_DrillStems(i)%LengthIni + end if + End Do + !print*, 'kk' , kk + !print*, 'TD_DrillStems(kk)%LengthIni0=' , TD_DrillStems(kk)%LengthIni + + + + +!==================================================== +! String Connection Mode Determination +!==================================================== + + !####TD_StringConnectionMode = + ! = 0 Slips Set ??????? + ! = 1 Kelly Connected to String + ! = 2 Kelly Nothing Connected + ! = 3 Kelly Connected to Single + ! = 4 Elevator Connected to String + ! = 5 Elevator Nothing Connected + ! = 6 Elevator Connected to Stand + ! = 7 Elevator Connected to Single + ! = 8 Elevator Latch String + ! = 18 Elevator Latch Single + ! = 19 Elevator Latch Stand + ! = 9 TDS CONNECTION SPINE + ! = 10 TDS CONNECTION STRING + ! = 11 TDS CONNECTION NOTHING .and. TDS ELEVATOR LATCH STRING + ! = 12 TDS CONNECTION NOTHING .and. TDS ELEVATOR CONNECTION STRING + ! = 13 TDS CONNECTION NOTHING .and. TDS ELEVATOR CONNECTION NOTHING + ! = 14 TDS CONNECTION NOTHING .and. TDS ELEVATOR CONNECTION STAND + ! = 15 TDS CONNECTION NOTHING .and. TDS ELEVATOR CONNECTION SINGLE + ! = 16 TDS CONNECTION NOTHING .and. TDS ELEVATOR LATCH SINGLE + ! = 17 TDS CONNECTION NOTHING .and. TDS ELEVATOR LATCH STAND + + + + + + !if (TD_DlTouch<=0.) then ![ft] + ! if(TD_HookVelocity<=0.) then + ! TD_ConnectionHeight = TD_ConnectionHeight + ! TD_StringVelocity = 0.0d0 + ! return + ! end if + !end if + + + + !=====> Connection Height Determination + + if ( TD_KellyDriveTypeMode==0 ) then + + if(Get_KellyConnection() == KELLY_CONNECTION_STRING) then + TD_KellyNewStatus1 = 1 + else + TD_KellyNewStatus1 = 0 + !TD_KellyOldStatus1 = 0 + end if + + if(Get_KellyConnection()==KELLY_CONNECTION_NOTHING) then + TD_KellyNewStatus2 = 1 + else + TD_KellyNewStatus2 = 0 + !TD_KellyOldStatus2 = 0 + end if + + if(Get_KellyConnection()==KELLY_CONNECTION_SINGLE) then + TD_KellyNewStatus3 = 1 + else + TD_KellyNewStatus3 = 0 + !TD_KellyOldStatus3 = 0 + end if + + + if ( Get_KellyConnection() == KELLY_CONNECTION_STRING ) then + TD_StringConnectionMode = 1 + !print*, 'TD_ConnectionHeight10=' , TD_ConnectionHeight + !print*, 'TD_KellyElementConst1=' , TD_KellyElementConst + !print*, 'TD_DrillStems(kk)%LengthIni1=' , TD_DrillStems(kk)%LengthIni + if (TD_KellyOldStatus2==1 .and. TD_KellyNewStatus1/=TD_KellyOldStatus1) then + TD_ConnectionHeight = TD_ConnectionHeight+TD_KellyElementConst + TD_KellyOldStatus1 = TD_KellyNewStatus1 + TD_KellyOldStatus2 = 0 + else if (TD_KellyOldStatus3==1 .and. TD_KellyNewStatus1/=TD_KellyOldStatus1) then + TD_ConnectionHeight = TD_ConnectionHeight+TD_KellyElementConst+30.d0 !TD_DrillStems(kk)%LengthIni + TD_KellyOldStatus1 = TD_KellyNewStatus1 + TD_KellyOldStatus3 = 0 + end if + !print*, 'TD_ConnectionHeight1=' , TD_ConnectionHeight + if ( Get_Slips() == SLIPS_SET_END ) then + !!if ( TD_HookVelocity>0. ) then + !! Print*, '*** UnSet Slips ***' !????????? + !!end if + TD_KellyConnectionHeight = TD_HookHeight-(TD_KellyConst-TD_KellyElementConst) !????????? + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + else + !if (TD_DlTouch<=0. .and. TD_HookVelocity<=0.) then + ! TD_ConnectionHeight = TD_ConnectionHeight + ! TD_StringVelocity = 0.0d0 + !else + TD_KellyConnectionHeight = TD_HookHeight-(TD_KellyConst-TD_KellyElementConst) !?????????? + TD_ConnectionHeight = TD_KellyConnectionHeight + TD_StringVelocity = TD_HookVelocity + !end if + end if + + else if ( Get_KellyConnection() == KELLY_CONNECTION_NOTHING ) then + TD_StringConnectionMode = 2 + !print*, 'TD_ConnectionHeight20=' , TD_ConnectionHeight + !print*, 'TD_KellyElementConst2=' , TD_KellyElementConst + if (TD_KellyOldStatus1==1 .and. TD_KellyNewStatus2/=TD_KellyOldStatus2) then + TD_ConnectionHeight = TD_ConnectionHeight-TD_KellyElementConst + TD_KellyOldStatus2 = TD_KellyNewStatus2 + TD_KellyOldStatus1 = 0 + else if (TD_KellyOldStatus3==1 .and. TD_KellyNewStatus2/=TD_KellyOldStatus2) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus2 = TD_KellyNewStatus2 + TD_KellyOldStatus3 = 0 + else if (TD_KellyOldStatus5==1 .and. TD_KellyNewStatus2/=TD_KellyOldStatus2) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus2 = TD_KellyNewStatus2 + TD_KellyOldStatus5 = 0 + end if + !print*, 'TD_ConnectionHeight2=' , TD_ConnectionHeight + TD_KellyConnectionHeight = TD_HookHeight-TD_KellyConst + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + + else if ( Get_KellyConnection() == KELLY_CONNECTION_SINGLE ) then + !print*, 'KELLY_CONNECTION_SINGLE' , TD_ConnectionHeight + TD_StringConnectionMode = 3 + !print*, 'TD_ConnectionHeight30=' , TD_ConnectionHeight + !print*, 'TD_KellyElementConst3=' , TD_KellyElementConst + !print*, 'TD_DrillStems(kk)%LengthIni3=' , TD_DrillStems(kk)%LengthIni + if (TD_KellyOldStatus1==1 .and. TD_KellyNewStatus3/=TD_KellyOldStatus3) then + !print*, 'KELLY_CONNECTION_SINGLE1' , TD_ConnectionHeight + !print*, 'TD_KellyElementConst=' , TD_KellyElementConst + !print*, 'TD_DrillStems(kk)%LengthIni=' , TD_DrillStems(kk)%LengthIni + TD_ConnectionHeight = TD_ConnectionHeight-TD_KellyElementConst-30.d0 !TD_DrillStems(kk)%LengthIni + TD_KellyOldStatus3 = TD_KellyNewStatus3 + TD_KellyOldStatus1 = 0 + else if (TD_KellyOldStatus2==1 .and. TD_KellyNewStatus3/=TD_KellyOldStatus3) then + !print*, 'KELLY_CONNECTION_SINGLE2' , TD_ConnectionHeight + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus3 = TD_KellyNewStatus3 + TD_KellyOldStatus2 = 0 + end if + !print*, 'TD_ConnectionHeight3=' , TD_ConnectionHeight + !print*, 'KELLY_CONNECTION_SINGLE3' , TD_ConnectionHeight + TD_KellyConnectionHeight = TD_HookHeight-TD_KellyConst-TD_DrillStems(kk)%LengthIni + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + !print*, 'KELLY_CONNECTION_SINGLE4' , TD_ConnectionHeight + end if + !print*, 'KELLY_CONNECTION_SINGLE5' , TD_ConnectionHeight + + else if ( TD_KellyDriveTypeMode==1 ) then + + if(Get_ElevatorConnection() == ELEVATOR_CONNECTION_STRING) then + TD_KellyNewStatus4 = 1 + else + TD_KellyNewStatus4 = 0 + !TD_KellyOldStatus4 = 0 + end if + + if(Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING) then + TD_KellyNewStatus5 = 1 + else + TD_KellyNewStatus5 = 0 + !TD_KellyOldStatus5 = 0 + end if + + if(Get_ElevatorConnection() == ELEVATOR_CONNECTION_STAND) then + TD_KellyNewStatus6 = 1 + else + TD_KellyNewStatus6 = 0 + !TD_KellyOldStatus6 = 0 + end if + + if(Get_ElevatorConnection() == ELEVATOR_CONNECTION_SINGLE) then + TD_KellyNewStatus7 = 1 + else + TD_KellyNewStatus7 = 0 + !TD_KellyOldStatus7 = 0 + end if + + if(Get_ElevatorConnection() == ELEVATOR_LATCH_STRING) then + TD_KellyNewStatus8 = 1 + else + TD_KellyNewStatus8 = 0 + !TD_KellyOldStatus8 = 0 + end if + + if(Get_ElevatorConnection() == ELEVATOR_LATCH_SINGLE) then + TD_KellyNewStatus18 = 1 + else + TD_KellyNewStatus18 = 0 + !TD_KellyOldStatus18 = 0 + end if + + if(Get_ElevatorConnection() == ELEVATOR_LATCH_STAND) then + TD_KellyNewStatus19 = 1 + else + TD_KellyNewStatus19 = 0 + !TD_KellyOldStatus19 = 0 + end if + + + if ( Get_ElevatorConnection() == ELEVATOR_CONNECTION_STRING ) then + TD_StringConnectionMode = 4 + if (TD_KellyOldStatus5==1 .and. TD_KellyNewStatus4/=TD_KellyOldStatus4) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus4 = TD_KellyNewStatus4 + TD_KellyOldStatus5 = 0 + else if (TD_KellyOldStatus6==1 .and. TD_KellyNewStatus4/=TD_KellyOldStatus4) then + TD_ConnectionHeight = TD_ConnectionHeight+(3.d0*TD_DrillStems(kk)%LengthIni) + TD_KellyOldStatus4 = TD_KellyNewStatus4 + TD_KellyOldStatus6 = 0 + else if (TD_KellyOldStatus7==1 .and. TD_KellyNewStatus4/=TD_KellyOldStatus4) then + TD_ConnectionHeight = TD_ConnectionHeight+TD_DrillStems(kk)%LengthIni + TD_KellyOldStatus4 = TD_KellyNewStatus4 + TD_KellyOldStatus7 = 0 + else if (TD_KellyOldStatus8==1 .and. TD_KellyNewStatus4/=TD_KellyOldStatus4) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus4 = TD_KellyNewStatus4 + TD_KellyOldStatus8 = 0 + end if + if ( Get_Slips() == SLIPS_SET_END ) then + !if ( TD_HookVelocity>0. ) then + ! Print*, '*** UnSet Slips ***' !??????????????????? + !end if + TD_ElevatorHeight = TD_HookHeight-TD_ElevatorConst !????????????? + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + else + TD_ElevatorHeight = TD_HookHeight-TD_ElevatorConst + TD_ConnectionHeight = TD_HookHeight-TD_ElevatorConst+(LengthSum+TD_ElevatorECG) !(LengthSum+TD_DrillStems(kk)%ToolJointRange) + TD_StringVelocity = TD_HookVelocity + end if + + else if ( Get_ElevatorConnection() == ELEVATOR_CONNECTION_NOTHING ) then + TD_StringConnectionMode = 5 + if (TD_KellyOldStatus4==1 .and. TD_KellyNewStatus5/=TD_KellyOldStatus5) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus5 = TD_KellyNewStatus5 + TD_KellyOldStatus4 = 0 + else if (TD_KellyOldStatus6==1 .and. TD_KellyNewStatus5/=TD_KellyOldStatus5) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus5 = TD_KellyNewStatus5 + TD_KellyOldStatus6 = 0 + else if (TD_KellyOldStatus7==1 .and. TD_KellyNewStatus5/=TD_KellyOldStatus5) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus5 = TD_KellyNewStatus5 + TD_KellyOldStatus7 = 0 + else if (TD_KellyOldStatus8==1 .and. TD_KellyNewStatus5/=TD_KellyOldStatus5) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus5 = TD_KellyNewStatus5 + TD_KellyOldStatus8 = 0 + else if (TD_KellyOldStatus2==1 .and. TD_KellyNewStatus5/=TD_KellyOldStatus5) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus5 = TD_KellyNewStatus5 + TD_KellyOldStatus2 = 0 + end if + TD_ElevatorHeight = TD_HookHeight-TD_ElevatorConst + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + + else if ( Get_ElevatorConnection() == ELEVATOR_CONNECTION_STAND ) then + TD_StringConnectionMode = 6 + if (TD_KellyOldStatus4==1 .and. TD_KellyNewStatus6/=TD_KellyOldStatus6) then + TD_ConnectionHeight = TD_ConnectionHeight-(3.*TD_DrillStems(kk)%LengthIni) + TD_KellyOldStatus6 = TD_KellyNewStatus6 + TD_KellyOldStatus4 = 0 + else if (TD_KellyOldStatus5==1 .and. TD_KellyNewStatus6/=TD_KellyOldStatus6) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus6 = TD_KellyNewStatus6 + TD_KellyOldStatus5 = 0 + else if (TD_KellyOldStatus7==1 .and. TD_KellyNewStatus6/=TD_KellyOldStatus6) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus6 = TD_KellyNewStatus6 + TD_KellyOldStatus7 = 0 + else if (TD_KellyOldStatus8==1 .and. TD_KellyNewStatus6/=TD_KellyOldStatus6) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus6 = TD_KellyNewStatus6 + TD_KellyOldStatus8 = 0 + end if + TD_ElevatorHeight = TD_HookHeight-TD_ElevatorConst-(3.*TD_DrillStems(kk)%LengthIni) + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + + else if ( Get_ElevatorConnection() == ELEVATOR_CONNECTION_SINGLE ) then + TD_StringConnectionMode = 7 + if (TD_KellyOldStatus4==1 .and. TD_KellyNewStatus7/=TD_KellyOldStatus7) then + TD_ConnectionHeight = TD_ConnectionHeight-TD_DrillStems(kk)%LengthIni + TD_KellyOldStatus7 = TD_KellyNewStatus7 + TD_KellyOldStatus4 = 0 + else if (TD_KellyOldStatus5==1 .and. TD_KellyNewStatus7/=TD_KellyOldStatus7) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus7 = TD_KellyNewStatus7 + TD_KellyOldStatus5 = 0 + else if (TD_KellyOldStatus6==1 .and. TD_KellyNewStatus7/=TD_KellyOldStatus7) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus7 = TD_KellyNewStatus7 + TD_KellyOldStatus6 = 0 + else if (TD_KellyOldStatus8==1 .and. TD_KellyNewStatus7/=TD_KellyOldStatus7) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus7 = TD_KellyNewStatus7 + TD_KellyOldStatus8 = 0 + end if + TD_ElevatorHeight = TD_HookHeight-TD_ElevatorConst-TD_DrillStems(kk)%LengthIni + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + + else if ( Get_ElevatorConnection() == ELEVATOR_LATCH_STRING ) then + TD_StringConnectionMode = 8 + if (TD_KellyOldStatus4==1 .and. TD_KellyNewStatus8/=TD_KellyOldStatus8) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus8 = TD_KellyNewStatus8 + TD_KellyOldStatus4 = 0 + else if (TD_KellyOldStatus5==1 .and. TD_KellyNewStatus8/=TD_KellyOldStatus8) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus8 = TD_KellyNewStatus8 + TD_KellyOldStatus5 = 0 + else if (TD_KellyOldStatus6==1 .and. TD_KellyNewStatus8/=TD_KellyOldStatus8) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus8 = TD_KellyNewStatus8 + TD_KellyOldStatus6 = 0 + else if (TD_KellyOldStatus7==1 .and. TD_KellyNewStatus8/=TD_KellyOldStatus8) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus8 = TD_KellyNewStatus8 + TD_KellyOldStatus7 = 0 + end if + TD_ElevatorHeight = TD_HookHeight-TD_ElevatorConst + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + + else if ( Get_ElevatorConnection() == ELEVATOR_LATCH_SINGLE ) then + TD_StringConnectionMode = 18 + if (TD_KellyOldStatus5==1 .and. TD_KellyNewStatus18/=TD_KellyOldStatus18) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus18 = TD_KellyNewStatus18 + TD_KellyOldStatus5 = 0 + else if (TD_KellyOldStatus7==1 .and. TD_KellyNewStatus18/=TD_KellyOldStatus18) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus18 = TD_KellyNewStatus18 + TD_KellyOldStatus7 = 0 + else if (TD_KellyOldStatus8==1 .and. TD_KellyNewStatus18/=TD_KellyOldStatus18) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus18 = TD_KellyNewStatus18 + TD_KellyOldStatus8 = 0 + end if + TD_ElevatorHeight = TD_HookHeight-TD_ElevatorConst + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + + else if ( Get_ElevatorConnection() == ELEVATOR_LATCH_STAND ) then + TD_StringConnectionMode = 19 + if (TD_KellyOldStatus5==1 .and. TD_KellyNewStatus19/=TD_KellyOldStatus19) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus19 = TD_KellyNewStatus19 + TD_KellyOldStatus5 = 0 + else if (TD_KellyOldStatus6==1 .and. TD_KellyNewStatus19/=TD_KellyOldStatus19) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus19 = TD_KellyNewStatus19 + TD_KellyOldStatus6 = 0 + else if (TD_KellyOldStatus8==1 .and. TD_KellyNewStatus19/=TD_KellyOldStatus19) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus19 = TD_KellyNewStatus19 + TD_KellyOldStatus8 = 0 + end if + TD_ElevatorHeight = TD_HookHeight-TD_ElevatorConst + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + end if + + else if ( TD_KellyDriveTypeMode==2 ) then + + if( Get_TdsConnectionModes()==TDS_CONNECTION_SPINE ) then + TD_KellyNewStatus9 = 1 + else + TD_KellyNewStatus9 = 0 + !TD_KellyOldStatus9 = 0 + end if + + if( Get_TdsConnectionModes()==TDS_CONNECTION_STRING ) then + TD_KellyNewStatus10 = 1 + else + TD_KellyNewStatus10 = 0 + !TD_KellyOldStatus10 = 0 + end if + + if( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_LATCH_STRING ) then + TD_KellyNewStatus11 = 1 + else + TD_KellyNewStatus11 = 0 + !TD_KellyOldStatus11 = 0 + end if + + if( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_CONNECTION_STRING ) then + TD_KellyNewStatus12 = 1 + else + TD_KellyNewStatus12 = 0 + !TD_KellyOldStatus12 = 0 + end if + + if( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_CONNECTION_NOTHING ) then + TD_KellyNewStatus13 = 1 + else + TD_KellyNewStatus13 = 0 + !TD_KellyOldStatus13 = 0 + end if + + if( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_CONNECTION_STAND ) then + TD_KellyNewStatus14 = 1 + else + TD_KellyNewStatus14 = 0 + !TD_KellyOldStatus14 = 0 + end if + + if( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_CONNECTION_SINGLE ) then + TD_KellyNewStatus15 = 1 + else + TD_KellyNewStatus15 = 0 + !TD_KellyOldStatus15 = 0 + end if + + if( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_LATCH_SINGLE ) then + TD_KellyNewStatus16 = 1 + else + TD_KellyNewStatus16 = 0 + !TD_KellyOldStatus16 = 0 + end if + + if( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_LATCH_STAND ) then + TD_KellyNewStatus17 = 1 + else + TD_KellyNewStatus17 = 0 + !TD_KellyOldStatus17 = 0 + end if + + if ( Get_TdsConnectionModes()==TDS_CONNECTION_SPINE ) then + TD_StringConnectionMode = 9 + if (TD_KellyOldStatus10==1 .and. TD_KellyNewStatus9/=TD_KellyOldStatus9) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus9 = TD_KellyNewStatus9 + TD_KellyOldStatus10 = 0 + else if (TD_KellyOldStatus11==1 .and. TD_KellyNewStatus9/=TD_KellyOldStatus9) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus9 = TD_KellyNewStatus9 + TD_KellyOldStatus11 = 0 + else if (TD_KellyOldStatus13==1 .and. TD_KellyNewStatus9/=TD_KellyOldStatus9) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus9 = TD_KellyNewStatus9 + TD_KellyOldStatus13 = 0 + end if + if ( Get_Slips() == SLIPS_SET_END ) then + !if ( TD_HookVelocity>0. ) then + ! Print*, '*** UnSet Slips ***' !??????????????????? + !end if + TD_TDSHeight = TD_HookHeight-TD_TDSLength-TD_TDSToolJointLength !????????????? + TD_TDSElevatorHeight = TD_HookHeight-TD_TDSElevatorLength !????????????? + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + else + TD_TDSHeight = TD_HookHeight-TD_TDSLength-TD_TDSToolJointLength !????????????? + TD_TDSElevatorHeight = TD_HookHeight-TD_TDSElevatorLength !????????????? + TD_ConnectionHeight = TD_TDSHeight + TD_StringVelocity = TD_HookVelocity + end if + + else if ( Get_TdsConnectionModes()==TDS_CONNECTION_STRING ) then + TD_StringConnectionMode = 10 + if (TD_KellyOldStatus9==1 .and. TD_KellyNewStatus10/=TD_KellyOldStatus10) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus10 = TD_KellyNewStatus10 + TD_KellyOldStatus9 = 0 + end if + if ( Get_Slips() == SLIPS_SET_END ) then + !if ( TD_HookVelocity>0. ) then + ! Print*, '*** UnSet Slips ***' !??????????????????? + !end if + TD_TDSHeight = TD_HookHeight-TD_TDSLength-TD_TDSToolJointLength !????????????? + TD_TDSElevatorHeight = TD_HookHeight-TD_TDSElevatorLength !????????????? + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + else + TD_TDSHeight = TD_HookHeight-TD_TDSLength-TD_TDSToolJointLength !????????????? + TD_TDSElevatorHeight = TD_HookHeight-TD_TDSElevatorLength !????????????? + TD_ConnectionHeight = TD_TDSHeight + TD_StringVelocity = TD_HookVelocity + end if + + else if ( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_LATCH_STRING ) then + TD_StringConnectionMode = 11 + if (TD_KellyOldStatus9==1 .and. TD_KellyNewStatus11/=TD_KellyOldStatus11) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus11 = TD_KellyNewStatus11 + TD_KellyOldStatus9 = 0 + else if (TD_KellyOldStatus12==1 .and. TD_KellyNewStatus11/=TD_KellyOldStatus11) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus11 = TD_KellyNewStatus11 + TD_KellyOldStatus12 = 0 + else if (TD_KellyOldStatus13==1 .and. TD_KellyNewStatus11/=TD_KellyOldStatus11) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus11 = TD_KellyNewStatus11 + TD_KellyOldStatus13 = 0 + else if (TD_KellyOldStatus16==1 .and. TD_KellyNewStatus11/=TD_KellyOldStatus11) then + TD_ConnectionHeight = TD_ConnectionHeight+(TD_DrillStems(kk)%LengthIni) + TD_KellyOldStatus11 = TD_KellyNewStatus11 + TD_KellyOldStatus16 = 0 + else if (TD_KellyOldStatus17==1 .and. TD_KellyNewStatus11/=TD_KellyOldStatus11) then + TD_ConnectionHeight = TD_ConnectionHeight+(3.d0*TD_DrillStems(kk)%LengthIni) + TD_KellyOldStatus11 = TD_KellyNewStatus11 + TD_KellyOldStatus17 = 0 + end if + TD_TDSHeight = TD_HookHeight-TD_TDSLength !????????????? + TD_TDSElevatorHeight = TD_HookHeight-TD_TDSElevatorLength !????????????? + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + + else if ( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_CONNECTION_STRING ) then + TD_StringConnectionMode = 12 + if (TD_KellyOldStatus11==1 .and. TD_KellyNewStatus12/=TD_KellyOldStatus12) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus12 = TD_KellyNewStatus12 + TD_KellyOldStatus11 = 0 + else if (TD_KellyOldStatus14==1 .and. TD_KellyNewStatus12/=TD_KellyOldStatus12) then + TD_ConnectionHeight = TD_ConnectionHeight+(3.d0*TD_DrillStems(kk)%LengthIni) + TD_KellyOldStatus12 = TD_KellyNewStatus12 + TD_KellyOldStatus14 = 0 + else if (TD_KellyOldStatus15==1 .and. TD_KellyNewStatus12/=TD_KellyOldStatus12) then + TD_ConnectionHeight = TD_ConnectionHeight+(TD_DrillStems(kk)%LengthIni) + TD_KellyOldStatus12 = TD_KellyNewStatus12 + TD_KellyOldStatus15 = 0 + end if + if ( Get_Slips() == SLIPS_SET_END ) then + !if ( TD_HookVelocity>0. ) then + ! Print*, '*** UnSet Slips ***' !??????????????????? + !end if + TD_TDSHeight = TD_HookHeight-TD_TDSLength !????????????? + TD_TDSElevatorHeight = TD_HookHeight-TD_TDSElevatorLength !????????????? + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + else + TD_TDSHeight = TD_HookHeight-TD_TDSLength !????????????? + TD_TDSElevatorHeight = TD_HookHeight-TD_TDSLength-TD_TDSElevatorLength !????????????? + TD_ConnectionHeight = TD_HookHeight-TD_TDSElevatorLength+(LengthSum+TD_TDSElevatorECG) !????????????? + TD_StringVelocity = TD_HookVelocity + end if + + else if ( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_CONNECTION_NOTHING ) then + TD_StringConnectionMode = 13 + if (TD_KellyOldStatus9==1 .and. TD_KellyNewStatus13/=TD_KellyOldStatus13) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus13 = TD_KellyNewStatus13 + TD_KellyOldStatus9 = 0 + else if (TD_KellyOldStatus11==1 .and. TD_KellyNewStatus13/=TD_KellyOldStatus13) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus13 = TD_KellyNewStatus13 + TD_KellyOldStatus11 = 0 + else if (TD_KellyOldStatus12==1 .and. TD_KellyNewStatus13/=TD_KellyOldStatus13) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus13 = TD_KellyNewStatus13 + TD_KellyOldStatus12 = 0 + else if (TD_KellyOldStatus14==1 .and. TD_KellyNewStatus13/=TD_KellyOldStatus13) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus13 = TD_KellyNewStatus13 + TD_KellyOldStatus14 = 0 + else if (TD_KellyOldStatus15==1 .and. TD_KellyNewStatus13/=TD_KellyOldStatus13) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus13 = TD_KellyNewStatus13 + TD_KellyOldStatus15 = 0 + else if (TD_KellyOldStatus16==1 .and. TD_KellyNewStatus13/=TD_KellyOldStatus13) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus13 = TD_KellyNewStatus13 + TD_KellyOldStatus16 = 0 + end if + TD_TDSHeight = TD_HookHeight-TD_TDSLength !????????????? + TD_TDSElevatorHeight = TD_HookHeight-TD_TDSElevatorLength !????????????? + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + + else if ( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_CONNECTION_STAND ) then + TD_StringConnectionMode = 14 + if (TD_KellyOldStatus12==1 .and. TD_KellyNewStatus14/=TD_KellyOldStatus14) then + TD_ConnectionHeight = TD_ConnectionHeight-(3.d0*TD_DrillStems(kk)%LengthIni) + TD_KellyOldStatus14 = TD_KellyNewStatus14 + TD_KellyOldStatus12 = 0 + else if (TD_KellyOldStatus13==1 .and. TD_KellyNewStatus14/=TD_KellyOldStatus14) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus14 = TD_KellyNewStatus14 + TD_KellyOldStatus13 = 0 + else if (TD_KellyOldStatus17==1 .and. TD_KellyNewStatus14/=TD_KellyOldStatus14) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus14 = TD_KellyNewStatus14 + TD_KellyOldStatus17 = 0 + end if + TD_TDSHeight = TD_HookHeight-TD_TDSLength !????????????? + TD_TDSElevatorHeight = TD_HookHeight-TD_TDSElevatorLength !????????????? + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + + else if ( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_CONNECTION_SINGLE ) then + TD_StringConnectionMode = 15 + if (TD_KellyOldStatus12==1 .and. TD_KellyNewStatus15/=TD_KellyOldStatus15) then + TD_ConnectionHeight = TD_ConnectionHeight-(TD_DrillStems(kk)%LengthIni) + TD_KellyOldStatus15 = TD_KellyNewStatus15 + TD_KellyOldStatus12 = 0 + else if (TD_KellyOldStatus13==1 .and. TD_KellyNewStatus15/=TD_KellyOldStatus15) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus15 = TD_KellyNewStatus15 + TD_KellyOldStatus13 = 0 + else if (TD_KellyOldStatus16==1 .and. TD_KellyNewStatus15/=TD_KellyOldStatus15) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus15 = TD_KellyNewStatus15 + TD_KellyOldStatus16 = 0 + end if + TD_TDSHeight = TD_HookHeight-TD_TDSLength !????????????? + TD_TDSElevatorHeight = TD_HookHeight-TD_TDSElevatorLength !????????????? + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + + else if ( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_LATCH_SINGLE ) then + TD_StringConnectionMode = 16 + if (TD_KellyOldStatus11==1 .and. TD_KellyNewStatus16/=TD_KellyOldStatus16) then + TD_ConnectionHeight = TD_ConnectionHeight-(TD_DrillStems(kk)%LengthIni) + TD_KellyOldStatus16 = TD_KellyNewStatus16 + TD_KellyOldStatus11 = 0 + else if (TD_KellyOldStatus13==1 .and. TD_KellyNewStatus16/=TD_KellyOldStatus16) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus16 = TD_KellyNewStatus16 + TD_KellyOldStatus13 = 0 + else if (TD_KellyOldStatus15==1 .and. TD_KellyNewStatus16/=TD_KellyOldStatus16) then + TD_ConnectionHeight = TD_ConnectionHeight + TD_KellyOldStatus16 = TD_KellyNewStatus16 + TD_KellyOldStatus15 = 0 + end if + TD_TDSHeight = TD_HookHeight-TD_TDSLength !????????????? + TD_TDSElevatorHeight = TD_HookHeight-TD_TDSElevatorLength !????????????? + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + + else if ( Get_TdsConnectionModes()==TDS_CONNECTION_NOTHING .and. Get_TdsElevatorModes()==TDS_ELEVATOR_LATCH_STAND ) then + TD_StringConnectionMode = 17 + if (TD_KellyOldStatus11==1 .and. TD_KellyNewStatus17/=TD_KellyOldStatus17) then + TD_ConnectionHeight = TD_ConnectionHeight-(3.d0*TD_DrillStems(kk)%LengthIni) + TD_KellyOldStatus17 = TD_KellyNewStatus17 + TD_KellyOldStatus11 = 0 + else if (TD_KellyOldStatus14==1 .and. TD_KellyNewStatus17/=TD_KellyOldStatus17) then + TD_ConnectionHeight = TD_ConnectionHeight+(3.d0*TD_DrillStems(kk)%LengthIni) + TD_KellyOldStatus17 = TD_KellyNewStatus17 + TD_KellyOldStatus14 = 0 + end if + TD_TDSHeight = TD_HookHeight-TD_TDSLength !????????????? + TD_TDSElevatorHeight = TD_HookHeight-TD_TDSElevatorLength !????????????? + TD_ConnectionHeight = TD_ConnectionHeight + TD_StringVelocity = 0.0d0 + end if + + + end if + + !Print*, 'TD_StringConnectionMode=' , TD_StringConnectionMode + !print* , 'TD_ConnectionHeight=' , TD_ConnectionHeight + !Print*, 'TD_StringConnectionMode=' , TD_StringConnectionMode + !print*, 'TD_DrillStemComponentsNumbs=' , TD_DrillStemComponentsNumbs + !!Print*, 'TD_KellyNewStatus1=' , TD_KellyNewStatus1 + !Print*, 'TD_KellyOldStatus1=' , TD_KellyOldStatus1 + !Print*, 'TD_KellyNewStatus2=' , TD_KellyNewStatus2 + !Print*, 'TD_KellyOldStatus2=' , TD_KellyOldStatus2 + !Print*, 'TD_KellyNewStatus3=' , TD_KellyNewStatus3 + !Print*, 'TD_KellyOldStatus3=' , TD_KellyOldStatus3 + + + + + + + if ( (any(TD_StringConnectionMode==(/1,9,10/))) .or. CloseSafetyValve==.true. ) then !for fluid module + TD_FluidStringConnectionMode = 1 !string is connected + !else if ( (any(TD_StringConnectionMode==(/1,9,10/))) .or. CloseSafetyValve==.true. ) then + ! + else + TD_FluidStringConnectionMode = 0 !string is not connected + end if + + + + + + +!==================================================== +! Zero String Speed +!==================================================== + if ( abs(TD_StringVelocity)<=0.05d0 ) then ! [ft/s] + TD_ZeroStringSpeed = 1 + Call Set_ZeroStringSpeed(.true.) + else + TD_ZeroStringSpeed = 0 + Call Set_ZeroStringSpeed(.false.) + end if + + + + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_DrillingSubs/TD_WellElementsConfiguration.f90 b/TorqueDrag/TD_DrillingSubs/TD_WellElementsConfiguration.f90 new file mode 100644 index 0000000..69b00e8 --- /dev/null +++ b/TorqueDrag/TD_DrillingSubs/TD_WellElementsConfiguration.f90 @@ -0,0 +1,28 @@ +subroutine TD_WellElementsConfiguration + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + + + implicit none + + Integer :: i, j + + +!==================================================== +! Modified Well Elements Data +!==================================================== + + Do i = 1 , TD_ROPHoleNumbs + !TD_ROPHole(i)%TopDepth = TD_WellGeo(TD_WellIntervalsCount)%TopDepth + TD_ROPHole(i)%DownDepth = TD_WellGeo(TD_WellIntervalsCount)%DownDepth + TD_ROPHole(i)%Length = TD_WellGeo(TD_WellIntervalsCount)%IntervalLength + TD_ROPHole(i)%Id = TD_ROPHole(i)%Id !!??????????? + End Do + + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_DrillingSubs/TD_WellGeoConfiguration.f90 b/TorqueDrag/TD_DrillingSubs/TD_WellGeoConfiguration.f90 new file mode 100644 index 0000000..10c0136 --- /dev/null +++ b/TorqueDrag/TD_DrillingSubs/TD_WellGeoConfiguration.f90 @@ -0,0 +1,51 @@ +subroutine TD_WellGeoConfiguration + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + Use sROP_Variables + Use CDataDisplayConsoleVariables + Use CWarningsVariables + + + + implicit none + + +!==================================================== +! Well Geometry Data Modification +!==================================================== + + +!=====> ROP Calculation + if ( TD_DrillStems(1)%ComponentType==0 .and. MaximumWellDepthExceeded==.false. ) then + Call ROP_MainCalculation + else + Rate_of_Penetration = 0.d0 + Call Set_ROP(Rate_of_Penetration) + end if + + + + +!=====> ROPHole Data correction + TD_ROP = (Rate_of_Penetration/3600.d0) ! [ft/s] + TD_WellGeo(TD_WellIntervalsCount)%VerticalDepth = TD_WellGeo(TD_WellIntervalsCount)%VerticalDepth++((TD_ROP*TD_TimeStep)*cos(TD_WellGeo(TD_WellIntervalsCount)%StartAngle)) + TD_WellGeo(TD_WellIntervalsCount)%IntervalLength = TD_WellGeo(TD_WellIntervalsCount)%IntervalLength+(TD_ROP*TD_TimeStep) !????????check + TD_WellGeo(TD_WellIntervalsCount)%DownDepth = TD_WellGeo(TD_WellIntervalsCount)%TopDepth+TD_WellGeo(TD_WellIntervalsCount)%IntervalLength + + + + + +!=====> Well Total Length Calculation + TD_WellTotalLength = TD_WellGeo(TD_WellIntervalsCount)%DownDepth + TD_WellTotalVerticalLength = TD_WellTotalVerticalLength+((TD_ROP*TD_TimeStep)*cos(TD_WellGeo(TD_WellIntervalsCount)%StartAngle)) + + Call Set_TotalDepth(real(TD_WellTotalLength,8)) + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_DrillingSubs/TVD_Calculator.f90 b/TorqueDrag/TD_DrillingSubs/TVD_Calculator.f90 new file mode 100644 index 0000000..4bed1d0 --- /dev/null +++ b/TorqueDrag/TD_DrillingSubs/TVD_Calculator.f90 @@ -0,0 +1,78 @@ +subroutine TVD_Calculator(MeasuredDepth,VerticalDepth) + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_StringConnectionData + + + implicit none + + Integer :: kk + REAL(8) :: MeasuredDepth , VerticalDepth + REAL(8) :: mm , nn , dl , StartAngle , EndAngle + + + + + + if ( MeasuredDepth<=0. ) then + VerticalDepth = MeasuredDepth + !Angle(ii) = 0.d0 + return + end if + + + + mm = 0.d0 !last vertical depth + nn = 0.d0 !last measured depth + EndAngle = TD_WellGeo(1)%StartAngle + !Angle(jj) = EndAngle + + do kk = 1, TD_WellIntervalsCount + StartAngle = EndAngle + if ( MeasuredDepth>TD_WellGeo(kk)%TopDepth ) then + if ( MeasuredDepth>TD_WellGeo(kk)%DownDepth ) then + dl = TD_WellGeo(kk)%DownDepth-nn ![ft] + nn = TD_WellGeo(kk)%DownDepth + if ( TD_WellGeo(kk)%HoleType==0 ) then + EndAngle = StartAngle + VerticalDepth = mm+(dl*cos(TD_WellGeo(kk)%StartAngle)) ![ft] + !Angle(ii) = EndAngle + else if ( TD_WellGeo(kk)%HoleType==1 ) then + EndAngle = StartAngle+(dl/TD_WellGeo(kk)%RCurvature) !????? + VerticalDepth = mm+(TD_WellGeo(kk)%RCurvature*sin(abs(EndAngle)-abs(StartAngle))*cos(abs(StartAngle)))-(TD_WellGeo(kk)%RCurvature*(1.-cos(abs(EndAngle)-abs(StartAngle)))*sin(abs(StartAngle))) + !Angle(ii) = EndAngle + else if ( TD_WellGeo(kk)%HoleType==2 ) then + EndAngle = StartAngle-(dl/TD_WellGeo(kk)%RCurvature) !????? + VerticalDepth = mm+(TD_WellGeo(kk)%RCurvature*sin(abs(abs(EndAngle)-abs(StartAngle)))*cos(abs(StartAngle)))+(TD_WellGeo(kk)%RCurvature*(1.-cos(abs(abs(EndAngle)-abs(StartAngle))))*sin(abs(StartAngle))) + !Angle(ii) = EndAngle + end if + mm = VerticalDepth + else + dl = MeasuredDepth-nn + nn = MeasuredDepth + if ( TD_WellGeo(kk)%HoleType==0 ) then + EndAngle = StartAngle + VerticalDepth = mm+(dl*cos(TD_WellGeo(kk)%StartAngle)) + !Angle(ii) = EndAngle + else if ( TD_WellGeo(kk)%HoleType==1 ) then + EndAngle = StartAngle+(dl/TD_WellGeo(kk)%RCurvature) !????? + VerticalDepth = mm+(TD_WellGeo(kk)%RCurvature*sin(abs(EndAngle)-abs(StartAngle))*cos(abs(StartAngle)))-(TD_WellGeo(kk)%RCurvature*(1.-cos(abs(EndAngle)-abs(StartAngle)))*sin(abs(StartAngle))) + !Angle(ii) = EndAngle + else if ( TD_WellGeo(kk)%HoleType==2 ) then + EndAngle = StartAngle-(dl/TD_WellGeo(kk)%RCurvature) !????? + VerticalDepth = mm+(TD_WellGeo(kk)%RCurvature*sin(abs(abs(EndAngle)-abs(StartAngle)))*cos(abs(StartAngle)))+(TD_WellGeo(kk)%RCurvature*(1.-cos(abs(abs(EndAngle)-abs(StartAngle))))*sin(abs(StartAngle))) + !Angle(ii) = EndAngle + end if + mm = VerticalDepth + exit + end if + end if + end do + + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_BouyancyFactor.f90 b/TorqueDrag/TD_Forces/TD_BouyancyFactor.f90 new file mode 100644 index 0000000..3e3f24f --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_BouyancyFactor.f90 @@ -0,0 +1,32 @@ +subroutine TD_BouyancyFactor (i) + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + + + + +!==================================================== +! Bouyancy Factor Calculation +!==================================================== + + if ( TD_DrillStems(i)%MudDensityOut==0.d0 .or. TD_DrillStems(i)%MudDensityIn==0.d0 ) then + TD_DrillStems(i)%BouyancyFactor = 0.d0 + else + TD_DrillStems(i)%BouyancyFactor = 1.d0-( ((TD_DrillStems(i)%MudDensityOut*(TD_DrillStems(i)%Od**2)/4.0d0) & + -(TD_DrillStems(i)%MudDensityIn*(TD_DrillStems(i)%Id**2)/4.0d0)) & + /(TD_DrillStems(i)%Density*((TD_DrillStems(i)%Od**2-TD_DrillStems(i)%Id**2))/4.0d0) ) + end if + + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_BuildArea/TD_ForceDownB.f90 b/TorqueDrag/TD_Forces/TD_BuildArea/TD_ForceDownB.f90 new file mode 100644 index 0000000..8e53b0b --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_BuildArea/TD_ForceDownB.f90 @@ -0,0 +1,65 @@ +subroutine TD_ForceDownB(i,TD_SemiMudVisc) + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + Real(8) :: TD_SemiMudVisc + + If (i==1) then + TD_DrillStems(1)%Force1 = -TD_WeightOnBit + TD_DrillStems(1)%Force2 = (TD_DrillStems(1)%Force1 * exp(-(TD_SemiMudVisc*TD_DrillStems(1)%MudVisCorrectCoef)*(TD_DrillStems(1)%EndAngle-TD_DrillStems(1)%StartAngle))) - & + (TD_DrillStems(1)%WeightperLength * TD_DrillStems(1)%RCurvature * & + (sin(TD_DrillStems(1)%EndAngle) - (exp(-(TD_SemiMudVisc*TD_DrillStems(1)%MudVisCorrectCoef) * & + (TD_DrillStems(1)%EndAngle-TD_DrillStems(1)%StartAngle)) * & + sin(TD_DrillStems(1)%StartAngle)))) + + if (TD_DrillStems(i)%ComponentType==0) then + TD_DrillStems(i)%Torque = TD_BitTorque + else + TD_DrillStems(i)%Torque = (TD_SemiMudVisc * TD_DrillStems(i)%RtoolJoint * (TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%WeightperLength * & + TD_DrillStems(i)%RCurvature * sin(TD_DrillStems(i)%StartAngle))) * & + abs(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)) + & + (2.0d0 * TD_SemiMudVisc * TD_DrillStems(i)%RtoolJoint * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature * & + (cos(TD_DrillStems(i)%EndAngle) - cos(TD_DrillStems(i)%StartAngle))) + end if + + + + return + End If + + + +!=========> F1 Calculation + TD_DrillStems(i)%Force1 = TD_DrillStems(i-1)%Force2 + + +!=========> F2 Calculation + TD_DrillStems(i)%Force2 = (TD_DrillStems(i)%Force1 * exp(-(TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle))) - & + (TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature * & + (sin(TD_DrillStems(i)%EndAngle) - (exp(-(TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef) * & + (TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)) * & + sin(TD_DrillStems(i)%StartAngle)))) + + + + ! + ! Strains(i)%Dl = TDForces(i)%Force * (Elements(i)%Length ) / & + ! (Elements(i)%Area * Element%ElasticModule) + ! + + TD_DrillStems(i)%Torque = (TD_SemiMudVisc * TD_DrillStems(i)%RtoolJoint * (TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%WeightperLength * & + TD_DrillStems(i)%RCurvature * sin(TD_DrillStems(i)%StartAngle))) * & + abs(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)) + & + (2.0d0 * TD_SemiMudVisc * TD_DrillStems(i)%RtoolJoint * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature * & + (cos(TD_DrillStems(i)%EndAngle) - cos(TD_DrillStems(i)%StartAngle))) + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_BuildArea/TD_ForceDownBRot.f90 b/TorqueDrag/TD_Forces/TD_BuildArea/TD_ForceDownBRot.f90 new file mode 100644 index 0000000..d53573b --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_BuildArea/TD_ForceDownBRot.f90 @@ -0,0 +1,56 @@ +subroutine TD_ForceDownBRot(i,TD_SemiMudVisc) + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + Real(8) :: TD_SemiMudVisc + + + If (i==1) then + TD_DrillStems(1)%Force1 = -TD_WeightOnBit + TD_DrillStems(1)%Force2 = TD_DrillStems(1)%Force1 + (TD_DrillStems(1)%Force1 * & + (exp(-(TD_SemiMudVisc*TD_DrillStems(1)%MudVisCorrectCoef)*abs(TD_DrillStems(1)%EndAngle-TD_DrillStems(1)%StartAngle))-1.0d0) * & + sin(TD_DrillStems(1)%CombVelRatio )) + (TD_DrillStems(1)%BouyancyFactor * & + TD_DrillStems(1)%WeightperLength * TD_DrillStems(1)%Length * & + ((sin(TD_DrillStems(1)%EndAngle)-sin(TD_DrillStems(1)%StartAngle))/ & + (TD_DrillStems(1)%EndAngle-TD_DrillStems(1)%StartAngle))) + + + if (TD_DrillStems(i)%ComponentType==0) then + TD_DrillStems(i)%Torque = TD_BitTorque + else + TD_DrillStems(i)%Torque = TD_SemiMudVisc*TD_DrillStems(i)%RtoolJoint*TD_DrillStems(i)%Force1* & + abs(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)*cos(TD_DrillStems(i)%CombVelRatio) + end if + + + return + End If + + +!=========> F1 Calculation + TD_DrillStems(i)%Force1 = TD_DrillStems(i-1)%Force2 + + +!=========> F2 Calculation + TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%Force1 * & + (exp(-(TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*abs(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle))-1.0d0) * & + sin(TD_DrillStems(i)%CombVelRatio )) + (TD_DrillStems(i)%BouyancyFactor * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + ((sin(TD_DrillStems(i)%EndAngle)-sin(TD_DrillStems(i)%StartAngle))/ & + (TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle))) + ! + !Strains(i)%Dl = TDForces(i)%Force * (Elements(i)%Length) / & + ! (Elements(i)%Area * Element%ElasticModule) + ! + TD_DrillStems(i)%Torque = TD_SemiMudVisc*TD_DrillStems(i)%RtoolJoint*TD_DrillStems(i)%Force1* & + abs(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)*cos(TD_DrillStems(i)%CombVelRatio) + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_BuildArea/TD_ForceUpB.f90 b/TorqueDrag/TD_Forces/TD_BuildArea/TD_ForceUpB.f90 new file mode 100644 index 0000000..7d2a6cd --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_BuildArea/TD_ForceUpB.f90 @@ -0,0 +1,75 @@ +subroutine TD_ForceUpB(i,TD_SemiMudVisc) + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + Real(8) :: TD_SemiMudVisc + + If (i==1) then + TD_DrillStems(1)%Force1 = -TD_WeightOnBit + TD_DrillStems(1)%Force2 = (TD_DrillStems(1)%Force1 * exp((TD_SemiMudVisc*TD_DrillStems(1)%MudVisCorrectCoef)*(TD_DrillStems(1)%EndAngle-TD_DrillStems(1)%StartAngle))) - & + (((TD_DrillStems(1)%WeightperLength * TD_DrillStems(1)%RCurvature) / (1 + (TD_SemiMudVisc*TD_DrillStems(1)%MudVisCorrectCoef)**2)) * & + (((1-(TD_SemiMudVisc*TD_DrillStems(1)%MudVisCorrectCoef)**2)*(sin(TD_DrillStems(1)%EndAngle) - & + (exp((TD_SemiMudVisc*TD_DrillStems(1)%MudVisCorrectCoef)*(TD_DrillStems(1)%EndAngle-TD_DrillStems(1)%StartAngle)) * sin(TD_DrillStems(1)%StartAngle))))) - & + (2.0d0* (TD_SemiMudVisc*TD_DrillStems(1)%MudVisCorrectCoef)*(cos(TD_DrillStems(1)%EndAngle) - & + (exp((TD_SemiMudVisc*TD_DrillStems(1)%MudVisCorrectCoef)*(TD_DrillStems(1)%EndAngle-TD_DrillStems(1)%StartAngle))* & + cos(TD_DrillStems(1)%StartAngle))))) + + + if (TD_DrillStems(i)%ComponentType==0) then + TD_DrillStems(i)%Torque = TD_BitTorque + else + TD_DrillStems(i)%Torque = (TD_DrillStems(i)%MudViscosity * TD_DrillStems(i)%RtoolJoint * (TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%WeightperLength * & + TD_DrillStems(i)%RCurvature * sin(TD_DrillStems(i)%StartAngle))) * & + abs(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)) + & + (2.0d0 * TD_DrillStems(i)%MudViscosity * TD_DrillStems(i)%RtoolJoint * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature * & + (cos(TD_DrillStems(i)%EndAngle) - cos(TD_DrillStems(i)%StartAngle))) + end if + + + return + End If + + + +!=========> F1 Calculation + TD_DrillStems(i)%Force1 = TD_DrillStems(i-1)%Force2 + + +!=========> F2 Calculation + TD_DrillStems(i)%Force2 = (TD_DrillStems(i)%Force1 * exp((TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle))) - & + (((TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature) / (1 + (TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)**2)) * & + (((1-(TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)**2)*(sin(TD_DrillStems(i)%EndAngle) - & + (exp((TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)) * sin(TD_DrillStems(i)%StartAngle))))) - & + (2.0d0* (TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*(cos(TD_DrillStems(i)%EndAngle) - & + (exp((TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle))* & + cos(TD_DrillStems(i)%StartAngle))))) + ! + ! Strains(i)%Dl = TDForces(i)%Force * (Elements(i)%Length ) / & + ! (Elements(i)%Area * Element%ElasticModule) + ! + TD_DrillStems(i)%Torque = (TD_DrillStems(i)%MudViscosity * TD_DrillStems(i)%RtoolJoint * (TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%WeightperLength * & + TD_DrillStems(i)%RCurvature * sin(TD_DrillStems(i)%StartAngle))) * & + abs(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)) + & + (2.0d0 * TD_DrillStems(i)%MudViscosity * TD_DrillStems(i)%RtoolJoint * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature * & + (cos(TD_DrillStems(i)%EndAngle) - cos(TD_DrillStems(i)%StartAngle))) + + !!if (TD_DrillStems(i)%Torque>500.) then + ! print* , 'TD_TotalTorqueb=' , i , TD_TotalTorque , TD_DrillStems(i)%Torque , TD_WeightOnBit , sin(30.) , sin(3.14/6.) + ! print* , 'torquepropertiesb=' , TD_DrillStems(i)%MudViscosity * TD_DrillStems(i)%RtoolJoint , (TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%WeightperLength * & + ! TD_DrillStems(i)%RCurvature * sin(TD_DrillStems(i)%StartAngle))) , abs(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle), & + ! 2.0d0 * TD_DrillStems(i)%MudViscosity * TD_DrillStems(i)%RtoolJoint * & + ! TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature , (cos(TD_DrillStems(i)%EndAngle) - cos(TD_DrillStems(i)%StartAngle)) + ! print* , 'propertiesb=' , TD_DrillStems(i)%Force2 , TD_DrillStems(i)%Force1 , TD_DrillStems(i)%MudViscosity , TD_DrillStems(i)%EndAngle , TD_DrillStems(i)%StartAngle , TD_DrillStems(i)%WeightperLength , TD_DrillStems(i)%MudVisCorrectCoef , TD_DrillStems(i)%RCurvature + ! !end if + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_BuildArea/TD_ForceUpBRot.f90 b/TorqueDrag/TD_Forces/TD_BuildArea/TD_ForceUpBRot.f90 new file mode 100644 index 0000000..863995f --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_BuildArea/TD_ForceUpBRot.f90 @@ -0,0 +1,56 @@ +subroutine TD_ForceUpBRot(i,TD_SemiMudVisc) + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + Real(8) :: TD_SemiMudVisc + + + If (i==1) then + TD_DrillStems(1)%Force1 = -TD_WeightOnBit + TD_DrillStems(1)%Force2 = TD_DrillStems(1)%Force1 + (TD_DrillStems(1)%Force1 * & + (exp(+(TD_SemiMudVisc*TD_DrillStems(1)%MudVisCorrectCoef)*abs(TD_DrillStems(1)%EndAngle-TD_DrillStems(1)%StartAngle))-1.0d0) * & + sin(TD_DrillStems(1)%CombVelRatio )) + (TD_DrillStems(1)%BouyancyFactor * & + TD_DrillStems(1)%WeightperLength * TD_DrillStems(1)%Length * & + ((sin(TD_DrillStems(1)%EndAngle)-sin(TD_DrillStems(1)%StartAngle))/ & + (TD_DrillStems(1)%EndAngle-TD_DrillStems(1)%StartAngle))) + + + if (TD_DrillStems(i)%ComponentType==0) then + TD_DrillStems(i)%Torque = TD_BitTorque + else + TD_DrillStems(i)%Torque = TD_SemiMudVisc*TD_DrillStems(i)%RtoolJoint*TD_DrillStems(i)%Force1* & + abs(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)*cos(TD_DrillStems(i)%CombVelRatio) + end if + + + return + End If + + +!=========> F1 Calculation + TD_DrillStems(i)%Force1 = TD_DrillStems(i-1)%Force2 + + +!=========> F2 Calculation + TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%Force1 * & + (exp(+(TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*abs(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle))-1.0d0) * & + sin(TD_DrillStems(i)%CombVelRatio )) + (TD_DrillStems(i)%BouyancyFactor * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + ((sin(TD_DrillStems(i)%EndAngle)-sin(TD_DrillStems(i)%StartAngle))/ & + (TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle))) + ! + !Strains(i)%Dl = TDForces(i)%Force * (Elements(i)%Length) / & + ! (Elements(i)%Area * Element%ElasticModule) + ! + TD_DrillStems(i)%Torque = TD_SemiMudVisc*TD_DrillStems(i)%RtoolJoint*TD_DrillStems(i)%Force1* & + abs(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)*cos(TD_DrillStems(i)%CombVelRatio) + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_CombinedMotionData.f90 b/TorqueDrag/TD_Forces/TD_CombinedMotionData.f90 new file mode 100644 index 0000000..ebb4df9 --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_CombinedMotionData.f90 @@ -0,0 +1,21 @@ +subroutine TD_CombinedMotionData (i) + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + + + + TD_DrillStems(i)%CombVelRatio = atan( TD_DrillStemAxialVelocity/TD_DrillStemRotVelocity ) + + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_DropArea/TD_ForceDownD.f90 b/TorqueDrag/TD_Forces/TD_DropArea/TD_ForceDownD.f90 new file mode 100644 index 0000000..21d94d7 --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_DropArea/TD_ForceDownD.f90 @@ -0,0 +1,61 @@ +subroutine TD_ForceDownD(i,TD_SemiMudVisc) + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + Real(8) :: TD_SemiMudVisc + + + If (i==1) then + TD_DrillStems(1)%Force1 = -TD_WeightOnBit + TD_DrillStems(i)%Force2 = (TD_DrillStems(i)%Force1 * exp(-(TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle))) + & + (TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature * & + (sin(TD_DrillStems(i)%EndAngle) - (exp(-(TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef) * & + (TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)) * & + sin(TD_DrillStems(i)%StartAngle)))) + + + if (TD_DrillStems(i)%ComponentType==0) then + TD_DrillStems(i)%Torque = TD_BitTorque + else + TD_DrillStems(i)%Torque = (TD_SemiMudVisc * TD_DrillStems(i)%RtoolJoint * (TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%WeightperLength * & + TD_DrillStems(i)%RCurvature * sin(TD_DrillStems(i)%StartAngle))) * & + (TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)) - & + (2.0d0 * TD_SemiMudVisc * TD_DrillStems(i)%RtoolJoint * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature * & + (cos(TD_DrillStems(i)%EndAngle) - cos(TD_DrillStems(i)%StartAngle))) + end if + + + return + End If + + +!=========> F1 Calculation + TD_DrillStems(i)%Force1 = TD_DrillStems(i-1)%Force2 + + +!=========> F2 Calculation + TD_DrillStems(i)%Force2 = (TD_DrillStems(i)%Force1 * exp(-(TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle))) + & + (TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature * & + (sin(TD_DrillStems(i)%EndAngle) - (exp(-(TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef) * & + (TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)) * & + sin(TD_DrillStems(i)%StartAngle)))) + ! + ! Strains(i)%Dl = TDForces(i)%Force * (Elements(i)%Length ) / & + ! (Elements(i)%Area * Element%ElasticModule) + ! + TD_DrillStems(i)%Torque = (TD_SemiMudVisc * TD_DrillStems(i)%RtoolJoint * (TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%WeightperLength * & + TD_DrillStems(i)%RCurvature * sin(TD_DrillStems(i)%StartAngle))) * & + (TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)) - & + (2.0d0 * TD_SemiMudVisc * TD_DrillStems(i)%RtoolJoint * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature * & + (cos(TD_DrillStems(i)%EndAngle) - cos(TD_DrillStems(i)%StartAngle))) + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_DropArea/TD_ForceDownDRot.f90 b/TorqueDrag/TD_Forces/TD_DropArea/TD_ForceDownDRot.f90 new file mode 100644 index 0000000..16235f4 --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_DropArea/TD_ForceDownDRot.f90 @@ -0,0 +1,56 @@ +subroutine TD_ForceDownDRot(i,TD_SemiMudVisc) + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + Real(8) :: TD_SemiMudVisc + + + If (i==1) then + TD_DrillStems(1)%Force1 = -TD_WeightOnBit + TD_DrillStems(1)%Force2 = TD_DrillStems(1)%Force1 + (TD_DrillStems(1)%Force1 * & + (exp(-(TD_SemiMudVisc*TD_DrillStems(1)%MudVisCorrectCoef)*abs(TD_DrillStems(1)%EndAngle-TD_DrillStems(1)%StartAngle))-1.0d0) * & + sin(TD_DrillStems(1)%CombVelRatio )) + (TD_DrillStems(1)%BouyancyFactor * & + TD_DrillStems(1)%WeightperLength * TD_DrillStems(1)%Length * & + ((sin(TD_DrillStems(1)%EndAngle)-sin(TD_DrillStems(1)%StartAngle))/ & + (TD_DrillStems(1)%EndAngle-TD_DrillStems(1)%StartAngle))) + + + if (TD_DrillStems(i)%ComponentType==0) then + TD_DrillStems(i)%Torque = TD_BitTorque + else + TD_DrillStems(i)%Torque = TD_SemiMudVisc*TD_DrillStems(i)%RtoolJoint*TD_DrillStems(i)%Force1* & + abs(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)*cos(TD_DrillStems(i)%CombVelRatio) + end if + + + return + End If + + +!=========> F1 Calculation + TD_DrillStems(i)%Force1 = TD_DrillStems(i-1)%Force2 + + +!=========> F2 Calculation + TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%Force1 * & + (exp(-(TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*abs(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle))-1.0d0) * & + sin(TD_DrillStems(i)%CombVelRatio )) + (TD_DrillStems(i)%BouyancyFactor * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + ((sin(TD_DrillStems(i)%EndAngle)-sin(TD_DrillStems(i)%StartAngle))/ & + (TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle))) + ! + !Strains(i)%Dl = TDForces(i)%Force * (Elements(i)%Length) / & + ! (Elements(i)%Area * Element%ElasticModule) + ! + TD_DrillStems(i)%Torque = TD_SemiMudVisc*TD_DrillStems(i)%RtoolJoint*TD_DrillStems(i)%Force1* & + abs(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)*cos(TD_DrillStems(i)%CombVelRatio) + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_DropArea/TD_ForceUpD.f90 b/TorqueDrag/TD_Forces/TD_DropArea/TD_ForceUpD.f90 new file mode 100644 index 0000000..7ccea69 --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_DropArea/TD_ForceUpD.f90 @@ -0,0 +1,68 @@ +subroutine TD_ForceUpD(i,TD_SemiMudVisc) + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + Real(8) :: TD_SemiMudVisc + + + If (i==1) then + TD_DrillStems(1)%Force1 = -TD_WeightOnBit + TD_DrillStems(i)%Force2 = (TD_DrillStems(i)%Force1 * exp((TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle))) + & + (((TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature) / (1 + (TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)**2)) * & + (((1-(TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)**2)*(sin(TD_DrillStems(i)%EndAngle) - & + (exp((TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)) * sin(TD_DrillStems(i)%StartAngle))))) - & + (2.0d0* (TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*(cos(TD_DrillStems(i)%EndAngle) - & + (exp((TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle))* & + cos(TD_DrillStems(i)%StartAngle))))) + + + if (TD_DrillStems(i)%ComponentType==0) then + TD_DrillStems(i)%Torque = TD_BitTorque + else + TD_DrillStems(i)%Torque = (TD_DrillStems(i)%MudViscosity * TD_DrillStems(i)%RtoolJoint * (TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%WeightperLength * & + TD_DrillStems(i)%RCurvature * sin(TD_DrillStems(i)%StartAngle))) * & + (TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)) - & + (2.0d0 * TD_DrillStems(i)%MudViscosity * TD_DrillStems(i)%RtoolJoint * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature * & + (cos(TD_DrillStems(i)%EndAngle) - cos(TD_DrillStems(i)%StartAngle))) + end if + + + + return + End If + + + +!=========> F1 Calculation + TD_DrillStems(i)%Force1 = TD_DrillStems(i-1)%Force2 + + +!=========> F2 Calculation + TD_DrillStems(i)%Force2 = (TD_DrillStems(i)%Force1 * exp((TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle))) + & + (((TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature) / (1 + (TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)**2)) * & + (((1-(TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)**2)*(sin(TD_DrillStems(i)%EndAngle) - & + (exp((TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)) * sin(TD_DrillStems(i)%StartAngle))))) - & + (2.0d0* (TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*(cos(TD_DrillStems(i)%EndAngle) - & + (exp((TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle))* & + cos(TD_DrillStems(i)%StartAngle))))) + + !Strains(i)%Dl = TDForces(i)%Force * (Elements(i)%Length) / & + ! (Elements(i)%Area * Element%ElasticModule) + ! + TD_DrillStems(i)%Torque = (TD_DrillStems(i)%MudViscosity * TD_DrillStems(i)%RtoolJoint * (TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%WeightperLength * & + TD_DrillStems(i)%RCurvature * sin(TD_DrillStems(i)%StartAngle))) * & + (TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)) - & + (2.0d0 * TD_DrillStems(i)%MudViscosity * TD_DrillStems(i)%RtoolJoint * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature * & + (cos(TD_DrillStems(i)%EndAngle) - cos(TD_DrillStems(i)%StartAngle))) + !return + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_DropArea/TD_ForceUpDRot.f90 b/TorqueDrag/TD_Forces/TD_DropArea/TD_ForceUpDRot.f90 new file mode 100644 index 0000000..1372d78 --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_DropArea/TD_ForceUpDRot.f90 @@ -0,0 +1,55 @@ +subroutine TD_ForceUpDRot(i,TD_SemiMudVisc) + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + Real(8) :: TD_SemiMudVisc + + If (i==1) then + TD_DrillStems(1)%Force1 = -TD_WeightOnBit + TD_DrillStems(1)%Force2 = TD_DrillStems(1)%Force1 + (TD_DrillStems(1)%Force1 * & + (exp(+(TD_SemiMudVisc*TD_DrillStems(1)%MudVisCorrectCoef)*abs(TD_DrillStems(1)%EndAngle-TD_DrillStems(1)%StartAngle))-1.0d0) * & + sin(TD_DrillStems(1)%CombVelRatio )) + (TD_DrillStems(1)%BouyancyFactor * & + TD_DrillStems(1)%WeightperLength * TD_DrillStems(1)%Length * & + ((sin(TD_DrillStems(1)%EndAngle)-sin(TD_DrillStems(1)%StartAngle))/ & + (TD_DrillStems(1)%EndAngle-TD_DrillStems(1)%StartAngle))) + + + if (TD_DrillStems(i)%ComponentType==0) then + TD_DrillStems(i)%Torque = TD_BitTorque + else + TD_DrillStems(i)%Torque = TD_SemiMudVisc*TD_DrillStems(i)%RtoolJoint*TD_DrillStems(i)%Force1* & + abs(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)*cos(TD_DrillStems(i)%CombVelRatio) + end if + + + return + End If + + +!=========> F1 Calculation + TD_DrillStems(i)%Force1 = TD_DrillStems(i-1)%Force2 + + +!=========> F2 Calculation + TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%Force1 * & + (exp(+(TD_SemiMudVisc*TD_DrillStems(i)%MudVisCorrectCoef)*abs(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle))-1.0d0) * & + sin(TD_DrillStems(i)%CombVelRatio )) + (TD_DrillStems(i)%BouyancyFactor * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + ((sin(TD_DrillStems(i)%EndAngle)-sin(TD_DrillStems(i)%StartAngle))/ & + (TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle))) + ! + !Strains(i)%Dl = TDForces(i)%Force * (Elements(i)%Length) / & + ! (Elements(i)%Area * Element%ElasticModule) + ! + TD_DrillStems(i)%Torque = TD_SemiMudVisc*TD_DrillStems(i)%RtoolJoint*TD_DrillStems(i)%Force1* & + abs(TD_DrillStems(i)%EndAngle-TD_DrillStems(i)%StartAngle)*cos(TD_DrillStems(i)%CombVelRatio) + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_ForceCalculation.f90 b/TorqueDrag/TD_Forces/TD_ForceCalculation.f90 new file mode 100644 index 0000000..0338856 --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_ForceCalculation.f90 @@ -0,0 +1,138 @@ +subroutine TD_ForceCalculation + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + Real(8) :: TD_SemiMudVisc + + + + + if (TD_DrillStemForceType == 1) then + + Do i = 1 , TD_DrillStemComponentsNumbs + TD_SemiMudVisc = TD_DrillStems(i)%MudViscosity + if (TD_DrillStems(i)%HoleType == 0) then + Call TD_ForceUpS(i,TD_SemiMudVisc) + else if (TD_DrillStems(i)%HoleType == 1) then + Call TD_ForceUpB(i,TD_SemiMudVisc) + else if (TD_DrillStems(i)%HoleType == 2) then + Call TD_ForceUpD(i,TD_SemiMudVisc) + end if + Call TD_StrainCalculation(i) + Call TD_TorqueCalculation(i) + End Do + + else if (TD_DrillStemForceType == 2) then + + Do i = 1 , TD_DrillStemComponentsNumbs + TD_SemiMudVisc = TD_DrillStems(i)%MudViscosity + if (TD_DrillStems(i)%HoleType == 0) then + Call TD_ForceUpSRot(i,TD_SemiMudVisc) + else if (TD_DrillStems(i)%HoleType == 1) then + Call TD_ForceUpBRot(i,TD_SemiMudVisc) + else if (TD_DrillStems(i)%HoleType == 2) then + Call TD_ForceUpDRot(i,TD_SemiMudVisc) + end if + Call TD_StrainCalculation(i) + Call TD_TorqueCalculation(i) + End Do + + else if (TD_DrillStemForceType == 3) then + + Do i = 1 , TD_DrillStemComponentsNumbs + TD_SemiMudVisc = TD_DrillStems(i)%MudViscosity + if (TD_DrillStems(i)%HoleType == 0) then + Call TD_ForceDownS(i,TD_SemiMudVisc) + else if (TD_DrillStems(i)%HoleType == 1) then + Call TD_ForceDownB(i,TD_SemiMudVisc) + else if (TD_DrillStems(i)%HoleType == 2) then + Call TD_ForceDownD(i,TD_SemiMudVisc) + end if + Call TD_StrainCalculation(i) + Call TD_TorqueCalculation(i) + End Do + + else if (TD_DrillStemForceType == 4) then + + Do i = 1 , TD_DrillStemComponentsNumbs + TD_SemiMudVisc = TD_DrillStems(i)%MudViscosity + if (TD_DrillStems(i)%HoleType == 0) then + Call TD_ForceDownSRot(i,TD_SemiMudVisc) + else if (TD_DrillStems(i)%HoleType == 1) then + Call TD_ForceDownBRot(i,TD_SemiMudVisc) + else if (TD_DrillStems(i)%HoleType == 2) then + Call TD_ForceDownDRot(i,TD_SemiMudVisc) + end if + Call TD_StrainCalculation(i) + Call TD_TorqueCalculation(i) + End Do + + else if (TD_DrillStemForceType == 5) then + + Do i = 1 , TD_DrillStemComponentsNumbs + TD_SemiMudVisc = 0.0d0 + if (TD_DrillStems(i)%HoleType == 0) then + Call TD_ForceUpS(i,TD_SemiMudVisc) + else if (TD_DrillStems(i)%HoleType == 1) then + Call TD_ForceUpB(i,TD_SemiMudVisc) + else if (TD_DrillStems(i)%HoleType == 2) then + Call TD_ForceUpD(i,TD_SemiMudVisc) + end if + Call TD_StrainCalculation(i) + Call TD_TorqueCalculation(i) + End Do + + end if + + + +!----------------------------------------------------------------------------------- +! + !if (TD_DrillStemAxialVelocity>0.) then + ! + ! i = 1 + ! TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force2 - TD_DrillStems(i)%Drag + ! TD_DrillStems(i)%Dl = TD_DrillStems(i)%Force2 * TD_DrillStems(i)%Length / TD_DrillStems(i)%Area / TD_DrillStems(i)%ElasticModule + ! TD_DrillStems(i)%DlTotal = TD_DrillStems(i)%Dl + ! + ! do i = 2 , TD_DrillStemComponentsNumbs + ! TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force2 - TD_DrillStems(i)%Drag + ! TD_DrillStems(i)%Dl = TD_DrillStems(i)%Force2 * TD_DrillStems(i)%Length / TD_DrillStems(i)%Area / TD_DrillStems(i)%ElasticModule + ! TD_DrillStems(i)%DlTotal = TD_DrillStems(i-1)%DlTotal + TD_DrillStems(i)%Dl + ! end do + ! !print*, 'i=' ,i + ! !print*, 'TD_DrillStemComponentsNumbs=' ,TD_DrillStemComponentsNumbs + ! + !else if (TD_DrillStemAxialVelocity<0.) then + ! i = 1 + ! TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force2 + TD_DrillStems(i)%Drag + ! TD_DrillStems(i)%Dl = TD_DrillStems(i)%Force2 * TD_DrillStems(i)%Length / TD_DrillStems(i)%Area / TD_DrillStems(i)%ElasticModule + ! TD_DrillStems(i)%DlTotal = TD_DrillStems(i)%Dl + ! + ! do i = 2 , TD_DrillStemComponentsNumbs + ! TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force2 + TD_DrillStems(i)%Drag + ! TD_DrillStems(i)%Dl = TD_DrillStems(i)%Force2 * TD_DrillStems(i)%Length / TD_DrillStems(i)%Area / TD_DrillStems(i)%ElasticModule + ! TD_DrillStems(i)%DlTotal = TD_DrillStems(i-1)%DlTotal + TD_DrillStems(i)%Dl + ! end do + !end if + + + TD_DlTotal = TD_DrillStems(TD_DrillStemComponentsNumbs)%DlTotal + + + + +!!=====> Modified Length of the Drill Stem +! do i = 1 , TD_DrillStemComponentsNumbs +! TD_DrillStems(i)%Length = TD_DrillStems(i)%Length + TD_DrillStems(i)%Dl +! end do + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_HookLoadCalculation.f90 b/TorqueDrag/TD_Forces/TD_HookLoadCalculation.f90 new file mode 100644 index 0000000..5aebbf9 --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_HookLoadCalculation.f90 @@ -0,0 +1,285 @@ +subroutine TD_HookLoadCalculation + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + Use TD_StringConnectionData + Use Drawworks_VARIABLES, only: Drawworks + Use CDataDisplayConsoleVariables + Use CHoistingVariables + Use CSlipsEnumVariables + Use CBopStackVariables + Use VARIABLES + Use CUnityInputs + + + implicit none + + Integer :: i , kk + Real(8) :: TD_eConst=0.98d0 , TD_SumWeight + + + + +!==================================================== +! Torque & Hook Load Calculation +!==================================================== + +!=========> HookLoad + TD_HookLoad = TD_DrillStems(TD_DrillStemComponentsNumbs)%Force2 ! [lb] + !print* , 'TD_HookLoad1=' , TD_HookLoad + + if ( Drawworks%motion==1 ) then + if ( PipeRam1_Situation_forTD==1 ) then !Upper Ram + TD_HookLoad = TD_HookLoad+RamStringDrag + end if + if ( PipeRam2_Situation_forTD==1 ) then !Lower Ram + TD_HookLoad = TD_HookLoad+RamStringDrag + end if + if ( ShearBop_Situation_forTD==1 ) then !Blind Ram + TD_HookLoad = TD_HookLoad+RamStringDrag !???????????????????? + end if + if ( Annular_Situation_forTD==1 ) then !Annular Preventer + TD_HookLoad = TD_HookLoad+(p_annular*AnnularStringDrag) + end if + else if ( Drawworks%motion==-1 ) then + if ( PipeRam1_Situation_forTD==1 ) then !Upper Ram + TD_HookLoad = TD_HookLoad-RamStringDrag + end if + if ( PipeRam2_Situation_forTD==1 ) then !Lower Ram + TD_HookLoad = TD_HookLoad-RamStringDrag + end if + if ( ShearBop_Situation_forTD==1 ) then !Blind Ram + TD_HookLoad = TD_HookLoad-RamStringDrag !???????????????????? + end if + if ( Annular_Situation_forTD==1 ) then !Annular Preventer + TD_HookLoad = TD_HookLoad-(p_annular*AnnularStringDrag) + end if + end if + + !print* , 'TD_HookLoad2=' , TD_HookLoad + + + + + + !if ( UpperRamClose_withPossibility==1 ) then + ! if ( Drawworks%motion==1 ) then + ! TD_HookLoad = TD_HookLoad+RamStringDrag + ! else if ( Drawworks%motion==-1 ) then + ! TD_HookLoad = TD_HookLoad-RamStringDrag + ! end if + !end if + !if ( LowerRamClose_withPossibility==1 ) then + ! if ( Drawworks%motion==1 ) then + ! TD_HookLoad = TD_HookLoad+RamStringDrag + ! else if ( Drawworks%motion==-1 ) then + ! TD_HookLoad = TD_HookLoad-RamStringDrag + ! end if + !end if + !if ( BlindRamClose_withPossibility==1 ) then + ! if ( Drawworks%motion==1 ) then + ! TD_HookLoad = TD_HookLoad+RamStringDrag + ! else if ( Drawworks%motion==-1 ) then + ! TD_HookLoad = TD_HookLoad-RamStringDrag + ! end if + !end if + !if ( AnnularPreventerClose_withPossibility==1 ) then + ! if ( Drawworks%motion==1 ) then + ! TD_HookLoad = TD_HookLoad+AnnularStringDrag + ! else if ( Drawworks%motion==-1 ) then + ! TD_HookLoad = TD_HookLoad-AnnularStringDrag + ! end if + !end if + + + + + + + + +!=========> Torque + TD_StringTorque = TD_TotalTorque ![lb.ft] ?????????? + !print* , 'TD_StringTorque=' , TD_StringTorque + + + + + +!==================================================== +! Weight Indicator Calculation +!==================================================== + + kk = 0 + Do i = TD_DrillStemComponentsNumbs , 1 , -1 + if (TD_DrillStems(i)%ComponentType==3) then + kk = i + exit + end if + End Do + + + + + + if ( TD_KellyDriveTypeMode==0 ) then + + if ( TD_StringConnectionMode == 1 ) then + if ( Get_Slips() == SLIPS_SET_END ) then + TD_SumWeight = TD_WeightTB+TD_KellyWeight + else + TD_SumWeight = TD_HookLoad+TD_WeightTB+TD_KellyWeight ! TD_HookLoad = String Weight + end if + + else if ( TD_StringConnectionMode == 2 ) then + if ( Get_JointConnectionPossible() ) then + TD_SumWeight = TD_WeightTB + else + TD_SumWeight = TD_WeightTB+TD_KellyWeight + end if + + else if ( TD_StringConnectionMode == 3 ) then + if ( Get_JointConnectionPossible() ) then + TD_SumWeight = TD_WeightTB + else + TD_SumWeight = TD_WeightTB+TD_KellyWeight+TD_DrillStems(kk)%Weight + end if + + end if + + else if ( TD_KellyDriveTypeMode==1 ) then + + if ( TD_StringConnectionMode == 4 ) then + if ( Get_Slips() == SLIPS_SET_END ) then + TD_SumWeight = TD_WeightTB + else + TD_SumWeight = TD_HookLoad+TD_WeightTB + end if + + else if ( TD_StringConnectionMode == 5 ) then + TD_SumWeight = TD_WeightTB + + else if ( TD_StringConnectionMode == 6 ) then + if ( Get_JointConnectionPossible() ) then + TD_SumWeight = TD_WeightTB + else + TD_SumWeight = TD_WeightTB+(3.d0*TD_DrillStems(kk)%Weight) + end if + + else if ( TD_StringConnectionMode == 7 ) then + if ( Get_JointConnectionPossible() ) then + TD_SumWeight = TD_WeightTB + else + TD_SumWeight = TD_WeightTB+TD_DrillStems(kk)%Weight + end if + + else if ( TD_StringConnectionMode == 8 ) then + TD_SumWeight = TD_WeightTB + + else if ( TD_StringConnectionMode == 18 ) then + TD_SumWeight = TD_WeightTB + + else if ( TD_StringConnectionMode == 19 ) then + TD_SumWeight = TD_WeightTB + + end if + + else if ( TD_KellyDriveTypeMode==2 ) then + + if ( TD_StringConnectionMode == 9 ) then + if ( Get_Slips() == SLIPS_SET_END ) then + TD_SumWeight = TD_WeightTD + else + TD_SumWeight = TD_HookLoad+TD_WeightTD + end if + + else if ( TD_StringConnectionMode == 10 ) then + if ( Get_Slips() == SLIPS_SET_END ) then + TD_SumWeight = TD_WeightTD + else + TD_SumWeight = TD_HookLoad+TD_WeightTD + end if + + else if ( TD_StringConnectionMode == 11 ) then + TD_SumWeight = TD_WeightTD + + else if ( TD_StringConnectionMode == 12 ) then + if ( Get_Slips() == SLIPS_SET_END ) then + TD_SumWeight = TD_WeightTD + else + TD_SumWeight = TD_HookLoad+TD_WeightTD + end if + + else if ( TD_StringConnectionMode == 13 ) then + TD_SumWeight = TD_WeightTD + + else if ( TD_StringConnectionMode == 14 ) then + TD_SumWeight = TD_WeightTD+(3.d0*TD_DrillStems(kk)%Weight) + + else if ( TD_StringConnectionMode == 15 ) then + TD_SumWeight = TD_WeightTD+(TD_DrillStems(kk)%Weight) + + else if ( TD_StringConnectionMode == 16 ) then + TD_SumWeight = TD_WeightTD + + else if ( TD_StringConnectionMode == 17 ) then + TD_SumWeight = TD_WeightTD + + end if + + end if + + + + !print* , 'TD_HookLoad3=' , TD_HookLoad + + + + + !if ( DriveType==1 ) then !==> Kelly_DriveType + ! + ! if ( TD_DrillStemForceType==1 .or. TD_DrillStemForceType==2 ) then + ! TD_WeightIndicator = ( sngl(TD_NumOfCables)*(TD_eConst-1.d0)*(TD_SumWeight) )& + ! /( TD_eConst*(1.d0-(1.d0/(TD_eConst**TD_NumOfCables))) ) + ! else if ( TD_DrillStemForceType==3 .or. TD_DrillStemForceType==4 ) then + ! TD_WeightIndicator = ( sngl(TD_NumOfCables)*(1.d0-TD_eConst)*(TD_SumWeight) )& + ! /( 1.d0-(TD_eConst**TD_NumOfCables) ) + ! else if ( TD_DrillStemForceType==5 ) then + TD_WeightIndicator = TD_SumWeight + ! end if + ! + ! + !else if ( DriveType==0 ) then !==> TopDrive_DriveType ?????????????? + ! + ! if ( TD_DrillStemForceType==1 .or. TD_DrillStemForceType==2 ) then + ! TD_WeightIndicator = ( sngl(TD_NumOfCables)*(TD_eConst-1.d0)*(TD_SumWeight) )& + ! /( TD_eConst*(1.d0-(1.d0/(TD_eConst**TD_NumOfCables))) ) + ! else if ( TD_DrillStemForceType==3 .or. TD_DrillStemForceType==4 ) then + ! TD_WeightIndicator = ( sngl(TD_NumOfCables)*(1.d0-TD_eConst)*(TD_SumWeight) )& + ! /( 1.d0-(TD_eConst**TD_NumOfCables) ) + ! else if ( TD_DrillStemForceType==5 ) then + ! TD_WeightIndicator = TD_SumWeight + ! end if + ! + !!else + !!TD_WeightIndicator = 0. !????????????????? + ! + !end if + + + + + + TD_DrawworksLoadInput = TD_WeightIndicator/(sngl(TD_NumOfCables)) ! [lb] + !print* , 'TD_HookLoad4=' , TD_HookLoad + !HookLoadPointer = TD_WeightIndicator/1.0d3 ! [klb] + call Set_HookLoad ((1-TD_WeightIndicatorMalf)*AINT(TD_WeightIndicator/1.0d3)) ! [klb] + + + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_StaticHookLoadCalculation.f90 b/TorqueDrag/TD_Forces/TD_StaticHookLoadCalculation.f90 new file mode 100644 index 0000000..01a4054 --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_StaticHookLoadCalculation.f90 @@ -0,0 +1,71 @@ +subroutine TD_StaticHookLoadCalculation + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + + + + + + i = 1 + if(TD_DrillStems(i)%HoleType == 0) then + TD_DrillStems(i)%StaticHookLoad = TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + TD_DrillStems(i)%BouyancyFactor * cos(TD_DrillStems(i)%StartAngle) + + else if (TD_DrillStems(i)%HoleType == 1) then + TD_DrillStems(i)%StaticHookLoad = -(TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature * & + (sin(TD_DrillStems(i)%EndAngle) - sin(TD_DrillStems(i)%StartAngle))) + + else if (TD_DrillStems(i)%HoleType == 2) then + TD_DrillStems(i)%StaticHookLoad = (TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature * & + (sin(TD_DrillStems(i)%EndAngle) - sin(TD_DrillStems(i)%StartAngle))) + end if + + + + do i = 2, TD_DrillStemComponentsNumbs + + if(TD_DrillStems(i)%HoleType == 0) then + TD_DrillStems(i)%StaticHookLoad = TD_DrillStems(i-1)%StaticHookLoad + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + TD_DrillStems(i)%BouyancyFactor * cos(TD_DrillStems(i)%StartAngle) + + else if (TD_DrillStems(i)%HoleType == 1) then + TD_DrillStems(i)%StaticHookLoad = TD_DrillStems(i-1)%StaticHookLoad -(TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature * & + (sin(TD_DrillStems(i)%EndAngle) - sin(TD_DrillStems(i)%StartAngle))) + + else if (TD_DrillStems(i)%HoleType == 2) then + TD_DrillStems(i)%StaticHookLoad = TD_DrillStems(i-1)%StaticHookLoad +(TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%RCurvature * & + (sin(TD_DrillStems(i)%EndAngle) - sin(TD_DrillStems(i)%StartAngle))) + end if + + end do +! +!--------------------------------------------------------------------------------------------------- +! + i = 1 + !TD_DrillStems(i)%TotalSHookLoad = TD_DrillStems(i)%StaticHookLoad ???????????????????????????? + TD_DrillStems(i)%Dl = TD_DrillStems(i)%StaticHookLoad * TD_DrillStems(i)%Length / TD_DrillStems(i)%Area / TD_DrillStems(i)%ElasticModule + TD_DrillStems(i)%DlTotal = TD_DrillStems(i)%Dl + do i = 2 , TD_DrillStemComponentsNumbs + !TD_DrillStems(i)%TotalSHookLoad = TD_DrillStems(i-1)%TotalSHookLoad + TD_DrillStems(i)%StaticHookLoad ????????????????????????? + TD_DrillStems(i)%Dl = TD_DrillStems(i)%StaticHookLoad * TD_DrillStems(i)%Length / TD_DrillStems(i)%Area / TD_DrillStems(i)%ElasticModule + TD_DrillStems(i)%DlTotal = TD_DrillStems(i-1)%DlTotal + TD_DrillStems(i)%Dl + end do + + TD_StaticHookLoad = TD_DrillStems(TD_DrillStemComponentsNumbs)%StaticHookLoad + TD_DlMax = TD_DrillStems(TD_DrillStemComponentsNumbs)%DlTotal + + + + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_StraightArea/TD_ForceDownS.f90 b/TorqueDrag/TD_Forces/TD_StraightArea/TD_ForceDownS.f90 new file mode 100644 index 0000000..49da7fe --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_StraightArea/TD_ForceDownS.f90 @@ -0,0 +1,64 @@ +subroutine TD_ForceDownS(i,TD_SemiMudVisc) + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + Real(8) :: TD_SemiMudVisc , TD_SemiAngle + + + if ( TD_DrillStems(i)%StartAngle<=(pi/180.) ) then + TD_SemiAngle = (pi/180.) + else + TD_SemiAngle = TD_DrillStems(i)%StartAngle + end if + + + If (i==1) then + TD_DrillStems(1)%Force1 = -TD_WeightOnBit + TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + TD_DrillStems(i)%BouyancyFactor * (cos(TD_DrillStems(i)%StartAngle) - & + (TD_SemiMudVisc * sin(TD_DrillStems(i)%StartAngle)))) + + + if (TD_DrillStems(i)%ComponentType==0) then + TD_DrillStems(i)%Torque = TD_BitTorque + else + TD_DrillStems(i)%Torque = TD_SemiMudVisc* TD_DrillStems(i)%BouyancyFactor* & + TD_DrillStems(i)%WeightperLength* TD_DrillStems(i)%Length* TD_DrillStems(i)%RtoolJoint * & + sin(TD_SemiAngle) + end if + + + return + End If + + +!=========> F1 Calculation + TD_DrillStems(i)%Force1 = TD_DrillStems(i-1)%Force2 + + +!=========> F2 Calculation + TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + TD_DrillStems(i)%BouyancyFactor * (cos(TD_DrillStems(i)%StartAngle) - & + (TD_SemiMudVisc * sin(TD_DrillStems(i)%StartAngle)))) + ! + ! + !Strains(i)%Dl = TDForces(i)%Force * (Elements(i)%Length ) / & + ! (Elements(i)%Area * Element%ElasticModule) + ! + + TD_DrillStems(i)%Torque = TD_SemiMudVisc* TD_DrillStems(i)%BouyancyFactor* & + TD_DrillStems(i)%WeightperLength* TD_DrillStems(i)%Length* TD_DrillStems(i)%RtoolJoint * & + sin(TD_SemiAngle) + ! + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_StraightArea/TD_ForceDownSRot.f90 b/TorqueDrag/TD_Forces/TD_StraightArea/TD_ForceDownSRot.f90 new file mode 100644 index 0000000..424173c --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_StraightArea/TD_ForceDownSRot.f90 @@ -0,0 +1,60 @@ +subroutine TD_ForceDownSRot(i,TD_SemiMudVisc) + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + Real(8) :: TD_SemiMudVisc , TD_SemiAngle + + + if ( TD_DrillStems(i)%StartAngle<=(pi/180.) ) then + TD_SemiAngle = (pi/180.) + else + TD_SemiAngle = TD_DrillStems(i)%StartAngle + end if + + + If (i==1) then + TD_DrillStems(1)%Force1 = -TD_WeightOnBit + TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%BouyancyFactor * TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + cos(TD_DrillStems(i)%StartAngle)) - (TD_SemiMudVisc * TD_DrillStems(i)%BouyancyFactor * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + sin(TD_DrillStems(i)%StartAngle) * sin(TD_DrillStems(i)%CombVelRatio)) + + + if (TD_DrillStems(i)%ComponentType==0) then + TD_DrillStems(i)%Torque = TD_BitTorque + else + TD_DrillStems(i)%Torque = TD_DrillStems(i)%RtoolJoint * TD_SemiMudVisc * TD_DrillStems(i)%BouyancyFactor * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * sin(TD_SemiAngle) * cos(TD_DrillStems(i)%CombVelRatio) + end if + + + return + End If + + +!=========> F1 Calculation + TD_DrillStems(i)%Force1 = TD_DrillStems(i-1)%Force2 + + +!=========> F2 Calculation + TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%BouyancyFactor * TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + cos(TD_DrillStems(i)%StartAngle)) - (TD_SemiMudVisc * TD_DrillStems(i)%BouyancyFactor * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + sin(TD_DrillStems(i)%StartAngle) * sin(TD_DrillStems(i)%CombVelRatio)) + ! + TD_DrillStems(i)%Torque = TD_DrillStems(i)%RtoolJoint * TD_SemiMudVisc * TD_DrillStems(i)%BouyancyFactor * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * sin(TD_SemiAngle) * cos(TD_DrillStems(i)%CombVelRatio) + + ! + !Strains(i)%dL = TDForces(i)%Force * (Elements(i)%Length) / & + ! (Elements(i)%Area * Element%ElasticModule) + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_StraightArea/TD_ForceUpS.f90 b/TorqueDrag/TD_Forces/TD_StraightArea/TD_ForceUpS.f90 new file mode 100644 index 0000000..d185cce --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_StraightArea/TD_ForceUpS.f90 @@ -0,0 +1,65 @@ +subroutine TD_ForceUpS(i,TD_SemiMudVisc) + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + Real(8) :: TD_SemiMudVisc , TD_SemiAngle + + + if ( TD_DrillStems(i)%StartAngle<=(pi/180.) ) then + TD_SemiAngle = (pi/180.) + else + TD_SemiAngle = TD_DrillStems(i)%StartAngle + end if + + + If (i==1) then + TD_DrillStems(1)%Force1 = -TD_WeightOnBit + TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + TD_DrillStems(i)%BouyancyFactor * (cos(TD_DrillStems(i)%StartAngle) + & + (TD_SemiMudVisc * sin(TD_DrillStems(i)%StartAngle)))) + + + if (TD_DrillStems(i)%ComponentType==0) then + TD_DrillStems(i)%Torque = TD_BitTorque + else + TD_DrillStems(i)%Torque = TD_DrillStems(i)%MudViscosity* TD_DrillStems(i)%BouyancyFactor* & + TD_DrillStems(i)%WeightperLength* TD_DrillStems(i)%Length* TD_DrillStems(i)%RtoolJoint * & + sin(TD_SemiAngle) + end if + + return + End If + + +!=========> F1 Calculation + TD_DrillStems(i)%Force1 = TD_DrillStems(i-1)%Force2 + + +!=========> F2 Calculation + TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + TD_DrillStems(i)%BouyancyFactor * (cos(TD_DrillStems(i)%StartAngle) + & + (TD_SemiMudVisc * sin(TD_DrillStems(i)%StartAngle)))) + + !Strains(i)%Dl = TDForces(i)%Force * (Elements(i)%Length ) / & + ! (Elements(i)%Area * Element%ElasticModule) + + + TD_DrillStems(i)%Torque = TD_DrillStems(i)%MudViscosity* TD_DrillStems(i)%BouyancyFactor* & + TD_DrillStems(i)%WeightperLength* TD_DrillStems(i)%Length* TD_DrillStems(i)%RtoolJoint * & + sin(TD_SemiAngle) + + + !!if (TD_DrillStems(i)%Torque>500.) then + ! print* , 'TD_TotalTorque=' , i , TD_TotalTorque , TD_DrillStems(i)%Torque , TD_WeightOnBit + ! print* , 'propertiess=' , TD_DrillStems(i)%Force2 , TD_DrillStems(i)%Force1 , TD_DrillStems(i)%MudViscosity , TD_DrillStems(i)%EndAngle , TD_DrillStems(i)%StartAngle , TD_DrillStems(i)%WeightperLength , TD_DrillStems(i)%MudVisCorrectCoef + ! !end if + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_StraightArea/TD_ForceUpSRot.f90 b/TorqueDrag/TD_Forces/TD_StraightArea/TD_ForceUpSRot.f90 new file mode 100644 index 0000000..8da78a0 --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_StraightArea/TD_ForceUpSRot.f90 @@ -0,0 +1,59 @@ +subroutine TD_ForceUpSRot(i,TD_SemiMudVisc) + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + Real(8) :: TD_SemiMudVisc , TD_SemiAngle + + + if ( TD_DrillStems(i)%StartAngle<=(pi/180.d0) ) then + TD_SemiAngle = (pi/180.) + else + TD_SemiAngle = TD_DrillStems(i)%StartAngle + end if + + + If (i==1) then + TD_DrillStems(1)%Force1 = -TD_WeightOnBit + TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%BouyancyFactor * TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + cos(TD_DrillStems(i)%StartAngle)) + (TD_SemiMudVisc * TD_DrillStems(i)%BouyancyFactor * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + sin(TD_DrillStems(i)%StartAngle) * sin(TD_DrillStems(i)%CombVelRatio)) + + + if (TD_DrillStems(i)%ComponentType==0) then + TD_DrillStems(i)%Torque = TD_BitTorque + else + TD_DrillStems(i)%Torque = TD_DrillStems(i)%RtoolJoint * TD_SemiMudVisc * TD_DrillStems(i)%BouyancyFactor * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * sin(TD_SemiAngle) * cos(TD_DrillStems(i)%CombVelRatio) + end if + + + return + End If + + +!=========> F1 Calculation + TD_DrillStems(i)%Force1 = TD_DrillStems(i-1)%Force2 + + +!=========> F2 Calculation + TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force1 + (TD_DrillStems(i)%BouyancyFactor * TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + cos(TD_DrillStems(i)%StartAngle)) + (TD_SemiMudVisc * TD_DrillStems(i)%BouyancyFactor * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * & + sin(TD_DrillStems(i)%StartAngle) * sin(TD_DrillStems(i)%CombVelRatio)) + ! + TD_DrillStems(i)%Torque = TD_DrillStems(i)%RtoolJoint * TD_SemiMudVisc * TD_DrillStems(i)%BouyancyFactor * & + TD_DrillStems(i)%WeightperLength * TD_DrillStems(i)%Length * sin(TD_SemiAngle) * cos(TD_DrillStems(i)%CombVelRatio) + ! + !Strains(i)%dL = TDForces(i)%Force * (Elements(i)%Length) / & + ! (Elements(i)%Area * Element%ElasticModule) + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_StrainCalculation.f90 b/TorqueDrag/TD_Forces/TD_StrainCalculation.f90 new file mode 100644 index 0000000..10bf806 --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_StrainCalculation.f90 @@ -0,0 +1,54 @@ +subroutine TD_StrainCalculation(i) + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + + + + if (TD_DrillStemAxialVelocity>=0.d0) then + + if (i == 1) then + TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force2 + TD_DrillStems(i)%Drag + TD_DrillStems(i)%Dl = (TD_DrillStems(i)%Force2) * TD_DrillStems(i)%Length / TD_DrillStems(i)%Area / TD_DrillStems(i)%ElasticModule + TD_DrillStems(i)%DlTotal = TD_DrillStems(i)%Dl + else + !do i = 2 , TD_DrillStemComponentsNumbs + TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force2 + TD_DrillStems(i)%Drag + TD_DrillStems(i)%Dl = (TD_DrillStems(i)%Force2) * TD_DrillStems(i)%Length / TD_DrillStems(i)%Area / TD_DrillStems(i)%ElasticModule + TD_DrillStems(i)%DlTotal = TD_DrillStems(i-1)%DlTotal + TD_DrillStems(i)%Dl + !end do + end if + + + else if (TD_DrillStemAxialVelocity<0.) then + + if (i == 1) then + TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force2 - TD_DrillStems(i)%Drag + TD_DrillStems(i)%Dl = (TD_DrillStems(i)%Force2) * TD_DrillStems(i)%Length / TD_DrillStems(i)%Area / TD_DrillStems(i)%ElasticModule + TD_DrillStems(i)%DlTotal = TD_DrillStems(i)%Dl + else + !do i = 2 , TD_DrillStemComponentsNumbs + TD_DrillStems(i)%Force2 = TD_DrillStems(i)%Force2 - TD_DrillStems(i)%Drag + TD_DrillStems(i)%Dl = (TD_DrillStems(i)%Force2) * TD_DrillStems(i)%Length / TD_DrillStems(i)%Area / TD_DrillStems(i)%ElasticModule + TD_DrillStems(i)%DlTotal = TD_DrillStems(i-1)%DlTotal + TD_DrillStems(i)%Dl + !end do + end if + + + end if + + +!=====> Modified Length of Drill Stem + !TD_DrillStems(i)%Length = TD_DrillStems(i)%LengthIni + TD_DrillStems(i)%Dl + TD_DrillStems(i)%Length = TD_DrillStems(i)%LengthIni + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_TorqueCalculation.f90 b/TorqueDrag/TD_Forces/TD_TorqueCalculation.f90 new file mode 100644 index 0000000..7412fd4 --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_TorqueCalculation.f90 @@ -0,0 +1,42 @@ +subroutine TD_TorqueCalculation(i) + + Use CHoistingVariables + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + Use RTable_VARIABLES, only: RTable + Use TopDrive_VARIABLES, only: TDS + + + implicit none + + Integer :: i + + + + + if ( DriveType==1 .and. RTable%Speed==0.d0 ) then + TD_DrillStems(i)%Torque = 0.d0 + else if ( DriveType==0 .and. TDS%Speed==0.d0 .and. RTable%Speed==0.d0 ) then + TD_DrillStems(i)%Torque = 0.d0 + end if + + + + + if ( i==1 ) then + TD_TotalTorque = TD_DrillStems(i)%Torque + else + TD_TotalTorque = TD_TotalTorque + TD_DrillStems(i)%Torque + end if + + !if (TD_DrillStems(i)%Torque>500.) then + ! print* , 'TD_TotalTorque=' , i , TD_TotalTorque , TD_DrillStems(i)%Torque + ! !print* , 'properties=' , TD_DrillStems(i)%Force1 , TD_DrillStems(i)%MudViscosity , TD_DrillStems(i)%EndAngle , TD_DrillStems(i)%StartAngle , TD_DrillStems(i)%WeightperLength , TD_DrillStems(i)%MudVisCorrectCoef + !end if + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_ViscousDragForce/TD_ViscousDragForce.f90 b/TorqueDrag/TD_Forces/TD_ViscousDragForce/TD_ViscousDragForce.f90 new file mode 100644 index 0000000..e224514 --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_ViscousDragForce/TD_ViscousDragForce.f90 @@ -0,0 +1,176 @@ +subroutine TD_ViscousDragForce + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + + implicit none + + Integer :: i + real(8) :: TDden, TDpreup , TDpredown , TDtem , TDmdup , TDmddown + Real(8) :: TD_ThetaCoef1 , TD_ThetaCoef2 , TD_NCoef , TD_KCoef + Real(8) :: TD_DragSum + + + + + + Do i = 1 , TD_DrillStemComponentsNumbs + + if ( TD_DrillStems(i)%MudDensityOut==0.d0 .or. TD_DrillStems(i)%MudDensityIn==0.d0 ) then + TD_DrillStems(i)%Drag = 0.d0 + cycle + end if + TDmdup = TD_DrillStems(i)%TopDepthIni + Call AnnulusPropertyCalculator ( INT(TDmdup) , TDden , TDpreup , TDtem ) + TDmddown = TD_DrillStems(i)%DownDepthIni + Call AnnulusPropertyCalculator ( INT(TDmddown) , TDden , TDpredown , TDtem ) + TD_DrillStems(i)%Drag = abs(TDpredown-TDpreup)*(pi*TD_DrillStems(i)%Length*12.d0*TD_DrillStems(i)%Od*12.d0) ![psi]*[inch^2]=[lb] ????? + + TD_DrillStems(i)%Drag = 0.0d0 !????????????????????? + + End Do + + + + + + + !Do i = 1 , TD_DrillStemComponentsNumbs + ! + ! + ! if ( TD_DrillStems(i)%MudDensityOut==0.d0 .or. TD_DrillStems(i)%MudDensityIn==0.d0 ) then + ! TD_DrillStems(i)%Drag = 0.d0 + ! cycle + ! end if + ! + ! !------------------------------------------------------------------------------------ + ! TD_DrillStems(i)%Od = TD_DrillStems(i)%Od*12.d0 ! [inch] + ! TD_DrillStems(i)%HoleDiameter = TD_DrillStems(i)%HoleDiameter*12.d0 ! [inch] + ! TD_DrillStems(i)%MudDensityOut = TD_DrillStems(i)%MudDensityOut/7.48051948d0 ! [ppg] + ! !------------------------------------------------------------------------------------ + ! + ! + ! TD_ThetaCoef1 = TD_DrillStems(i)%MudYieldPoint+TD_DrillStems(i)%MudPlasticVis + ! TD_ThetaCoef2 = (2.0d0*TD_DrillStems(i)%MudPlasticVis)+TD_DrillStems(i)%MudYieldPoint + ! TD_NCoef = 3.32d0*log10(TD_ThetaCoef2/TD_ThetaCoef1) + ! TD_KCoef = (TD_ThetaCoef1)/(511.d0*TD_NCoef) + ! + ! + ! + ! If (TD_DrillStems(i)%TopDepth>0.d0) then + ! + ! TD_DrillStems(i)%PipeVelocity = abs(TD_DrillStemAxialVelocity) + ! + ! TD_DrillStems(i)%DiamRatio = (TD_DrillStems(i)%Od)/TD_DrillStems(i)%HoleDiameter + ! + ! + ! TD_DrillStems(i)%MudClingingConst = ((TD_DrillStems(i)%DiamRatio**2) * (1.0d0 - (2.0d0*log(TD_DrillStems(i)%DiamRatio))) - 1.0d0) & + ! / (2.0d0*(1.0d0-(TD_DrillStems(i)%DiamRatio**2))*log(TD_DrillStems(i)%DiamRatio)) + ! + ! TD_DrillStems(i)%AveEffVelocity = TD_DrillStems(i)%PipeVelocity * ( ((TD_DrillStems(i)%DiamRatio**2)/(1.0d0-(TD_DrillStems(i)%DiamRatio**2))) & + ! + TD_DrillStems(i)%MudClingingConst) + ! + ! TD_DrillStems(i)%ReNumber = (926.4*(TD_DrillStems(i)%MudDensityOut * TD_DrillStems(i)%AveEffVelocity * (TD_DrillStems(i)%HoleDiameter - TD_DrillStems(i)%Od))) & + ! / TD_DrillStems(i)%MudPlasticVis !Bingham-plastic drilling fluid + ! !TD_DrillStems(i)%ReNumber = 10.9d4*( TD_DrillStems(i)%MudDensityOut*(TD_DrillStems(i)%AveEffVelocity**(2-TD_NCoef))/TD_DrillStems(i)%MudPlasticVis ) & + ! ! *( (((TD_DrillStems(i)%HoleDiameter - TD_DrillStems(i)%Od)/48.)*(TD_NCoef/((2.*TD_NCoef)+1.)))**TD_NCoef ) !Power-law fluid + ! + ! if ( TD_DrillStems(i)%ReNumber .le. 2.1d3 ) then !Bingham-plastic drilling fluid + ! !if ( TD_DrillStems(i)%ReNumber .le. (3479.-(1370.*TD_NCoef)) ) then !Power-law fluid + ! + ! TD_DrillStems(i)%FricFactor = 1.60d1/TD_DrillStems(i)%ReNumber + ! + ! !TD_DrillStems(i)%Dp_Dl = ( TD_KCoef/(14.4d4*(TD_DrillStems(i)%HoleDiameter - TD_DrillStems(i)%Od)) )& + ! ! *( ((48./(TD_DrillStems(i)%HoleDiameter - TD_DrillStems(i)%Od))*(((2.*TD_NCoef)+1.)/TD_NCoef))**TD_NCoef ) !Power-law fluid + ! TD_DrillStems(i)%Dp_Dl = (TD_DrillStems(i)%FricFactor * (TD_DrillStems(i)%AveEffVelocity**2) * TD_DrillStems(i)%MudDensityOut) & + ! / (25.78d0*(TD_DrillStems(i)%HoleDiameter - TD_DrillStems(i)%Od)) !Bingham-plastic drilling fluid + ! + ! else !Bingham-plastic drilling fluid + ! !else if ( TD_DrillStems(i)%ReNumber .gt. (4270.-(1370.*TD_NCoef)) ) then !Power-law fluid + ! + ! TD_DrillStems(i)%MudClingingConst = (sqrt(( (TD_DrillStems(i)%DiamRatio**4) + TD_DrillStems(i)%DiamRatio ) & + ! /(1.0d0 + TD_DrillStems(i)%DiamRatio )) - (TD_DrillStems(i)%DiamRatio**2)) & + ! /(1.0d0- (TD_DrillStems(i)%DiamRatio**2)) + ! + ! TD_DrillStems(i)%AveEffVelocity = TD_DrillStems(i)%PipeVelocity * ( ((TD_DrillStems(i)%DiamRatio**2)/(1.0d0-(TD_DrillStems(i)%DiamRatio**2))) & + ! + TD_DrillStems(i)%MudClingingConst) + ! + ! TD_DrillStems(i)%ReNumber = (926.4d0*(TD_DrillStems(i)%MudDensityOut * TD_DrillStems(i)%AveEffVelocity * (TD_DrillStems(i)%HoleDiameter - TD_DrillStems(i)%Od))) & + ! / TD_DrillStems(i)%MudPlasticVis !Bingham-plastic drilling fluid + ! !TD_DrillStems(i)%ReNumber = 10.9d4*( TD_DrillStems(i)%MudDensityOut*(TD_DrillStems(i)%AveEffVelocity**(2-TD_NCoef))/TD_DrillStems(i)%MudPlasticVis ) & + ! ! *( (((TD_DrillStems(i)%HoleDiameter - TD_DrillStems(i)%Od)/48.)*(TD_NCoef/((2.*TD_NCoef)+1.)))**TD_NCoef ) !Power-law fluid + ! + ! TD_DrillStems(i)%FricFactor = 0.0791d0/(TD_DrillStems(i)%ReNumber**0.25d0) + ! + ! TD_DrillStems(i)%Dp_Dl = (TD_DrillStems(i)%FricFactor * (TD_DrillStems(i)%AveEffVelocity**2) * TD_DrillStems(i)%MudDensityOut) & + ! / (25.78d0*(TD_DrillStems(i)%HoleDiameter - TD_DrillStems(i)%Od)) !Bingham-plastic drilling fluid + ! !TD_DrillStems(i)%Dp_Dl = (TD_DrillStems(i)%FricFactor * (TD_DrillStems(i)%AveEffVelocity**2) * TD_DrillStems(i)%MudDensityOut) & + ! ! / (21.1*(TD_DrillStems(i)%HoleDiameter - TD_DrillStems(i)%Od)) !Power-law fluid + ! + ! end if + ! + ! + ! TD_DrillStems(i)%Drag = ( (pi/4.0d0)*TD_DrillStems(i)%Dp_Dl*TD_DrillStems(i)%Length*(TD_DrillStems(i)%Od**2)/10.d0 ) ! drag/10 = because of the value of drag force + ! + ! Else + ! TD_DrillStems(i)%Drag = 0.0d0 + ! + ! End if + ! + ! + ! !------------------------------------------------------------------------------------ + ! TD_DrillStems(i)%Od = TD_DrillStems(i)%Od/12.d0 ! [ft] + ! TD_DrillStems(i)%HoleDiameter = TD_DrillStems(i)%HoleDiameter/12.d0 ! [ft] + ! TD_DrillStems(i)%MudDensityOut = TD_DrillStems(i)%MudDensityOut*7.48051948d0 ! [lb/ft3] + ! !------------------------------------------------------------------------------------ + ! + ! + !end do + + if (TD_DrillStems(1)%ComponentType==0) then + TD_DrillStems(1)%Drag = 50.d0*TD_DrillStems(1)%Od !Od[ft] , Drag[lb]????? + if ( TD_DrillStems(1)%MudDensityOut==0.d0 .or. TD_DrillStems(1)%MudDensityIn==0.d0 ) then + TD_DrillStems(1)%Drag = 0.d0 + end if + end if + + !!TD_DragSum = 0. + !!Do i = 1 , TD_DrillStemComponentsNumbs + !! TD_DragSum = TD_DragSum+TD_DrillStems(i)%Drag + !!end do + + + ! print*, 'TD_NCoef=' , TD_NCoef + ! print*, 'TD_KCoef=' , TD_KCoef + ! + ! print*, 'TD_DrillStems(1)%DiamRatio=' , TD_DrillStems(1)%DiamRatio + ! print*, 'TD_DrillStems(1)%Od=' , TD_DrillStems(1)%Od + ! print*, 'TD_DrillStems(1)%HoleDiameter=' , TD_DrillStems(1)%HoleDiameter + ! ! + ! print*, 'TD_DrillStems(1)%MudClingingConst=' , TD_DrillStems(1)%MudClingingConst + ! ! + ! print*, 'TD_DrillStems(1)%AveEffVelocity=' , TD_DrillStems(1)%AveEffVelocity + ! ! + ! !print*, 'TD_DrillStems(1)%MudPlasticVis=' , TD_DrillStems(1)%MudPlasticVis + ! print*, 'TD_DrillStems(1)%MudDensityOut=' , TD_DrillStems(1)%MudDensityOut + ! print*, 'TD_DrillStems(1)%ReNumber=' , TD_DrillStems(1)%ReNumber + ! ! + ! print*, 'TD_DrillStems(1)%FricFactor=' , TD_DrillStems(1)%FricFactor + ! print*, 'TD_DrillStems(1)%Dp_Dl=' , TD_DrillStems(1)%Dp_Dl + ! print*, 'TD_DrillStems(1)%Drag=' , TD_DrillStems(1)%Drag + ! print*, 'TD_DrillStems(2)%Drag=' , TD_DrillStems(2)%Drag + ! print*, 'TD_DrillStems(3)%Drag=' , TD_DrillStems(3)%Drag + ! print*, 'TD_DragSum=' , TD_DragSum + ! print*, 'TD_DrillStems(330)%Drag=' , TD_DrillStems(330)%Drag + ! print*, 'TD_DrillStems(331)%Drag=' , TD_DrillStems(331)%Drag + ! print*, 'TD_DrillStems(333)%Drag=' , TD_DrillStems(333)%Drag + + + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_Forces/TD_WeightOnBitCalculation.f90 b/TorqueDrag/TD_Forces/TD_WeightOnBitCalculation.f90 new file mode 100644 index 0000000..c2a75db --- /dev/null +++ b/TorqueDrag/TD_Forces/TD_WeightOnBitCalculation.f90 @@ -0,0 +1,40 @@ +subroutine TD_WeightOnBitCalculation + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + Use TD_StringConnectionData + Use CDataDisplayConsoleVariables + + + implicit none + + Integer :: i + + + !TD_TouchConnectionHeight = TD_DlMax + TD_DrillStemTotalLengthIni - TD_WellTotalLength + TD_TouchConnectionHeight = TD_DrillStemTotalLengthIni - TD_WellTotalLength + + + + !if (TD_DrillStems(1)%ComponentType == 0) then ????????????? + + + + !if (TD_DrillStems(1)%DownDepth < TD_WellTotalLength) then + if (TD_ConnectionHeight < TD_TouchConnectionHeight) then + TD_DlTouch = TD_DlMax-(TD_TouchConnectionHeight-TD_ConnectionHeight) + TD_WeightOnBit = ((TD_StaticHookLoad/2.0d0)/TD_DlMax)*(TD_DlMax-TD_DlTouch) !(TD_StaticHookLoad/2.0d0) ---> because of Uniform drill stem(drillpipes) ?????????? + else + TD_WeightOnBit = 0.d0 ![lb] + end if + + Call Set_WeightOnBit(AINT(real(TD_WeightOnBit,8))) + + + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_MainCalculations.f90 b/TorqueDrag/TD_MainCalculations.f90 new file mode 100644 index 0000000..2a42f95 --- /dev/null +++ b/TorqueDrag/TD_MainCalculations.f90 @@ -0,0 +1,180 @@ +subroutine TD_MainCalculations + + Use CCasingLinerChokeVariables + Use CStringConfigurationVariables + Use CSimulationVariables + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + Use TD_StringConnectionData + Use FricPressDropVars + Use MudSystemVARIABLES + + + implicit none + + Integer :: i + !Integer :: TD_SolDuration + !integer,dimension(8) :: TD_StartTime , TD_EndTime + + + + TD_TimeStep = 0.1d0 ! Unit: [s] + !Call TD_StartUp + !Call TD_WellReadData + !Call TD_WellElementsReadData + !Call TD_DrillStemReadData + !Call TD_PipePropertiesReadData + !!Call TD_WellGeoConfiguration + !!Call TD_WellElementsConfiguration + !!Call TD_StringConnectionModes + !!Call TD_DrillStemConfiguration + + + + + !loop1: do + + + !CALL DATE_AND_TIME(values=TD_StartTime) + + + Call TD_WellGeoConfiguration + Call TD_WellElementsConfiguration + Call TD_StringConnectionModes + Call TD_DrillStemConfiguration + Call TD_ForceReadData + + +!===> Mud properties Read_Data from Fluid Module + !!TD_NoHorizontalMudElements = TDNoHorizontalMudElements + !!TD_NoStringMudElements = TDNoStringMudElements + !!TD_NoCasingMudElements = TDNoCasingMudElements + !! + !!if (allocated(TDDensity_MudElementArray) .and. (TD_NoHorizontalMudElements+TD_NoStringMudElements+TD_NoCasingMudElements)/=0) then + !! if (Allocated(TD_FluidMudDensity)) Deallocate(TD_FluidMudDensity) + !! Allocate(TD_FluidMudDensity(TD_NoHorizontalMudElements+TD_NoStringMudElements+TD_NoCasingMudElements)) + !! TD_FluidMudDensity(:) = TDDensity_MudElementArray(:) + !!end if + !! + !!if (allocated(TDXend_MudElementArray)) then + !! if (Allocated(TD_FluidMudEndX)) Deallocate(TD_FluidMudEndX) + !! Allocate(TD_FluidMudEndX(TD_NoHorizontalMudElements+TD_NoStringMudElements+TD_NoCasingMudElements)) + !! TD_FluidMudEndX(:) = TDXend_MudElementArray(:) + !!end if + !! + !!if (allocated(TDXstart_MudElementArray)) then + !! if (Allocated(TD_FluidMudStartX)) Deallocate(TD_FluidMudStartX) + !! Allocate(TD_FluidMudStartX(TD_NoHorizontalMudElements+TD_NoStringMudElements+TD_NoCasingMudElements)) + !! TD_FluidMudStartX(:) = TDXstart_MudElementArray(:) + !!end if + + if (TD_DrillStem(1)%ComponentType==0) then + Do i = 2 , TD_DrillStemComponentsNumbs + Call TD_MudPropertiesReadData(i) + Call TD_BouyancyFactor(i) + Call TD_CombinedMotionData(i) + End Do + TD_DrillStems(1)%MudDensityIn = TD_DrillStems(2)%MudDensityIn !(1): bit mud properties + TD_DrillStems(1)%MudDensityOut = TD_DrillStems(2)%MudDensityOut + TD_DrillStems(1)%MudWeight = TD_DrillStems(2)%MudWeight + TD_DrillStems(1)%MudPlasticVis = 5.d0+(5.d0*(TD_DrillStems(1)%MudWeight-8.3d0)) + TD_DrillStems(1)%MudViscosity = 0.2d0 !TD_DrillStems(i)%MudPlasticVis + TD_DrillStems(1)%MudYieldPoint = 10.d0+(TD_DrillStems(1)%MudWeight-8.3d0) + Call TD_BouyancyFactor(1) + Call TD_CombinedMotionData(1) + else + Do i = 1 , TD_DrillStemComponentsNumbs + Call TD_MudPropertiesReadData(i) + Call TD_BouyancyFactor(i) + Call TD_CombinedMotionData(i) + End Do + end if +!================================================ + + + + Call TD_BOPDiamCalculation + + + Call TD_StaticHookLoadCalculation + Call TD_WeightOnBitCalculation + if (abs(TD_DrillStemAxialVelocity)>3.2808d0) then !1[m/s]=3.2808[ft/s] + Call TD_ViscousDragForce + else + TD_DrillStems%Drag = 0.d0 + TD_DrillStemForceType = 5 + end if + Call TD_ForceCalculation + Call TD_HookLoadCalculation + + + + !!!!!!print*, 'TD_StringVelocity=' , TD_StringVelocity + !!!!!!print*, 'TD_HookLoad=' , TD_HookLoad + !print*, 'TD_WellTotalLength=' , TD_WellTotalLength + !print*, 'TD_ConnectionHeight_main=' , TD_ConnectionHeight + !!!!!!!!print*, 'TD_DrillStems(1)%StartAngle=' , TD_DrillStems(1)%StartAngle + !!!!!!print*, 'TD_DrillStems(1)%Force2=' , TD_DrillStems(1)%Force2 + !!!!!!print*, 'TD_DrillStems(1)%Force1=' , TD_DrillStems(1)%Force1 + !!!!!print*, 'TD_WeightIndicator=' , TD_WeightIndicator + !!!!!print*, 'TD_DlTotal=' , TD_DlTotal + !!!!!print*, 'TD_DlMax=' , TD_DlMax + !!!!!!print*, 'TD_DrillStems(n)%Force2=' , TD_DrillStems(TD_DrillStemComponentsNumbs)%Force2 + !!!!!!print*, 'TD_DrillStems(n)%Force1=' , TD_DrillStems(TD_DrillStemComponentsNumbs)%Force1 + !print*, 'TD_DrillStems(1)%Drag=' , TD_DrillStems(1)%Drag + !!!!!!!!! + !print*, 'TD_WeightOnBit=' , TD_WeightOnBit + !!print*, 'TD_StringTorque=' , TD_StringTorque + !!print*, 'TD_DrillStems(1)%Torque=' , TD_DrillStems(1)%Torque + !!print*, 'TD_DrillStems(n)%Torque=' , TD_DrillStems(TD_DrillStemComponentsNumbs)%Torque + !!!!!!!!! + !print*, 'TD_DrillStemComponentsNumbs_main =' ,TD_DrillStemComponentsNumbs + !print*, 'TD_DrillStemTotalLength=' ,TD_DrillStemTotalLength + !!print*, 'TD_StringConfigurationCount=' ,TD_StringConfigurationCount + !print*, 'TD_HookHeight=' ,TD_HookHeight + !!!!!!print*, 'TD_HookVelocity=' ,TD_HookVelocity + !print*, 'TD_DrillStems(1)%DownDepth=' ,TD_DrillStems(1)%DownDepth + !print*, 'TD_DrillStems(1)%DownDepthIni_main=' ,TD_DrillStems(1)%DownDepthIni + !!!!!!print*, 'TD_DrillStems(1)%DownDepth=' ,TD_DrillStems(335)%DownDepth + !!print*, 'TD_DrillStems(n)%DownDepth=' ,TD_DrillStems(TD_DrillStemComponentsNumbs)%DownDepth + !!!print*, 'TD_DrillStems(n)%ID=' ,TD_DrillStems(TD_DrillStemComponentsNumbs)%ID + !!!print*, 'TD_DrillStems(n)%OD=' ,TD_DrillStems(TD_DrillStemComponentsNumbs)%OD + !!!print*, 'TD_DrillStem(n)%ID=' ,TD_DrillStem(TD_StringConfigurationCount)%ID + !!!print*, 'TD_DrillStem(n)%OD=' ,TD_DrillStem(TD_StringConfigurationCount)%OD + !!!print*, 'TD_DrillStem(1)%ID=' ,TD_DrillStem(1)%ID + !!!print*, 'TD_DrillStem(1)%OD=' ,TD_DrillStem(1)%OD + !!!!!print*, 'TD_StaticHookLoad=' ,TD_StaticHookLoad + !!!!print*, 'TD_DrillStems(n)%Dl=' ,TD_DrillStems(TD_DrillStemComponentsNumbs)%Dl + !!!!!print*, 'TD_DrillStems(n)%Length=' ,TD_DrillStems(TD_DrillStemComponentsNumbs)%Length + !!!!!print*, 'TD_DrillStem(1)%Length=' ,TD_DrillStem(1)%Length + !!!!!print*, 'TD_DrillStems(n)%Area=' ,TD_DrillStems(TD_DrillStemComponentsNumbs)%Area + !!!!!print*, 'TD_DrillStems(n)%ElasticModule=' ,TD_DrillStems(TD_DrillStemComponentsNumbs)%ElasticModule + + TD_HookHeightOld = TD_HookHeight + + + ! if(IsStopped == .true.) then + ! EXIT loop1 + ! end if + ! + ! + ! CALL DATE_AND_TIME(values=TD_EndTime) + ! TD_SolDuration=100-(TD_EndTime(6)*60000+TD_EndTime(7)*1000+TD_EndTime(8)-TD_StartTime(6)*60000-TD_StartTime(7)*1000-TD_StartTime(8)) + ! !print*, 'TD_SolDuration=' , TD_SolDuration + ! !print*, 'TD_exe=' , (TD_EndTime(6)*60000+TD_EndTime(7)*1000+TD_EndTime(8)-TD_StartTime(6)*60000-TD_StartTime(7)*1000-TD_StartTime(8)) + ! if(TD_SolDuration > 0.0d0) then + ! CALL sleepqq(TD_SolDuration) + ! end if + ! + ! + !end do loop1 + ! + !return + + + + + +end subroutine TD_MainCalculations \ No newline at end of file diff --git a/TorqueDrag/TD_Modules/GeoElements_FluidModule.f90 b/TorqueDrag/TD_Modules/GeoElements_FluidModule.f90 new file mode 100644 index 0000000..cdf3ff3 --- /dev/null +++ b/TorqueDrag/TD_Modules/GeoElements_FluidModule.f90 @@ -0,0 +1,58 @@ +MODULE GeoElements_FluidModule + + + IMPLICIT NONE + PUBLIC + + + + + REAL(8) , Allocatable :: MD(:) , TVD(:) , Angle(:) + + + +!==================================================== +! Well Geometrical Elements Info (for fluid module) +!==================================================== + + TYPE , PUBLIC :: F_StringData + INTEGER :: FirstElement , LastElement , ElType + REAL(8) :: ID , OD , TopDepth , DownDepth + END TYPE F_StringData + + TYPE(F_StringData) , Allocatable :: F_String(:) + + + + + + INTEGER :: F_IntervalsTotalCounts , F_StringIntervalCounts , F_BottomHoleIntervalCounts , F_AnnulusIntervalCounts + INTEGER :: OutOfWellIntervalCounts + TYPE , PUBLIC :: F_IntervalData + INTEGER :: Number , GeoType + REAL(8) :: ID , OD , StartDepth , EndDepth , HydDiameter , Volume + REAL(8) :: StartTVD , EndTVD , StartAngle , EndAngle + END TYPE F_IntervalData + + TYPE(F_IntervalData) , Allocatable :: F_Interval(:) + !####F_Interval(:)%GeoType = + ! 0 : String Interval + ! 1 : BottomHole Interval + ! 2 : Annulus Interval + + + + + + TYPE , PUBLIC :: OD_AnnulusData + REAL(8) :: ODValue , StartMD , EndMD + END TYPE OD_AnnulusData + + TYPE(OD_AnnulusData) :: OD_Annulus(4) + + + + + + +END MODULE GeoElements_FluidModule \ No newline at end of file diff --git a/TorqueDrag/TD_Modules/TD_DrillStem.f90 b/TorqueDrag/TD_Modules/TD_DrillStem.f90 new file mode 100644 index 0000000..bddf8f9 --- /dev/null +++ b/TorqueDrag/TD_Modules/TD_DrillStem.f90 @@ -0,0 +1,128 @@ +MODULE TD_DrillStemComponents + + Use CDownHoleVariables + + IMPLICIT NONE + PUBLIC + + INTEGER :: TD_StringConfigurationCount , TD_DrillStemComponentsNumbs , TD_DrillStemForceType + REAL(8) :: TD_DrillStemTotalLength , TD_DrillStemTotalLengthIni , TD_OutOfWellLength , TD_DrillStemTotalWeight , TD_DrillStemBottom + REAL(8) :: TD_DrillStemAxialVelocity , TD_DrillStemRotVelocity , TD_TopJointHeight + REAL(8) :: TD_WeightOnBit , TD_BitTorque , TD_TotalTorque , TD_StaticHookLoad , TD_DlMax , TD_DlTotal , TD_DlTouch + REAL(8) :: TD_HookLoad , TD_StringTorque + REAL(8) :: TD_ToolJointRange + real(8) , allocatable :: TD_FluidMudDensity(:) , TD_FluidMudEndX(:) , TD_FluidMudStartX(:) + INTEGER :: TD_NoHorizontalMudElements , TD_NoStringMudElements , TD_NoCasingMudElements + + + + + +!==================================================== +! Drill Stem Components Info +!==================================================== + + TYPE, PUBLIC :: TD_DrillStemInfo + INTEGER :: Numbs , ComponentType + REAL(8) :: Length , TopDepth , DownDepth , Od , Id , WeightperLength , TotalLength , TotalWeight + END TYPE TD_DrillStemInfo + + TYPE(TD_DrillStemInfo), ALLOCATABLE, DIMENSION(:) :: TD_DrillStem + + + + + + + +!==================================================== +! Separated Parts of the Drill Stem +!==================================================== + + TYPE , PUBLIC :: TD_SeparatedDrillStemInfo + !=========> Elements Geometry + INTEGER :: HoleType , ComponentType + REAL(8) :: Length , TopDepth , DownDepth , Od , Id , Area , Weight , WeightperLength , StartAngle , EndAngle + REAL(8) :: RCurvature , RtoolJoint , HoleDiameter , ToolJointRange + !=========> Elements initial Geometry + REAL(8) :: LengthIni , TopDepthIni , DownDepthIni , StartAngleIni , EndAngleIni + !=========> Elements initial Geometry (graphic) + REAL(8) :: TopDepthIniG , DownDepthIniG + !=========> Pipes Properties + REAL(8) :: Density , ElasticModule + !=========> Forces Info + REAL(8) :: Force1 , Force2 , Torque , Drag , CombVelRatio + !=========> Mud Properties + REAL(8) :: MudDensityIn , MudDensityOut , MudViscosity , MudVisCorrectCoef , BouyancyFactor , MudWeight , MudPlasticVis , MudYieldPoint + !=========> Viscous Drag Force + REAL(8) :: FricFactor , DiamRatio , MudClingingConst , PipeVelocity , AveEffVelocity , ReNumber , Dp_Dl + !=========> Hook Load + REAL(8) :: StaticHookLoad , TotalSHookLoad , Dl , DlTotal + END TYPE TD_SeparatedDrillStemInfo + + TYPE(TD_SeparatedDrillStemInfo), ALLOCATABLE, DIMENSION(:) :: TD_DrillStems + + + + + + + +!==================================================== +! Separated Parts of the Drill Stem +!==================================================== + + INTEGER :: TD_NearFloorConnectionNo + REAL(8) :: TD_NearFloorConnectionHeight + + + + + + +!==================================================== +! Add&Remove DrillStem Components +!==================================================== + integer :: TD_IBOPNewAdd , TD_IBOPOldAdd , TD_SafetyValveNewAdd , TD_SafetyValveOldAdd , TD_KellyNewAdd , TD_KellyOldAdd + integer :: TD_IBOPNewRemove , TD_IBOPOldRemove , TD_SafetyValveNewRemove , TD_SafetyValveOldRemove , TD_KellyNewRemove , TD_KellyOldRemove + integer :: TD_KellyOldStatus1 , TD_KellyNewStatus1 , TD_KellyOldStatus2 , TD_KellyNewStatus2 , TD_KellyOldStatus3 , TD_KellyNewStatus3 + integer :: TD_KellyOldStatus4 , TD_KellyNewStatus4 , TD_KellyOldStatus5 , TD_KellyNewStatus5 , TD_KellyOldStatus6 , TD_KellyNewStatus6 + integer :: TD_KellyOldStatus7 , TD_KellyNewStatus7 , TD_KellyOldStatus8 , TD_KellyNewStatus8 + integer :: TD_KellyOldStatus9 , TD_KellyNewStatus9 , TD_KellyOldStatus10 , TD_KellyNewStatus10 + integer :: TD_KellyOldStatus11 , TD_KellyNewStatus11 , TD_KellyOldStatus12 , TD_KellyNewStatus12 + integer :: TD_KellyOldStatus13 , TD_KellyNewStatus13 , TD_KellyOldStatus14 , TD_KellyNewStatus14 + integer :: TD_KellyOldStatus15 , TD_KellyNewStatus15 , TD_KellyOldStatus16 , TD_KellyNewStatus16 , TD_KellyOldStatus17 , TD_KellyNewStatus17 + integer :: TD_KellyOldStatus18 , TD_KellyNewStatus18 , TD_KellyOldStatus19 , TD_KellyNewStatus19 + + + + + +!==================================================== +! Graphic Output Info +!==================================================== + + !TYPE, PUBLIC :: CStringComponent + ! Integer :: ComponentType + ! REAL(8) :: Length , TopDepth , DownDepth , Od , Id + !END TYPE CStringComponent + + TYPE(CStringComponents), ALLOCATABLE, DIMENSION(:) :: G_StringElement + + + + + + +!==================================================== +! Removed-Volume Variables +!==================================================== + Integer :: TD_PreCount + REAL(8) :: TD_RemoveVolume , TD_PreElementVolume , TD_PreElementLength + + + + + + +END MODULE TD_DrillStemComponents \ No newline at end of file diff --git a/TorqueDrag/TD_Modules/TD_GeneralData.f90 b/TorqueDrag/TD_Modules/TD_GeneralData.f90 new file mode 100644 index 0000000..c685aeb --- /dev/null +++ b/TorqueDrag/TD_Modules/TD_GeneralData.f90 @@ -0,0 +1,51 @@ +MODULE TD_GeneralData + + + Use CDownHoleTypes + + IMPLICIT NONE + PUBLIC + + + + +!==================================================== +! General Info +!==================================================== + +!=====> Time Info + REAL :: TD_TimeStep + INTEGER :: TD_IntCPUTime, TD_DtRef + !REAL :: TD_StartTime, TD_EndTime + + + + + + +!=====> BOP Info + !REAL(8) :: TD_AboveAnnularHeight , TD_AnnularPreventerHeight , TD_UpperRamHeight , TD_LowerRamHeight , TD_BlindRamHeight , TD_KillHeight + REAL(8) :: TD_AboveAnnularDiam , TD_AnnularPreventerDiam , TD_UpperRamDiam , TD_LowerRamDiam , TD_BlindRamDiam , TD_KillDiam + REAL(8) , Dimension(6) :: TD_BOPHeight , TD_BOPDiam + REAL(8) , Dimension(4) :: TD_BOPRamDiam + REAL(8) :: TD_BOPThickness , TD_AnnularFillingFinal + INTEGER , Dimension(4) :: TD_BOPCondition + INTEGER , Dimension(6) :: TD_BOPElementNo + INTEGER , Dimension(6) :: TD_BOPConnectionPossibility ! 0:impossible , 1:possible(for DrillPipe Element) + + !TYPE , PUBLIC :: TD_BOPElementData + ! INTEGER :: CType + ! REAL(8) :: TopDepth , DownDepth + !END TYPE TD_BOPElementData + TYPE(CBopElement) :: TD_BOPElement(4) + + + +!=====> Problems + INTEGER :: TD_WeightIndicatorMalf + + + + + +END MODULE TD_GeneralData \ No newline at end of file diff --git a/TorqueDrag/TD_Modules/TD_StringConnectionData.f90 b/TorqueDrag/TD_Modules/TD_StringConnectionData.f90 new file mode 100644 index 0000000..f99306a --- /dev/null +++ b/TorqueDrag/TD_Modules/TD_StringConnectionData.f90 @@ -0,0 +1,47 @@ +MODULE TD_StringConnectionData + + + IMPLICIT NONE + PUBLIC + + + + +!==================================================== +! String Connection Info +!==================================================== + + INTEGER :: TD_StringConnectionMode , TD_KellyDriveTypeMode , TD_OldOperationCondition , TD_FluidStringConnectionMode + REAL(8) :: TD_ConnectionHeight , TD_TouchConnectionHeight , TD_RigidConnectionHeight , TD_GRigidConnectionHeight , TD_StringVelocity + REAL(8) :: TD_HookHeightOld , TD_HookHeight , TD_HookVelocity + REAL(8) :: TD_ElevatorHeight , TD_ElevatorConst + REAL(8) :: TD_SafetyValveLength , TD_IBOPLength , TD_KellyElementID , TD_KellyElementOD + REAL(8) :: TD_KellyConnectionHeight , TD_KellyConst , TD_KellyElementConst + REAL(8) :: TD_TDSHeight , TD_TDSElevatorHeight , TD_TDSLength , TD_TDSElevatorLength , TD_TDSToolJointLength , TD_TDSElevatorToolLength + REAL(8) :: TD_TDSElevatorECG , TD_ElevatorECG + + + + + + +!==================================================== +! Weight Indicator Info +!==================================================== + + INTEGER :: TD_NumOfCables + REAL(8) :: TD_WeightIndicator + REAL(8) :: TD_WeightTB , TD_WeightTD , TD_KellyWeight + + + + + INTEGER :: TD_ZeroStringSpeed + REAL(8) :: TD_DrawworksLoadInput + + + + + + +END MODULE TD_StringConnectionData \ No newline at end of file diff --git a/TorqueDrag/TD_Modules/TD_WellElements.f90 b/TorqueDrag/TD_Modules/TD_WellElements.f90 new file mode 100644 index 0000000..8fcac0d --- /dev/null +++ b/TorqueDrag/TD_Modules/TD_WellElements.f90 @@ -0,0 +1,80 @@ +MODULE TD_WellElements + + + IMPLICIT NONE + PUBLIC + + + + +!==================================================== +! Casing Info +!==================================================== + + INTEGER :: TD_CasingNumbs + + TYPE, PUBLIC :: TD_CasingInfo + INTEGER :: HoleType + REAL(8) :: Length , TopDepth , DownDepth , Od , Id , Weight , CollapsePressure , TensileStrength , Roughness + END TYPE TD_CasingInfo +! + TYPE(TD_CasingInfo), ALLOCATABLE, DIMENSION(:) :: TD_Casing + + + + + + +!==================================================== +! Liner Info +!==================================================== + + INTEGER :: TD_LinerNumbs + + TYPE, PUBLIC :: TD_LinerInfo + REAL(8) :: Length , TopDepth , DownDepth , Od , Id , Weight , CollapsePressure , TensileStrength , Roughness , HoleType + END TYPE TD_LinerInfo +! + TYPE(TD_LinerInfo), ALLOCATABLE, DIMENSION(:) :: TD_Liner + + + + + + +!==================================================== +! Open_Hole Info +!==================================================== + + INTEGER :: TD_OpenHoleNumbs + + TYPE, PUBLIC :: TD_OpenHoleInfo + REAL(8) :: Length , TopDepth , DownDepth , Id , HoleType + END TYPE TD_OpenHoleInfo +! + TYPE(TD_OpenHoleInfo), ALLOCATABLE, DIMENSION(:) :: TD_OpenHole + + + + + + +!==================================================== +! ROP_Hole Info +!==================================================== + + INTEGER :: TD_ROPHoleNumbs + REAL(8) :: TD_ROP + + TYPE, PUBLIC :: TD_ROPHoleInfo + REAL(8) :: Length , TopDepth , DownDepth , Id , HoleType + END TYPE TD_ROPHoleInfo +! + TYPE(TD_ROPHoleInfo), ALLOCATABLE, DIMENSION(:) :: TD_ROPHole + + + + + + +END MODULE TD_WellElements \ No newline at end of file diff --git a/TorqueDrag/TD_Modules/TD_WellGeometry.f90 b/TorqueDrag/TD_Modules/TD_WellGeometry.f90 new file mode 100644 index 0000000..00b00b8 --- /dev/null +++ b/TorqueDrag/TD_Modules/TD_WellGeometry.f90 @@ -0,0 +1,32 @@ +MODULE TD_WellGeometry + + + IMPLICIT NONE + PUBLIC + + + + REAL(8) , PARAMETER :: pi=3.14159265 + + + + +!==================================================== +! Well Geometry Info +!==================================================== + + INTEGER :: TD_WellIntervalsCount + REAL(8) :: TD_WellTotalLength , TD_WellTotalVerticalLength + + TYPE, PUBLIC :: TD_WellGeometryData + INTEGER :: HoleType + REAL(8) :: StartAngle , EndAngle , IntervalLength , VerticalDepth , TopDepth , DownDepth , RCurvature + END TYPE TD_WellGeometryData + + TYPE(TD_WellGeometryData), Allocatable :: TD_WellGeo(:) + + + + + +END MODULE TD_WellGeometry \ No newline at end of file diff --git a/TorqueDrag/TD_Modules/td_wellgeometry.mod b/TorqueDrag/TD_Modules/td_wellgeometry.mod new file mode 100644 index 0000000..3827539 Binary files /dev/null and b/TorqueDrag/TD_Modules/td_wellgeometry.mod differ diff --git a/TorqueDrag/TD_ReadDataSubroutines/TD_DrillStemReadData.f90 b/TorqueDrag/TD_ReadDataSubroutines/TD_DrillStemReadData.f90 new file mode 100644 index 0000000..fae9879 --- /dev/null +++ b/TorqueDrag/TD_ReadDataSubroutines/TD_DrillStemReadData.f90 @@ -0,0 +1,145 @@ +subroutine TD_DrillStemReadData + + Use CStringConfigurationVariables + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_StringConnectionData + Use Drawworks_VARIABLES, only: Drawworks + + + implicit none + + + + + Integer :: i + Integer :: TD_FirstIndex , TD_LastIndex + + + + +!==================================================== +! Set Drill Stem Components Data +!==================================================== + TD_StringConfigurationCount = StringConfigurationCount + TD_DrillStemComponentsNumbs = 0 + + + !########## TD_DrillStem%ComponentType :: + !#Bit_ComponentType = 0 + !#Stabilizer_ComponentType = 1 + !#Collar_ComponentType = 2 + !#DrillPipe_ComponentType = 3 + !#Heavyweight_ComponentType = 4 + !#IBOP = 5 + !#Kelly & SafetyValve (DrillMode) = 6 + !#SafetyValve (TripMode) = 7 + + + if (Allocated(TD_DrillStem)) deAllocate (TD_DrillStem) + Allocate (TD_DrillStem(TD_StringConfigurationCount+100)) + + + Do i=1, TD_StringConfigurationCount + TD_DrillStem(i)%ComponentType = StringConfigurations(i)%ComponentType + TD_DrillStem(i)%Numbs = StringConfigurations(i)%NumberOfJoint + TD_DrillStem(i)%Id = StringConfigurations(i)%NominalId/12.d0 ![ft] + TD_DrillStem(i)%Od = StringConfigurations(i)%NominalOd/12.d0 ![ft] + TD_DrillStem(i)%Length = StringConfigurations(i)%LengthPerJoint ![ft] + TD_DrillStem(i)%WeightperLength = StringConfigurations(i)%WeightPerLength ![lb/ft] + TD_DrillStem(i)%TotalLength = StringConfigurations(i)%ComponentLength + TD_DrillStem(i)%TotalWeight = TD_DrillStem(i)%TotalLength*TD_DrillStem(i)%WeightperLength + + TD_DrillStemComponentsNumbs = TD_DrillStemComponentsNumbs+StringConfigurations(i)%NumberOfJoint + + !!=========> Set Separated Drill Stem Components Data + ! TD_LastIndex = TD_LastIndex+StringConfigurations(i)%NumberOfJoint + ! + ! TD_DrillStems(TD_FirstIndex:TD_LastIndex)%ComponentType = TD_DrillStem(i)%ComponentType + ! TD_DrillStems(TD_FirstIndex:TD_LastIndex)%Id = TD_DrillStem(i)%Id + ! TD_DrillStems(TD_FirstIndex:TD_LastIndex)%Od = TD_DrillStem(i)%Od + ! TD_DrillStems(TD_FirstIndex:TD_LastIndex)%Length = TD_DrillStem(i)%Length + ! TD_DrillStems(TD_FirstIndex:TD_LastIndex)%Weight = TD_DrillStem(i)%Weight + ! + ! TD_FirstIndex = TD_LastIndex+1 + End Do + + + + + + +!===> Initial Values of Removed-Volume Variables + if (TD_DrillStem(1)%ComponentType==0) then + TD_PreCount = TD_StringConfigurationCount-1 + else + TD_PreCount = TD_StringConfigurationCount + end if + TD_PreElementVolume = TD_DrillStem(TD_StringConfigurationCount)%TotalLength*(((pi*((TD_DrillStem(TD_StringConfigurationCount)%Id)**2))/4.d0)) ![ft^3] + TD_PreElementLength = TD_DrillStem(TD_StringConfigurationCount)%TotalLength + + + + + + + +!==================================================== +! Set Separated Drill Stem Components Data +!==================================================== + + TD_FirstIndex = 1 + TD_LastIndex = 0 + if (Allocated(TD_DrillStems)) deAllocate (TD_DrillStems) + Allocate (TD_DrillStems(TD_DrillStemComponentsNumbs+300)) ! +300: because of: Add or Remove DrillStem Components + Call TD_DrillStemStartUp + + + Do i=1, TD_StringConfigurationCount + + TD_LastIndex = TD_LastIndex+StringConfigurations(i)%NumberOfJoint + + TD_DrillStems(TD_FirstIndex:TD_LastIndex)%ComponentType = TD_DrillStem(i)%ComponentType + TD_DrillStems(TD_FirstIndex:TD_LastIndex)%Id = TD_DrillStem(i)%Id + TD_DrillStems(TD_FirstIndex:TD_LastIndex)%Od = TD_DrillStem(i)%Od + TD_DrillStems(TD_FirstIndex:TD_LastIndex)%Area = (pi*((TD_DrillStem(i)%Od**2)-(TD_DrillStem(i)%Id**2)))/4.0d0 + + if (TD_DrillStem(i)%ComponentType == 3 .or. TD_DrillStem(i)%ComponentType == 4) then + TD_DrillStems(TD_FirstIndex:TD_LastIndex)%RtoolJoint = TD_DrillStem(i)%Od*1.30d0/2.0d0 + TD_DrillStems(TD_FirstIndex:TD_LastIndex)%ToolJointRange = TD_ToolJointRange + else if (TD_DrillStem(i)%ComponentType == 1 .or. TD_DrillStem(i)%ComponentType == 2) then + TD_DrillStems(TD_FirstIndex:TD_LastIndex)%RtoolJoint = TD_DrillStem(i)%Od/2.0d0 + TD_DrillStems(TD_FirstIndex:TD_LastIndex)%ToolJointRange = TD_ToolJointRange + else if (TD_DrillStem(i)%ComponentType == 0) then + TD_DrillStems(TD_FirstIndex:TD_LastIndex)%RtoolJoint = TD_DrillStem(i)%Od + TD_DrillStems(TD_FirstIndex:TD_LastIndex)%ToolJointRange = 0.0d0 + end if + + TD_DrillStems(TD_FirstIndex:TD_LastIndex)%Length = TD_DrillStem(i)%Length + TD_DrillStems(TD_FirstIndex:TD_LastIndex)%LengthIni = TD_DrillStem(i)%Length + TD_DrillStems(TD_FirstIndex:TD_LastIndex)%WeightperLength= TD_DrillStem(i)%WeightperLength + TD_DrillStems(TD_FirstIndex:TD_LastIndex)%Weight = TD_DrillStem(i)%WeightperLength*TD_DrillStem(i)%Length + + TD_FirstIndex = TD_LastIndex+1 + + End Do + + + + + + + +!==================================================== +! Set Hook Height Data +!==================================================== + TD_HookHeightOld = Drawworks%Hook_Height_ini + TD_HookHeight = TD_HookHeightOld + + + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_ReadDataSubroutines/TD_ForceReadData.f90 b/TorqueDrag/TD_ReadDataSubroutines/TD_ForceReadData.f90 new file mode 100644 index 0000000..8da3dfd --- /dev/null +++ b/TorqueDrag/TD_ReadDataSubroutines/TD_ForceReadData.f90 @@ -0,0 +1,61 @@ +subroutine TD_ForceReadData + + Use CHoistingVariables + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + Use TD_StringConnectionData + Use RTable_VARIABLES, only: RTable + Use sROP_Variables + Use TopDrive_VARIABLES, only: TDS + + + implicit none + + + integer :: i + + + + TD_DrillStemAxialVelocity = TD_StringVelocity + Do i = 1 , TD_DrillStemComponentsNumbs + if ( DriveType==1) then + TD_DrillStemRotVelocity = (2.d0*pi*TD_DrillStems(i)%RtoolJoint)*(RTable%Speed)/60.d0 ! RTable%Speed[RPM] ---> TD_DrillStemRotVelocity[ft/s] + else if ( DriveType==0) then + TD_DrillStemRotVelocity = (2.d0*pi*TD_DrillStems(i)%RtoolJoint)*(TDS%Speed+RTable%Speed)/60.d0 ! TDS%Speed[RPM] ---> TD_DrillStemRotVelocity[ft/s] + end if + End Do + + + + + TD_BitTorque = Bit_Torque + + + + + + !TD_DrillStemAxialVelocity = 0.0 !??????????????????? + !TD_DrillStemRotVelocity = 0.0 !??????????????????? + + + + + TD_DrillStemForceType = 0 + if(TD_DrillStemAxialVelocity > 0.) then !??????????????????? check + TD_DrillStemForceType = 1 + if(TD_DrillStemRotVelocity /= 0.d0) TD_DrillStemForceType = 2 + else if(TD_DrillStemAxialVelocity < 0.d0) then + TD_DrillStemForceType = 3 + if(TD_DrillStemRotVelocity /= 0.d0) TD_DrillStemForceType = 4 + else if(TD_DrillStemAxialVelocity == 0.d0) then + TD_DrillStemForceType = 5 !no axial motion + end if + + + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_ReadDataSubroutines/TD_MudPropertiesReadData.f90 b/TorqueDrag/TD_ReadDataSubroutines/TD_MudPropertiesReadData.f90 new file mode 100644 index 0000000..0099d92 --- /dev/null +++ b/TorqueDrag/TD_ReadDataSubroutines/TD_MudPropertiesReadData.f90 @@ -0,0 +1,96 @@ +subroutine TD_MudPropertiesReadData (i) + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + Use FricPressDropVars + Use MudSystemVARIABLES + + implicit none + + + + Integer :: i , j , TDmd + real(8) :: TDden, TDpre, TDtem + + + +!==================================================== +! Set Mud Properties Data +!==================================================== + IF ( ALLOCATED(FlowEl) ) THEN + if ( i==2 ) then + TDmd = int(TD_DrillStems(i)%DownDepthIni-1.d0) + else + TDmd = int(TD_DrillStems(i)%DownDepthIni) + end if + Call StringPropertyCalculator (TDmd , TDden, TDpre, TDtem) + TD_DrillStems(i)%MudDensityIn = TDden*7.48051948d0 ! [ppg]*7.48051948=[lb/ft3] + Call AnnulusPropertyCalculator (TDmd , TDden, TDpre, TDtem) + TD_DrillStems(i)%MudDensityOut = TDden*7.48051948d0 ! [ppg]*7.48051948=[lb/ft3] + TD_DrillStems(i)%MudWeight = TDden ! [ppg] ??????????????? + ELSE + TD_DrillStems(i)%MudDensityIn = TD_DrillStems(i)%MudDensityIn + TD_DrillStems(i)%MudDensityOut = TD_DrillStems(i)%MudDensityOut + TD_DrillStems(i)%MudWeight = TD_DrillStems(i)%MudWeight + END IF + + + !TD_DrillStems(i)%Drag = + + + + + + !IF (ALLOCATED(TD_FluidMudDensity) .and. ALLOCATED(TD_FluidMudStartX) .and. TD_NoStringMudElements/=0) THEN + ! Do j = TD_NoHorizontalMudElements+1,TD_NoHorizontalMudElements+TD_NoStringMudElements + ! if ( TD_DrillStems(i)%DownDepthIni<=TD_FluidMudStartX(j) ) then + ! exit + ! end if + ! TD_DrillStems(i)%MudDensityIn = TD_FluidMudDensity(j)*7.48051948d0 !10.*7.48051948 ! [ppg]*7.48051948=[lb/ft3] + ! !print*, 'TD_DrillStems(i)%MudDensityIn=' ,TD_DrillStems(i)%MudDensityIn , i + ! !print*, 'FlowEl(j)%density=' ,FlowEl(j)%density , i + ! End Do + !ELSE + ! TD_DrillStems(i)%MudDensityIn = TD_DrillStems(i)%MudDensityIn ! [ppg]*7.48051948=[lb/ft3] + !! !print*, '=================' , i + !END IF + ! + ! + ! + ! + ! + ! + ! + !IF (ALLOCATED(TD_FluidMudDensity) .and. ALLOCATED(TD_FluidMudEndX) .and. TD_NoCasingMudElements/=0) THEN + ! Do j = (TD_NoHorizontalMudElements+TD_NoStringMudElements+TD_NoCasingMudElements),(TD_NoHorizontalMudElements+TD_NoStringMudElements+1),-1 + ! if ( TD_DrillStems(i)%DownDepthIni<=TD_FluidMudEndX(j) ) then + ! exit + ! end if + ! TD_DrillStems(i)%MudDensityOut = TD_FluidMudDensity(j)*7.48051948d0 !10.*7.48051948 ! [ppg]*7.48051948=[lb/ft3] + ! TD_DrillStems(i)%MudWeight = TD_FluidMudDensity(j) !10.0 ! [ppg] ??????????????? + ! End Do + !ELSE + ! TD_DrillStems(i)%MudDensityOut = TD_DrillStems(i)%MudDensityOut ! [ppg]*7.48051948=[lb/ft3] + ! TD_DrillStems(i)%MudWeight = TD_DrillStems(i)%MudWeight ! [ppg] ??????????????? + !END IF + + + + + + + + + TD_DrillStems(i)%MudPlasticVis = 5.d0+(5.d0*(TD_DrillStems(i)%MudWeight-8.3d0)) ! [cP] + !TD_DrillStems(i)%MudPlasticVis= TD_DrillStems(i)%MudPlasticVis * 6.71968d-4 ! [cP]*6.71968d-4=[lb/(ft.s)] + TD_DrillStems(i)%MudViscosity = 0.2d0 !TD_DrillStems(i)%MudPlasticVis + TD_DrillStems(i)%MudYieldPoint = 10.d0+(TD_DrillStems(i)%MudWeight-8.3d0) + + + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_ReadDataSubroutines/TD_PipePropertiesReadData.f90 b/TorqueDrag/TD_ReadDataSubroutines/TD_PipePropertiesReadData.f90 new file mode 100644 index 0000000..7a590e7 --- /dev/null +++ b/TorqueDrag/TD_ReadDataSubroutines/TD_PipePropertiesReadData.f90 @@ -0,0 +1,26 @@ +subroutine TD_PipePropertiesReadData + + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + + implicit none + + Integer :: i + + +!==================================================== +! Set Pipe Properties Data +!==================================================== + + Do i = 1 , TD_DrillStemComponentsNumbs + TD_DrillStems(i)%Density = 7850.d0*0.06242796d0 ![kg/m3]*0.06242796=[lb/ft3] + TD_DrillStems(i)%ElasticModule = 200.0d9*0.02088543d0 ![lb/ft2] !200GPa=29Mpsi (steel) + End Do + + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_ReadDataSubroutines/TD_WellElementsReadData.f90 b/TorqueDrag/TD_ReadDataSubroutines/TD_WellElementsReadData.f90 new file mode 100644 index 0000000..4c242a7 --- /dev/null +++ b/TorqueDrag/TD_ReadDataSubroutines/TD_WellElementsReadData.f90 @@ -0,0 +1,132 @@ +subroutine TD_WellElementsReadData + + Use CCasingLinerChokeVariables + use CStringConfigurationVariables + Use TD_WellElements + Use TD_WellGeometry + + implicit none + + + Integer :: i + Real(8) :: TD_OpenHoleLength + + + + +!==================================================== +! Set Casing Data +!==================================================== + TD_CasingNumbs = 1 + + if (Allocated(TD_Casing)) deAllocate (TD_Casing) + Allocate (TD_Casing(TD_CasingNumbs)) + + Do i=1, TD_CasingNumbs + TD_Casing(i)%Length = CasingDepth ! unit: [ft] + TD_Casing(i)%TopDepth = 0.d0 + TD_Casing(i)%DownDepth = TD_Casing(i)%Length + TD_Casing(i)%Od = CasingOd/12.d0 ! unit: [ft] + TD_Casing(i)%Id = CasingId/12.d0 ! unit: [ft] + TD_Casing(i)%Weight = CasingWeight + TD_Casing(i)%CollapsePressure = CasingCollapsePressure + TD_Casing(i)%TensileStrength = CasingTensileStrength + End Do + + + + + +!==================================================== +! Set Liner Data +!==================================================== + TD_LinerNumbs = 0 + if(LinerLength > 0.d0) then + TD_LinerNumbs = 1 + + !if (TD_LinerNumbs>0) then + if (Allocated(TD_Liner)) deAllocate (TD_Liner) + Allocate (TD_Liner(TD_LinerNumbs)) + + Do i=1, TD_LinerNumbs + TD_Liner(i)%TopDepth = LinerTopDepth ! unit: [ft] + if (TD_Liner(i)%TopDepth 0.d0) TD_OpenHoleNumbs=1 + + if (TD_OpenHoleNumbs>0) then + if (Allocated(TD_OpenHole)) deAllocate (TD_OpenHole) + Allocate (TD_OpenHole(TD_OpenHoleNumbs)) !!!??????????????????check + + Do i = 1, TD_OpenHoleNumbs + TD_OpenHole(i)%TopDepth = TD_Liner(TD_LinerNumbs)%DownDepth + TD_OpenHole(i)%Length = TD_OpenHoleLength ! unit: [ft] + TD_OpenHole(i)%DownDepth = TD_OpenHole(i)%TopDepth+TD_OpenHole(i)%Length + TD_OpenHole(i)%Id = OpenHoleId/12.d0 ! unit: [ft] + End Do + + else + if (Allocated(TD_OpenHole)) deAllocate (TD_OpenHole) + Allocate (TD_OpenHole(1)) + TD_OpenHoleNumbs = 1 + TD_OpenHole%Length = 0.d0 + TD_OpenHole%TopDepth = TD_Liner(TD_LinerNumbs)%DownDepth + TD_OpenHole%DownDepth = TD_OpenHole%TopDepth + + end if + + + + +!==================================================== +! Set ROP_Hole Data +!==================================================== + + TD_ROPHoleNumbs = 1 + if (Allocated(TD_ROPHole)) deAllocate (TD_ROPHole) + Allocate (TD_ROPHole(TD_ROPHoleNumbs)) + + Do i = 1, TD_ROPHoleNumbs + TD_ROPHole(i)%TopDepth = TD_WellGeo(TD_WellIntervalsCount)%TopDepth + TD_ROPHole(i)%DownDepth = TD_WellGeo(TD_WellIntervalsCount)%DownDepth + TD_ROPHole(i)%Length = TD_WellGeo(TD_WellIntervalsCount)%IntervalLength + TD_ROPHole(i)%Id = BitDefinition%BitSize/12.d0 ! unit: [ft] + End Do + + + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_ReadDataSubroutines/TD_WellReadData.f90 b/TorqueDrag/TD_ReadDataSubroutines/TD_WellReadData.f90 new file mode 100644 index 0000000..22f5676 --- /dev/null +++ b/TorqueDrag/TD_ReadDataSubroutines/TD_WellReadData.f90 @@ -0,0 +1,111 @@ +subroutine TD_WellReadData + + Use CPathGenerationVariables + Use TD_WellGeometry + + implicit none + + Integer :: i + + + + TD_WellIntervalsCount = PathGenerationCount + 1 ! +1 is belong to ROP hole + + if (Allocated(TD_WellGeo)) deAllocate (TD_WellGeo) + Allocate (TD_WellGeo(TD_WellIntervalsCount)) + + + + +!==================================================== +! Set Well Geometry Data +!==================================================== + + TD_WellGeo(1)%HoleType = PathGenerations(1)%HoleType + TD_WellGeo(1)%StartAngle = 0.d0 ![rad] + TD_WellGeo(1)%EndAngle = PathGenerations(1)%FinalAngle*(pi/180.d0) ![rad] + TD_WellGeo(1)%IntervalLength= PathGenerations(1)%TotalLength ![ft] + !TD_WellGeo(1)%VerticalDepth = PathGenerations(1)%TotalVerticalDepth + TD_WellGeo(1)%TopDepth = 0.d0 + TD_WellGeo(1)%DownDepth = PathGenerations(1)%MeasuredDepth + + + + Do i=2,TD_WellIntervalsCount-1 + + TD_WellGeo(i)%HoleType = PathGenerations(i)%HoleType + TD_WellGeo(i)%StartAngle = PathGenerations(i-1)%FinalAngle*(pi/180.d0) + TD_WellGeo(i)%EndAngle = PathGenerations(i)%FinalAngle*(pi/180.d0) + TD_WellGeo(i)%IntervalLength= PathGenerations(i)%TotalLength + !TD_WellGeo(i)%VerticalDepth = PathGenerations(i)%TotalVerticalDepth + TD_WellGeo(i)%TopDepth = PathGenerations(i-1)%MeasuredDepth + TD_WellGeo(i)%DownDepth = PathGenerations(i)%MeasuredDepth + + !=====> Radius Of Curvature Calculation + if (TD_WellGeo(i)%HoleType/=0) then + TD_WellGeo(i)%RCurvature = ((TD_WellGeo(i)%IntervalLength)/abs(TD_WellGeo(i)%EndAngle-TD_WellGeo(i)%StartAngle)) + end if + + End Do + + + + + +!=====> Set ROP Hole Data + TD_WellGeo(TD_WellIntervalsCount)%HoleType = 0 !Straight + TD_WellGeo(TD_WellIntervalsCount)%StartAngle = TD_WellGeo(TD_WellIntervalsCount-1)%EndAngle + TD_WellGeo(TD_WellIntervalsCount)%EndAngle = TD_WellGeo(TD_WellIntervalsCount)%StartAngle + TD_WellGeo(TD_WellIntervalsCount)%IntervalLength= 0.d0 + !TD_WellGeo(TD_WellIntervalsCount)%VerticalDepth = TD_WellGeo(TD_WellIntervalsCount-1)%VerticalDepth + TD_WellGeo(TD_WellIntervalsCount)%TopDepth = TD_WellGeo(TD_WellIntervalsCount-1)%DownDepth + TD_WellGeo(TD_WellIntervalsCount)%DownDepth = TD_WellGeo(TD_WellIntervalsCount)%TopDepth+TD_WellGeo(TD_WellIntervalsCount)%IntervalLength + + + + + + +!=====> Vertical Depth Calculation + if ( TD_WellGeo(1)%HoleType==0 ) then + TD_WellGeo(1)%VerticalDepth = TD_WellGeo(1)%IntervalLength*cos(TD_WellGeo(1)%StartAngle) + else if ( TD_WellGeo(1)%HoleType==1 ) then + TD_WellGeo(1)%VerticalDepth = (TD_WellGeo(1)%RCurvature*sin(abs(TD_WellGeo(1)%EndAngle)-abs(TD_WellGeo(1)%StartAngle))*cos(abs(TD_WellGeo(1)%StartAngle)))-(TD_WellGeo(1)%RCurvature*(1.-cos(abs(TD_WellGeo(1)%EndAngle)-abs(TD_WellGeo(1)%StartAngle)))*sin(abs(TD_WellGeo(1)%StartAngle))) + else if ( TD_WellGeo(1)%HoleType==2 ) then + TD_WellGeo(1)%VerticalDepth = (TD_WellGeo(1)%RCurvature*sin(abs(abs(TD_WellGeo(1)%EndAngle)-abs(TD_WellGeo(1)%StartAngle)))*cos(abs(TD_WellGeo(1)%StartAngle)))+(TD_WellGeo(1)%RCurvature*(1.-cos(abs(abs(TD_WellGeo(1)%EndAngle)-abs(TD_WellGeo(1)%StartAngle))))*sin(abs(TD_WellGeo(1)%StartAngle))) + End if + Do i= 2,TD_WellIntervalsCount + if ( TD_WellGeo(i)%HoleType==0 ) then + TD_WellGeo(i)%VerticalDepth = TD_WellGeo(i-1)%VerticalDepth+TD_WellGeo(i)%IntervalLength*cos(TD_WellGeo(i)%StartAngle) + else if ( TD_WellGeo(i)%HoleType==1 ) then + TD_WellGeo(i)%VerticalDepth = TD_WellGeo(i-1)%VerticalDepth+(TD_WellGeo(i)%RCurvature*sin(abs(TD_WellGeo(i)%EndAngle)-abs(TD_WellGeo(i)%StartAngle))*cos(abs(TD_WellGeo(i)%StartAngle)))-(TD_WellGeo(i)%RCurvature*(1.-cos(abs(TD_WellGeo(i)%EndAngle)-abs(TD_WellGeo(i)%StartAngle)))*sin(abs(TD_WellGeo(i)%StartAngle))) + else if ( TD_WellGeo(i)%HoleType==2 ) then + TD_WellGeo(i)%VerticalDepth = TD_WellGeo(i-1)%VerticalDepth+(TD_WellGeo(i)%RCurvature*sin(abs(abs(TD_WellGeo(i)%EndAngle)-abs(TD_WellGeo(i)%StartAngle)))*cos(abs(TD_WellGeo(i)%StartAngle)))+(TD_WellGeo(i)%RCurvature*(1.-cos(abs(abs(TD_WellGeo(i)%EndAngle)-abs(TD_WellGeo(i)%StartAngle))))*sin(abs(TD_WellGeo(i)%StartAngle))) + End if + End Do + !Do i=1,TD_WellIntervalsCount + ! print*, 'TD_WellGeo(i)%TopDepth=' , i , TD_WellGeo(i)%TopDepth + ! print*, 'TD_WellGeo(i)%DownDepth=' , i , TD_WellGeo(i)%DownDepth + ! print*, 'TD_WellGeo(i)%HoleType=' , i , TD_WellGeo(i)%HoleType + ! print*, 'TD_WellGeo(i)%RCurvature=' , i , TD_WellGeo(i)%RCurvature + ! print*, 'TD_WellGeo(i)%EndAngle=' , i , TD_WellGeo(i)%EndAngle + ! print*, 'TD_WellGeo(i)%StartAngle=' , i , TD_WellGeo(i)%StartAngle + ! print*, 'TD_WellGeo(i)%VerticalDepth=' , i , TD_WellGeo(i)%VerticalDepth + !end do + + + + + + + +!=====> Well Total Length Calculation + TD_WellTotalLength = TD_WellGeo(TD_WellIntervalsCount)%DownDepth + TD_WellTotalVerticalLength = TD_WellGeo(TD_WellIntervalsCount)%VerticalDepth + + + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_StartUp/TD_DrillStemStartUp.f90 b/TorqueDrag/TD_StartUp/TD_DrillStemStartUp.f90 new file mode 100644 index 0000000..c7b71b6 --- /dev/null +++ b/TorqueDrag/TD_StartUp/TD_DrillStemStartUp.f90 @@ -0,0 +1,81 @@ +subroutine TD_DrillStemStartUp + + Use CCasingLinerChokeVariables + Use CStringConfigurationVariables + Use CSimulationVariables + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + Use TD_StringConnectionData + + + implicit none + + + + + TD_DrillStemTotalLength = 500.d0 !??????????????????? + TD_DrillStemTotalLengthIni = 500.d0 !??????????????????? + TD_OutOfWellLength = 3.48d0 + TD_DrillStemAxialVelocity = 0.d0 + TD_DrillStemRotVelocity = 0.d0 + TD_WeightOnBit = 0.d0 + TD_BitTorque = 0.d0 + TD_TotalTorque = 0.d0 + TD_StaticHookLoad = 0.d0 + TD_DlMax = 0.d0 + TD_DlTotal = 0.d0 + TD_DlTouch = 1.d0 !(=/0.) because of TD_StringConnectionModes subroutine (initial value for first iteration in if condition) + TD_HookLoad = 0.d0 + TD_StringTorque = 0.d0 + TD_ToolJointRange = 0.4005d0*3.28 ![m]*3.28=[ft] , ToolJointLength=400.5mm + TD_RemoveVolume = 0.0d0 + + TD_DrillStemBottom = TD_DrillStemTotalLength-TD_OutOfWellLength !???????????? + !TD_DrillStems%TopDepth = + !TD_DrillStems%DownDepth = + !TD_DrillStems%StartAngle = + !TD_DrillStems%EndAngle = + TD_DrillStems%Area = 0.d0 + TD_DrillStems%RCurvature = 0.d0 + TD_DrillStems%RtoolJoint = 0.d0 + TD_DrillStems%ToolJointRange = 0.d0 + TD_DrillStems%HoleDiameter = 0.d0 + + TD_DrillStems%Force1 = 0.d0 + TD_DrillStems%Force2 = 0.d0 + TD_DrillStems%Torque = 0.d0 + TD_DrillStems%Drag = 0.d0 + TD_DrillStems%CombVelRatio = 0.d0 + + TD_DrillStems%MudDensityIn = 10.d0*7.48051948d0 + TD_DrillStems%MudDensityOut = 10.d0*7.48051948d0 + TD_DrillStems%MudViscosity = 0.16d0 !???????????????? + TD_DrillStems%MudVisCorrectCoef = 1.d0 !???????????????? + TD_DrillStems%MudWeight = 10.d0 + !TD_DrillStems%MudPlasticVis = !???????????????? + !TD_DrillStems%MudYieldPoint = !???????????????? + + !TD_DrillStems%FricFactor = + !TD_DrillStems% = + !TD_DrillStems% = + + !TD_DrillStems%StaticHookLoad = + !TD_DrillStems%TotalSHookLoad = + !TD_DrillStems%Dl = + !TD_DrillStems%DlTotal = + + !if (allocated(TD_FluidMudDensity)) deallocate(TD_FluidMudDensity) + !if (allocated(TD_FluidMudEndX)) deallocate(TD_FluidMudEndX) + !if (allocated(TD_FluidMudStartX)) deallocate(TD_FluidMudStartX) + !Allocate (TD_FluidMudDensity(1) , TD_FluidMudEndX(1) , TD_FluidMudStartX(1)) + !TD_FluidMudDensity(:) = 10.d0 + !TD_FluidMudStartX(:) = -268.d0 !?????????? + !TD_FluidMudEndX(:) = 9990.d0 !?????????? + + + + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TD_StartUp/TD_StartUp.f90 b/TorqueDrag/TD_StartUp/TD_StartUp.f90 new file mode 100644 index 0000000..abbbfba --- /dev/null +++ b/TorqueDrag/TD_StartUp/TD_StartUp.f90 @@ -0,0 +1,155 @@ +subroutine TD_StartUp + + Use CCasingLinerChokeVariables + Use CStringConfigurationVariables + Use CSimulationVariables + Use COperationConditionEnumVariables + Use CHoistingVariables + Use CPathGenerationVariables + Use TD_DrillStemComponents + Use TD_WellElements + Use TD_WellGeometry + Use TD_GeneralData + Use TD_StringConnectionData + Use Drawworks_VARIABLES!, only: Drawworks + Use sROP_Variables + Use sROP_Other_Variables + + + implicit none + + +!!==================================================== +!! Allocate Modules +!!==================================================== +! !=====> Set WellGeo Dimension +! TD_WellIntervalsCount = PathGenerationCount + 1 ! +1 is belong to ROP hole +! Allocate (TD_WellGeo(TD_WellIntervalsCount)) +! +! !=====> Set WellGeo Dimension + + + !=====> Set ROP StartUp + Bit_Wearing = 0.d0 + Rate_of_Penetration = 0.d0 + Bearing_Wear = 0.d0 + FormationNumber = 0 + Old_ROPDepth = PathGenerations(PathGenerationCount)%MeasuredDepth + Old_ROPValue = 0.d0 + Set_ROPGauge = 0.d0 + + + + !=====> Set BOP StartUp + TD_BOPCondition = 0 + TD_BOPThickness = (0.13477d0/2.d0)*3.28d0 ![m]*3.28=[ft] , Total Thickness (RAM)= 134.77mm + TD_AnnularFillingFinal = 0.d0 + + + DW_TDHookHeight = 75.d0 ![ft] + Drawworks%Hook_Height_ini = 75.d0 ![ft] + Drawworks%Hook_Height_final = 75.d0 ![ft] + + + + !=====> String Connection Mode + if ( Get_OperationCondition()==OPERATION_TRIP ) then + TD_OldOperationCondition = 1 + else + TD_OldOperationCondition = 0 + end if + TD_KellyDriveTypeMode = 0 !Kelly Mode + TD_FluidStringConnectionMode = 0 + TD_ConnectionHeight = 3.48d0 ![ft] + TD_RigidConnectionHeight = 3.48d0 ![ft] + TD_GRigidConnectionHeight = 3.48d0 ![ft] + TD_TopJointHeight = 3.48d0 ![ft] + !TD_TouchConnectionHeight = + TD_StringVelocity = 0.0d0 + TD_HookHeightOld = 75.d0 ![ft] + TD_HookHeight = 75.d0 ![ft] + TD_HookVelocity = 0.0d0 + + !=====> Element Specification + TD_HookHeight = DW_TDHookHeight ! unit: [ft] + TD_ElevatorConst = 17.985 ! [ft] Elevator Length(14.84) ????????????????? adad ha daghigh shavand + TD_ElevatorECG = 2.217 ! [ft] + TD_KellyConst = 63.280d0 ! [ft] Kelly Length(61.74) + Safety Valve Length(1.54) + TD_KellyElementConst = 41.840d0 ! [ft] Kelly Element Length(40.3) + Safety Valve Length(1.54) + TD_TDSLength = 24.08d0 !??????????????????? ! [ft] + TD_TDSToolJointLength = 0.77d0 !??????????????????? ! [ft] + TD_TDSElevatorLength = 26.837d0 !?????? ! TDS with Elevator Length [ft] + TD_TDSElevatorToolLength= 0.859d0 !??????????????????? ! [ft] + TD_TDSElevatorECG = 2.454 ! [ft] + TD_NumOfCables = NumberOfLine + TD_WeightTB = TravelingBlockWeight ! [lb] + TD_WeightTD = TopDriveWeight ! [lb] + TD_KellyWeight = KellyWeight ! [lb] + TD_SafetyValveLength = 1.54d0 ! [ft] + TD_IBOPLength = 1.54d0 ! [ft] + TD_KellyElementID = 3.0d0/12.d0 ! [ft] + TD_KellyElementOD = 5.90d0/12.d0 ! [ft] + TD_DrawworksLoadInput = TravelingBlockWeight/NumberOfLine + + TD_IBOPNewAdd = 0 + TD_IBOPOldAdd = 0 !Remove + TD_SafetyValveNewAdd = 0 + TD_SafetyValveOldAdd = 1 !Install + TD_KellyNewAdd = 0 + TD_KellyOldAdd = 0 + TD_IBOPNewRemove = 0 + TD_IBOPOldRemove = 1 !Remove + TD_SafetyValveNewRemove = 0 + TD_SafetyValveOldRemove = 0 !Install + TD_KellyNewRemove = 0 + TD_KellyOldRemove = 1 + + TD_KellyOldStatus1 = 0 + TD_KellyNewStatus1 = 0 + TD_KellyOldStatus2 = 1 ! Kelly Connected Nothing + TD_KellyNewStatus2 = 1 ! Kelly Connected Nothing + TD_KellyOldStatus3 = 0 + TD_KellyNewStatus3 = 0 + + TD_KellyOldStatus4 = 0 + TD_KellyNewStatus4 = 0 + TD_KellyOldStatus5 = 0 + TD_KellyNewStatus5 = 0 + TD_KellyOldStatus6 = 0 + TD_KellyNewStatus6 = 0 + TD_KellyOldStatus7 = 0 + TD_KellyNewStatus7 = 0 + TD_KellyOldStatus8 = 0 + TD_KellyNewStatus8 = 0 + TD_KellyOldStatus18 = 0 + TD_KellyNewStatus18 = 0 + TD_KellyOldStatus19 = 0 + TD_KellyNewStatus19 = 0 + + TD_KellyOldStatus9 = 0 + TD_KellyNewStatus9 = 0 + TD_KellyOldStatus10 = 0 + TD_KellyNewStatus10 = 0 + TD_KellyOldStatus11 = 0 + TD_KellyNewStatus11 = 0 + TD_KellyOldStatus12 = 0 + TD_KellyNewStatus12 = 0 + TD_KellyOldStatus13 = 1 + TD_KellyNewStatus13 = 1 + TD_KellyOldStatus14 = 0 + TD_KellyNewStatus14 = 0 + TD_KellyOldStatus15 = 0 + TD_KellyNewStatus15 = 0 + TD_KellyOldStatus16 = 0 + TD_KellyNewStatus16 = 0 + TD_KellyOldStatus17 = 0 + TD_KellyNewStatus17 = 0 + + + + + !=====> Problems + TD_WeightIndicatorMalf = 0 + + +end subroutine \ No newline at end of file diff --git a/TorqueDrag/TorqueDragMain.f90 b/TorqueDrag/TorqueDragMain.f90 new file mode 100644 index 0000000..60c4318 --- /dev/null +++ b/TorqueDrag/TorqueDragMain.f90 @@ -0,0 +1,46 @@ +MODULE TorqueDragMain + USE CPumpsVariables + USE CDrillingConsoleVariables + USE CDataDisplayConsoleVariables + USE CSimulationVariables + USE Pump_VARIABLES + IMPLICIT NONE + PUBLIC + CONTAINS + + subroutine TorqueDrag_Setup() + use CSimulationVariables + implicit none + call OnSimulationInitialization%Add(TorqueDrag_Init) + call OnSimulationStop%Add(TorqueDrag_Init) + call OnTorqueDragStep%Add(TorqueDrag_Step) + call OnTorqueDragOutput%Add(TorqueDrag_Output) + call OnTorqueDragMain%Add(TorqueDragMainBody) + end subroutine + + subroutine TorqueDrag_Init + implicit none + end subroutine TorqueDrag_Init + + subroutine TorqueDrag_Step + implicit none + end subroutine TorqueDrag_Step + + subroutine TorqueDrag_Output + implicit none + end subroutine TorqueDrag_Output + + + SUBROUTINE TorqueDragMainBody + USE ifport + USE ifmt + USE CSimulationVariables + !USE TDSUP + IMPLICIT NONE + + !CALL TD_MainCalculations + + + END SUBROUTINE TorqueDragMainBody + +END MODULE TorqueDragMain \ No newline at end of file diff --git a/config.json b/config.json new file mode 100644 index 0000000..d4440c3 --- /dev/null +++ b/config.json @@ -0,0 +1,14 @@ +{ + "t0": 0.0, + "dt": 1.0, + "tf": 86400.0, + "mu": 398600.4418, + "x0": [ + 10000.0, + 10000.0, + 10000.0, + 1.0, + 2.0, + 3.0 + ] +} \ No newline at end of file diff --git a/lib/x64/json_file_module.mod b/lib/x64/json_file_module.mod new file mode 100644 index 0000000..f327593 Binary files /dev/null and b/lib/x64/json_file_module.mod differ diff --git a/lib/x64/json_kinds.mod b/lib/x64/json_kinds.mod new file mode 100644 index 0000000..1dad4e1 Binary files /dev/null and b/lib/x64/json_kinds.mod differ diff --git a/lib/x64/json_module.mod b/lib/x64/json_module.mod new file mode 100644 index 0000000..d30af8a Binary files /dev/null and b/lib/x64/json_module.mod differ diff --git a/lib/x64/json_parameters.mod b/lib/x64/json_parameters.mod new file mode 100644 index 0000000..eb74857 Binary files /dev/null and b/lib/x64/json_parameters.mod differ diff --git a/lib/x64/json_string_utilities.mod b/lib/x64/json_string_utilities.mod new file mode 100644 index 0000000..ac08ac6 Binary files /dev/null and b/lib/x64/json_string_utilities.mod differ diff --git a/lib/x64/json_value_module.mod b/lib/x64/json_value_module.mod new file mode 100644 index 0000000..45294c8 Binary files /dev/null and b/lib/x64/json_value_module.mod differ diff --git a/lib/x64/libjsonfortrand.lib b/lib/x64/libjsonfortrand.lib new file mode 100644 index 0000000..d82c0f3 Binary files /dev/null and b/lib/x64/libjsonfortrand.lib differ diff --git a/x64/Debug/ANNULAR.obj b/x64/Debug/ANNULAR.obj new file mode 100644 index 0000000..63d4de8 Binary files /dev/null and b/x64/Debug/ANNULAR.obj differ diff --git a/x64/Debug/AirPump_Choke_Subs.obj b/x64/Debug/AirPump_Choke_Subs.obj new file mode 100644 index 0000000..8e86e5e Binary files /dev/null and b/x64/Debug/AirPump_Choke_Subs.obj differ diff --git a/x64/Debug/AnnularMain.obj b/x64/Debug/AnnularMain.obj new file mode 100644 index 0000000..7779028 Binary files /dev/null and b/x64/Debug/AnnularMain.obj differ diff --git a/x64/Debug/Annulus_Property_Calculator.obj b/x64/Debug/Annulus_Property_Calculator.obj new file mode 100644 index 0000000..667b33f Binary files /dev/null and b/x64/Debug/Annulus_Property_Calculator.obj differ diff --git a/x64/Debug/Annulus_and_Openhole_Pressure_Distribution.obj b/x64/Debug/Annulus_and_Openhole_Pressure_Distribution.obj new file mode 100644 index 0000000..1861fac Binary files /dev/null and b/x64/Debug/Annulus_and_Openhole_Pressure_Distribution.obj differ diff --git a/x64/Debug/BOP.obj b/x64/Debug/BOP.obj new file mode 100644 index 0000000..702eb75 Binary files /dev/null and b/x64/Debug/BOP.obj differ diff --git a/x64/Debug/BOPstartup.obj b/x64/Debug/BOPstartup.obj new file mode 100644 index 0000000..3967468 Binary files /dev/null and b/x64/Debug/BOPstartup.obj differ diff --git a/x64/Debug/Bit_Specification.obj b/x64/Debug/Bit_Specification.obj new file mode 100644 index 0000000..77d87d7 Binary files /dev/null and b/x64/Debug/Bit_Specification.obj differ diff --git a/x64/Debug/BlindRamsMain.obj b/x64/Debug/BlindRamsMain.obj new file mode 100644 index 0000000..8b99811 Binary files /dev/null and b/x64/Debug/BlindRamsMain.obj differ diff --git a/x64/Debug/BopStackMain.obj b/x64/Debug/BopStackMain.obj new file mode 100644 index 0000000..42a4d0a Binary files /dev/null and b/x64/Debug/BopStackMain.obj differ diff --git a/x64/Debug/BuildLog.htm b/x64/Debug/BuildLog.htm new file mode 100644 index 0000000..d416180 Binary files /dev/null and b/x64/Debug/BuildLog.htm differ diff --git a/x64/Debug/CAccumulator.obj b/x64/Debug/CAccumulator.obj new file mode 100644 index 0000000..5481fc8 Binary files /dev/null and b/x64/Debug/CAccumulator.obj differ diff --git a/x64/Debug/CAccumulatorVariables.obj b/x64/Debug/CAccumulatorVariables.obj new file mode 100644 index 0000000..690689e Binary files /dev/null and b/x64/Debug/CAccumulatorVariables.obj differ diff --git a/x64/Debug/CArrangement.obj b/x64/Debug/CArrangement.obj new file mode 100644 index 0000000..a05ce82 Binary files /dev/null and b/x64/Debug/CArrangement.obj differ diff --git a/x64/Debug/CBitProblems.obj b/x64/Debug/CBitProblems.obj new file mode 100644 index 0000000..a11ccef Binary files /dev/null and b/x64/Debug/CBitProblems.obj differ diff --git a/x64/Debug/CBitProblemsVariables.obj b/x64/Debug/CBitProblemsVariables.obj new file mode 100644 index 0000000..c30c0d0 Binary files /dev/null and b/x64/Debug/CBitProblemsVariables.obj differ diff --git a/x64/Debug/CBoolEventHandler.obj b/x64/Debug/CBoolEventHandler.obj new file mode 100644 index 0000000..0ef777d Binary files /dev/null and b/x64/Debug/CBoolEventHandler.obj differ diff --git a/x64/Debug/CBoolEventHandlerCollection.obj b/x64/Debug/CBoolEventHandlerCollection.obj new file mode 100644 index 0000000..770d2be Binary files /dev/null and b/x64/Debug/CBoolEventHandlerCollection.obj differ diff --git a/x64/Debug/CBopControlPanel.obj b/x64/Debug/CBopControlPanel.obj new file mode 100644 index 0000000..6e8935f Binary files /dev/null and b/x64/Debug/CBopControlPanel.obj differ diff --git a/x64/Debug/CBopControlPanelVariables.obj b/x64/Debug/CBopControlPanelVariables.obj new file mode 100644 index 0000000..dd98c94 Binary files /dev/null and b/x64/Debug/CBopControlPanelVariables.obj differ diff --git a/x64/Debug/CBopProblems.obj b/x64/Debug/CBopProblems.obj new file mode 100644 index 0000000..d871d1f Binary files /dev/null and b/x64/Debug/CBopProblems.obj differ diff --git a/x64/Debug/CBopProblemsVariables.obj b/x64/Debug/CBopProblemsVariables.obj new file mode 100644 index 0000000..c9c41ad Binary files /dev/null and b/x64/Debug/CBopProblemsVariables.obj differ diff --git a/x64/Debug/CBopStack.obj b/x64/Debug/CBopStack.obj new file mode 100644 index 0000000..968d958 Binary files /dev/null and b/x64/Debug/CBopStack.obj differ diff --git a/x64/Debug/CBopStackVariables.obj b/x64/Debug/CBopStackVariables.obj new file mode 100644 index 0000000..9a333b0 Binary files /dev/null and b/x64/Debug/CBopStackVariables.obj differ diff --git a/x64/Debug/CBucketEnum.obj b/x64/Debug/CBucketEnum.obj new file mode 100644 index 0000000..cf4104d Binary files /dev/null and b/x64/Debug/CBucketEnum.obj differ diff --git a/x64/Debug/CBucketEnumVariables.obj b/x64/Debug/CBucketEnumVariables.obj new file mode 100644 index 0000000..95f78c2 Binary files /dev/null and b/x64/Debug/CBucketEnumVariables.obj differ diff --git a/x64/Debug/CCasingLinerChoke.obj b/x64/Debug/CCasingLinerChoke.obj new file mode 100644 index 0000000..7cb9c10 Binary files /dev/null and b/x64/Debug/CCasingLinerChoke.obj differ diff --git a/x64/Debug/CCasingLinerChokeVariables.obj b/x64/Debug/CCasingLinerChokeVariables.obj new file mode 100644 index 0000000..364de14 Binary files /dev/null and b/x64/Debug/CCasingLinerChokeVariables.obj differ diff --git a/x64/Debug/CChokeControlPanel.obj b/x64/Debug/CChokeControlPanel.obj new file mode 100644 index 0000000..0791531 Binary files /dev/null and b/x64/Debug/CChokeControlPanel.obj differ diff --git a/x64/Debug/CChokeControlPanelVariables.obj b/x64/Debug/CChokeControlPanelVariables.obj new file mode 100644 index 0000000..4e38bd9 Binary files /dev/null and b/x64/Debug/CChokeControlPanelVariables.obj differ diff --git a/x64/Debug/CChokeManifold.obj b/x64/Debug/CChokeManifold.obj new file mode 100644 index 0000000..99e5390 Binary files /dev/null and b/x64/Debug/CChokeManifold.obj differ diff --git a/x64/Debug/CChokeManifoldVariables.obj b/x64/Debug/CChokeManifoldVariables.obj new file mode 100644 index 0000000..cafdbe6 Binary files /dev/null and b/x64/Debug/CChokeManifoldVariables.obj differ diff --git a/x64/Debug/CChokeProblems.obj b/x64/Debug/CChokeProblems.obj new file mode 100644 index 0000000..d7f3c1a Binary files /dev/null and b/x64/Debug/CChokeProblems.obj differ diff --git a/x64/Debug/CChokeProblemsVariables.obj b/x64/Debug/CChokeProblemsVariables.obj new file mode 100644 index 0000000..89be67f Binary files /dev/null and b/x64/Debug/CChokeProblemsVariables.obj differ diff --git a/x64/Debug/CCloseKellyCockLedNotification.obj b/x64/Debug/CCloseKellyCockLedNotification.obj new file mode 100644 index 0000000..b2cf833 Binary files /dev/null and b/x64/Debug/CCloseKellyCockLedNotification.obj differ diff --git a/x64/Debug/CCloseKellyCockLedNotificationVariables.obj b/x64/Debug/CCloseKellyCockLedNotificationVariables.obj new file mode 100644 index 0000000..302fea8 Binary files /dev/null and b/x64/Debug/CCloseKellyCockLedNotificationVariables.obj differ diff --git a/x64/Debug/CCloseSafetyValveLedNotification.obj b/x64/Debug/CCloseSafetyValveLedNotification.obj new file mode 100644 index 0000000..8089809 Binary files /dev/null and b/x64/Debug/CCloseSafetyValveLedNotification.obj differ diff --git a/x64/Debug/CCloseSafetyValveLedNotificationVariables.obj b/x64/Debug/CCloseSafetyValveLedNotificationVariables.obj new file mode 100644 index 0000000..0bfca2f Binary files /dev/null and b/x64/Debug/CCloseSafetyValveLedNotificationVariables.obj differ diff --git a/x64/Debug/CCommon.obj b/x64/Debug/CCommon.obj new file mode 100644 index 0000000..b342010 Binary files /dev/null and b/x64/Debug/CCommon.obj differ diff --git a/x64/Debug/CCommonVariables.obj b/x64/Debug/CCommonVariables.obj new file mode 100644 index 0000000..c46c0d5 Binary files /dev/null and b/x64/Debug/CCommonVariables.obj differ diff --git a/x64/Debug/CDataDisplayConsole.obj b/x64/Debug/CDataDisplayConsole.obj new file mode 100644 index 0000000..185a45d Binary files /dev/null and b/x64/Debug/CDataDisplayConsole.obj differ diff --git a/x64/Debug/CDataDisplayConsoleVariables.obj b/x64/Debug/CDataDisplayConsoleVariables.obj new file mode 100644 index 0000000..c2ac912 Binary files /dev/null and b/x64/Debug/CDataDisplayConsoleVariables.obj differ diff --git a/x64/Debug/CDoubleEventHandler.obj b/x64/Debug/CDoubleEventHandler.obj new file mode 100644 index 0000000..eeb1687 Binary files /dev/null and b/x64/Debug/CDoubleEventHandler.obj differ diff --git a/x64/Debug/CDoubleEventHandlerCollection.obj b/x64/Debug/CDoubleEventHandlerCollection.obj new file mode 100644 index 0000000..9e9c0f5 Binary files /dev/null and b/x64/Debug/CDoubleEventHandlerCollection.obj differ diff --git a/x64/Debug/CDownHole.obj b/x64/Debug/CDownHole.obj new file mode 100644 index 0000000..4510ce4 Binary files /dev/null and b/x64/Debug/CDownHole.obj differ diff --git a/x64/Debug/CDownHoleActions.obj b/x64/Debug/CDownHoleActions.obj new file mode 100644 index 0000000..2fbbf95 Binary files /dev/null and b/x64/Debug/CDownHoleActions.obj differ diff --git a/x64/Debug/CDownHoleTypes.obj b/x64/Debug/CDownHoleTypes.obj new file mode 100644 index 0000000..36aa59d Binary files /dev/null and b/x64/Debug/CDownHoleTypes.obj differ diff --git a/x64/Debug/CDownHoleVariables.obj b/x64/Debug/CDownHoleVariables.obj new file mode 100644 index 0000000..4f38016 Binary files /dev/null and b/x64/Debug/CDownHoleVariables.obj differ diff --git a/x64/Debug/CDrillStemProblems.obj b/x64/Debug/CDrillStemProblems.obj new file mode 100644 index 0000000..5895a46 Binary files /dev/null and b/x64/Debug/CDrillStemProblems.obj differ diff --git a/x64/Debug/CDrillStemProblemsVariables.obj b/x64/Debug/CDrillStemProblemsVariables.obj new file mode 100644 index 0000000..103d4ec Binary files /dev/null and b/x64/Debug/CDrillStemProblemsVariables.obj differ diff --git a/x64/Debug/CDrillWatch.obj b/x64/Debug/CDrillWatch.obj new file mode 100644 index 0000000..96e15ec Binary files /dev/null and b/x64/Debug/CDrillWatch.obj differ diff --git a/x64/Debug/CDrillWatchVariables.obj b/x64/Debug/CDrillWatchVariables.obj new file mode 100644 index 0000000..4476d17 Binary files /dev/null and b/x64/Debug/CDrillWatchVariables.obj differ diff --git a/x64/Debug/CDrillingConsole.obj b/x64/Debug/CDrillingConsole.obj new file mode 100644 index 0000000..3435828 Binary files /dev/null and b/x64/Debug/CDrillingConsole.obj differ diff --git a/x64/Debug/CDrillingConsoleVariables.obj b/x64/Debug/CDrillingConsoleVariables.obj new file mode 100644 index 0000000..5e331ec Binary files /dev/null and b/x64/Debug/CDrillingConsoleVariables.obj differ diff --git a/x64/Debug/CElevatorConnectionEnum.obj b/x64/Debug/CElevatorConnectionEnum.obj new file mode 100644 index 0000000..c127e2a Binary files /dev/null and b/x64/Debug/CElevatorConnectionEnum.obj differ diff --git a/x64/Debug/CElevatorConnectionEnumVariables.obj b/x64/Debug/CElevatorConnectionEnumVariables.obj new file mode 100644 index 0000000..cfd4e14 Binary files /dev/null and b/x64/Debug/CElevatorConnectionEnumVariables.obj differ diff --git a/x64/Debug/CElevatorEnum.obj b/x64/Debug/CElevatorEnum.obj new file mode 100644 index 0000000..935fe4a Binary files /dev/null and b/x64/Debug/CElevatorEnum.obj differ diff --git a/x64/Debug/CElevatorEnumVariables.obj b/x64/Debug/CElevatorEnumVariables.obj new file mode 100644 index 0000000..7dc10b5 Binary files /dev/null and b/x64/Debug/CElevatorEnumVariables.obj differ diff --git a/x64/Debug/CEquipmentsConstants.obj b/x64/Debug/CEquipmentsConstants.obj new file mode 100644 index 0000000..0090850 Binary files /dev/null and b/x64/Debug/CEquipmentsConstants.obj differ diff --git a/x64/Debug/CError.obj b/x64/Debug/CError.obj new file mode 100644 index 0000000..9b22593 Binary files /dev/null and b/x64/Debug/CError.obj differ diff --git a/x64/Debug/CFillMouseHoleLedNotification.obj b/x64/Debug/CFillMouseHoleLedNotification.obj new file mode 100644 index 0000000..dde667b Binary files /dev/null and b/x64/Debug/CFillMouseHoleLedNotification.obj differ diff --git a/x64/Debug/CFillMouseHoleLedNotificationVariables.obj b/x64/Debug/CFillMouseHoleLedNotificationVariables.obj new file mode 100644 index 0000000..5d7b443 Binary files /dev/null and b/x64/Debug/CFillMouseHoleLedNotificationVariables.obj differ diff --git a/x64/Debug/CFillupHeadPermission.obj b/x64/Debug/CFillupHeadPermission.obj new file mode 100644 index 0000000..ce64ee5 Binary files /dev/null and b/x64/Debug/CFillupHeadPermission.obj differ diff --git a/x64/Debug/CFillupHeadPermissionVariables.obj b/x64/Debug/CFillupHeadPermissionVariables.obj new file mode 100644 index 0000000..d79d3fd Binary files /dev/null and b/x64/Debug/CFillupHeadPermissionVariables.obj differ diff --git a/x64/Debug/CFlowKellyDisconnectEnum.obj b/x64/Debug/CFlowKellyDisconnectEnum.obj new file mode 100644 index 0000000..405a7e9 Binary files /dev/null and b/x64/Debug/CFlowKellyDisconnectEnum.obj differ diff --git a/x64/Debug/CFlowKellyDisconnectEnumVariables.obj b/x64/Debug/CFlowKellyDisconnectEnumVariables.obj new file mode 100644 index 0000000..884408c Binary files /dev/null and b/x64/Debug/CFlowKellyDisconnectEnumVariables.obj differ diff --git a/x64/Debug/CFlowPipeDisconnectEnum.obj b/x64/Debug/CFlowPipeDisconnectEnum.obj new file mode 100644 index 0000000..c974b67 Binary files /dev/null and b/x64/Debug/CFlowPipeDisconnectEnum.obj differ diff --git a/x64/Debug/CFlowPipeDisconnectEnumVariables.obj b/x64/Debug/CFlowPipeDisconnectEnumVariables.obj new file mode 100644 index 0000000..752219d Binary files /dev/null and b/x64/Debug/CFlowPipeDisconnectEnumVariables.obj differ diff --git a/x64/Debug/CFormation.obj b/x64/Debug/CFormation.obj new file mode 100644 index 0000000..00c091f Binary files /dev/null and b/x64/Debug/CFormation.obj differ diff --git a/x64/Debug/CFormationVariables.obj b/x64/Debug/CFormationVariables.obj new file mode 100644 index 0000000..94386b3 Binary files /dev/null and b/x64/Debug/CFormationVariables.obj differ diff --git a/x64/Debug/CGaugesProblems.obj b/x64/Debug/CGaugesProblems.obj new file mode 100644 index 0000000..c6c876a Binary files /dev/null and b/x64/Debug/CGaugesProblems.obj differ diff --git a/x64/Debug/CGaugesProblemsVariables.obj b/x64/Debug/CGaugesProblemsVariables.obj new file mode 100644 index 0000000..49c95b7 Binary files /dev/null and b/x64/Debug/CGaugesProblemsVariables.obj differ diff --git a/x64/Debug/CHOKE.obj b/x64/Debug/CHOKE.obj new file mode 100644 index 0000000..700bdf7 Binary files /dev/null and b/x64/Debug/CHOKE.obj differ diff --git a/x64/Debug/CHOKE_LINE.obj b/x64/Debug/CHOKE_LINE.obj new file mode 100644 index 0000000..8835e49 Binary files /dev/null and b/x64/Debug/CHOKE_LINE.obj differ diff --git a/x64/Debug/CHOKE_VARIABLES.obj b/x64/Debug/CHOKE_VARIABLES.obj new file mode 100644 index 0000000..fda8f8f Binary files /dev/null and b/x64/Debug/CHOKE_VARIABLES.obj differ diff --git a/x64/Debug/CHeadEnum.obj b/x64/Debug/CHeadEnum.obj new file mode 100644 index 0000000..6689547 Binary files /dev/null and b/x64/Debug/CHeadEnum.obj differ diff --git a/x64/Debug/CHeadEnumVariables.obj b/x64/Debug/CHeadEnumVariables.obj new file mode 100644 index 0000000..58418fc Binary files /dev/null and b/x64/Debug/CHeadEnumVariables.obj differ diff --git a/x64/Debug/CHoisting.obj b/x64/Debug/CHoisting.obj new file mode 100644 index 0000000..b6d82f2 Binary files /dev/null and b/x64/Debug/CHoisting.obj differ diff --git a/x64/Debug/CHoistingProblems.obj b/x64/Debug/CHoistingProblems.obj new file mode 100644 index 0000000..1c4c8ba Binary files /dev/null and b/x64/Debug/CHoistingProblems.obj differ diff --git a/x64/Debug/CHoistingProblemsVariables.obj b/x64/Debug/CHoistingProblemsVariables.obj new file mode 100644 index 0000000..9e1895c Binary files /dev/null and b/x64/Debug/CHoistingProblemsVariables.obj differ diff --git a/x64/Debug/CHoistingVariables.obj b/x64/Debug/CHoistingVariables.obj new file mode 100644 index 0000000..399221b Binary files /dev/null and b/x64/Debug/CHoistingVariables.obj differ diff --git a/x64/Debug/CHook.obj b/x64/Debug/CHook.obj new file mode 100644 index 0000000..548b08a Binary files /dev/null and b/x64/Debug/CHook.obj differ diff --git a/x64/Debug/CHookActions.obj b/x64/Debug/CHookActions.obj new file mode 100644 index 0000000..9381048 Binary files /dev/null and b/x64/Debug/CHookActions.obj differ diff --git a/x64/Debug/CHookHeight.obj b/x64/Debug/CHookHeight.obj new file mode 100644 index 0000000..61a2003 Binary files /dev/null and b/x64/Debug/CHookHeight.obj differ diff --git a/x64/Debug/CHookVariables.obj b/x64/Debug/CHookVariables.obj new file mode 100644 index 0000000..ef6d727 Binary files /dev/null and b/x64/Debug/CHookVariables.obj differ diff --git a/x64/Debug/CIActionReference.obj b/x64/Debug/CIActionReference.obj new file mode 100644 index 0000000..779351e Binary files /dev/null and b/x64/Debug/CIActionReference.obj differ diff --git a/x64/Debug/CIbopEnum.obj b/x64/Debug/CIbopEnum.obj new file mode 100644 index 0000000..3325539 Binary files /dev/null and b/x64/Debug/CIbopEnum.obj differ diff --git a/x64/Debug/CIbopEnumVariables.obj b/x64/Debug/CIbopEnumVariables.obj new file mode 100644 index 0000000..54bbdc7 Binary files /dev/null and b/x64/Debug/CIbopEnumVariables.obj differ diff --git a/x64/Debug/CIbopHeight.obj b/x64/Debug/CIbopHeight.obj new file mode 100644 index 0000000..55e96e0 Binary files /dev/null and b/x64/Debug/CIbopHeight.obj differ diff --git a/x64/Debug/CInstallFillupHeadPermission.obj b/x64/Debug/CInstallFillupHeadPermission.obj new file mode 100644 index 0000000..846f222 Binary files /dev/null and b/x64/Debug/CInstallFillupHeadPermission.obj differ diff --git a/x64/Debug/CInstallFillupHeadPermissionVariables.obj b/x64/Debug/CInstallFillupHeadPermissionVariables.obj new file mode 100644 index 0000000..2157732 Binary files /dev/null and b/x64/Debug/CInstallFillupHeadPermissionVariables.obj differ diff --git a/x64/Debug/CInstallMudBucketPermission.obj b/x64/Debug/CInstallMudBucketPermission.obj new file mode 100644 index 0000000..bd226f9 Binary files /dev/null and b/x64/Debug/CInstallMudBucketPermission.obj differ diff --git a/x64/Debug/CInstallMudBucketPermissionVariables.obj b/x64/Debug/CInstallMudBucketPermissionVariables.obj new file mode 100644 index 0000000..5340bce Binary files /dev/null and b/x64/Debug/CInstallMudBucketPermissionVariables.obj differ diff --git a/x64/Debug/CIntegerArrayEventHandler.obj b/x64/Debug/CIntegerArrayEventHandler.obj new file mode 100644 index 0000000..7daa3e0 Binary files /dev/null and b/x64/Debug/CIntegerArrayEventHandler.obj differ diff --git a/x64/Debug/CIntegerArrayEventHandlerCollection.obj b/x64/Debug/CIntegerArrayEventHandlerCollection.obj new file mode 100644 index 0000000..f9da352 Binary files /dev/null and b/x64/Debug/CIntegerArrayEventHandlerCollection.obj differ diff --git a/x64/Debug/CIntegerEventHandler.obj b/x64/Debug/CIntegerEventHandler.obj new file mode 100644 index 0000000..0bbcead Binary files /dev/null and b/x64/Debug/CIntegerEventHandler.obj differ diff --git a/x64/Debug/CIntegerEventHandlerCollection.obj b/x64/Debug/CIntegerEventHandlerCollection.obj new file mode 100644 index 0000000..f169a65 Binary files /dev/null and b/x64/Debug/CIntegerEventHandlerCollection.obj differ diff --git a/x64/Debug/CIrIBopLedNotification.obj b/x64/Debug/CIrIBopLedNotification.obj new file mode 100644 index 0000000..b9ff393 Binary files /dev/null and b/x64/Debug/CIrIBopLedNotification.obj differ diff --git a/x64/Debug/CIrIBopLedNotificationVariables.obj b/x64/Debug/CIrIBopLedNotificationVariables.obj new file mode 100644 index 0000000..9e77f4f Binary files /dev/null and b/x64/Debug/CIrIBopLedNotificationVariables.obj differ diff --git a/x64/Debug/CIrIbopPermission.obj b/x64/Debug/CIrIbopPermission.obj new file mode 100644 index 0000000..4b2b895 Binary files /dev/null and b/x64/Debug/CIrIbopPermission.obj differ diff --git a/x64/Debug/CIrIbopPermissionVariables.obj b/x64/Debug/CIrIbopPermissionVariables.obj new file mode 100644 index 0000000..56e8779 Binary files /dev/null and b/x64/Debug/CIrIbopPermissionVariables.obj differ diff --git a/x64/Debug/CIrSafetyValveLedNotification.obj b/x64/Debug/CIrSafetyValveLedNotification.obj new file mode 100644 index 0000000..27819d6 Binary files /dev/null and b/x64/Debug/CIrSafetyValveLedNotification.obj differ diff --git a/x64/Debug/CIrSafetyValveLedNotificationVariables.obj b/x64/Debug/CIrSafetyValveLedNotificationVariables.obj new file mode 100644 index 0000000..aa98ddb Binary files /dev/null and b/x64/Debug/CIrSafetyValveLedNotificationVariables.obj differ diff --git a/x64/Debug/CIrSafetyValvePermission.obj b/x64/Debug/CIrSafetyValvePermission.obj new file mode 100644 index 0000000..d62f80d Binary files /dev/null and b/x64/Debug/CIrSafetyValvePermission.obj differ diff --git a/x64/Debug/CIrSafetyValvePermissionVariables.obj b/x64/Debug/CIrSafetyValvePermissionVariables.obj new file mode 100644 index 0000000..a0cd088 Binary files /dev/null and b/x64/Debug/CIrSafetyValvePermissionVariables.obj differ diff --git a/x64/Debug/CKellyConnectionEnum.obj b/x64/Debug/CKellyConnectionEnum.obj new file mode 100644 index 0000000..84247c3 Binary files /dev/null and b/x64/Debug/CKellyConnectionEnum.obj differ diff --git a/x64/Debug/CKellyConnectionEnumVariables.obj b/x64/Debug/CKellyConnectionEnumVariables.obj new file mode 100644 index 0000000..9127636 Binary files /dev/null and b/x64/Debug/CKellyConnectionEnumVariables.obj differ diff --git a/x64/Debug/CKellyEnum.obj b/x64/Debug/CKellyEnum.obj new file mode 100644 index 0000000..da1b2ab Binary files /dev/null and b/x64/Debug/CKellyEnum.obj differ diff --git a/x64/Debug/CKellyEnumVariables.obj b/x64/Debug/CKellyEnumVariables.obj new file mode 100644 index 0000000..c59fbe1 Binary files /dev/null and b/x64/Debug/CKellyEnumVariables.obj differ diff --git a/x64/Debug/CKickProblems.obj b/x64/Debug/CKickProblems.obj new file mode 100644 index 0000000..66a9226 Binary files /dev/null and b/x64/Debug/CKickProblems.obj differ diff --git a/x64/Debug/CKickProblemsVariables.obj b/x64/Debug/CKickProblemsVariables.obj new file mode 100644 index 0000000..9b01846 Binary files /dev/null and b/x64/Debug/CKickProblemsVariables.obj differ diff --git a/x64/Debug/CLatchLedNotification.obj b/x64/Debug/CLatchLedNotification.obj new file mode 100644 index 0000000..cd3f3db Binary files /dev/null and b/x64/Debug/CLatchLedNotification.obj differ diff --git a/x64/Debug/CLatchLedNotificationVariables.obj b/x64/Debug/CLatchLedNotificationVariables.obj new file mode 100644 index 0000000..9ebe4e6 Binary files /dev/null and b/x64/Debug/CLatchLedNotificationVariables.obj differ diff --git a/x64/Debug/CLesson.obj b/x64/Debug/CLesson.obj new file mode 100644 index 0000000..132cf7c Binary files /dev/null and b/x64/Debug/CLesson.obj differ diff --git a/x64/Debug/CLessonVariables.obj b/x64/Debug/CLessonVariables.obj new file mode 100644 index 0000000..e20282e Binary files /dev/null and b/x64/Debug/CLessonVariables.obj differ diff --git a/x64/Debug/CLog1.obj b/x64/Debug/CLog1.obj new file mode 100644 index 0000000..587e228 Binary files /dev/null and b/x64/Debug/CLog1.obj differ diff --git a/x64/Debug/CLog2.obj b/x64/Debug/CLog2.obj new file mode 100644 index 0000000..dc7803e Binary files /dev/null and b/x64/Debug/CLog2.obj differ diff --git a/x64/Debug/CLog3.obj b/x64/Debug/CLog3.obj new file mode 100644 index 0000000..2b53a08 Binary files /dev/null and b/x64/Debug/CLog3.obj differ diff --git a/x64/Debug/CLog4.obj b/x64/Debug/CLog4.obj new file mode 100644 index 0000000..0447ba4 Binary files /dev/null and b/x64/Debug/CLog4.obj differ diff --git a/x64/Debug/CLog5.obj b/x64/Debug/CLog5.obj new file mode 100644 index 0000000..030b0c5 Binary files /dev/null and b/x64/Debug/CLog5.obj differ diff --git a/x64/Debug/CLostProblems.obj b/x64/Debug/CLostProblems.obj new file mode 100644 index 0000000..ad9ae28 Binary files /dev/null and b/x64/Debug/CLostProblems.obj differ diff --git a/x64/Debug/CLostProblemsVariables.obj b/x64/Debug/CLostProblemsVariables.obj new file mode 100644 index 0000000..2a2acb8 Binary files /dev/null and b/x64/Debug/CLostProblemsVariables.obj differ diff --git a/x64/Debug/CManifolds.obj b/x64/Debug/CManifolds.obj new file mode 100644 index 0000000..588e586 Binary files /dev/null and b/x64/Debug/CManifolds.obj differ diff --git a/x64/Debug/CMouseHoleEnum.obj b/x64/Debug/CMouseHoleEnum.obj new file mode 100644 index 0000000..87fcc5e Binary files /dev/null and b/x64/Debug/CMouseHoleEnum.obj differ diff --git a/x64/Debug/CMouseHoleEnumVariables.obj b/x64/Debug/CMouseHoleEnumVariables.obj new file mode 100644 index 0000000..05db1cf Binary files /dev/null and b/x64/Debug/CMouseHoleEnumVariables.obj differ diff --git a/x64/Debug/CMudProperties.obj b/x64/Debug/CMudProperties.obj new file mode 100644 index 0000000..acc924b Binary files /dev/null and b/x64/Debug/CMudProperties.obj differ diff --git a/x64/Debug/CMudPropertiesVariables.obj b/x64/Debug/CMudPropertiesVariables.obj new file mode 100644 index 0000000..192fb25 Binary files /dev/null and b/x64/Debug/CMudPropertiesVariables.obj differ diff --git a/x64/Debug/CMudTreatmentProblems.obj b/x64/Debug/CMudTreatmentProblems.obj new file mode 100644 index 0000000..f33106f Binary files /dev/null and b/x64/Debug/CMudTreatmentProblems.obj differ diff --git a/x64/Debug/CMudTreatmentProblemsVariables.obj b/x64/Debug/CMudTreatmentProblemsVariables.obj new file mode 100644 index 0000000..84999be Binary files /dev/null and b/x64/Debug/CMudTreatmentProblemsVariables.obj differ diff --git a/x64/Debug/CNearFloorConnection.obj b/x64/Debug/CNearFloorConnection.obj new file mode 100644 index 0000000..ee39837 Binary files /dev/null and b/x64/Debug/CNearFloorConnection.obj differ diff --git a/x64/Debug/COpenKellyCockLedNotification.obj b/x64/Debug/COpenKellyCockLedNotification.obj new file mode 100644 index 0000000..e565902 Binary files /dev/null and b/x64/Debug/COpenKellyCockLedNotification.obj differ diff --git a/x64/Debug/COpenKellyCockLedNotificationVariables.obj b/x64/Debug/COpenKellyCockLedNotificationVariables.obj new file mode 100644 index 0000000..ae4d836 Binary files /dev/null and b/x64/Debug/COpenKellyCockLedNotificationVariables.obj differ diff --git a/x64/Debug/COpenSafetyValveLedNotification.obj b/x64/Debug/COpenSafetyValveLedNotification.obj new file mode 100644 index 0000000..03169e3 Binary files /dev/null and b/x64/Debug/COpenSafetyValveLedNotification.obj differ diff --git a/x64/Debug/COpenSafetyValveLedNotificationVariables.obj b/x64/Debug/COpenSafetyValveLedNotificationVariables.obj new file mode 100644 index 0000000..72888ec Binary files /dev/null and b/x64/Debug/COpenSafetyValveLedNotificationVariables.obj differ diff --git a/x64/Debug/COperationConditionEnum.obj b/x64/Debug/COperationConditionEnum.obj new file mode 100644 index 0000000..ed77d90 Binary files /dev/null and b/x64/Debug/COperationConditionEnum.obj differ diff --git a/x64/Debug/COperationConditionEnumVariables.obj b/x64/Debug/COperationConditionEnumVariables.obj new file mode 100644 index 0000000..6b41a02 Binary files /dev/null and b/x64/Debug/COperationConditionEnumVariables.obj differ diff --git a/x64/Debug/COperationScenariosMain.obj b/x64/Debug/COperationScenariosMain.obj new file mode 100644 index 0000000..dda67a3 Binary files /dev/null and b/x64/Debug/COperationScenariosMain.obj differ diff --git a/x64/Debug/COperationScenariosSettings.obj b/x64/Debug/COperationScenariosSettings.obj new file mode 100644 index 0000000..6f34bda Binary files /dev/null and b/x64/Debug/COperationScenariosSettings.obj differ diff --git a/x64/Debug/COperationScenariosVariables.obj b/x64/Debug/COperationScenariosVariables.obj new file mode 100644 index 0000000..1b47b96 Binary files /dev/null and b/x64/Debug/COperationScenariosVariables.obj differ diff --git a/x64/Debug/COtherProblems.obj b/x64/Debug/COtherProblems.obj new file mode 100644 index 0000000..25c05ac Binary files /dev/null and b/x64/Debug/COtherProblems.obj differ diff --git a/x64/Debug/COtherProblemsVariables.obj b/x64/Debug/COtherProblemsVariables.obj new file mode 100644 index 0000000..d73fa17 Binary files /dev/null and b/x64/Debug/COtherProblemsVariables.obj differ diff --git a/x64/Debug/CPath.obj b/x64/Debug/CPath.obj new file mode 100644 index 0000000..474e1f0 Binary files /dev/null and b/x64/Debug/CPath.obj differ diff --git a/x64/Debug/CPathChangeEvents.obj b/x64/Debug/CPathChangeEvents.obj new file mode 100644 index 0000000..dacceb6 Binary files /dev/null and b/x64/Debug/CPathChangeEvents.obj differ diff --git a/x64/Debug/CPathGeneration.obj b/x64/Debug/CPathGeneration.obj new file mode 100644 index 0000000..c44211e Binary files /dev/null and b/x64/Debug/CPathGeneration.obj differ diff --git a/x64/Debug/CPathGenerationVariables.obj b/x64/Debug/CPathGenerationVariables.obj new file mode 100644 index 0000000..a0f6a42 Binary files /dev/null and b/x64/Debug/CPathGenerationVariables.obj differ diff --git a/x64/Debug/CPower.obj b/x64/Debug/CPower.obj new file mode 100644 index 0000000..68ec37b Binary files /dev/null and b/x64/Debug/CPower.obj differ diff --git a/x64/Debug/CPowerVariables.obj b/x64/Debug/CPowerVariables.obj new file mode 100644 index 0000000..79a2052 Binary files /dev/null and b/x64/Debug/CPowerVariables.obj differ diff --git a/x64/Debug/CProblemDifinition.obj b/x64/Debug/CProblemDifinition.obj new file mode 100644 index 0000000..78cdc65 Binary files /dev/null and b/x64/Debug/CProblemDifinition.obj differ diff --git a/x64/Debug/CPumpProblems.obj b/x64/Debug/CPumpProblems.obj new file mode 100644 index 0000000..4912b9d Binary files /dev/null and b/x64/Debug/CPumpProblems.obj differ diff --git a/x64/Debug/CPumpProblemsVariables.obj b/x64/Debug/CPumpProblemsVariables.obj new file mode 100644 index 0000000..04ac152 Binary files /dev/null and b/x64/Debug/CPumpProblemsVariables.obj differ diff --git a/x64/Debug/CPumps.obj b/x64/Debug/CPumps.obj new file mode 100644 index 0000000..24cc86f Binary files /dev/null and b/x64/Debug/CPumps.obj differ diff --git a/x64/Debug/CPumpsVariables.obj b/x64/Debug/CPumpsVariables.obj new file mode 100644 index 0000000..616cc94 Binary files /dev/null and b/x64/Debug/CPumpsVariables.obj differ diff --git a/x64/Debug/CQuery.obj b/x64/Debug/CQuery.obj new file mode 100644 index 0000000..5bef0bd Binary files /dev/null and b/x64/Debug/CQuery.obj differ diff --git a/x64/Debug/CRealEventHandler.obj b/x64/Debug/CRealEventHandler.obj new file mode 100644 index 0000000..03df7f2 Binary files /dev/null and b/x64/Debug/CRealEventHandler.obj differ diff --git a/x64/Debug/CRealEventHandlerCollection.obj b/x64/Debug/CRealEventHandlerCollection.obj new file mode 100644 index 0000000..31d5d7e Binary files /dev/null and b/x64/Debug/CRealEventHandlerCollection.obj differ diff --git a/x64/Debug/CRemoveFillupHeadPermission.obj b/x64/Debug/CRemoveFillupHeadPermission.obj new file mode 100644 index 0000000..b6a34a5 Binary files /dev/null and b/x64/Debug/CRemoveFillupHeadPermission.obj differ diff --git a/x64/Debug/CRemoveFillupHeadPermissionVariables.obj b/x64/Debug/CRemoveFillupHeadPermissionVariables.obj new file mode 100644 index 0000000..697a07c Binary files /dev/null and b/x64/Debug/CRemoveFillupHeadPermissionVariables.obj differ diff --git a/x64/Debug/CRemoveMudBucketPermission.obj b/x64/Debug/CRemoveMudBucketPermission.obj new file mode 100644 index 0000000..703a1a0 Binary files /dev/null and b/x64/Debug/CRemoveMudBucketPermission.obj differ diff --git a/x64/Debug/CRemoveMudBucketPermissionVariables.obj b/x64/Debug/CRemoveMudBucketPermissionVariables.obj new file mode 100644 index 0000000..9f579bb Binary files /dev/null and b/x64/Debug/CRemoveMudBucketPermissionVariables.obj differ diff --git a/x64/Debug/CReservoir.obj b/x64/Debug/CReservoir.obj new file mode 100644 index 0000000..5cf7ea3 Binary files /dev/null and b/x64/Debug/CReservoir.obj differ diff --git a/x64/Debug/CReservoirVariables.obj b/x64/Debug/CReservoirVariables.obj new file mode 100644 index 0000000..48edced Binary files /dev/null and b/x64/Debug/CReservoirVariables.obj differ diff --git a/x64/Debug/CRigSize.obj b/x64/Debug/CRigSize.obj new file mode 100644 index 0000000..0bba46b Binary files /dev/null and b/x64/Debug/CRigSize.obj differ diff --git a/x64/Debug/CRigSizeVariables.obj b/x64/Debug/CRigSizeVariables.obj new file mode 100644 index 0000000..69fe677 Binary files /dev/null and b/x64/Debug/CRigSizeVariables.obj differ diff --git a/x64/Debug/CRotaryProblems.obj b/x64/Debug/CRotaryProblems.obj new file mode 100644 index 0000000..9a2c33e Binary files /dev/null and b/x64/Debug/CRotaryProblems.obj differ diff --git a/x64/Debug/CRotaryProblemsVariables.obj b/x64/Debug/CRotaryProblemsVariables.obj new file mode 100644 index 0000000..928c165 Binary files /dev/null and b/x64/Debug/CRotaryProblemsVariables.obj differ diff --git a/x64/Debug/CSafetyValveEnum.obj b/x64/Debug/CSafetyValveEnum.obj new file mode 100644 index 0000000..cba23a8 Binary files /dev/null and b/x64/Debug/CSafetyValveEnum.obj differ diff --git a/x64/Debug/CSafetyValveEnumVariables.obj b/x64/Debug/CSafetyValveEnumVariables.obj new file mode 100644 index 0000000..9b8b02e Binary files /dev/null and b/x64/Debug/CSafetyValveEnumVariables.obj differ diff --git a/x64/Debug/CSafetyValveHeight.obj b/x64/Debug/CSafetyValveHeight.obj new file mode 100644 index 0000000..42e41c7 Binary files /dev/null and b/x64/Debug/CSafetyValveHeight.obj differ diff --git a/x64/Debug/CScaleRange.obj b/x64/Debug/CScaleRange.obj new file mode 100644 index 0000000..50f79ac Binary files /dev/null and b/x64/Debug/CScaleRange.obj differ diff --git a/x64/Debug/CShoe.obj b/x64/Debug/CShoe.obj new file mode 100644 index 0000000..e5052d6 Binary files /dev/null and b/x64/Debug/CShoe.obj differ diff --git a/x64/Debug/CShoeVariables.obj b/x64/Debug/CShoeVariables.obj new file mode 100644 index 0000000..64d34a1 Binary files /dev/null and b/x64/Debug/CShoeVariables.obj differ diff --git a/x64/Debug/CSimulationThreads.obj b/x64/Debug/CSimulationThreads.obj new file mode 100644 index 0000000..0426962 Binary files /dev/null and b/x64/Debug/CSimulationThreads.obj differ diff --git a/x64/Debug/CSimulationVariables.obj b/x64/Debug/CSimulationVariables.obj new file mode 100644 index 0000000..10af8f8 Binary files /dev/null and b/x64/Debug/CSimulationVariables.obj differ diff --git a/x64/Debug/CSlackOff.obj b/x64/Debug/CSlackOff.obj new file mode 100644 index 0000000..fbb44f0 Binary files /dev/null and b/x64/Debug/CSlackOff.obj differ diff --git a/x64/Debug/CSlipsEnum.obj b/x64/Debug/CSlipsEnum.obj new file mode 100644 index 0000000..e4fa6ab Binary files /dev/null and b/x64/Debug/CSlipsEnum.obj differ diff --git a/x64/Debug/CSlipsEnumVariables.obj b/x64/Debug/CSlipsEnumVariables.obj new file mode 100644 index 0000000..a544b30 Binary files /dev/null and b/x64/Debug/CSlipsEnumVariables.obj differ diff --git a/x64/Debug/CSlipsNotification.obj b/x64/Debug/CSlipsNotification.obj new file mode 100644 index 0000000..29b95c7 Binary files /dev/null and b/x64/Debug/CSlipsNotification.obj differ diff --git a/x64/Debug/CSlipsNotificationVariables.obj b/x64/Debug/CSlipsNotificationVariables.obj new file mode 100644 index 0000000..01ca08e Binary files /dev/null and b/x64/Debug/CSlipsNotificationVariables.obj differ diff --git a/x64/Debug/CSounds.obj b/x64/Debug/CSounds.obj new file mode 100644 index 0000000..21b080a Binary files /dev/null and b/x64/Debug/CSounds.obj differ diff --git a/x64/Debug/CStack.obj b/x64/Debug/CStack.obj new file mode 100644 index 0000000..ca7c920 Binary files /dev/null and b/x64/Debug/CStack.obj differ diff --git a/x64/Debug/CStandPipeManifold.obj b/x64/Debug/CStandPipeManifold.obj new file mode 100644 index 0000000..61184aa Binary files /dev/null and b/x64/Debug/CStandPipeManifold.obj differ diff --git a/x64/Debug/CStandPipeManifoldVariables.obj b/x64/Debug/CStandPipeManifoldVariables.obj new file mode 100644 index 0000000..c96991d Binary files /dev/null and b/x64/Debug/CStandPipeManifoldVariables.obj differ diff --git a/x64/Debug/CStandRack.obj b/x64/Debug/CStandRack.obj new file mode 100644 index 0000000..e401ed9 Binary files /dev/null and b/x64/Debug/CStandRack.obj differ diff --git a/x64/Debug/CStringConfiguration.obj b/x64/Debug/CStringConfiguration.obj new file mode 100644 index 0000000..f581ead Binary files /dev/null and b/x64/Debug/CStringConfiguration.obj differ diff --git a/x64/Debug/CStringConfigurationVariables.obj b/x64/Debug/CStringConfigurationVariables.obj new file mode 100644 index 0000000..9ac9a98 Binary files /dev/null and b/x64/Debug/CStringConfigurationVariables.obj differ diff --git a/x64/Debug/CStringPressure.obj b/x64/Debug/CStringPressure.obj new file mode 100644 index 0000000..f50396e Binary files /dev/null and b/x64/Debug/CStringPressure.obj differ diff --git a/x64/Debug/CStringUpdate.obj b/x64/Debug/CStringUpdate.obj new file mode 100644 index 0000000..44065f2 Binary files /dev/null and b/x64/Debug/CStringUpdate.obj differ diff --git a/x64/Debug/CStringUpdateVariables.obj b/x64/Debug/CStringUpdateVariables.obj new file mode 100644 index 0000000..3c92c20 Binary files /dev/null and b/x64/Debug/CStringUpdateVariables.obj differ diff --git a/x64/Debug/CStudentStation.obj b/x64/Debug/CStudentStation.obj new file mode 100644 index 0000000..6d44fcb Binary files /dev/null and b/x64/Debug/CStudentStation.obj differ diff --git a/x64/Debug/CStudentStationVariables.obj b/x64/Debug/CStudentStationVariables.obj new file mode 100644 index 0000000..a1c843b Binary files /dev/null and b/x64/Debug/CStudentStationVariables.obj differ diff --git a/x64/Debug/CSwingDrillPermission.obj b/x64/Debug/CSwingDrillPermission.obj new file mode 100644 index 0000000..a8daa07 Binary files /dev/null and b/x64/Debug/CSwingDrillPermission.obj differ diff --git a/x64/Debug/CSwingDrillPermissionVariables.obj b/x64/Debug/CSwingDrillPermissionVariables.obj new file mode 100644 index 0000000..1392540 Binary files /dev/null and b/x64/Debug/CSwingDrillPermissionVariables.obj differ diff --git a/x64/Debug/CSwingEnum.obj b/x64/Debug/CSwingEnum.obj new file mode 100644 index 0000000..38a4571 Binary files /dev/null and b/x64/Debug/CSwingEnum.obj differ diff --git a/x64/Debug/CSwingEnumVariables.obj b/x64/Debug/CSwingEnumVariables.obj new file mode 100644 index 0000000..59f398f Binary files /dev/null and b/x64/Debug/CSwingEnumVariables.obj differ diff --git a/x64/Debug/CSwingLedNotification.obj b/x64/Debug/CSwingLedNotification.obj new file mode 100644 index 0000000..d38be3a Binary files /dev/null and b/x64/Debug/CSwingLedNotification.obj differ diff --git a/x64/Debug/CSwingLedNotificationVariables.obj b/x64/Debug/CSwingLedNotificationVariables.obj new file mode 100644 index 0000000..4108603 Binary files /dev/null and b/x64/Debug/CSwingLedNotificationVariables.obj differ diff --git a/x64/Debug/CSwingOffPermission.obj b/x64/Debug/CSwingOffPermission.obj new file mode 100644 index 0000000..7e3d63a Binary files /dev/null and b/x64/Debug/CSwingOffPermission.obj differ diff --git a/x64/Debug/CSwingOffPermissionVariables.obj b/x64/Debug/CSwingOffPermissionVariables.obj new file mode 100644 index 0000000..3df9a42 Binary files /dev/null and b/x64/Debug/CSwingOffPermissionVariables.obj differ diff --git a/x64/Debug/CSwingTiltPermission.obj b/x64/Debug/CSwingTiltPermission.obj new file mode 100644 index 0000000..cf48247 Binary files /dev/null and b/x64/Debug/CSwingTiltPermission.obj differ diff --git a/x64/Debug/CSwingTiltPermissionVariables.obj b/x64/Debug/CSwingTiltPermissionVariables.obj new file mode 100644 index 0000000..4fd92ba Binary files /dev/null and b/x64/Debug/CSwingTiltPermissionVariables.obj differ diff --git a/x64/Debug/CTanks.obj b/x64/Debug/CTanks.obj new file mode 100644 index 0000000..649cd16 Binary files /dev/null and b/x64/Debug/CTanks.obj differ diff --git a/x64/Debug/CTanksVariables.obj b/x64/Debug/CTanksVariables.obj new file mode 100644 index 0000000..a63869f Binary files /dev/null and b/x64/Debug/CTanksVariables.obj differ diff --git a/x64/Debug/CTdsBackupClamp.obj b/x64/Debug/CTdsBackupClamp.obj new file mode 100644 index 0000000..ea4c2eb Binary files /dev/null and b/x64/Debug/CTdsBackupClamp.obj differ diff --git a/x64/Debug/CTdsBackupClampVariables.obj b/x64/Debug/CTdsBackupClampVariables.obj new file mode 100644 index 0000000..6168d1e Binary files /dev/null and b/x64/Debug/CTdsBackupClampVariables.obj differ diff --git a/x64/Debug/CTdsConnectionModesEnum.obj b/x64/Debug/CTdsConnectionModesEnum.obj new file mode 100644 index 0000000..5de9a60 Binary files /dev/null and b/x64/Debug/CTdsConnectionModesEnum.obj differ diff --git a/x64/Debug/CTdsConnectionModesEnumVariables.obj b/x64/Debug/CTdsConnectionModesEnumVariables.obj new file mode 100644 index 0000000..29af446 Binary files /dev/null and b/x64/Debug/CTdsConnectionModesEnumVariables.obj differ diff --git a/x64/Debug/CTdsElevatorModesEnum.obj b/x64/Debug/CTdsElevatorModesEnum.obj new file mode 100644 index 0000000..5c3b48b Binary files /dev/null and b/x64/Debug/CTdsElevatorModesEnum.obj differ diff --git a/x64/Debug/CTdsElevatorModesEnumVariables.obj b/x64/Debug/CTdsElevatorModesEnumVariables.obj new file mode 100644 index 0000000..e5c967c Binary files /dev/null and b/x64/Debug/CTdsElevatorModesEnumVariables.obj differ diff --git a/x64/Debug/CTdsIbopLedNotification.obj b/x64/Debug/CTdsIbopLedNotification.obj new file mode 100644 index 0000000..679f36b Binary files /dev/null and b/x64/Debug/CTdsIbopLedNotification.obj differ diff --git a/x64/Debug/CTdsIbopLedNotificationVariables.obj b/x64/Debug/CTdsIbopLedNotificationVariables.obj new file mode 100644 index 0000000..6cfc22e Binary files /dev/null and b/x64/Debug/CTdsIbopLedNotificationVariables.obj differ diff --git a/x64/Debug/CTdsPowerLedNotification.obj b/x64/Debug/CTdsPowerLedNotification.obj new file mode 100644 index 0000000..290d7a5 Binary files /dev/null and b/x64/Debug/CTdsPowerLedNotification.obj differ diff --git a/x64/Debug/CTdsPowerLedNotificationVariables.obj b/x64/Debug/CTdsPowerLedNotificationVariables.obj new file mode 100644 index 0000000..b4b3dad Binary files /dev/null and b/x64/Debug/CTdsPowerLedNotificationVariables.obj differ diff --git a/x64/Debug/CTdsSpineEnum.obj b/x64/Debug/CTdsSpineEnum.obj new file mode 100644 index 0000000..38eaa05 Binary files /dev/null and b/x64/Debug/CTdsSpineEnum.obj differ diff --git a/x64/Debug/CTdsSpineEnumVariables.obj b/x64/Debug/CTdsSpineEnumVariables.obj new file mode 100644 index 0000000..024b10f Binary files /dev/null and b/x64/Debug/CTdsSpineEnumVariables.obj differ diff --git a/x64/Debug/CTdsStemJointHeight.obj b/x64/Debug/CTdsStemJointHeight.obj new file mode 100644 index 0000000..2ca91cb Binary files /dev/null and b/x64/Debug/CTdsStemJointHeight.obj differ diff --git a/x64/Debug/CTdsSwingEnum.obj b/x64/Debug/CTdsSwingEnum.obj new file mode 100644 index 0000000..40a60a0 Binary files /dev/null and b/x64/Debug/CTdsSwingEnum.obj differ diff --git a/x64/Debug/CTdsSwingEnumVariables.obj b/x64/Debug/CTdsSwingEnumVariables.obj new file mode 100644 index 0000000..11613d7 Binary files /dev/null and b/x64/Debug/CTdsSwingEnumVariables.obj differ diff --git a/x64/Debug/CTdsTongEnum.obj b/x64/Debug/CTdsTongEnum.obj new file mode 100644 index 0000000..4565999 Binary files /dev/null and b/x64/Debug/CTdsTongEnum.obj differ diff --git a/x64/Debug/CTdsTongEnumVariables.obj b/x64/Debug/CTdsTongEnumVariables.obj new file mode 100644 index 0000000..8d4a690 Binary files /dev/null and b/x64/Debug/CTdsTongEnumVariables.obj differ diff --git a/x64/Debug/CTdsTorqueWrenchLedNotification.obj b/x64/Debug/CTdsTorqueWrenchLedNotification.obj new file mode 100644 index 0000000..6864521 Binary files /dev/null and b/x64/Debug/CTdsTorqueWrenchLedNotification.obj differ diff --git a/x64/Debug/CTdsTorqueWrenchLedNotificationVariables.obj b/x64/Debug/CTdsTorqueWrenchLedNotificationVariables.obj new file mode 100644 index 0000000..f9b2834 Binary files /dev/null and b/x64/Debug/CTdsTorqueWrenchLedNotificationVariables.obj differ diff --git a/x64/Debug/CTimer.obj b/x64/Debug/CTimer.obj new file mode 100644 index 0000000..9c42589 Binary files /dev/null and b/x64/Debug/CTimer.obj differ diff --git a/x64/Debug/CTimerLegacy.obj b/x64/Debug/CTimerLegacy.obj new file mode 100644 index 0000000..64a4315 Binary files /dev/null and b/x64/Debug/CTimerLegacy.obj differ diff --git a/x64/Debug/CTongEnum.obj b/x64/Debug/CTongEnum.obj new file mode 100644 index 0000000..45f7750 Binary files /dev/null and b/x64/Debug/CTongEnum.obj differ diff --git a/x64/Debug/CTongEnumVariables.obj b/x64/Debug/CTongEnumVariables.obj new file mode 100644 index 0000000..751ad6b Binary files /dev/null and b/x64/Debug/CTongEnumVariables.obj differ diff --git a/x64/Debug/CTongNotification.obj b/x64/Debug/CTongNotification.obj new file mode 100644 index 0000000..05116b4 Binary files /dev/null and b/x64/Debug/CTongNotification.obj differ diff --git a/x64/Debug/CTongNotificationVariables.obj b/x64/Debug/CTongNotificationVariables.obj new file mode 100644 index 0000000..f7c1230 Binary files /dev/null and b/x64/Debug/CTongNotificationVariables.obj differ diff --git a/x64/Debug/CTopDrivePanel.obj b/x64/Debug/CTopDrivePanel.obj new file mode 100644 index 0000000..6bcc4a6 Binary files /dev/null and b/x64/Debug/CTopDrivePanel.obj differ diff --git a/x64/Debug/CTopDrivePanelVariables.obj b/x64/Debug/CTopDrivePanelVariables.obj new file mode 100644 index 0000000..ec2643d Binary files /dev/null and b/x64/Debug/CTopDrivePanelVariables.obj differ diff --git a/x64/Debug/CUnityInputs.obj b/x64/Debug/CUnityInputs.obj new file mode 100644 index 0000000..769c265 Binary files /dev/null and b/x64/Debug/CUnityInputs.obj differ diff --git a/x64/Debug/CUnityOutputs.obj b/x64/Debug/CUnityOutputs.obj new file mode 100644 index 0000000..73bbc82 Binary files /dev/null and b/x64/Debug/CUnityOutputs.obj differ diff --git a/x64/Debug/CUnlatchLedNotification.obj b/x64/Debug/CUnlatchLedNotification.obj new file mode 100644 index 0000000..7e47045 Binary files /dev/null and b/x64/Debug/CUnlatchLedNotification.obj differ diff --git a/x64/Debug/CUnlatchLedNotificationVariables.obj b/x64/Debug/CUnlatchLedNotificationVariables.obj new file mode 100644 index 0000000..f4970c4 Binary files /dev/null and b/x64/Debug/CUnlatchLedNotificationVariables.obj differ diff --git a/x64/Debug/CVoidEventHandler.obj b/x64/Debug/CVoidEventHandler.obj new file mode 100644 index 0000000..76cd317 Binary files /dev/null and b/x64/Debug/CVoidEventHandler.obj differ diff --git a/x64/Debug/CVoidEventHandlerCollection.obj b/x64/Debug/CVoidEventHandlerCollection.obj new file mode 100644 index 0000000..7493b24 Binary files /dev/null and b/x64/Debug/CVoidEventHandlerCollection.obj differ diff --git a/x64/Debug/CWarnings.obj b/x64/Debug/CWarnings.obj new file mode 100644 index 0000000..6319dc6 Binary files /dev/null and b/x64/Debug/CWarnings.obj differ diff --git a/x64/Debug/CWarningsActions.obj b/x64/Debug/CWarningsActions.obj new file mode 100644 index 0000000..82a2717 Binary files /dev/null and b/x64/Debug/CWarningsActions.obj differ diff --git a/x64/Debug/CWarningsVariables.obj b/x64/Debug/CWarningsVariables.obj new file mode 100644 index 0000000..94a2050 Binary files /dev/null and b/x64/Debug/CWarningsVariables.obj differ diff --git a/x64/Debug/CWellSurveyData.obj b/x64/Debug/CWellSurveyData.obj new file mode 100644 index 0000000..9d0fe3f Binary files /dev/null and b/x64/Debug/CWellSurveyData.obj differ diff --git a/x64/Debug/CWellSurveyDataVariables.obj b/x64/Debug/CWellSurveyDataVariables.obj new file mode 100644 index 0000000..5afc7f0 Binary files /dev/null and b/x64/Debug/CWellSurveyDataVariables.obj differ diff --git a/x64/Debug/CZeroStringSpeed.obj b/x64/Debug/CZeroStringSpeed.obj new file mode 100644 index 0000000..881bd48 Binary files /dev/null and b/x64/Debug/CZeroStringSpeed.obj differ diff --git a/x64/Debug/ChokeControlMain.obj b/x64/Debug/ChokeControlMain.obj new file mode 100644 index 0000000..89a910e Binary files /dev/null and b/x64/Debug/ChokeControlMain.obj differ diff --git a/x64/Debug/ChokeLineMain.obj b/x64/Debug/ChokeLineMain.obj new file mode 100644 index 0000000..67e1d23 Binary files /dev/null and b/x64/Debug/ChokeLineMain.obj differ diff --git a/x64/Debug/ChokeStartup.obj b/x64/Debug/ChokeStartup.obj new file mode 100644 index 0000000..d3cd15c Binary files /dev/null and b/x64/Debug/ChokeStartup.obj differ diff --git a/x64/Debug/Circulation_Code_Select.obj b/x64/Debug/Circulation_Code_Select.obj new file mode 100644 index 0000000..6b26e9b Binary files /dev/null and b/x64/Debug/Circulation_Code_Select.obj differ diff --git a/x64/Debug/DWBrakeSound.obj b/x64/Debug/DWBrakeSound.obj new file mode 100644 index 0000000..0f6517e Binary files /dev/null and b/x64/Debug/DWBrakeSound.obj differ diff --git a/x64/Debug/DWFixModeMotion.obj b/x64/Debug/DWFixModeMotion.obj new file mode 100644 index 0000000..11dcb18 Binary files /dev/null and b/x64/Debug/DWFixModeMotion.obj differ diff --git a/x64/Debug/DWMalfunction_ClutchDisengage.obj b/x64/Debug/DWMalfunction_ClutchDisengage.obj new file mode 100644 index 0000000..7214a06 Binary files /dev/null and b/x64/Debug/DWMalfunction_ClutchDisengage.obj differ diff --git a/x64/Debug/DWMalfunction_ClutchEngage.obj b/x64/Debug/DWMalfunction_ClutchEngage.obj new file mode 100644 index 0000000..b20c44d Binary files /dev/null and b/x64/Debug/DWMalfunction_ClutchEngage.obj differ diff --git a/x64/Debug/DWMalfunction_MotorFailure.obj b/x64/Debug/DWMalfunction_MotorFailure.obj new file mode 100644 index 0000000..973cc3a Binary files /dev/null and b/x64/Debug/DWMalfunction_MotorFailure.obj differ diff --git a/x64/Debug/Deallocate_Normal_Circulation.obj b/x64/Debug/Deallocate_Normal_Circulation.obj new file mode 100644 index 0000000..d2698e0 Binary files /dev/null and b/x64/Debug/Deallocate_Normal_Circulation.obj differ diff --git a/x64/Debug/Disconnecting_Pipe.obj b/x64/Debug/Disconnecting_Pipe.obj new file mode 100644 index 0000000..e95bb5f Binary files /dev/null and b/x64/Debug/Disconnecting_Pipe.obj differ diff --git a/x64/Debug/DrawworksMain.obj b/x64/Debug/DrawworksMain.obj new file mode 100644 index 0000000..5b9c4eb Binary files /dev/null and b/x64/Debug/DrawworksMain.obj differ diff --git a/x64/Debug/Drawworks_Diff_Equations.obj b/x64/Debug/Drawworks_Diff_Equations.obj new file mode 100644 index 0000000..0d65690 Binary files /dev/null and b/x64/Debug/Drawworks_Diff_Equations.obj differ diff --git a/x64/Debug/Drawworks_Direction.obj b/x64/Debug/Drawworks_Direction.obj new file mode 100644 index 0000000..d61c3e5 Binary files /dev/null and b/x64/Debug/Drawworks_Direction.obj differ diff --git a/x64/Debug/Drawworks_Free_Traction_motor.obj b/x64/Debug/Drawworks_Free_Traction_motor.obj new file mode 100644 index 0000000..ee895ab Binary files /dev/null and b/x64/Debug/Drawworks_Free_Traction_motor.obj differ diff --git a/x64/Debug/Drawworks_Free_Traction_motor_Dir.obj b/x64/Debug/Drawworks_Free_Traction_motor_Dir.obj new file mode 100644 index 0000000..b8f9056 Binary files /dev/null and b/x64/Debug/Drawworks_Free_Traction_motor_Dir.obj differ diff --git a/x64/Debug/Drawworks_Free_Traction_motor_dawn_motion.obj b/x64/Debug/Drawworks_Free_Traction_motor_dawn_motion.obj new file mode 100644 index 0000000..d9f1fb4 Binary files /dev/null and b/x64/Debug/Drawworks_Free_Traction_motor_dawn_motion.obj differ diff --git a/x64/Debug/Drawworks_INPUTS.obj b/x64/Debug/Drawworks_INPUTS.obj new file mode 100644 index 0000000..e7d389d Binary files /dev/null and b/x64/Debug/Drawworks_INPUTS.obj differ diff --git a/x64/Debug/Drawworks_Solver.obj b/x64/Debug/Drawworks_Solver.obj new file mode 100644 index 0000000..c8794af Binary files /dev/null and b/x64/Debug/Drawworks_Solver.obj differ diff --git a/x64/Debug/Drawworks_Solver_FreeTractionMotor.obj b/x64/Debug/Drawworks_Solver_FreeTractionMotor.obj new file mode 100644 index 0000000..eabd0d4 Binary files /dev/null and b/x64/Debug/Drawworks_Solver_FreeTractionMotor.obj differ diff --git a/x64/Debug/Drawworks_StartUp.obj b/x64/Debug/Drawworks_StartUp.obj new file mode 100644 index 0000000..389c1b3 Binary files /dev/null and b/x64/Debug/Drawworks_StartUp.obj differ diff --git a/x64/Debug/Drawworks_Traction_motor_ClutchMode.obj b/x64/Debug/Drawworks_Traction_motor_ClutchMode.obj new file mode 100644 index 0000000..baeea05 Binary files /dev/null and b/x64/Debug/Drawworks_Traction_motor_ClutchMode.obj differ diff --git a/x64/Debug/Drawworks_Traction_motor_ClutchMode_Dir.obj b/x64/Debug/Drawworks_Traction_motor_ClutchMode_Dir.obj new file mode 100644 index 0000000..f9fb124 Binary files /dev/null and b/x64/Debug/Drawworks_Traction_motor_ClutchMode_Dir.obj differ diff --git a/x64/Debug/Drawworks_Traction_motor_dawnmotion.obj b/x64/Debug/Drawworks_Traction_motor_dawnmotion.obj new file mode 100644 index 0000000..ec75989 Binary files /dev/null and b/x64/Debug/Drawworks_Traction_motor_dawnmotion.obj differ diff --git a/x64/Debug/Drawworks_Traction_motor_dawnmotion_Dir.obj b/x64/Debug/Drawworks_Traction_motor_dawnmotion_Dir.obj new file mode 100644 index 0000000..e48fb05 Binary files /dev/null and b/x64/Debug/Drawworks_Traction_motor_dawnmotion_Dir.obj differ diff --git a/x64/Debug/Drawworks_VARIABLES.obj b/x64/Debug/Drawworks_VARIABLES.obj new file mode 100644 index 0000000..b3431d5 Binary files /dev/null and b/x64/Debug/Drawworks_VARIABLES.obj differ diff --git a/x64/Debug/DrillingConsole_ScrLEDs.obj b/x64/Debug/DrillingConsole_ScrLEDs.obj new file mode 100644 index 0000000..7230fea Binary files /dev/null and b/x64/Debug/DrillingConsole_ScrLEDs.obj differ diff --git a/x64/Debug/DynamicDoubleArray.obj b/x64/Debug/DynamicDoubleArray.obj new file mode 100644 index 0000000..74de51e Binary files /dev/null and b/x64/Debug/DynamicDoubleArray.obj differ diff --git a/x64/Debug/DynamicIntegerArray.obj b/x64/Debug/DynamicIntegerArray.obj new file mode 100644 index 0000000..14dc9ad Binary files /dev/null and b/x64/Debug/DynamicIntegerArray.obj differ diff --git a/x64/Debug/DynamicLogicalArray.obj b/x64/Debug/DynamicLogicalArray.obj new file mode 100644 index 0000000..5bec56a Binary files /dev/null and b/x64/Debug/DynamicLogicalArray.obj differ diff --git a/x64/Debug/DynamicRealArray.obj b/x64/Debug/DynamicRealArray.obj new file mode 100644 index 0000000..9d8f97f Binary files /dev/null and b/x64/Debug/DynamicRealArray.obj differ diff --git a/x64/Debug/Elements_Creation.obj b/x64/Debug/Elements_Creation.obj new file mode 100644 index 0000000..2ac3a82 Binary files /dev/null and b/x64/Debug/Elements_Creation.obj differ diff --git a/x64/Debug/FillingWell_By_BellNipple.obj b/x64/Debug/FillingWell_By_BellNipple.obj new file mode 100644 index 0000000..7053ed7 Binary files /dev/null and b/x64/Debug/FillingWell_By_BellNipple.obj differ diff --git a/x64/Debug/Flow_Startup.obj b/x64/Debug/Flow_Startup.obj new file mode 100644 index 0000000..1026a47 Binary files /dev/null and b/x64/Debug/Flow_Startup.obj differ diff --git a/x64/Debug/Flow_Startup_VARIABLES.obj b/x64/Debug/Flow_Startup_VARIABLES.obj new file mode 100644 index 0000000..5ab1404 Binary files /dev/null and b/x64/Debug/Flow_Startup_VARIABLES.obj differ diff --git a/x64/Debug/FluidFlowMain.obj b/x64/Debug/FluidFlowMain.obj new file mode 100644 index 0000000..0c0ebb4 Binary files /dev/null and b/x64/Debug/FluidFlowMain.obj differ diff --git a/x64/Debug/Fluid_Flow_Solver.obj b/x64/Debug/Fluid_Flow_Solver.obj new file mode 100644 index 0000000..aac92b2 Binary files /dev/null and b/x64/Debug/Fluid_Flow_Solver.obj differ diff --git a/x64/Debug/Formation_Information.obj b/x64/Debug/Formation_Information.obj new file mode 100644 index 0000000..9ac0720 Binary files /dev/null and b/x64/Debug/Formation_Information.obj differ diff --git a/x64/Debug/Frictional_Press_Drop_Calc.obj b/x64/Debug/Frictional_Press_Drop_Calc.obj new file mode 100644 index 0000000..34cb62e Binary files /dev/null and b/x64/Debug/Frictional_Press_Drop_Calc.obj differ diff --git a/x64/Debug/Gas_Kick_Calculator.obj b/x64/Debug/Gas_Kick_Calculator.obj new file mode 100644 index 0000000..7516bec Binary files /dev/null and b/x64/Debug/Gas_Kick_Calculator.obj differ diff --git a/x64/Debug/GeoElements_FluidModule.obj b/x64/Debug/GeoElements_FluidModule.obj new file mode 100644 index 0000000..c7a17a7 Binary files /dev/null and b/x64/Debug/GeoElements_FluidModule.obj differ diff --git a/x64/Debug/GeoMain.obj b/x64/Debug/GeoMain.obj new file mode 100644 index 0000000..ef040ec Binary files /dev/null and b/x64/Debug/GeoMain.obj differ diff --git a/x64/Debug/Horizontal_and_String_Pressure_Distribution.obj b/x64/Debug/Horizontal_and_String_Pressure_Distribution.obj new file mode 100644 index 0000000..fbc4554 Binary files /dev/null and b/x64/Debug/Horizontal_and_String_Pressure_Distribution.obj differ diff --git a/x64/Debug/JetImpactForce.obj b/x64/Debug/JetImpactForce.obj new file mode 100644 index 0000000..0078e2b Binary files /dev/null and b/x64/Debug/JetImpactForce.obj differ diff --git a/x64/Debug/KILL_LINE.obj b/x64/Debug/KILL_LINE.obj new file mode 100644 index 0000000..c7ac283 Binary files /dev/null and b/x64/Debug/KILL_LINE.obj differ diff --git a/x64/Debug/Kick_Expansion_and_Contraction.obj b/x64/Debug/Kick_Expansion_and_Contraction.obj new file mode 100644 index 0000000..08e40ad Binary files /dev/null and b/x64/Debug/Kick_Expansion_and_Contraction.obj differ diff --git a/x64/Debug/Kick_Influx.obj b/x64/Debug/Kick_Influx.obj new file mode 100644 index 0000000..535940d Binary files /dev/null and b/x64/Debug/Kick_Influx.obj differ diff --git a/x64/Debug/Kick_Migration.obj b/x64/Debug/Kick_Migration.obj new file mode 100644 index 0000000..47e9ea9 Binary files /dev/null and b/x64/Debug/Kick_Migration.obj differ diff --git a/x64/Debug/Kick_VARIABLES.obj b/x64/Debug/Kick_VARIABLES.obj new file mode 100644 index 0000000..e115b97 Binary files /dev/null and b/x64/Debug/Kick_VARIABLES.obj differ diff --git a/x64/Debug/KillLineMain.obj b/x64/Debug/KillLineMain.obj new file mode 100644 index 0000000..9cd5d00 Binary files /dev/null and b/x64/Debug/KillLineMain.obj differ diff --git a/x64/Debug/LOSS_INPUTS.obj b/x64/Debug/LOSS_INPUTS.obj new file mode 100644 index 0000000..293923a Binary files /dev/null and b/x64/Debug/LOSS_INPUTS.obj differ diff --git a/x64/Debug/MeshGeneration_FluidModule.obj b/x64/Debug/MeshGeneration_FluidModule.obj new file mode 100644 index 0000000..2fc0c9f Binary files /dev/null and b/x64/Debug/MeshGeneration_FluidModule.obj differ diff --git a/x64/Debug/MudSystem.obj b/x64/Debug/MudSystem.obj new file mode 100644 index 0000000..7908f58 Binary files /dev/null and b/x64/Debug/MudSystem.obj differ diff --git a/x64/Debug/MudSystemMain.obj b/x64/Debug/MudSystemMain.obj new file mode 100644 index 0000000..1f7b2da Binary files /dev/null and b/x64/Debug/MudSystemMain.obj differ diff --git a/x64/Debug/MudSystemStartup.obj b/x64/Debug/MudSystemStartup.obj new file mode 100644 index 0000000..9ade1a4 Binary files /dev/null and b/x64/Debug/MudSystemStartup.obj differ diff --git a/x64/Debug/MudSystem_Variables.obj b/x64/Debug/MudSystem_Variables.obj new file mode 100644 index 0000000..4af3389 Binary files /dev/null and b/x64/Debug/MudSystem_Variables.obj differ diff --git a/x64/Debug/ON_mode_simulation.obj b/x64/Debug/ON_mode_simulation.obj new file mode 100644 index 0000000..b259172 Binary files /dev/null and b/x64/Debug/ON_mode_simulation.obj differ diff --git a/x64/Debug/Off_mode_Simulation.obj b/x64/Debug/Off_mode_Simulation.obj new file mode 100644 index 0000000..bfd4b4f Binary files /dev/null and b/x64/Debug/Off_mode_Simulation.obj differ diff --git a/x64/Debug/PIPE_RAM1.obj b/x64/Debug/PIPE_RAM1.obj new file mode 100644 index 0000000..abce350 Binary files /dev/null and b/x64/Debug/PIPE_RAM1.obj differ diff --git a/x64/Debug/PIPE_RAM2.obj b/x64/Debug/PIPE_RAM2.obj new file mode 100644 index 0000000..225647a Binary files /dev/null and b/x64/Debug/PIPE_RAM2.obj differ diff --git a/x64/Debug/PipeRams1Main.obj b/x64/Debug/PipeRams1Main.obj new file mode 100644 index 0000000..83e9636 Binary files /dev/null and b/x64/Debug/PipeRams1Main.obj differ diff --git a/x64/Debug/PipeRams2Main.obj b/x64/Debug/PipeRams2Main.obj new file mode 100644 index 0000000..b4f135e Binary files /dev/null and b/x64/Debug/PipeRams2Main.obj differ diff --git a/x64/Debug/Plot_Final_Mud_Elements.obj b/x64/Debug/Plot_Final_Mud_Elements.obj new file mode 100644 index 0000000..45856ab Binary files /dev/null and b/x64/Debug/Plot_Final_Mud_Elements.obj differ diff --git a/x64/Debug/PowerLimits.obj b/x64/Debug/PowerLimits.obj new file mode 100644 index 0000000..33b61e8 Binary files /dev/null and b/x64/Debug/PowerLimits.obj differ diff --git a/x64/Debug/Pressure_Display_VARIABLES.obj b/x64/Debug/Pressure_Display_VARIABLES.obj new file mode 100644 index 0000000..33aba58 Binary files /dev/null and b/x64/Debug/Pressure_Display_VARIABLES.obj differ diff --git a/x64/Debug/Pressure_Distribution_VARIABLES.obj b/x64/Debug/Pressure_Distribution_VARIABLES.obj new file mode 100644 index 0000000..2f58c6a Binary files /dev/null and b/x64/Debug/Pressure_Distribution_VARIABLES.obj differ diff --git a/x64/Debug/Pump1_MainSolver.obj b/x64/Debug/Pump1_MainSolver.obj new file mode 100644 index 0000000..31a1c41 Binary files /dev/null and b/x64/Debug/Pump1_MainSolver.obj differ diff --git a/x64/Debug/Pump1_OffMode_Solver.obj b/x64/Debug/Pump1_OffMode_Solver.obj new file mode 100644 index 0000000..a66bfa8 Binary files /dev/null and b/x64/Debug/Pump1_OffMode_Solver.obj differ diff --git a/x64/Debug/Pump1_OnMode_Solver.obj b/x64/Debug/Pump1_OnMode_Solver.obj new file mode 100644 index 0000000..986dda5 Binary files /dev/null and b/x64/Debug/Pump1_OnMode_Solver.obj differ diff --git a/x64/Debug/Pump2_MainSolver.obj b/x64/Debug/Pump2_MainSolver.obj new file mode 100644 index 0000000..4cd2bf5 Binary files /dev/null and b/x64/Debug/Pump2_MainSolver.obj differ diff --git a/x64/Debug/Pump2_OffMode_Solver.obj b/x64/Debug/Pump2_OffMode_Solver.obj new file mode 100644 index 0000000..75fa8fb Binary files /dev/null and b/x64/Debug/Pump2_OffMode_Solver.obj differ diff --git a/x64/Debug/Pump2_OnMode_Solver.obj b/x64/Debug/Pump2_OnMode_Solver.obj new file mode 100644 index 0000000..8778a44 Binary files /dev/null and b/x64/Debug/Pump2_OnMode_Solver.obj differ diff --git a/x64/Debug/Pump3_OffMode_Solver.obj b/x64/Debug/Pump3_OffMode_Solver.obj new file mode 100644 index 0000000..1570754 Binary files /dev/null and b/x64/Debug/Pump3_OffMode_Solver.obj differ diff --git a/x64/Debug/Pump3_OnMode_Solver.obj b/x64/Debug/Pump3_OnMode_Solver.obj new file mode 100644 index 0000000..27318f0 Binary files /dev/null and b/x64/Debug/Pump3_OnMode_Solver.obj differ diff --git a/x64/Debug/Pump_INPUTS.obj b/x64/Debug/Pump_INPUTS.obj new file mode 100644 index 0000000..e90847a Binary files /dev/null and b/x64/Debug/Pump_INPUTS.obj differ diff --git a/x64/Debug/Pump_Solver.obj b/x64/Debug/Pump_Solver.obj new file mode 100644 index 0000000..d1d0d70 Binary files /dev/null and b/x64/Debug/Pump_Solver.obj differ diff --git a/x64/Debug/Pump_StartUp.obj b/x64/Debug/Pump_StartUp.obj new file mode 100644 index 0000000..7da7c87 Binary files /dev/null and b/x64/Debug/Pump_StartUp.obj differ diff --git a/x64/Debug/Pump_Total_Counts.obj b/x64/Debug/Pump_Total_Counts.obj new file mode 100644 index 0000000..cb6de82 Binary files /dev/null and b/x64/Debug/Pump_Total_Counts.obj differ diff --git a/x64/Debug/Pump_Traction_Motor.obj b/x64/Debug/Pump_Traction_Motor.obj new file mode 100644 index 0000000..1eabe88 Binary files /dev/null and b/x64/Debug/Pump_Traction_Motor.obj differ diff --git a/x64/Debug/Pump_VARIABLES.obj b/x64/Debug/Pump_VARIABLES.obj new file mode 100644 index 0000000..1322c51 Binary files /dev/null and b/x64/Debug/Pump_VARIABLES.obj differ diff --git a/x64/Debug/Pump_and_Trip_In.obj b/x64/Debug/Pump_and_Trip_In.obj new file mode 100644 index 0000000..33ef4b3 Binary files /dev/null and b/x64/Debug/Pump_and_Trip_In.obj differ diff --git a/x64/Debug/PumpsMain.obj b/x64/Debug/PumpsMain.obj new file mode 100644 index 0000000..3b0e77e Binary files /dev/null and b/x64/Debug/PumpsMain.obj differ diff --git a/x64/Debug/ROP_MainCalculation.obj b/x64/Debug/ROP_MainCalculation.obj new file mode 100644 index 0000000..01bc7ea Binary files /dev/null and b/x64/Debug/ROP_MainCalculation.obj differ diff --git a/x64/Debug/ROP_StartUp.obj b/x64/Debug/ROP_StartUp.obj new file mode 100644 index 0000000..7f79c47 Binary files /dev/null and b/x64/Debug/ROP_StartUp.obj differ diff --git a/x64/Debug/RTMalfunction_MotorFailure.obj b/x64/Debug/RTMalfunction_MotorFailure.obj new file mode 100644 index 0000000..5108f20 Binary files /dev/null and b/x64/Debug/RTMalfunction_MotorFailure.obj differ diff --git a/x64/Debug/RTTorqueLimit.obj b/x64/Debug/RTTorqueLimit.obj new file mode 100644 index 0000000..f622f00 Binary files /dev/null and b/x64/Debug/RTTorqueLimit.obj differ diff --git a/x64/Debug/RTable_INPUTS.obj b/x64/Debug/RTable_INPUTS.obj new file mode 100644 index 0000000..d4b0ded Binary files /dev/null and b/x64/Debug/RTable_INPUTS.obj differ diff --git a/x64/Debug/RTable_OffMode.obj b/x64/Debug/RTable_OffMode.obj new file mode 100644 index 0000000..cb59ea1 Binary files /dev/null and b/x64/Debug/RTable_OffMode.obj differ diff --git a/x64/Debug/RTable_Solver.obj b/x64/Debug/RTable_Solver.obj new file mode 100644 index 0000000..cfb378a Binary files /dev/null and b/x64/Debug/RTable_Solver.obj differ diff --git a/x64/Debug/RTable_StartUp.obj b/x64/Debug/RTable_StartUp.obj new file mode 100644 index 0000000..2d86aeb Binary files /dev/null and b/x64/Debug/RTable_StartUp.obj differ diff --git a/x64/Debug/RTable_Traction_Motor.obj b/x64/Debug/RTable_Traction_Motor.obj new file mode 100644 index 0000000..87a7551 Binary files /dev/null and b/x64/Debug/RTable_Traction_Motor.obj differ diff --git a/x64/Debug/RTable_VARIABLES.obj b/x64/Debug/RTable_VARIABLES.obj new file mode 100644 index 0000000..0e83b12 Binary files /dev/null and b/x64/Debug/RTable_VARIABLES.obj differ diff --git a/x64/Debug/RTable_diff_eqs.obj b/x64/Debug/RTable_diff_eqs.obj new file mode 100644 index 0000000..ea1a8ff Binary files /dev/null and b/x64/Debug/RTable_diff_eqs.obj differ diff --git a/x64/Debug/RopMain.obj b/x64/Debug/RopMain.obj new file mode 100644 index 0000000..d9b6b2c Binary files /dev/null and b/x64/Debug/RopMain.obj differ diff --git a/x64/Debug/RotaryTableMain.obj b/x64/Debug/RotaryTableMain.obj new file mode 100644 index 0000000..f572942 Binary files /dev/null and b/x64/Debug/RotaryTableMain.obj differ diff --git a/x64/Debug/SHEAR_RAM.obj b/x64/Debug/SHEAR_RAM.obj new file mode 100644 index 0000000..53004b8 Binary files /dev/null and b/x64/Debug/SHEAR_RAM.obj differ diff --git a/x64/Debug/SimulationCore2.exe b/x64/Debug/SimulationCore2.exe new file mode 100644 index 0000000..b6b7bea Binary files /dev/null and b/x64/Debug/SimulationCore2.exe differ diff --git a/x64/Debug/SimulationCore2.exe.intermediate.manifest b/x64/Debug/SimulationCore2.exe.intermediate.manifest new file mode 100644 index 0000000..ecea6f7 --- /dev/null +++ b/x64/Debug/SimulationCore2.exe.intermediate.manifest @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/x64/Debug/SimulationCore2.exp b/x64/Debug/SimulationCore2.exp new file mode 100644 index 0000000..5b592a4 Binary files /dev/null and b/x64/Debug/SimulationCore2.exp differ diff --git a/x64/Debug/SimulationCore2.lib b/x64/Debug/SimulationCore2.lib new file mode 100644 index 0000000..3dd8ae2 Binary files /dev/null and b/x64/Debug/SimulationCore2.lib differ diff --git a/x64/Debug/SimulationCore2.obj b/x64/Debug/SimulationCore2.obj new file mode 100644 index 0000000..95af1f4 Binary files /dev/null and b/x64/Debug/SimulationCore2.obj differ diff --git a/x64/Debug/SimulationCore2.pdb b/x64/Debug/SimulationCore2.pdb new file mode 100644 index 0000000..cc0a399 Binary files /dev/null and b/x64/Debug/SimulationCore2.pdb differ diff --git a/x64/Debug/Simulator.obj b/x64/Debug/Simulator.obj new file mode 100644 index 0000000..79e4926 Binary files /dev/null and b/x64/Debug/Simulator.obj differ diff --git a/x64/Debug/String_Property_Calculator.obj b/x64/Debug/String_Property_Calculator.obj new file mode 100644 index 0000000..3bfe3f8 Binary files /dev/null and b/x64/Debug/String_Property_Calculator.obj differ diff --git a/x64/Debug/TD_AddComponents.obj b/x64/Debug/TD_AddComponents.obj new file mode 100644 index 0000000..c60589c Binary files /dev/null and b/x64/Debug/TD_AddComponents.obj differ diff --git a/x64/Debug/TD_BOPDiamCalculation.obj b/x64/Debug/TD_BOPDiamCalculation.obj new file mode 100644 index 0000000..3a7c2f8 Binary files /dev/null and b/x64/Debug/TD_BOPDiamCalculation.obj differ diff --git a/x64/Debug/TD_BouyancyFactor.obj b/x64/Debug/TD_BouyancyFactor.obj new file mode 100644 index 0000000..6bff77f Binary files /dev/null and b/x64/Debug/TD_BouyancyFactor.obj differ diff --git a/x64/Debug/TD_CombinedMotionData.obj b/x64/Debug/TD_CombinedMotionData.obj new file mode 100644 index 0000000..c80fdcc Binary files /dev/null and b/x64/Debug/TD_CombinedMotionData.obj differ diff --git a/x64/Debug/TD_DrillStem.obj b/x64/Debug/TD_DrillStem.obj new file mode 100644 index 0000000..6ccd243 Binary files /dev/null and b/x64/Debug/TD_DrillStem.obj differ diff --git a/x64/Debug/TD_DrillStemConfiguration.obj b/x64/Debug/TD_DrillStemConfiguration.obj new file mode 100644 index 0000000..b252f08 Binary files /dev/null and b/x64/Debug/TD_DrillStemConfiguration.obj differ diff --git a/x64/Debug/TD_DrillStemReadData.obj b/x64/Debug/TD_DrillStemReadData.obj new file mode 100644 index 0000000..4a233ce Binary files /dev/null and b/x64/Debug/TD_DrillStemReadData.obj differ diff --git a/x64/Debug/TD_DrillStemStartUp.obj b/x64/Debug/TD_DrillStemStartUp.obj new file mode 100644 index 0000000..da536b9 Binary files /dev/null and b/x64/Debug/TD_DrillStemStartUp.obj differ diff --git a/x64/Debug/TD_ForceCalculation.obj b/x64/Debug/TD_ForceCalculation.obj new file mode 100644 index 0000000..a6a9890 Binary files /dev/null and b/x64/Debug/TD_ForceCalculation.obj differ diff --git a/x64/Debug/TD_ForceDownB.obj b/x64/Debug/TD_ForceDownB.obj new file mode 100644 index 0000000..f46caee Binary files /dev/null and b/x64/Debug/TD_ForceDownB.obj differ diff --git a/x64/Debug/TD_ForceDownBRot.obj b/x64/Debug/TD_ForceDownBRot.obj new file mode 100644 index 0000000..c73fe3b Binary files /dev/null and b/x64/Debug/TD_ForceDownBRot.obj differ diff --git a/x64/Debug/TD_ForceDownD.obj b/x64/Debug/TD_ForceDownD.obj new file mode 100644 index 0000000..b3043da Binary files /dev/null and b/x64/Debug/TD_ForceDownD.obj differ diff --git a/x64/Debug/TD_ForceDownDRot.obj b/x64/Debug/TD_ForceDownDRot.obj new file mode 100644 index 0000000..9437509 Binary files /dev/null and b/x64/Debug/TD_ForceDownDRot.obj differ diff --git a/x64/Debug/TD_ForceDownS.obj b/x64/Debug/TD_ForceDownS.obj new file mode 100644 index 0000000..958b7c8 Binary files /dev/null and b/x64/Debug/TD_ForceDownS.obj differ diff --git a/x64/Debug/TD_ForceDownSRot.obj b/x64/Debug/TD_ForceDownSRot.obj new file mode 100644 index 0000000..e142e10 Binary files /dev/null and b/x64/Debug/TD_ForceDownSRot.obj differ diff --git a/x64/Debug/TD_ForceReadData.obj b/x64/Debug/TD_ForceReadData.obj new file mode 100644 index 0000000..ed24fed Binary files /dev/null and b/x64/Debug/TD_ForceReadData.obj differ diff --git a/x64/Debug/TD_ForceUpB.obj b/x64/Debug/TD_ForceUpB.obj new file mode 100644 index 0000000..0e7d69d Binary files /dev/null and b/x64/Debug/TD_ForceUpB.obj differ diff --git a/x64/Debug/TD_ForceUpBRot.obj b/x64/Debug/TD_ForceUpBRot.obj new file mode 100644 index 0000000..59e6aeb Binary files /dev/null and b/x64/Debug/TD_ForceUpBRot.obj differ diff --git a/x64/Debug/TD_ForceUpD.obj b/x64/Debug/TD_ForceUpD.obj new file mode 100644 index 0000000..b5bcb59 Binary files /dev/null and b/x64/Debug/TD_ForceUpD.obj differ diff --git a/x64/Debug/TD_ForceUpDRot.obj b/x64/Debug/TD_ForceUpDRot.obj new file mode 100644 index 0000000..2a4a1a7 Binary files /dev/null and b/x64/Debug/TD_ForceUpDRot.obj differ diff --git a/x64/Debug/TD_ForceUpS.obj b/x64/Debug/TD_ForceUpS.obj new file mode 100644 index 0000000..8ff3b31 Binary files /dev/null and b/x64/Debug/TD_ForceUpS.obj differ diff --git a/x64/Debug/TD_ForceUpSRot.obj b/x64/Debug/TD_ForceUpSRot.obj new file mode 100644 index 0000000..8e802ca Binary files /dev/null and b/x64/Debug/TD_ForceUpSRot.obj differ diff --git a/x64/Debug/TD_GeneralData.obj b/x64/Debug/TD_GeneralData.obj new file mode 100644 index 0000000..41cf2e8 Binary files /dev/null and b/x64/Debug/TD_GeneralData.obj differ diff --git a/x64/Debug/TD_HookLoadCalculation.obj b/x64/Debug/TD_HookLoadCalculation.obj new file mode 100644 index 0000000..b7a9be4 Binary files /dev/null and b/x64/Debug/TD_HookLoadCalculation.obj differ diff --git a/x64/Debug/TD_MainCalculations.obj b/x64/Debug/TD_MainCalculations.obj new file mode 100644 index 0000000..dcd4032 Binary files /dev/null and b/x64/Debug/TD_MainCalculations.obj differ diff --git a/x64/Debug/TD_MudPropertiesReadData.obj b/x64/Debug/TD_MudPropertiesReadData.obj new file mode 100644 index 0000000..9287bdf Binary files /dev/null and b/x64/Debug/TD_MudPropertiesReadData.obj differ diff --git a/x64/Debug/TD_PipePropertiesReadData.obj b/x64/Debug/TD_PipePropertiesReadData.obj new file mode 100644 index 0000000..684b9fb Binary files /dev/null and b/x64/Debug/TD_PipePropertiesReadData.obj differ diff --git a/x64/Debug/TD_RemoveComponents.obj b/x64/Debug/TD_RemoveComponents.obj new file mode 100644 index 0000000..9a6f20e Binary files /dev/null and b/x64/Debug/TD_RemoveComponents.obj differ diff --git a/x64/Debug/TD_StartUp.obj b/x64/Debug/TD_StartUp.obj new file mode 100644 index 0000000..713eb97 Binary files /dev/null and b/x64/Debug/TD_StartUp.obj differ diff --git a/x64/Debug/TD_StaticHookLoadCalculation.obj b/x64/Debug/TD_StaticHookLoadCalculation.obj new file mode 100644 index 0000000..40e0b34 Binary files /dev/null and b/x64/Debug/TD_StaticHookLoadCalculation.obj differ diff --git a/x64/Debug/TD_StrainCalculation.obj b/x64/Debug/TD_StrainCalculation.obj new file mode 100644 index 0000000..b3ec519 Binary files /dev/null and b/x64/Debug/TD_StrainCalculation.obj differ diff --git a/x64/Debug/TD_StringConnectionData.obj b/x64/Debug/TD_StringConnectionData.obj new file mode 100644 index 0000000..9eb8c47 Binary files /dev/null and b/x64/Debug/TD_StringConnectionData.obj differ diff --git a/x64/Debug/TD_StringConnectionModes.obj b/x64/Debug/TD_StringConnectionModes.obj new file mode 100644 index 0000000..075b3f6 Binary files /dev/null and b/x64/Debug/TD_StringConnectionModes.obj differ diff --git a/x64/Debug/TD_TorqueCalculation.obj b/x64/Debug/TD_TorqueCalculation.obj new file mode 100644 index 0000000..148f3bb Binary files /dev/null and b/x64/Debug/TD_TorqueCalculation.obj differ diff --git a/x64/Debug/TD_ViscousDragForce.obj b/x64/Debug/TD_ViscousDragForce.obj new file mode 100644 index 0000000..b60927f Binary files /dev/null and b/x64/Debug/TD_ViscousDragForce.obj differ diff --git a/x64/Debug/TD_WeightOnBitCalculation.obj b/x64/Debug/TD_WeightOnBitCalculation.obj new file mode 100644 index 0000000..e46bb10 Binary files /dev/null and b/x64/Debug/TD_WeightOnBitCalculation.obj differ diff --git a/x64/Debug/TD_WellElements.obj b/x64/Debug/TD_WellElements.obj new file mode 100644 index 0000000..0a3893f Binary files /dev/null and b/x64/Debug/TD_WellElements.obj differ diff --git a/x64/Debug/TD_WellElementsConfiguration.obj b/x64/Debug/TD_WellElementsConfiguration.obj new file mode 100644 index 0000000..0596649 Binary files /dev/null and b/x64/Debug/TD_WellElementsConfiguration.obj differ diff --git a/x64/Debug/TD_WellElementsReadData.obj b/x64/Debug/TD_WellElementsReadData.obj new file mode 100644 index 0000000..4ea57ac Binary files /dev/null and b/x64/Debug/TD_WellElementsReadData.obj differ diff --git a/x64/Debug/TD_WellGeoConfiguration.obj b/x64/Debug/TD_WellGeoConfiguration.obj new file mode 100644 index 0000000..fa49860 Binary files /dev/null and b/x64/Debug/TD_WellGeoConfiguration.obj differ diff --git a/x64/Debug/TD_WellGeometry.obj b/x64/Debug/TD_WellGeometry.obj new file mode 100644 index 0000000..0c71696 Binary files /dev/null and b/x64/Debug/TD_WellGeometry.obj differ diff --git a/x64/Debug/TD_WellReadData.obj b/x64/Debug/TD_WellReadData.obj new file mode 100644 index 0000000..6619b6f Binary files /dev/null and b/x64/Debug/TD_WellReadData.obj differ diff --git a/x64/Debug/TVD_Calculator.obj b/x64/Debug/TVD_Calculator.obj new file mode 100644 index 0000000..dc90a85 Binary files /dev/null and b/x64/Debug/TVD_Calculator.obj differ diff --git a/x64/Debug/TestOperationScenarios.obj b/x64/Debug/TestOperationScenarios.obj new file mode 100644 index 0000000..19646b8 Binary files /dev/null and b/x64/Debug/TestOperationScenarios.obj differ diff --git a/x64/Debug/TestOperationScenariosVariables.obj b/x64/Debug/TestOperationScenariosVariables.obj new file mode 100644 index 0000000..8e614c5 Binary files /dev/null and b/x64/Debug/TestOperationScenariosVariables.obj differ diff --git a/x64/Debug/TopDriveMain.obj b/x64/Debug/TopDriveMain.obj new file mode 100644 index 0000000..36c559d Binary files /dev/null and b/x64/Debug/TopDriveMain.obj differ diff --git a/x64/Debug/TopDrive_INPUTS.obj b/x64/Debug/TopDrive_INPUTS.obj new file mode 100644 index 0000000..9100617 Binary files /dev/null and b/x64/Debug/TopDrive_INPUTS.obj differ diff --git a/x64/Debug/TopDrive_Malfunction_MotorFailure.obj b/x64/Debug/TopDrive_Malfunction_MotorFailure.obj new file mode 100644 index 0000000..19c8996 Binary files /dev/null and b/x64/Debug/TopDrive_Malfunction_MotorFailure.obj differ diff --git a/x64/Debug/TopDrive_OffMode.obj b/x64/Debug/TopDrive_OffMode.obj new file mode 100644 index 0000000..d7ebc7c Binary files /dev/null and b/x64/Debug/TopDrive_OffMode.obj differ diff --git a/x64/Debug/TopDrive_Solver.obj b/x64/Debug/TopDrive_Solver.obj new file mode 100644 index 0000000..0e80b47 Binary files /dev/null and b/x64/Debug/TopDrive_Solver.obj differ diff --git a/x64/Debug/TopDrive_StartUp.obj b/x64/Debug/TopDrive_StartUp.obj new file mode 100644 index 0000000..7dd0258 Binary files /dev/null and b/x64/Debug/TopDrive_StartUp.obj differ diff --git a/x64/Debug/TopDrive_TorqueLimit.obj b/x64/Debug/TopDrive_TorqueLimit.obj new file mode 100644 index 0000000..f1669da Binary files /dev/null and b/x64/Debug/TopDrive_TorqueLimit.obj differ diff --git a/x64/Debug/TopDrive_Traction_Motor.obj b/x64/Debug/TopDrive_Traction_Motor.obj new file mode 100644 index 0000000..95c0a0d Binary files /dev/null and b/x64/Debug/TopDrive_Traction_Motor.obj differ diff --git a/x64/Debug/TopDrive_VARIABLES.obj b/x64/Debug/TopDrive_VARIABLES.obj new file mode 100644 index 0000000..6b93d02 Binary files /dev/null and b/x64/Debug/TopDrive_VARIABLES.obj differ diff --git a/x64/Debug/TopDrive_diff_eqs.obj b/x64/Debug/TopDrive_diff_eqs.obj new file mode 100644 index 0000000..79d6205 Binary files /dev/null and b/x64/Debug/TopDrive_diff_eqs.obj differ diff --git a/x64/Debug/TorqueDragMain.obj b/x64/Debug/TorqueDragMain.obj new file mode 100644 index 0000000..099d8d7 Binary files /dev/null and b/x64/Debug/TorqueDragMain.obj differ diff --git a/x64/Debug/Trip_Out_andPump.obj b/x64/Debug/Trip_Out_andPump.obj new file mode 100644 index 0000000..756574e Binary files /dev/null and b/x64/Debug/Trip_Out_andPump.obj differ diff --git a/x64/Debug/Utube.obj b/x64/Debug/Utube.obj new file mode 100644 index 0000000..47df36a Binary files /dev/null and b/x64/Debug/Utube.obj differ diff --git a/x64/Debug/Utube1_and_Trip_In.obj b/x64/Debug/Utube1_and_Trip_In.obj new file mode 100644 index 0000000..127b9fe Binary files /dev/null and b/x64/Debug/Utube1_and_Trip_In.obj differ diff --git a/x64/Debug/Utube2_and_Trip_In.obj b/x64/Debug/Utube2_and_Trip_In.obj new file mode 100644 index 0000000..26fa48e Binary files /dev/null and b/x64/Debug/Utube2_and_Trip_In.obj differ diff --git a/x64/Debug/VARIABLES.obj b/x64/Debug/VARIABLES.obj new file mode 100644 index 0000000..2900d83 Binary files /dev/null and b/x64/Debug/VARIABLES.obj differ diff --git a/x64/Debug/Well_Pressure_Data_Transfer.obj b/x64/Debug/Well_Pressure_Data_Transfer.obj new file mode 100644 index 0000000..0342a52 Binary files /dev/null and b/x64/Debug/Well_Pressure_Data_Transfer.obj differ diff --git a/x64/Debug/adddynamicarray__genmod.f90 b/x64/Debug/adddynamicarray__genmod.f90 new file mode 100644 index 0000000..d2467bb --- /dev/null +++ b/x64/Debug/adddynamicarray__genmod.f90 @@ -0,0 +1,11 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:47 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE ADDDYNAMICARRAY__genmod + INTERFACE + SUBROUTINE ADDDYNAMICARRAY(ARRAY,VALUE) + REAL(KIND=4) ,ALLOCATABLE, INTENT(INOUT) :: ARRAY(:) + REAL(KIND=4), INTENT(IN) :: VALUE + END SUBROUTINE ADDDYNAMICARRAY + END INTERFACE + END MODULE ADDDYNAMICARRAY__genmod diff --git a/x64/Debug/adddynamicarray__genmod.mod b/x64/Debug/adddynamicarray__genmod.mod new file mode 100644 index 0000000..b43fc5a Binary files /dev/null and b/x64/Debug/adddynamicarray__genmod.mod differ diff --git a/x64/Debug/airpump_code__genmod.f90 b/x64/Debug/airpump_code__genmod.f90 new file mode 100644 index 0000000..ce2128c --- /dev/null +++ b/x64/Debug/airpump_code__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:34 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE AIRPUMP_CODE__genmod + INTERFACE + SUBROUTINE AIRPUMP_CODE + END SUBROUTINE AIRPUMP_CODE + END INTERFACE + END MODULE AIRPUMP_CODE__genmod diff --git a/x64/Debug/airpump_code__genmod.mod b/x64/Debug/airpump_code__genmod.mod new file mode 100644 index 0000000..6cfdea8 Binary files /dev/null and b/x64/Debug/airpump_code__genmod.mod differ diff --git a/x64/Debug/airpump_code_choke__genmod.f90 b/x64/Debug/airpump_code_choke__genmod.f90 new file mode 100644 index 0000000..c4aae5e --- /dev/null +++ b/x64/Debug/airpump_code_choke__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:39 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE AIRPUMP_CODE_CHOKE__genmod + INTERFACE + SUBROUTINE AIRPUMP_CODE_CHOKE(CHNUMBER) + INTEGER(KIND=4) :: CHNUMBER + END SUBROUTINE AIRPUMP_CODE_CHOKE + END INTERFACE + END MODULE AIRPUMP_CODE_CHOKE__genmod diff --git a/x64/Debug/airpump_code_choke__genmod.mod b/x64/Debug/airpump_code_choke__genmod.mod new file mode 100644 index 0000000..7ee71a5 Binary files /dev/null and b/x64/Debug/airpump_code_choke__genmod.mod differ diff --git a/x64/Debug/annular__genmod.f90 b/x64/Debug/annular__genmod.f90 new file mode 100644 index 0000000..943632d --- /dev/null +++ b/x64/Debug/annular__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:36 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE ANNULAR__genmod + INTERFACE + SUBROUTINE ANNULAR + END SUBROUTINE ANNULAR + END INTERFACE + END MODULE ANNULAR__genmod diff --git a/x64/Debug/annular__genmod.mod b/x64/Debug/annular__genmod.mod new file mode 100644 index 0000000..dca3acc Binary files /dev/null and b/x64/Debug/annular__genmod.mod differ diff --git a/x64/Debug/annular_sub__genmod.f90 b/x64/Debug/annular_sub__genmod.f90 new file mode 100644 index 0000000..db3d517 --- /dev/null +++ b/x64/Debug/annular_sub__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:36 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE ANNULAR_SUB__genmod + INTERFACE + SUBROUTINE ANNULAR_SUB + END SUBROUTINE ANNULAR_SUB + END INTERFACE + END MODULE ANNULAR_SUB__genmod diff --git a/x64/Debug/annular_sub__genmod.mod b/x64/Debug/annular_sub__genmod.mod new file mode 100644 index 0000000..42278e4 Binary files /dev/null and b/x64/Debug/annular_sub__genmod.mod differ diff --git a/x64/Debug/annularmain.mod b/x64/Debug/annularmain.mod new file mode 100644 index 0000000..3d4ab82 Binary files /dev/null and b/x64/Debug/annularmain.mod differ diff --git a/x64/Debug/annuluspropertycalculator__genmod.f90 b/x64/Debug/annuluspropertycalculator__genmod.f90 new file mode 100644 index 0000000..3c84da9 --- /dev/null +++ b/x64/Debug/annuluspropertycalculator__genmod.f90 @@ -0,0 +1,13 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:44 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE ANNULUSPROPERTYCALCULATOR__genmod + INTERFACE + SUBROUTINE ANNULUSPROPERTYCALCULATOR(MD,DEN,PRE,TEM) + INTEGER(KIND=4), INTENT(IN) :: MD + REAL(KIND=8), INTENT(INOUT) :: DEN + REAL(KIND=8), INTENT(INOUT) :: PRE + REAL(KIND=8), INTENT(INOUT) :: TEM + END SUBROUTINE ANNULUSPROPERTYCALCULATOR + END INTERFACE + END MODULE ANNULUSPROPERTYCALCULATOR__genmod diff --git a/x64/Debug/annuluspropertycalculator__genmod.mod b/x64/Debug/annuluspropertycalculator__genmod.mod new file mode 100644 index 0000000..2c884de Binary files /dev/null and b/x64/Debug/annuluspropertycalculator__genmod.mod differ diff --git a/x64/Debug/bit_spec__genmod.f90 b/x64/Debug/bit_spec__genmod.f90 new file mode 100644 index 0000000..0ee6931 --- /dev/null +++ b/x64/Debug/bit_spec__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:39 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE BIT_SPEC__genmod + INTERFACE + SUBROUTINE BIT_SPEC + END SUBROUTINE BIT_SPEC + END INTERFACE + END MODULE BIT_SPEC__genmod diff --git a/x64/Debug/bit_spec__genmod.mod b/x64/Debug/bit_spec__genmod.mod new file mode 100644 index 0000000..4cbaeee Binary files /dev/null and b/x64/Debug/bit_spec__genmod.mod differ diff --git a/x64/Debug/bit_specification__genmod.f90 b/x64/Debug/bit_specification__genmod.f90 new file mode 100644 index 0000000..a5653d0 --- /dev/null +++ b/x64/Debug/bit_specification__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:52 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE BIT_SPECIFICATION__genmod + INTERFACE + SUBROUTINE BIT_SPECIFICATION + END SUBROUTINE BIT_SPECIFICATION + END INTERFACE + END MODULE BIT_SPECIFICATION__genmod diff --git a/x64/Debug/bit_specification__genmod.mod b/x64/Debug/bit_specification__genmod.mod new file mode 100644 index 0000000..182ac84 Binary files /dev/null and b/x64/Debug/bit_specification__genmod.mod differ diff --git a/x64/Debug/blindramsmain.mod b/x64/Debug/blindramsmain.mod new file mode 100644 index 0000000..d4cee23 Binary files /dev/null and b/x64/Debug/blindramsmain.mod differ diff --git a/x64/Debug/bop.mod b/x64/Debug/bop.mod new file mode 100644 index 0000000..bec5648 Binary files /dev/null and b/x64/Debug/bop.mod differ diff --git a/x64/Debug/bop_code__genmod.f90 b/x64/Debug/bop_code__genmod.f90 new file mode 100644 index 0000000..4138914 --- /dev/null +++ b/x64/Debug/bop_code__genmod.f90 @@ -0,0 +1,12 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:34 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE BOP_CODE__genmod + INTERFACE + SUBROUTINE BOP_CODE(RAMTYPE,H_RAMBOP,RNUMBER) + INTEGER(KIND=4) :: RAMTYPE + REAL(KIND=4) :: H_RAMBOP + INTEGER(KIND=4) :: RNUMBER + END SUBROUTINE BOP_CODE + END INTERFACE + END MODULE BOP_CODE__genmod diff --git a/x64/Debug/bop_code__genmod.mod b/x64/Debug/bop_code__genmod.mod new file mode 100644 index 0000000..90ec604 Binary files /dev/null and b/x64/Debug/bop_code__genmod.mod differ diff --git a/x64/Debug/bop_codeannular__genmod.f90 b/x64/Debug/bop_codeannular__genmod.f90 new file mode 100644 index 0000000..fb90d67 --- /dev/null +++ b/x64/Debug/bop_codeannular__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:34 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE BOP_CODEANNULAR__genmod + INTERFACE + SUBROUTINE BOP_CODEANNULAR(RNUMBER) + INTEGER(KIND=4) :: RNUMBER + END SUBROUTINE BOP_CODEANNULAR + END INTERFACE + END MODULE BOP_CODEANNULAR__genmod diff --git a/x64/Debug/bop_codeannular__genmod.mod b/x64/Debug/bop_codeannular__genmod.mod new file mode 100644 index 0000000..5333c34 Binary files /dev/null and b/x64/Debug/bop_codeannular__genmod.mod differ diff --git a/x64/Debug/bop_startup__genmod.f90 b/x64/Debug/bop_startup__genmod.f90 new file mode 100644 index 0000000..42dbd4a --- /dev/null +++ b/x64/Debug/bop_startup__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:26 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE BOP_STARTUP__genmod + INTERFACE + SUBROUTINE BOP_STARTUP + END SUBROUTINE BOP_STARTUP + END INTERFACE + END MODULE BOP_STARTUP__genmod diff --git a/x64/Debug/bop_startup__genmod.mod b/x64/Debug/bop_startup__genmod.mod new file mode 100644 index 0000000..a65acca Binary files /dev/null and b/x64/Debug/bop_startup__genmod.mod differ diff --git a/x64/Debug/bopstackmain.mod b/x64/Debug/bopstackmain.mod new file mode 100644 index 0000000..00ba93c Binary files /dev/null and b/x64/Debug/bopstackmain.mod differ diff --git a/x64/Debug/caccumulator.mod b/x64/Debug/caccumulator.mod new file mode 100644 index 0000000..f9960cc Binary files /dev/null and b/x64/Debug/caccumulator.mod differ diff --git a/x64/Debug/caccumulatorvariables.mod b/x64/Debug/caccumulatorvariables.mod new file mode 100644 index 0000000..580b5c8 Binary files /dev/null and b/x64/Debug/caccumulatorvariables.mod differ diff --git a/x64/Debug/calculate_rop__genmod.f90 b/x64/Debug/calculate_rop__genmod.f90 new file mode 100644 index 0000000..006722c --- /dev/null +++ b/x64/Debug/calculate_rop__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:39 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE CALCULATE_ROP__genmod + INTERFACE + SUBROUTINE CALCULATE_ROP + END SUBROUTINE CALCULATE_ROP + END INTERFACE + END MODULE CALCULATE_ROP__genmod diff --git a/x64/Debug/calculate_rop__genmod.mod b/x64/Debug/calculate_rop__genmod.mod new file mode 100644 index 0000000..fa43c8c Binary files /dev/null and b/x64/Debug/calculate_rop__genmod.mod differ diff --git a/x64/Debug/carrangement.mod b/x64/Debug/carrangement.mod new file mode 100644 index 0000000..322e03f Binary files /dev/null and b/x64/Debug/carrangement.mod differ diff --git a/x64/Debug/cbitproblems.mod b/x64/Debug/cbitproblems.mod new file mode 100644 index 0000000..704a026 Binary files /dev/null and b/x64/Debug/cbitproblems.mod differ diff --git a/x64/Debug/cbitproblemsvariables.mod b/x64/Debug/cbitproblemsvariables.mod new file mode 100644 index 0000000..22ce3ee Binary files /dev/null and b/x64/Debug/cbitproblemsvariables.mod differ diff --git a/x64/Debug/cbooleventhandler.mod b/x64/Debug/cbooleventhandler.mod new file mode 100644 index 0000000..6b77324 Binary files /dev/null and b/x64/Debug/cbooleventhandler.mod differ diff --git a/x64/Debug/cbooleventhandlercollection.mod b/x64/Debug/cbooleventhandlercollection.mod new file mode 100644 index 0000000..0c6900f Binary files /dev/null and b/x64/Debug/cbooleventhandlercollection.mod differ diff --git a/x64/Debug/cbopcontrolpanel.mod b/x64/Debug/cbopcontrolpanel.mod new file mode 100644 index 0000000..a931274 Binary files /dev/null and b/x64/Debug/cbopcontrolpanel.mod differ diff --git a/x64/Debug/cbopcontrolpanelvariables.mod b/x64/Debug/cbopcontrolpanelvariables.mod new file mode 100644 index 0000000..986059d Binary files /dev/null and b/x64/Debug/cbopcontrolpanelvariables.mod differ diff --git a/x64/Debug/cbopproblems.mod b/x64/Debug/cbopproblems.mod new file mode 100644 index 0000000..5643f72 Binary files /dev/null and b/x64/Debug/cbopproblems.mod differ diff --git a/x64/Debug/cbopproblemsvariables.mod b/x64/Debug/cbopproblemsvariables.mod new file mode 100644 index 0000000..cb7bf41 Binary files /dev/null and b/x64/Debug/cbopproblemsvariables.mod differ diff --git a/x64/Debug/cbopstack.mod b/x64/Debug/cbopstack.mod new file mode 100644 index 0000000..225932d Binary files /dev/null and b/x64/Debug/cbopstack.mod differ diff --git a/x64/Debug/cbopstackvariables.mod b/x64/Debug/cbopstackvariables.mod new file mode 100644 index 0000000..b83b35f Binary files /dev/null and b/x64/Debug/cbopstackvariables.mod differ diff --git a/x64/Debug/cbucketenum.mod b/x64/Debug/cbucketenum.mod new file mode 100644 index 0000000..383d9a7 Binary files /dev/null and b/x64/Debug/cbucketenum.mod differ diff --git a/x64/Debug/cbucketenumvariables.mod b/x64/Debug/cbucketenumvariables.mod new file mode 100644 index 0000000..a8fe8d3 Binary files /dev/null and b/x64/Debug/cbucketenumvariables.mod differ diff --git a/x64/Debug/ccasinglinerchoke.mod b/x64/Debug/ccasinglinerchoke.mod new file mode 100644 index 0000000..8b225cd Binary files /dev/null and b/x64/Debug/ccasinglinerchoke.mod differ diff --git a/x64/Debug/ccasinglinerchokevariables.mod b/x64/Debug/ccasinglinerchokevariables.mod new file mode 100644 index 0000000..71d13bb Binary files /dev/null and b/x64/Debug/ccasinglinerchokevariables.mod differ diff --git a/x64/Debug/cchokecontrolpanel.mod b/x64/Debug/cchokecontrolpanel.mod new file mode 100644 index 0000000..c3cbc17 Binary files /dev/null and b/x64/Debug/cchokecontrolpanel.mod differ diff --git a/x64/Debug/cchokecontrolpanelvariables.mod b/x64/Debug/cchokecontrolpanelvariables.mod new file mode 100644 index 0000000..87399fc Binary files /dev/null and b/x64/Debug/cchokecontrolpanelvariables.mod differ diff --git a/x64/Debug/cchokemanifold.mod b/x64/Debug/cchokemanifold.mod new file mode 100644 index 0000000..82ea2ab Binary files /dev/null and b/x64/Debug/cchokemanifold.mod differ diff --git a/x64/Debug/cchokemanifoldvariables.mod b/x64/Debug/cchokemanifoldvariables.mod new file mode 100644 index 0000000..70a4fa7 Binary files /dev/null and b/x64/Debug/cchokemanifoldvariables.mod differ diff --git a/x64/Debug/cchokeproblems.mod b/x64/Debug/cchokeproblems.mod new file mode 100644 index 0000000..42dd4c1 Binary files /dev/null and b/x64/Debug/cchokeproblems.mod differ diff --git a/x64/Debug/cchokeproblemsvariables.mod b/x64/Debug/cchokeproblemsvariables.mod new file mode 100644 index 0000000..828ea00 Binary files /dev/null and b/x64/Debug/cchokeproblemsvariables.mod differ diff --git a/x64/Debug/cclosekellycocklednotification.mod b/x64/Debug/cclosekellycocklednotification.mod new file mode 100644 index 0000000..38cae60 Binary files /dev/null and b/x64/Debug/cclosekellycocklednotification.mod differ diff --git a/x64/Debug/cclosekellycocklednotificationvariables.mod b/x64/Debug/cclosekellycocklednotificationvariables.mod new file mode 100644 index 0000000..cb1a9fd Binary files /dev/null and b/x64/Debug/cclosekellycocklednotificationvariables.mod differ diff --git a/x64/Debug/cclosesafetyvalvelednotification.mod b/x64/Debug/cclosesafetyvalvelednotification.mod new file mode 100644 index 0000000..8af5b66 Binary files /dev/null and b/x64/Debug/cclosesafetyvalvelednotification.mod differ diff --git a/x64/Debug/cclosesafetyvalvelednotificationvariables.mod b/x64/Debug/cclosesafetyvalvelednotificationvariables.mod new file mode 100644 index 0000000..184c4d3 Binary files /dev/null and b/x64/Debug/cclosesafetyvalvelednotificationvariables.mod differ diff --git a/x64/Debug/ccommon.mod b/x64/Debug/ccommon.mod new file mode 100644 index 0000000..44629bf Binary files /dev/null and b/x64/Debug/ccommon.mod differ diff --git a/x64/Debug/ccommonvariables.mod b/x64/Debug/ccommonvariables.mod new file mode 100644 index 0000000..f63ab6f Binary files /dev/null and b/x64/Debug/ccommonvariables.mod differ diff --git a/x64/Debug/cdatadisplayconsole.mod b/x64/Debug/cdatadisplayconsole.mod new file mode 100644 index 0000000..747d62a Binary files /dev/null and b/x64/Debug/cdatadisplayconsole.mod differ diff --git a/x64/Debug/cdatadisplayconsolevariables.mod b/x64/Debug/cdatadisplayconsolevariables.mod new file mode 100644 index 0000000..6b10338 Binary files /dev/null and b/x64/Debug/cdatadisplayconsolevariables.mod differ diff --git a/x64/Debug/cdoubleeventhandler.mod b/x64/Debug/cdoubleeventhandler.mod new file mode 100644 index 0000000..f82defc Binary files /dev/null and b/x64/Debug/cdoubleeventhandler.mod differ diff --git a/x64/Debug/cdoubleeventhandlercollection.mod b/x64/Debug/cdoubleeventhandlercollection.mod new file mode 100644 index 0000000..2e55eda Binary files /dev/null and b/x64/Debug/cdoubleeventhandlercollection.mod differ diff --git a/x64/Debug/cdownhole.mod b/x64/Debug/cdownhole.mod new file mode 100644 index 0000000..5a0f553 Binary files /dev/null and b/x64/Debug/cdownhole.mod differ diff --git a/x64/Debug/cdownholeactions.mod b/x64/Debug/cdownholeactions.mod new file mode 100644 index 0000000..53fd8e8 Binary files /dev/null and b/x64/Debug/cdownholeactions.mod differ diff --git a/x64/Debug/cdownholetypes.mod b/x64/Debug/cdownholetypes.mod new file mode 100644 index 0000000..c66e01b Binary files /dev/null and b/x64/Debug/cdownholetypes.mod differ diff --git a/x64/Debug/cdownholevariables.mod b/x64/Debug/cdownholevariables.mod new file mode 100644 index 0000000..e0ba146 Binary files /dev/null and b/x64/Debug/cdownholevariables.mod differ diff --git a/x64/Debug/cdrillingconsole.mod b/x64/Debug/cdrillingconsole.mod new file mode 100644 index 0000000..c1a27bc Binary files /dev/null and b/x64/Debug/cdrillingconsole.mod differ diff --git a/x64/Debug/cdrillingconsolevariables.mod b/x64/Debug/cdrillingconsolevariables.mod new file mode 100644 index 0000000..afd6322 Binary files /dev/null and b/x64/Debug/cdrillingconsolevariables.mod differ diff --git a/x64/Debug/cdrillstemproblems.mod b/x64/Debug/cdrillstemproblems.mod new file mode 100644 index 0000000..8747afb Binary files /dev/null and b/x64/Debug/cdrillstemproblems.mod differ diff --git a/x64/Debug/cdrillstemproblemsvariables.mod b/x64/Debug/cdrillstemproblemsvariables.mod new file mode 100644 index 0000000..c1fdf69 Binary files /dev/null and b/x64/Debug/cdrillstemproblemsvariables.mod differ diff --git a/x64/Debug/cdrillwatch.mod b/x64/Debug/cdrillwatch.mod new file mode 100644 index 0000000..0bd61af Binary files /dev/null and b/x64/Debug/cdrillwatch.mod differ diff --git a/x64/Debug/cdrillwatchvariables.mod b/x64/Debug/cdrillwatchvariables.mod new file mode 100644 index 0000000..a864b67 Binary files /dev/null and b/x64/Debug/cdrillwatchvariables.mod differ diff --git a/x64/Debug/celevatorconnectionenum.mod b/x64/Debug/celevatorconnectionenum.mod new file mode 100644 index 0000000..b03f161 Binary files /dev/null and b/x64/Debug/celevatorconnectionenum.mod differ diff --git a/x64/Debug/celevatorconnectionenumvariables.mod b/x64/Debug/celevatorconnectionenumvariables.mod new file mode 100644 index 0000000..80292d4 Binary files /dev/null and b/x64/Debug/celevatorconnectionenumvariables.mod differ diff --git a/x64/Debug/celevatorenum.mod b/x64/Debug/celevatorenum.mod new file mode 100644 index 0000000..83f7db9 Binary files /dev/null and b/x64/Debug/celevatorenum.mod differ diff --git a/x64/Debug/celevatorenumvariables.mod b/x64/Debug/celevatorenumvariables.mod new file mode 100644 index 0000000..a677b49 Binary files /dev/null and b/x64/Debug/celevatorenumvariables.mod differ diff --git a/x64/Debug/cequipmentsconstants.mod b/x64/Debug/cequipmentsconstants.mod new file mode 100644 index 0000000..25016d7 Binary files /dev/null and b/x64/Debug/cequipmentsconstants.mod differ diff --git a/x64/Debug/cerror.mod b/x64/Debug/cerror.mod new file mode 100644 index 0000000..3102891 Binary files /dev/null and b/x64/Debug/cerror.mod differ diff --git a/x64/Debug/cfillmouseholelednotification.mod b/x64/Debug/cfillmouseholelednotification.mod new file mode 100644 index 0000000..7ea298a Binary files /dev/null and b/x64/Debug/cfillmouseholelednotification.mod differ diff --git a/x64/Debug/cfillmouseholelednotificationvariables.mod b/x64/Debug/cfillmouseholelednotificationvariables.mod new file mode 100644 index 0000000..5f339dd Binary files /dev/null and b/x64/Debug/cfillmouseholelednotificationvariables.mod differ diff --git a/x64/Debug/cfillupheadpermission.mod b/x64/Debug/cfillupheadpermission.mod new file mode 100644 index 0000000..2fa3900 Binary files /dev/null and b/x64/Debug/cfillupheadpermission.mod differ diff --git a/x64/Debug/cfillupheadpermissionvariables.mod b/x64/Debug/cfillupheadpermissionvariables.mod new file mode 100644 index 0000000..9b020d2 Binary files /dev/null and b/x64/Debug/cfillupheadpermissionvariables.mod differ diff --git a/x64/Debug/cflowkellydisconnectenum.mod b/x64/Debug/cflowkellydisconnectenum.mod new file mode 100644 index 0000000..536be07 Binary files /dev/null and b/x64/Debug/cflowkellydisconnectenum.mod differ diff --git a/x64/Debug/cflowkellydisconnectenumvariables.mod b/x64/Debug/cflowkellydisconnectenumvariables.mod new file mode 100644 index 0000000..27f0530 Binary files /dev/null and b/x64/Debug/cflowkellydisconnectenumvariables.mod differ diff --git a/x64/Debug/cflowpipedisconnectenum.mod b/x64/Debug/cflowpipedisconnectenum.mod new file mode 100644 index 0000000..e642c93 Binary files /dev/null and b/x64/Debug/cflowpipedisconnectenum.mod differ diff --git a/x64/Debug/cflowpipedisconnectenumvariables.mod b/x64/Debug/cflowpipedisconnectenumvariables.mod new file mode 100644 index 0000000..163b18c Binary files /dev/null and b/x64/Debug/cflowpipedisconnectenumvariables.mod differ diff --git a/x64/Debug/cformation.mod b/x64/Debug/cformation.mod new file mode 100644 index 0000000..d44d952 Binary files /dev/null and b/x64/Debug/cformation.mod differ diff --git a/x64/Debug/cformationvariables.mod b/x64/Debug/cformationvariables.mod new file mode 100644 index 0000000..c7b40ed Binary files /dev/null and b/x64/Debug/cformationvariables.mod differ diff --git a/x64/Debug/cgaugesproblems.mod b/x64/Debug/cgaugesproblems.mod new file mode 100644 index 0000000..6bea0e6 Binary files /dev/null and b/x64/Debug/cgaugesproblems.mod differ diff --git a/x64/Debug/cgaugesproblemsvariables.mod b/x64/Debug/cgaugesproblemsvariables.mod new file mode 100644 index 0000000..4b8bbc9 Binary files /dev/null and b/x64/Debug/cgaugesproblemsvariables.mod differ diff --git a/x64/Debug/cheadenum.mod b/x64/Debug/cheadenum.mod new file mode 100644 index 0000000..41dfe36 Binary files /dev/null and b/x64/Debug/cheadenum.mod differ diff --git a/x64/Debug/cheadenumvariables.mod b/x64/Debug/cheadenumvariables.mod new file mode 100644 index 0000000..485b50d Binary files /dev/null and b/x64/Debug/cheadenumvariables.mod differ diff --git a/x64/Debug/choisting.mod b/x64/Debug/choisting.mod new file mode 100644 index 0000000..7f83a95 Binary files /dev/null and b/x64/Debug/choisting.mod differ diff --git a/x64/Debug/choistingproblems.mod b/x64/Debug/choistingproblems.mod new file mode 100644 index 0000000..69abf55 Binary files /dev/null and b/x64/Debug/choistingproblems.mod differ diff --git a/x64/Debug/choistingproblemsvariables.mod b/x64/Debug/choistingproblemsvariables.mod new file mode 100644 index 0000000..71350ca Binary files /dev/null and b/x64/Debug/choistingproblemsvariables.mod differ diff --git a/x64/Debug/choistingvariables.mod b/x64/Debug/choistingvariables.mod new file mode 100644 index 0000000..6380e32 Binary files /dev/null and b/x64/Debug/choistingvariables.mod differ diff --git a/x64/Debug/choke.mod b/x64/Debug/choke.mod new file mode 100644 index 0000000..b8f2cf6 Binary files /dev/null and b/x64/Debug/choke.mod differ diff --git a/x64/Debug/choke_gassound__genmod.f90 b/x64/Debug/choke_gassound__genmod.f90 new file mode 100644 index 0000000..a987dab --- /dev/null +++ b/x64/Debug/choke_gassound__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:29 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE CHOKE_GASSOUND__genmod + INTERFACE + SUBROUTINE CHOKE_GASSOUND + END SUBROUTINE CHOKE_GASSOUND + END INTERFACE + END MODULE CHOKE_GASSOUND__genmod diff --git a/x64/Debug/choke_gassound__genmod.mod b/x64/Debug/choke_gassound__genmod.mod new file mode 100644 index 0000000..6828b9f Binary files /dev/null and b/x64/Debug/choke_gassound__genmod.mod differ diff --git a/x64/Debug/choke_line__genmod.f90 b/x64/Debug/choke_line__genmod.f90 new file mode 100644 index 0000000..d349590 --- /dev/null +++ b/x64/Debug/choke_line__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:43 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE CHOKE_LINE__genmod + INTERFACE + SUBROUTINE CHOKE_LINE + END SUBROUTINE CHOKE_LINE + END INTERFACE + END MODULE CHOKE_LINE__genmod diff --git a/x64/Debug/choke_line__genmod.mod b/x64/Debug/choke_line__genmod.mod new file mode 100644 index 0000000..9c5dc59 Binary files /dev/null and b/x64/Debug/choke_line__genmod.mod differ diff --git a/x64/Debug/choke_line_sub__genmod.f90 b/x64/Debug/choke_line_sub__genmod.f90 new file mode 100644 index 0000000..b222f7e --- /dev/null +++ b/x64/Debug/choke_line_sub__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:43 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE CHOKE_LINE_SUB__genmod + INTERFACE + SUBROUTINE CHOKE_LINE_SUB + END SUBROUTINE CHOKE_LINE_SUB + END INTERFACE + END MODULE CHOKE_LINE_SUB__genmod diff --git a/x64/Debug/choke_line_sub__genmod.mod b/x64/Debug/choke_line_sub__genmod.mod new file mode 100644 index 0000000..6cb2385 Binary files /dev/null and b/x64/Debug/choke_line_sub__genmod.mod differ diff --git a/x64/Debug/choke_startup__genmod.f90 b/x64/Debug/choke_startup__genmod.f90 new file mode 100644 index 0000000..d289e65 --- /dev/null +++ b/x64/Debug/choke_startup__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:36 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE CHOKE_STARTUP__genmod + INTERFACE + SUBROUTINE CHOKE_STARTUP + END SUBROUTINE CHOKE_STARTUP + END INTERFACE + END MODULE CHOKE_STARTUP__genmod diff --git a/x64/Debug/choke_startup__genmod.mod b/x64/Debug/choke_startup__genmod.mod new file mode 100644 index 0000000..195b49f Binary files /dev/null and b/x64/Debug/choke_startup__genmod.mod differ diff --git a/x64/Debug/chokecontrolmain.mod b/x64/Debug/chokecontrolmain.mod new file mode 100644 index 0000000..e116305 Binary files /dev/null and b/x64/Debug/chokecontrolmain.mod differ diff --git a/x64/Debug/chokelinemain.mod b/x64/Debug/chokelinemain.mod new file mode 100644 index 0000000..ac7f57d Binary files /dev/null and b/x64/Debug/chokelinemain.mod differ diff --git a/x64/Debug/chokelinemud__genmod.f90 b/x64/Debug/chokelinemud__genmod.f90 new file mode 100644 index 0000000..3054d15 --- /dev/null +++ b/x64/Debug/chokelinemud__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:29 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE CHOKELINEMUD__genmod + INTERFACE + SUBROUTINE CHOKELINEMUD + END SUBROUTINE CHOKELINEMUD + END INTERFACE + END MODULE CHOKELINEMUD__genmod diff --git a/x64/Debug/chokelinemud__genmod.mod b/x64/Debug/chokelinemud__genmod.mod new file mode 100644 index 0000000..20e0746 Binary files /dev/null and b/x64/Debug/chokelinemud__genmod.mod differ diff --git a/x64/Debug/chokevariables.mod b/x64/Debug/chokevariables.mod new file mode 100644 index 0000000..435da10 Binary files /dev/null and b/x64/Debug/chokevariables.mod differ diff --git a/x64/Debug/chook.mod b/x64/Debug/chook.mod new file mode 100644 index 0000000..270b53c Binary files /dev/null and b/x64/Debug/chook.mod differ diff --git a/x64/Debug/chookactions.mod b/x64/Debug/chookactions.mod new file mode 100644 index 0000000..35cb80f Binary files /dev/null and b/x64/Debug/chookactions.mod differ diff --git a/x64/Debug/chookheight.mod b/x64/Debug/chookheight.mod new file mode 100644 index 0000000..f966859 Binary files /dev/null and b/x64/Debug/chookheight.mod differ diff --git a/x64/Debug/chookvariables.mod b/x64/Debug/chookvariables.mod new file mode 100644 index 0000000..4913be3 Binary files /dev/null and b/x64/Debug/chookvariables.mod differ diff --git a/x64/Debug/ciactionreference.mod b/x64/Debug/ciactionreference.mod new file mode 100644 index 0000000..71b81eb Binary files /dev/null and b/x64/Debug/ciactionreference.mod differ diff --git a/x64/Debug/cibopenum.mod b/x64/Debug/cibopenum.mod new file mode 100644 index 0000000..ca68e7e Binary files /dev/null and b/x64/Debug/cibopenum.mod differ diff --git a/x64/Debug/cibopenumvariables.mod b/x64/Debug/cibopenumvariables.mod new file mode 100644 index 0000000..dfd23f7 Binary files /dev/null and b/x64/Debug/cibopenumvariables.mod differ diff --git a/x64/Debug/cibopheight.mod b/x64/Debug/cibopheight.mod new file mode 100644 index 0000000..b360b2e Binary files /dev/null and b/x64/Debug/cibopheight.mod differ diff --git a/x64/Debug/cinstallfillupheadpermission.mod b/x64/Debug/cinstallfillupheadpermission.mod new file mode 100644 index 0000000..763298d Binary files /dev/null and b/x64/Debug/cinstallfillupheadpermission.mod differ diff --git a/x64/Debug/cinstallfillupheadpermissionvariables.mod b/x64/Debug/cinstallfillupheadpermissionvariables.mod new file mode 100644 index 0000000..f565ada Binary files /dev/null and b/x64/Debug/cinstallfillupheadpermissionvariables.mod differ diff --git a/x64/Debug/cinstallmudbucketpermission.mod b/x64/Debug/cinstallmudbucketpermission.mod new file mode 100644 index 0000000..94e4de8 Binary files /dev/null and b/x64/Debug/cinstallmudbucketpermission.mod differ diff --git a/x64/Debug/cinstallmudbucketpermissionvariables.mod b/x64/Debug/cinstallmudbucketpermissionvariables.mod new file mode 100644 index 0000000..e65d354 Binary files /dev/null and b/x64/Debug/cinstallmudbucketpermissionvariables.mod differ diff --git a/x64/Debug/cintegerarrayeventhandler.mod b/x64/Debug/cintegerarrayeventhandler.mod new file mode 100644 index 0000000..a024e15 Binary files /dev/null and b/x64/Debug/cintegerarrayeventhandler.mod differ diff --git a/x64/Debug/cintegerarrayeventhandlercollection.mod b/x64/Debug/cintegerarrayeventhandlercollection.mod new file mode 100644 index 0000000..0cf2917 Binary files /dev/null and b/x64/Debug/cintegerarrayeventhandlercollection.mod differ diff --git a/x64/Debug/cintegereventhandler.mod b/x64/Debug/cintegereventhandler.mod new file mode 100644 index 0000000..5349e0a Binary files /dev/null and b/x64/Debug/cintegereventhandler.mod differ diff --git a/x64/Debug/cintegereventhandlercollection.mod b/x64/Debug/cintegereventhandlercollection.mod new file mode 100644 index 0000000..9d61b72 Binary files /dev/null and b/x64/Debug/cintegereventhandlercollection.mod differ diff --git a/x64/Debug/circulationcodeselect__genmod.f90 b/x64/Debug/circulationcodeselect__genmod.f90 new file mode 100644 index 0000000..63271dd --- /dev/null +++ b/x64/Debug/circulationcodeselect__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:40 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE CIRCULATIONCODESELECT__genmod + INTERFACE + SUBROUTINE CIRCULATIONCODESELECT + END SUBROUTINE CIRCULATIONCODESELECT + END INTERFACE + END MODULE CIRCULATIONCODESELECT__genmod diff --git a/x64/Debug/circulationcodeselect__genmod.mod b/x64/Debug/circulationcodeselect__genmod.mod new file mode 100644 index 0000000..9a0b70d Binary files /dev/null and b/x64/Debug/circulationcodeselect__genmod.mod differ diff --git a/x64/Debug/ciriboplednotification.mod b/x64/Debug/ciriboplednotification.mod new file mode 100644 index 0000000..f723371 Binary files /dev/null and b/x64/Debug/ciriboplednotification.mod differ diff --git a/x64/Debug/ciriboplednotificationvariables.mod b/x64/Debug/ciriboplednotificationvariables.mod new file mode 100644 index 0000000..ff0c98c Binary files /dev/null and b/x64/Debug/ciriboplednotificationvariables.mod differ diff --git a/x64/Debug/ciriboppermission.mod b/x64/Debug/ciriboppermission.mod new file mode 100644 index 0000000..9b67526 Binary files /dev/null and b/x64/Debug/ciriboppermission.mod differ diff --git a/x64/Debug/ciriboppermissionvariables.mod b/x64/Debug/ciriboppermissionvariables.mod new file mode 100644 index 0000000..829facf Binary files /dev/null and b/x64/Debug/ciriboppermissionvariables.mod differ diff --git a/x64/Debug/cirsafetyvalvelednotification.mod b/x64/Debug/cirsafetyvalvelednotification.mod new file mode 100644 index 0000000..11ceb2a Binary files /dev/null and b/x64/Debug/cirsafetyvalvelednotification.mod differ diff --git a/x64/Debug/cirsafetyvalvelednotificationvariables.mod b/x64/Debug/cirsafetyvalvelednotificationvariables.mod new file mode 100644 index 0000000..d3f4d80 Binary files /dev/null and b/x64/Debug/cirsafetyvalvelednotificationvariables.mod differ diff --git a/x64/Debug/cirsafetyvalvepermission.mod b/x64/Debug/cirsafetyvalvepermission.mod new file mode 100644 index 0000000..d59f2d5 Binary files /dev/null and b/x64/Debug/cirsafetyvalvepermission.mod differ diff --git a/x64/Debug/cirsafetyvalvepermissionvariables.mod b/x64/Debug/cirsafetyvalvepermissionvariables.mod new file mode 100644 index 0000000..b2f8378 Binary files /dev/null and b/x64/Debug/cirsafetyvalvepermissionvariables.mod differ diff --git a/x64/Debug/ckellyconnectionenum.mod b/x64/Debug/ckellyconnectionenum.mod new file mode 100644 index 0000000..768bb04 Binary files /dev/null and b/x64/Debug/ckellyconnectionenum.mod differ diff --git a/x64/Debug/ckellyconnectionenumvariables.mod b/x64/Debug/ckellyconnectionenumvariables.mod new file mode 100644 index 0000000..09431c9 Binary files /dev/null and b/x64/Debug/ckellyconnectionenumvariables.mod differ diff --git a/x64/Debug/ckellyenum.mod b/x64/Debug/ckellyenum.mod new file mode 100644 index 0000000..20a8c99 Binary files /dev/null and b/x64/Debug/ckellyenum.mod differ diff --git a/x64/Debug/ckellyenumvariables.mod b/x64/Debug/ckellyenumvariables.mod new file mode 100644 index 0000000..c5cc1ee Binary files /dev/null and b/x64/Debug/ckellyenumvariables.mod differ diff --git a/x64/Debug/ckickproblems.mod b/x64/Debug/ckickproblems.mod new file mode 100644 index 0000000..2849360 Binary files /dev/null and b/x64/Debug/ckickproblems.mod differ diff --git a/x64/Debug/ckickproblemsvariables.mod b/x64/Debug/ckickproblemsvariables.mod new file mode 100644 index 0000000..cd2db96 Binary files /dev/null and b/x64/Debug/ckickproblemsvariables.mod differ diff --git a/x64/Debug/clatchlednotification.mod b/x64/Debug/clatchlednotification.mod new file mode 100644 index 0000000..41b1bd2 Binary files /dev/null and b/x64/Debug/clatchlednotification.mod differ diff --git a/x64/Debug/clatchlednotificationvariables.mod b/x64/Debug/clatchlednotificationvariables.mod new file mode 100644 index 0000000..e22de4e Binary files /dev/null and b/x64/Debug/clatchlednotificationvariables.mod differ diff --git a/x64/Debug/clesson.mod b/x64/Debug/clesson.mod new file mode 100644 index 0000000..f0521ee Binary files /dev/null and b/x64/Debug/clesson.mod differ diff --git a/x64/Debug/clessonvariables.mod b/x64/Debug/clessonvariables.mod new file mode 100644 index 0000000..fa49aa6 Binary files /dev/null and b/x64/Debug/clessonvariables.mod differ diff --git a/x64/Debug/clog1.mod b/x64/Debug/clog1.mod new file mode 100644 index 0000000..219384a Binary files /dev/null and b/x64/Debug/clog1.mod differ diff --git a/x64/Debug/clog2.mod b/x64/Debug/clog2.mod new file mode 100644 index 0000000..b37b4eb Binary files /dev/null and b/x64/Debug/clog2.mod differ diff --git a/x64/Debug/clog3.mod b/x64/Debug/clog3.mod new file mode 100644 index 0000000..4340f03 Binary files /dev/null and b/x64/Debug/clog3.mod differ diff --git a/x64/Debug/clog4.mod b/x64/Debug/clog4.mod new file mode 100644 index 0000000..483cc5b Binary files /dev/null and b/x64/Debug/clog4.mod differ diff --git a/x64/Debug/clog5.mod b/x64/Debug/clog5.mod new file mode 100644 index 0000000..ca679a4 Binary files /dev/null and b/x64/Debug/clog5.mod differ diff --git a/x64/Debug/clostproblems.mod b/x64/Debug/clostproblems.mod new file mode 100644 index 0000000..6465f77 Binary files /dev/null and b/x64/Debug/clostproblems.mod differ diff --git a/x64/Debug/clostproblemsvariables.mod b/x64/Debug/clostproblemsvariables.mod new file mode 100644 index 0000000..830be42 Binary files /dev/null and b/x64/Debug/clostproblemsvariables.mod differ diff --git a/x64/Debug/cmanifolds.mod b/x64/Debug/cmanifolds.mod new file mode 100644 index 0000000..171ad89 Binary files /dev/null and b/x64/Debug/cmanifolds.mod differ diff --git a/x64/Debug/cmouseholeenum.mod b/x64/Debug/cmouseholeenum.mod new file mode 100644 index 0000000..357e197 Binary files /dev/null and b/x64/Debug/cmouseholeenum.mod differ diff --git a/x64/Debug/cmouseholeenumvariables.mod b/x64/Debug/cmouseholeenumvariables.mod new file mode 100644 index 0000000..fcc00d8 Binary files /dev/null and b/x64/Debug/cmouseholeenumvariables.mod differ diff --git a/x64/Debug/cmudproperties.mod b/x64/Debug/cmudproperties.mod new file mode 100644 index 0000000..2707a63 Binary files /dev/null and b/x64/Debug/cmudproperties.mod differ diff --git a/x64/Debug/cmudpropertiesvariables.mod b/x64/Debug/cmudpropertiesvariables.mod new file mode 100644 index 0000000..e766575 Binary files /dev/null and b/x64/Debug/cmudpropertiesvariables.mod differ diff --git a/x64/Debug/cmudtreatmentproblems.mod b/x64/Debug/cmudtreatmentproblems.mod new file mode 100644 index 0000000..3a26a85 Binary files /dev/null and b/x64/Debug/cmudtreatmentproblems.mod differ diff --git a/x64/Debug/cmudtreatmentproblemsvariables.mod b/x64/Debug/cmudtreatmentproblemsvariables.mod new file mode 100644 index 0000000..1f4546c Binary files /dev/null and b/x64/Debug/cmudtreatmentproblemsvariables.mod differ diff --git a/x64/Debug/cnearfloorconnection.mod b/x64/Debug/cnearfloorconnection.mod new file mode 100644 index 0000000..75bc04f Binary files /dev/null and b/x64/Debug/cnearfloorconnection.mod differ diff --git a/x64/Debug/copenkellycocklednotification.mod b/x64/Debug/copenkellycocklednotification.mod new file mode 100644 index 0000000..6eeb2f8 Binary files /dev/null and b/x64/Debug/copenkellycocklednotification.mod differ diff --git a/x64/Debug/copenkellycocklednotificationvariables.mod b/x64/Debug/copenkellycocklednotificationvariables.mod new file mode 100644 index 0000000..af85329 Binary files /dev/null and b/x64/Debug/copenkellycocklednotificationvariables.mod differ diff --git a/x64/Debug/copensafetyvalvelednotification.mod b/x64/Debug/copensafetyvalvelednotification.mod new file mode 100644 index 0000000..c0372ce Binary files /dev/null and b/x64/Debug/copensafetyvalvelednotification.mod differ diff --git a/x64/Debug/copensafetyvalvelednotificationvariables.mod b/x64/Debug/copensafetyvalvelednotificationvariables.mod new file mode 100644 index 0000000..bfdbbe0 Binary files /dev/null and b/x64/Debug/copensafetyvalvelednotificationvariables.mod differ diff --git a/x64/Debug/coperationconditionenum.mod b/x64/Debug/coperationconditionenum.mod new file mode 100644 index 0000000..7f05395 Binary files /dev/null and b/x64/Debug/coperationconditionenum.mod differ diff --git a/x64/Debug/coperationconditionenumvariables.mod b/x64/Debug/coperationconditionenumvariables.mod new file mode 100644 index 0000000..95f6320 Binary files /dev/null and b/x64/Debug/coperationconditionenumvariables.mod differ diff --git a/x64/Debug/coperationscenariosmain.mod b/x64/Debug/coperationscenariosmain.mod new file mode 100644 index 0000000..1bf047c Binary files /dev/null and b/x64/Debug/coperationscenariosmain.mod differ diff --git a/x64/Debug/coperationscenariossettings.mod b/x64/Debug/coperationscenariossettings.mod new file mode 100644 index 0000000..7470c5a Binary files /dev/null and b/x64/Debug/coperationscenariossettings.mod differ diff --git a/x64/Debug/coperationscenariosvariables.mod b/x64/Debug/coperationscenariosvariables.mod new file mode 100644 index 0000000..5149d76 Binary files /dev/null and b/x64/Debug/coperationscenariosvariables.mod differ diff --git a/x64/Debug/cotherproblems.mod b/x64/Debug/cotherproblems.mod new file mode 100644 index 0000000..e209c85 Binary files /dev/null and b/x64/Debug/cotherproblems.mod differ diff --git a/x64/Debug/cotherproblemsvariables.mod b/x64/Debug/cotherproblemsvariables.mod new file mode 100644 index 0000000..ba2e0ea Binary files /dev/null and b/x64/Debug/cotherproblemsvariables.mod differ diff --git a/x64/Debug/cpath.mod b/x64/Debug/cpath.mod new file mode 100644 index 0000000..5a3be45 Binary files /dev/null and b/x64/Debug/cpath.mod differ diff --git a/x64/Debug/cpathchangeevents.mod b/x64/Debug/cpathchangeevents.mod new file mode 100644 index 0000000..51da06b Binary files /dev/null and b/x64/Debug/cpathchangeevents.mod differ diff --git a/x64/Debug/cpathgeneration.mod b/x64/Debug/cpathgeneration.mod new file mode 100644 index 0000000..a2d0061 Binary files /dev/null and b/x64/Debug/cpathgeneration.mod differ diff --git a/x64/Debug/cpathgenerationvariables.mod b/x64/Debug/cpathgenerationvariables.mod new file mode 100644 index 0000000..370c079 Binary files /dev/null and b/x64/Debug/cpathgenerationvariables.mod differ diff --git a/x64/Debug/cpower.mod b/x64/Debug/cpower.mod new file mode 100644 index 0000000..71e998a Binary files /dev/null and b/x64/Debug/cpower.mod differ diff --git a/x64/Debug/cpowervariables.mod b/x64/Debug/cpowervariables.mod new file mode 100644 index 0000000..cc02b88 Binary files /dev/null and b/x64/Debug/cpowervariables.mod differ diff --git a/x64/Debug/cproblemdifinition.mod b/x64/Debug/cproblemdifinition.mod new file mode 100644 index 0000000..73fd31c Binary files /dev/null and b/x64/Debug/cproblemdifinition.mod differ diff --git a/x64/Debug/cpumpproblems.mod b/x64/Debug/cpumpproblems.mod new file mode 100644 index 0000000..1521290 Binary files /dev/null and b/x64/Debug/cpumpproblems.mod differ diff --git a/x64/Debug/cpumpproblemsvariables.mod b/x64/Debug/cpumpproblemsvariables.mod new file mode 100644 index 0000000..4ef1d01 Binary files /dev/null and b/x64/Debug/cpumpproblemsvariables.mod differ diff --git a/x64/Debug/cpumps.mod b/x64/Debug/cpumps.mod new file mode 100644 index 0000000..82949b1 Binary files /dev/null and b/x64/Debug/cpumps.mod differ diff --git a/x64/Debug/cpumpsvariables.mod b/x64/Debug/cpumpsvariables.mod new file mode 100644 index 0000000..f3a3185 Binary files /dev/null and b/x64/Debug/cpumpsvariables.mod differ diff --git a/x64/Debug/cquery.mod b/x64/Debug/cquery.mod new file mode 100644 index 0000000..ae55feb Binary files /dev/null and b/x64/Debug/cquery.mod differ diff --git a/x64/Debug/crealeventhandler.mod b/x64/Debug/crealeventhandler.mod new file mode 100644 index 0000000..4c5d0f6 Binary files /dev/null and b/x64/Debug/crealeventhandler.mod differ diff --git a/x64/Debug/crealeventhandlercollection.mod b/x64/Debug/crealeventhandlercollection.mod new file mode 100644 index 0000000..9f7041d Binary files /dev/null and b/x64/Debug/crealeventhandlercollection.mod differ diff --git a/x64/Debug/cremovefillupheadpermission.mod b/x64/Debug/cremovefillupheadpermission.mod new file mode 100644 index 0000000..10aa65f Binary files /dev/null and b/x64/Debug/cremovefillupheadpermission.mod differ diff --git a/x64/Debug/cremovefillupheadpermissionvariables.mod b/x64/Debug/cremovefillupheadpermissionvariables.mod new file mode 100644 index 0000000..9220483 Binary files /dev/null and b/x64/Debug/cremovefillupheadpermissionvariables.mod differ diff --git a/x64/Debug/cremovemudbucketpermission.mod b/x64/Debug/cremovemudbucketpermission.mod new file mode 100644 index 0000000..dce62cc Binary files /dev/null and b/x64/Debug/cremovemudbucketpermission.mod differ diff --git a/x64/Debug/cremovemudbucketpermissionvariables.mod b/x64/Debug/cremovemudbucketpermissionvariables.mod new file mode 100644 index 0000000..4578afb Binary files /dev/null and b/x64/Debug/cremovemudbucketpermissionvariables.mod differ diff --git a/x64/Debug/creservoir.mod b/x64/Debug/creservoir.mod new file mode 100644 index 0000000..36abfe1 Binary files /dev/null and b/x64/Debug/creservoir.mod differ diff --git a/x64/Debug/creservoirvariables.mod b/x64/Debug/creservoirvariables.mod new file mode 100644 index 0000000..710eabe Binary files /dev/null and b/x64/Debug/creservoirvariables.mod differ diff --git a/x64/Debug/crigsize.mod b/x64/Debug/crigsize.mod new file mode 100644 index 0000000..a58c88e Binary files /dev/null and b/x64/Debug/crigsize.mod differ diff --git a/x64/Debug/crigsizevariables.mod b/x64/Debug/crigsizevariables.mod new file mode 100644 index 0000000..1122040 Binary files /dev/null and b/x64/Debug/crigsizevariables.mod differ diff --git a/x64/Debug/crotaryproblems.mod b/x64/Debug/crotaryproblems.mod new file mode 100644 index 0000000..1010c5d Binary files /dev/null and b/x64/Debug/crotaryproblems.mod differ diff --git a/x64/Debug/crotaryproblemsvariables.mod b/x64/Debug/crotaryproblemsvariables.mod new file mode 100644 index 0000000..e0f0ce4 Binary files /dev/null and b/x64/Debug/crotaryproblemsvariables.mod differ diff --git a/x64/Debug/csafetyvalveenum.mod b/x64/Debug/csafetyvalveenum.mod new file mode 100644 index 0000000..d01c583 Binary files /dev/null and b/x64/Debug/csafetyvalveenum.mod differ diff --git a/x64/Debug/csafetyvalveenumvariables.mod b/x64/Debug/csafetyvalveenumvariables.mod new file mode 100644 index 0000000..ecc80b6 Binary files /dev/null and b/x64/Debug/csafetyvalveenumvariables.mod differ diff --git a/x64/Debug/csafetyvalveheight.mod b/x64/Debug/csafetyvalveheight.mod new file mode 100644 index 0000000..9b339fb Binary files /dev/null and b/x64/Debug/csafetyvalveheight.mod differ diff --git a/x64/Debug/cscalerange.mod b/x64/Debug/cscalerange.mod new file mode 100644 index 0000000..505510f Binary files /dev/null and b/x64/Debug/cscalerange.mod differ diff --git a/x64/Debug/cshoe.mod b/x64/Debug/cshoe.mod new file mode 100644 index 0000000..1daeecd Binary files /dev/null and b/x64/Debug/cshoe.mod differ diff --git a/x64/Debug/cshoevariables.mod b/x64/Debug/cshoevariables.mod new file mode 100644 index 0000000..56bf3f6 Binary files /dev/null and b/x64/Debug/cshoevariables.mod differ diff --git a/x64/Debug/csimulationthreads.mod b/x64/Debug/csimulationthreads.mod new file mode 100644 index 0000000..cb48a36 Binary files /dev/null and b/x64/Debug/csimulationthreads.mod differ diff --git a/x64/Debug/csimulationvariables.mod b/x64/Debug/csimulationvariables.mod new file mode 100644 index 0000000..be3aea4 Binary files /dev/null and b/x64/Debug/csimulationvariables.mod differ diff --git a/x64/Debug/cslackoff.mod b/x64/Debug/cslackoff.mod new file mode 100644 index 0000000..9e8dd3b Binary files /dev/null and b/x64/Debug/cslackoff.mod differ diff --git a/x64/Debug/cslipsenum.mod b/x64/Debug/cslipsenum.mod new file mode 100644 index 0000000..8a9220a Binary files /dev/null and b/x64/Debug/cslipsenum.mod differ diff --git a/x64/Debug/cslipsenumvariables.mod b/x64/Debug/cslipsenumvariables.mod new file mode 100644 index 0000000..028d288 Binary files /dev/null and b/x64/Debug/cslipsenumvariables.mod differ diff --git a/x64/Debug/cslipsnotification.mod b/x64/Debug/cslipsnotification.mod new file mode 100644 index 0000000..c483d86 Binary files /dev/null and b/x64/Debug/cslipsnotification.mod differ diff --git a/x64/Debug/cslipsnotificationvariables.mod b/x64/Debug/cslipsnotificationvariables.mod new file mode 100644 index 0000000..efd2023 Binary files /dev/null and b/x64/Debug/cslipsnotificationvariables.mod differ diff --git a/x64/Debug/csounds.mod b/x64/Debug/csounds.mod new file mode 100644 index 0000000..776b9e4 Binary files /dev/null and b/x64/Debug/csounds.mod differ diff --git a/x64/Debug/cstack.mod b/x64/Debug/cstack.mod new file mode 100644 index 0000000..e23f94a Binary files /dev/null and b/x64/Debug/cstack.mod differ diff --git a/x64/Debug/cstandpipemanifold.mod b/x64/Debug/cstandpipemanifold.mod new file mode 100644 index 0000000..88b7660 Binary files /dev/null and b/x64/Debug/cstandpipemanifold.mod differ diff --git a/x64/Debug/cstandpipemanifoldvariables.mod b/x64/Debug/cstandpipemanifoldvariables.mod new file mode 100644 index 0000000..6586b96 Binary files /dev/null and b/x64/Debug/cstandpipemanifoldvariables.mod differ diff --git a/x64/Debug/cstandrack.mod b/x64/Debug/cstandrack.mod new file mode 100644 index 0000000..1f796cd Binary files /dev/null and b/x64/Debug/cstandrack.mod differ diff --git a/x64/Debug/cstringconfiguration.mod b/x64/Debug/cstringconfiguration.mod new file mode 100644 index 0000000..ee9a5ed Binary files /dev/null and b/x64/Debug/cstringconfiguration.mod differ diff --git a/x64/Debug/cstringconfigurationvariables.mod b/x64/Debug/cstringconfigurationvariables.mod new file mode 100644 index 0000000..8963909 Binary files /dev/null and b/x64/Debug/cstringconfigurationvariables.mod differ diff --git a/x64/Debug/cstringpressure.mod b/x64/Debug/cstringpressure.mod new file mode 100644 index 0000000..c0ab35b Binary files /dev/null and b/x64/Debug/cstringpressure.mod differ diff --git a/x64/Debug/cstringupdate.mod b/x64/Debug/cstringupdate.mod new file mode 100644 index 0000000..eb899a9 Binary files /dev/null and b/x64/Debug/cstringupdate.mod differ diff --git a/x64/Debug/cstringupdatevariables.mod b/x64/Debug/cstringupdatevariables.mod new file mode 100644 index 0000000..77a4b93 Binary files /dev/null and b/x64/Debug/cstringupdatevariables.mod differ diff --git a/x64/Debug/cstudentstation.mod b/x64/Debug/cstudentstation.mod new file mode 100644 index 0000000..7b50015 Binary files /dev/null and b/x64/Debug/cstudentstation.mod differ diff --git a/x64/Debug/cstudentstationvariables.mod b/x64/Debug/cstudentstationvariables.mod new file mode 100644 index 0000000..6080360 Binary files /dev/null and b/x64/Debug/cstudentstationvariables.mod differ diff --git a/x64/Debug/cswingdrillpermission.mod b/x64/Debug/cswingdrillpermission.mod new file mode 100644 index 0000000..a1dc18e Binary files /dev/null and b/x64/Debug/cswingdrillpermission.mod differ diff --git a/x64/Debug/cswingdrillpermissionvariables.mod b/x64/Debug/cswingdrillpermissionvariables.mod new file mode 100644 index 0000000..4acaac9 Binary files /dev/null and b/x64/Debug/cswingdrillpermissionvariables.mod differ diff --git a/x64/Debug/cswingenum.mod b/x64/Debug/cswingenum.mod new file mode 100644 index 0000000..b648823 Binary files /dev/null and b/x64/Debug/cswingenum.mod differ diff --git a/x64/Debug/cswingenumvariables.mod b/x64/Debug/cswingenumvariables.mod new file mode 100644 index 0000000..d27489a Binary files /dev/null and b/x64/Debug/cswingenumvariables.mod differ diff --git a/x64/Debug/cswinglednotification.mod b/x64/Debug/cswinglednotification.mod new file mode 100644 index 0000000..c7857b7 Binary files /dev/null and b/x64/Debug/cswinglednotification.mod differ diff --git a/x64/Debug/cswinglednotificationvariables.mod b/x64/Debug/cswinglednotificationvariables.mod new file mode 100644 index 0000000..f3d6477 Binary files /dev/null and b/x64/Debug/cswinglednotificationvariables.mod differ diff --git a/x64/Debug/cswingoffpermission.mod b/x64/Debug/cswingoffpermission.mod new file mode 100644 index 0000000..c1efa87 Binary files /dev/null and b/x64/Debug/cswingoffpermission.mod differ diff --git a/x64/Debug/cswingoffpermissionvariables.mod b/x64/Debug/cswingoffpermissionvariables.mod new file mode 100644 index 0000000..e2162fb Binary files /dev/null and b/x64/Debug/cswingoffpermissionvariables.mod differ diff --git a/x64/Debug/cswingtiltpermission.mod b/x64/Debug/cswingtiltpermission.mod new file mode 100644 index 0000000..09594ab Binary files /dev/null and b/x64/Debug/cswingtiltpermission.mod differ diff --git a/x64/Debug/cswingtiltpermissionvariables.mod b/x64/Debug/cswingtiltpermissionvariables.mod new file mode 100644 index 0000000..02bde72 Binary files /dev/null and b/x64/Debug/cswingtiltpermissionvariables.mod differ diff --git a/x64/Debug/ctanks.mod b/x64/Debug/ctanks.mod new file mode 100644 index 0000000..10405cc Binary files /dev/null and b/x64/Debug/ctanks.mod differ diff --git a/x64/Debug/ctanksvariables.mod b/x64/Debug/ctanksvariables.mod new file mode 100644 index 0000000..d7f248b Binary files /dev/null and b/x64/Debug/ctanksvariables.mod differ diff --git a/x64/Debug/ctdsbackupclamp.mod b/x64/Debug/ctdsbackupclamp.mod new file mode 100644 index 0000000..f855e86 Binary files /dev/null and b/x64/Debug/ctdsbackupclamp.mod differ diff --git a/x64/Debug/ctdsbackupclampvariables.mod b/x64/Debug/ctdsbackupclampvariables.mod new file mode 100644 index 0000000..f9edf2b Binary files /dev/null and b/x64/Debug/ctdsbackupclampvariables.mod differ diff --git a/x64/Debug/ctdsconnectionmodesenum.mod b/x64/Debug/ctdsconnectionmodesenum.mod new file mode 100644 index 0000000..de3fdae Binary files /dev/null and b/x64/Debug/ctdsconnectionmodesenum.mod differ diff --git a/x64/Debug/ctdsconnectionmodesenumvariables.mod b/x64/Debug/ctdsconnectionmodesenumvariables.mod new file mode 100644 index 0000000..ab38e59 Binary files /dev/null and b/x64/Debug/ctdsconnectionmodesenumvariables.mod differ diff --git a/x64/Debug/ctdselevatormodesenum.mod b/x64/Debug/ctdselevatormodesenum.mod new file mode 100644 index 0000000..bf55853 Binary files /dev/null and b/x64/Debug/ctdselevatormodesenum.mod differ diff --git a/x64/Debug/ctdselevatormodesenumvariables.mod b/x64/Debug/ctdselevatormodesenumvariables.mod new file mode 100644 index 0000000..fb575e8 Binary files /dev/null and b/x64/Debug/ctdselevatormodesenumvariables.mod differ diff --git a/x64/Debug/ctdsiboplednotification.mod b/x64/Debug/ctdsiboplednotification.mod new file mode 100644 index 0000000..89759a9 Binary files /dev/null and b/x64/Debug/ctdsiboplednotification.mod differ diff --git a/x64/Debug/ctdsiboplednotificationvariables.mod b/x64/Debug/ctdsiboplednotificationvariables.mod new file mode 100644 index 0000000..44f420c Binary files /dev/null and b/x64/Debug/ctdsiboplednotificationvariables.mod differ diff --git a/x64/Debug/ctdspowerlednotification.mod b/x64/Debug/ctdspowerlednotification.mod new file mode 100644 index 0000000..f9813f2 Binary files /dev/null and b/x64/Debug/ctdspowerlednotification.mod differ diff --git a/x64/Debug/ctdspowerlednotificationvariables.mod b/x64/Debug/ctdspowerlednotificationvariables.mod new file mode 100644 index 0000000..82904fb Binary files /dev/null and b/x64/Debug/ctdspowerlednotificationvariables.mod differ diff --git a/x64/Debug/ctdsspineenum.mod b/x64/Debug/ctdsspineenum.mod new file mode 100644 index 0000000..77367ba Binary files /dev/null and b/x64/Debug/ctdsspineenum.mod differ diff --git a/x64/Debug/ctdsspineenumvariables.mod b/x64/Debug/ctdsspineenumvariables.mod new file mode 100644 index 0000000..15af65d Binary files /dev/null and b/x64/Debug/ctdsspineenumvariables.mod differ diff --git a/x64/Debug/ctdsstemjointheight.mod b/x64/Debug/ctdsstemjointheight.mod new file mode 100644 index 0000000..638aa1b Binary files /dev/null and b/x64/Debug/ctdsstemjointheight.mod differ diff --git a/x64/Debug/ctdsswingenum.mod b/x64/Debug/ctdsswingenum.mod new file mode 100644 index 0000000..bfbdda6 Binary files /dev/null and b/x64/Debug/ctdsswingenum.mod differ diff --git a/x64/Debug/ctdsswingenumvariables.mod b/x64/Debug/ctdsswingenumvariables.mod new file mode 100644 index 0000000..3d5e762 Binary files /dev/null and b/x64/Debug/ctdsswingenumvariables.mod differ diff --git a/x64/Debug/ctdstongenum.mod b/x64/Debug/ctdstongenum.mod new file mode 100644 index 0000000..83c30a3 Binary files /dev/null and b/x64/Debug/ctdstongenum.mod differ diff --git a/x64/Debug/ctdstongenumvariables.mod b/x64/Debug/ctdstongenumvariables.mod new file mode 100644 index 0000000..b03a1ea Binary files /dev/null and b/x64/Debug/ctdstongenumvariables.mod differ diff --git a/x64/Debug/ctdstorquewrenchlednotification.mod b/x64/Debug/ctdstorquewrenchlednotification.mod new file mode 100644 index 0000000..1d5f8d3 Binary files /dev/null and b/x64/Debug/ctdstorquewrenchlednotification.mod differ diff --git a/x64/Debug/ctdstorquewrenchlednotificationvariables.mod b/x64/Debug/ctdstorquewrenchlednotificationvariables.mod new file mode 100644 index 0000000..51aaa16 Binary files /dev/null and b/x64/Debug/ctdstorquewrenchlednotificationvariables.mod differ diff --git a/x64/Debug/ctimer.mod b/x64/Debug/ctimer.mod new file mode 100644 index 0000000..46e8087 Binary files /dev/null and b/x64/Debug/ctimer.mod differ diff --git a/x64/Debug/ctimerlegacy.mod b/x64/Debug/ctimerlegacy.mod new file mode 100644 index 0000000..eaa1ab6 Binary files /dev/null and b/x64/Debug/ctimerlegacy.mod differ diff --git a/x64/Debug/ctongenum.mod b/x64/Debug/ctongenum.mod new file mode 100644 index 0000000..b6a6394 Binary files /dev/null and b/x64/Debug/ctongenum.mod differ diff --git a/x64/Debug/ctongenumvariables.mod b/x64/Debug/ctongenumvariables.mod new file mode 100644 index 0000000..54febee Binary files /dev/null and b/x64/Debug/ctongenumvariables.mod differ diff --git a/x64/Debug/ctongnotification.mod b/x64/Debug/ctongnotification.mod new file mode 100644 index 0000000..72cbc0c Binary files /dev/null and b/x64/Debug/ctongnotification.mod differ diff --git a/x64/Debug/ctongnotificationvariables.mod b/x64/Debug/ctongnotificationvariables.mod new file mode 100644 index 0000000..8238a4f Binary files /dev/null and b/x64/Debug/ctongnotificationvariables.mod differ diff --git a/x64/Debug/ctopdrivepanel.mod b/x64/Debug/ctopdrivepanel.mod new file mode 100644 index 0000000..ed0d9a8 Binary files /dev/null and b/x64/Debug/ctopdrivepanel.mod differ diff --git a/x64/Debug/ctopdrivepanelvariables.mod b/x64/Debug/ctopdrivepanelvariables.mod new file mode 100644 index 0000000..7dfd9ca Binary files /dev/null and b/x64/Debug/ctopdrivepanelvariables.mod differ diff --git a/x64/Debug/cunityinputs.mod b/x64/Debug/cunityinputs.mod new file mode 100644 index 0000000..d695f86 Binary files /dev/null and b/x64/Debug/cunityinputs.mod differ diff --git a/x64/Debug/cunityoutputs.mod b/x64/Debug/cunityoutputs.mod new file mode 100644 index 0000000..ebfaf4a Binary files /dev/null and b/x64/Debug/cunityoutputs.mod differ diff --git a/x64/Debug/cunlatchlednotification.mod b/x64/Debug/cunlatchlednotification.mod new file mode 100644 index 0000000..7d3c59b Binary files /dev/null and b/x64/Debug/cunlatchlednotification.mod differ diff --git a/x64/Debug/cunlatchlednotificationvariables.mod b/x64/Debug/cunlatchlednotificationvariables.mod new file mode 100644 index 0000000..38d1734 Binary files /dev/null and b/x64/Debug/cunlatchlednotificationvariables.mod differ diff --git a/x64/Debug/cvoideventhandler.mod b/x64/Debug/cvoideventhandler.mod new file mode 100644 index 0000000..3398d5f Binary files /dev/null and b/x64/Debug/cvoideventhandler.mod differ diff --git a/x64/Debug/cvoideventhandlercollection.mod b/x64/Debug/cvoideventhandlercollection.mod new file mode 100644 index 0000000..26363fd Binary files /dev/null and b/x64/Debug/cvoideventhandlercollection.mod differ diff --git a/x64/Debug/cwarnings.mod b/x64/Debug/cwarnings.mod new file mode 100644 index 0000000..6934026 Binary files /dev/null and b/x64/Debug/cwarnings.mod differ diff --git a/x64/Debug/cwarningsactions.mod b/x64/Debug/cwarningsactions.mod new file mode 100644 index 0000000..d6dd750 Binary files /dev/null and b/x64/Debug/cwarningsactions.mod differ diff --git a/x64/Debug/cwarningsvariables.mod b/x64/Debug/cwarningsvariables.mod new file mode 100644 index 0000000..bb72525 Binary files /dev/null and b/x64/Debug/cwarningsvariables.mod differ diff --git a/x64/Debug/cwellsurveydata.mod b/x64/Debug/cwellsurveydata.mod new file mode 100644 index 0000000..591f301 Binary files /dev/null and b/x64/Debug/cwellsurveydata.mod differ diff --git a/x64/Debug/cwellsurveydatavariables.mod b/x64/Debug/cwellsurveydatavariables.mod new file mode 100644 index 0000000..b11e273 Binary files /dev/null and b/x64/Debug/cwellsurveydatavariables.mod differ diff --git a/x64/Debug/czerostringspeed.mod b/x64/Debug/czerostringspeed.mod new file mode 100644 index 0000000..a75f21c Binary files /dev/null and b/x64/Debug/czerostringspeed.mod differ diff --git a/x64/Debug/deallocate_arrays__genmod.f90 b/x64/Debug/deallocate_arrays__genmod.f90 new file mode 100644 index 0000000..c422730 --- /dev/null +++ b/x64/Debug/deallocate_arrays__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:33 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DEALLOCATE_ARRAYS__genmod + INTERFACE + SUBROUTINE DEALLOCATE_ARRAYS + END SUBROUTINE DEALLOCATE_ARRAYS + END INTERFACE + END MODULE DEALLOCATE_ARRAYS__genmod diff --git a/x64/Debug/deallocate_arrays__genmod.mod b/x64/Debug/deallocate_arrays__genmod.mod new file mode 100644 index 0000000..31ede19 Binary files /dev/null and b/x64/Debug/deallocate_arrays__genmod.mod differ diff --git a/x64/Debug/deallocate_arrays_choke__genmod.f90 b/x64/Debug/deallocate_arrays_choke__genmod.f90 new file mode 100644 index 0000000..9bb9ab6 --- /dev/null +++ b/x64/Debug/deallocate_arrays_choke__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:39 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DEALLOCATE_ARRAYS_CHOKE__genmod + INTERFACE + SUBROUTINE DEALLOCATE_ARRAYS_CHOKE + END SUBROUTINE DEALLOCATE_ARRAYS_CHOKE + END INTERFACE + END MODULE DEALLOCATE_ARRAYS_CHOKE__genmod diff --git a/x64/Debug/deallocate_arrays_choke__genmod.mod b/x64/Debug/deallocate_arrays_choke__genmod.mod new file mode 100644 index 0000000..961ac44 Binary files /dev/null and b/x64/Debug/deallocate_arrays_choke__genmod.mod differ diff --git a/x64/Debug/deallocate_arrays_mudsystem__genmod.f90 b/x64/Debug/deallocate_arrays_mudsystem__genmod.f90 new file mode 100644 index 0000000..ff02ab3 --- /dev/null +++ b/x64/Debug/deallocate_arrays_mudsystem__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:47 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DEALLOCATE_ARRAYS_MUDSYSTEM__genmod + INTERFACE + SUBROUTINE DEALLOCATE_ARRAYS_MUDSYSTEM + END SUBROUTINE DEALLOCATE_ARRAYS_MUDSYSTEM + END INTERFACE + END MODULE DEALLOCATE_ARRAYS_MUDSYSTEM__genmod diff --git a/x64/Debug/deallocate_arrays_mudsystem__genmod.mod b/x64/Debug/deallocate_arrays_mudsystem__genmod.mod new file mode 100644 index 0000000..e3a5286 Binary files /dev/null and b/x64/Debug/deallocate_arrays_mudsystem__genmod.mod differ diff --git a/x64/Debug/deallocate_arrays_normalcirculation__genmod.f90 b/x64/Debug/deallocate_arrays_normalcirculation__genmod.f90 new file mode 100644 index 0000000..1b1cf39 --- /dev/null +++ b/x64/Debug/deallocate_arrays_normalcirculation__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:50 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DEALLOCATE_ARRAYS_NORMALCIRCULATION__genmod + INTERFACE + SUBROUTINE DEALLOCATE_ARRAYS_NORMALCIRCULATION + END SUBROUTINE DEALLOCATE_ARRAYS_NORMALCIRCULATION + END INTERFACE + END MODULE DEALLOCATE_ARRAYS_NORMALCIRCULATION__genmod diff --git a/x64/Debug/deallocate_arrays_normalcirculation__genmod.mod b/x64/Debug/deallocate_arrays_normalcirculation__genmod.mod new file mode 100644 index 0000000..ed054ce Binary files /dev/null and b/x64/Debug/deallocate_arrays_normalcirculation__genmod.mod differ diff --git a/x64/Debug/deallocateflowtypes__genmod.f90 b/x64/Debug/deallocateflowtypes__genmod.f90 new file mode 100644 index 0000000..b5453b3 --- /dev/null +++ b/x64/Debug/deallocateflowtypes__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:45:52 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DEALLOCATEFLOWTYPES__genmod + INTERFACE + SUBROUTINE DEALLOCATEFLOWTYPES + END SUBROUTINE DEALLOCATEFLOWTYPES + END INTERFACE + END MODULE DEALLOCATEFLOWTYPES__genmod diff --git a/x64/Debug/deallocateflowtypes__genmod.mod b/x64/Debug/deallocateflowtypes__genmod.mod new file mode 100644 index 0000000..0f6a97c Binary files /dev/null and b/x64/Debug/deallocateflowtypes__genmod.mod differ diff --git a/x64/Debug/dia__genmod.f90 b/x64/Debug/dia__genmod.f90 new file mode 100644 index 0000000..74ae0ab --- /dev/null +++ b/x64/Debug/dia__genmod.f90 @@ -0,0 +1,15 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:50 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DIA__genmod + INTERFACE + SUBROUTINE DIA(X1,X2,X3,X5,X6,X7) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + REAL(KIND=4) :: X3 + REAL(KIND=4) :: X5 + REAL(KIND=4) :: X6 + REAL(KIND=4) :: X7 + END SUBROUTINE DIA + END INTERFACE + END MODULE DIA__genmod diff --git a/x64/Debug/dia__genmod.mod b/x64/Debug/dia__genmod.mod new file mode 100644 index 0000000..dac4493 Binary files /dev/null and b/x64/Debug/dia__genmod.mod differ diff --git a/x64/Debug/disconnectingpipe__genmod.f90 b/x64/Debug/disconnectingpipe__genmod.f90 new file mode 100644 index 0000000..fb5a4cf --- /dev/null +++ b/x64/Debug/disconnectingpipe__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:37 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DISCONNECTINGPIPE__genmod + INTERFACE + SUBROUTINE DISCONNECTINGPIPE + END SUBROUTINE DISCONNECTINGPIPE + END INTERFACE + END MODULE DISCONNECTINGPIPE__genmod diff --git a/x64/Debug/disconnectingpipe__genmod.mod b/x64/Debug/disconnectingpipe__genmod.mod new file mode 100644 index 0000000..88bdcbf Binary files /dev/null and b/x64/Debug/disconnectingpipe__genmod.mod differ diff --git a/x64/Debug/drawworks_direction__genmod.f90 b/x64/Debug/drawworks_direction__genmod.f90 new file mode 100644 index 0000000..dec663d --- /dev/null +++ b/x64/Debug/drawworks_direction__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:28 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DRAWWORKS_DIRECTION__genmod + INTERFACE + SUBROUTINE DRAWWORKS_DIRECTION + END SUBROUTINE DRAWWORKS_DIRECTION + END INTERFACE + END MODULE DRAWWORKS_DIRECTION__genmod diff --git a/x64/Debug/drawworks_direction__genmod.mod b/x64/Debug/drawworks_direction__genmod.mod new file mode 100644 index 0000000..88df610 Binary files /dev/null and b/x64/Debug/drawworks_direction__genmod.mod differ diff --git a/x64/Debug/drawworks_free_traction_motor__genmod.f90 b/x64/Debug/drawworks_free_traction_motor__genmod.f90 new file mode 100644 index 0000000..ff090d1 --- /dev/null +++ b/x64/Debug/drawworks_free_traction_motor__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:30 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DRAWWORKS_FREE_TRACTION_MOTOR__genmod + INTERFACE + SUBROUTINE DRAWWORKS_FREE_TRACTION_MOTOR + END SUBROUTINE DRAWWORKS_FREE_TRACTION_MOTOR + END INTERFACE + END MODULE DRAWWORKS_FREE_TRACTION_MOTOR__genmod diff --git a/x64/Debug/drawworks_free_traction_motor__genmod.mod b/x64/Debug/drawworks_free_traction_motor__genmod.mod new file mode 100644 index 0000000..6c13620 Binary files /dev/null and b/x64/Debug/drawworks_free_traction_motor__genmod.mod differ diff --git a/x64/Debug/drawworks_free_traction_motor_dawn_motion__genmod.f90 b/x64/Debug/drawworks_free_traction_motor_dawn_motion__genmod.f90 new file mode 100644 index 0000000..839d4a5 --- /dev/null +++ b/x64/Debug/drawworks_free_traction_motor_dawn_motion__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:33 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DRAWWORKS_FREE_TRACTION_MOTOR_DAWN_MOTION__genmod + INTERFACE + SUBROUTINE DRAWWORKS_FREE_TRACTION_MOTOR_DAWN_MOTION + END SUBROUTINE DRAWWORKS_FREE_TRACTION_MOTOR_DAWN_MOTION + END INTERFACE + END MODULE DRAWWORKS_FREE_TRACTION_MOTOR_DAWN_MOTION__genmod diff --git a/x64/Debug/drawworks_free_traction_motor_dawn_motion__genmod.mod b/x64/Debug/drawworks_free_traction_motor_dawn_motion__genmod.mod new file mode 100644 index 0000000..53ff022 Binary files /dev/null and b/x64/Debug/drawworks_free_traction_motor_dawn_motion__genmod.mod differ diff --git a/x64/Debug/drawworks_free_traction_motor_dir__genmod.f90 b/x64/Debug/drawworks_free_traction_motor_dir__genmod.f90 new file mode 100644 index 0000000..3621c8b --- /dev/null +++ b/x64/Debug/drawworks_free_traction_motor_dir__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:30 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DRAWWORKS_FREE_TRACTION_MOTOR_DIR__genmod + INTERFACE + SUBROUTINE DRAWWORKS_FREE_TRACTION_MOTOR_DIR + END SUBROUTINE DRAWWORKS_FREE_TRACTION_MOTOR_DIR + END INTERFACE + END MODULE DRAWWORKS_FREE_TRACTION_MOTOR_DIR__genmod diff --git a/x64/Debug/drawworks_free_traction_motor_dir__genmod.mod b/x64/Debug/drawworks_free_traction_motor_dir__genmod.mod new file mode 100644 index 0000000..1cddfb2 Binary files /dev/null and b/x64/Debug/drawworks_free_traction_motor_dir__genmod.mod differ diff --git a/x64/Debug/drawworks_inputs__genmod.f90 b/x64/Debug/drawworks_inputs__genmod.f90 new file mode 100644 index 0000000..8eaf6ca --- /dev/null +++ b/x64/Debug/drawworks_inputs__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:32 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DRAWWORKS_INPUTS__genmod + INTERFACE + SUBROUTINE DRAWWORKS_INPUTS + END SUBROUTINE DRAWWORKS_INPUTS + END INTERFACE + END MODULE DRAWWORKS_INPUTS__genmod diff --git a/x64/Debug/drawworks_inputs__genmod.mod b/x64/Debug/drawworks_inputs__genmod.mod new file mode 100644 index 0000000..df4fc51 Binary files /dev/null and b/x64/Debug/drawworks_inputs__genmod.mod differ diff --git a/x64/Debug/drawworks_solver__genmod.f90 b/x64/Debug/drawworks_solver__genmod.f90 new file mode 100644 index 0000000..4dbb464 --- /dev/null +++ b/x64/Debug/drawworks_solver__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:35 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DRAWWORKS_SOLVER__genmod + INTERFACE + SUBROUTINE DRAWWORKS_SOLVER + END SUBROUTINE DRAWWORKS_SOLVER + END INTERFACE + END MODULE DRAWWORKS_SOLVER__genmod diff --git a/x64/Debug/drawworks_solver__genmod.mod b/x64/Debug/drawworks_solver__genmod.mod new file mode 100644 index 0000000..a843238 Binary files /dev/null and b/x64/Debug/drawworks_solver__genmod.mod differ diff --git a/x64/Debug/drawworks_solver_freetractionmotor__genmod.f90 b/x64/Debug/drawworks_solver_freetractionmotor__genmod.f90 new file mode 100644 index 0000000..a52c1a3 --- /dev/null +++ b/x64/Debug/drawworks_solver_freetractionmotor__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:27 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DRAWWORKS_SOLVER_FREETRACTIONMOTOR__genmod + INTERFACE + SUBROUTINE DRAWWORKS_SOLVER_FREETRACTIONMOTOR + END SUBROUTINE DRAWWORKS_SOLVER_FREETRACTIONMOTOR + END INTERFACE + END MODULE DRAWWORKS_SOLVER_FREETRACTIONMOTOR__genmod diff --git a/x64/Debug/drawworks_solver_freetractionmotor__genmod.mod b/x64/Debug/drawworks_solver_freetractionmotor__genmod.mod new file mode 100644 index 0000000..c9f97a0 Binary files /dev/null and b/x64/Debug/drawworks_solver_freetractionmotor__genmod.mod differ diff --git a/x64/Debug/drawworks_startup__genmod.f90 b/x64/Debug/drawworks_startup__genmod.f90 new file mode 100644 index 0000000..809e131 --- /dev/null +++ b/x64/Debug/drawworks_startup__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:31 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DRAWWORKS_STARTUP__genmod + INTERFACE + SUBROUTINE DRAWWORKS_STARTUP + END SUBROUTINE DRAWWORKS_STARTUP + END INTERFACE + END MODULE DRAWWORKS_STARTUP__genmod diff --git a/x64/Debug/drawworks_startup__genmod.mod b/x64/Debug/drawworks_startup__genmod.mod new file mode 100644 index 0000000..1e78a80 Binary files /dev/null and b/x64/Debug/drawworks_startup__genmod.mod differ diff --git a/x64/Debug/drawworks_traction_motor_clutchmode__genmod.f90 b/x64/Debug/drawworks_traction_motor_clutchmode__genmod.f90 new file mode 100644 index 0000000..e0ffb0c --- /dev/null +++ b/x64/Debug/drawworks_traction_motor_clutchmode__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:26 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DRAWWORKS_TRACTION_MOTOR_CLUTCHMODE__genmod + INTERFACE + SUBROUTINE DRAWWORKS_TRACTION_MOTOR_CLUTCHMODE + END SUBROUTINE DRAWWORKS_TRACTION_MOTOR_CLUTCHMODE + END INTERFACE + END MODULE DRAWWORKS_TRACTION_MOTOR_CLUTCHMODE__genmod diff --git a/x64/Debug/drawworks_traction_motor_clutchmode__genmod.mod b/x64/Debug/drawworks_traction_motor_clutchmode__genmod.mod new file mode 100644 index 0000000..301c47a Binary files /dev/null and b/x64/Debug/drawworks_traction_motor_clutchmode__genmod.mod differ diff --git a/x64/Debug/drawworks_traction_motor_clutchmode_dir__genmod.f90 b/x64/Debug/drawworks_traction_motor_clutchmode_dir__genmod.f90 new file mode 100644 index 0000000..3014608 --- /dev/null +++ b/x64/Debug/drawworks_traction_motor_clutchmode_dir__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:45 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DRAWWORKS_TRACTION_MOTOR_CLUTCHMODE_DIR__genmod + INTERFACE + SUBROUTINE DRAWWORKS_TRACTION_MOTOR_CLUTCHMODE_DIR + END SUBROUTINE DRAWWORKS_TRACTION_MOTOR_CLUTCHMODE_DIR + END INTERFACE + END MODULE DRAWWORKS_TRACTION_MOTOR_CLUTCHMODE_DIR__genmod diff --git a/x64/Debug/drawworks_traction_motor_clutchmode_dir__genmod.mod b/x64/Debug/drawworks_traction_motor_clutchmode_dir__genmod.mod new file mode 100644 index 0000000..e9facf2 Binary files /dev/null and b/x64/Debug/drawworks_traction_motor_clutchmode_dir__genmod.mod differ diff --git a/x64/Debug/drawworks_traction_motor_dawnmotion__genmod.f90 b/x64/Debug/drawworks_traction_motor_dawnmotion__genmod.f90 new file mode 100644 index 0000000..839a76f --- /dev/null +++ b/x64/Debug/drawworks_traction_motor_dawnmotion__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:44 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DRAWWORKS_TRACTION_MOTOR_DAWNMOTION__genmod + INTERFACE + SUBROUTINE DRAWWORKS_TRACTION_MOTOR_DAWNMOTION + END SUBROUTINE DRAWWORKS_TRACTION_MOTOR_DAWNMOTION + END INTERFACE + END MODULE DRAWWORKS_TRACTION_MOTOR_DAWNMOTION__genmod diff --git a/x64/Debug/drawworks_traction_motor_dawnmotion__genmod.mod b/x64/Debug/drawworks_traction_motor_dawnmotion__genmod.mod new file mode 100644 index 0000000..a86b673 Binary files /dev/null and b/x64/Debug/drawworks_traction_motor_dawnmotion__genmod.mod differ diff --git a/x64/Debug/drawworks_traction_motor_dawnmotion_dir__genmod.f90 b/x64/Debug/drawworks_traction_motor_dawnmotion_dir__genmod.f90 new file mode 100644 index 0000000..8ff51cf --- /dev/null +++ b/x64/Debug/drawworks_traction_motor_dawnmotion_dir__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:50 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DRAWWORKS_TRACTION_MOTOR_DAWNMOTION_DIR__genmod + INTERFACE + SUBROUTINE DRAWWORKS_TRACTION_MOTOR_DAWNMOTION_DIR + END SUBROUTINE DRAWWORKS_TRACTION_MOTOR_DAWNMOTION_DIR + END INTERFACE + END MODULE DRAWWORKS_TRACTION_MOTOR_DAWNMOTION_DIR__genmod diff --git a/x64/Debug/drawworks_traction_motor_dawnmotion_dir__genmod.mod b/x64/Debug/drawworks_traction_motor_dawnmotion_dir__genmod.mod new file mode 100644 index 0000000..192107d Binary files /dev/null and b/x64/Debug/drawworks_traction_motor_dawnmotion_dir__genmod.mod differ diff --git a/x64/Debug/drawworks_variables.mod b/x64/Debug/drawworks_variables.mod new file mode 100644 index 0000000..7716dc8 Binary files /dev/null and b/x64/Debug/drawworks_variables.mod differ diff --git a/x64/Debug/drawworksmain.mod b/x64/Debug/drawworksmain.mod new file mode 100644 index 0000000..ee75740 Binary files /dev/null and b/x64/Debug/drawworksmain.mod differ diff --git a/x64/Debug/drillingconsole_scrleds__genmod.f90 b/x64/Debug/drillingconsole_scrleds__genmod.f90 new file mode 100644 index 0000000..cc25130 --- /dev/null +++ b/x64/Debug/drillingconsole_scrleds__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:25 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DRILLINGCONSOLE_SCRLEDS__genmod + INTERFACE + SUBROUTINE DRILLINGCONSOLE_SCRLEDS + END SUBROUTINE DRILLINGCONSOLE_SCRLEDS + END INTERFACE + END MODULE DRILLINGCONSOLE_SCRLEDS__genmod diff --git a/x64/Debug/drillingconsole_scrleds__genmod.mod b/x64/Debug/drillingconsole_scrleds__genmod.mod new file mode 100644 index 0000000..5f75e70 Binary files /dev/null and b/x64/Debug/drillingconsole_scrleds__genmod.mod differ diff --git a/x64/Debug/dw__genmod.f90 b/x64/Debug/dw__genmod.f90 new file mode 100644 index 0000000..90e2232 --- /dev/null +++ b/x64/Debug/dw__genmod.f90 @@ -0,0 +1,14 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:50 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DW__genmod + INTERFACE + SUBROUTINE DW(X1,X2,X3,X4,X5) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + REAL(KIND=4) :: X3 + REAL(KIND=4) :: X4 + REAL(KIND=4) :: X5 + END SUBROUTINE DW + END INTERFACE + END MODULE DW__genmod diff --git a/x64/Debug/dw__genmod.mod b/x64/Debug/dw__genmod.mod new file mode 100644 index 0000000..2c8a500 Binary files /dev/null and b/x64/Debug/dw__genmod.mod differ diff --git a/x64/Debug/dw_dawnmotion__genmod.f90 b/x64/Debug/dw_dawnmotion__genmod.f90 new file mode 100644 index 0000000..0da99d1 --- /dev/null +++ b/x64/Debug/dw_dawnmotion__genmod.f90 @@ -0,0 +1,14 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:50 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DW_DAWNMOTION__genmod + INTERFACE + SUBROUTINE DW_DAWNMOTION(X1,X2,X3,X4,X5) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + REAL(KIND=4) :: X3 + REAL(KIND=4) :: X4 + REAL(KIND=4) :: X5 + END SUBROUTINE DW_DAWNMOTION + END INTERFACE + END MODULE DW_DAWNMOTION__genmod diff --git a/x64/Debug/dw_dawnmotion__genmod.mod b/x64/Debug/dw_dawnmotion__genmod.mod new file mode 100644 index 0000000..a434e63 Binary files /dev/null and b/x64/Debug/dw_dawnmotion__genmod.mod differ diff --git a/x64/Debug/dw_freetrac__genmod.f90 b/x64/Debug/dw_freetrac__genmod.f90 new file mode 100644 index 0000000..39001e2 --- /dev/null +++ b/x64/Debug/dw_freetrac__genmod.f90 @@ -0,0 +1,11 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:50 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DW_FREETRAC__genmod + INTERFACE + SUBROUTINE DW_FREETRAC(X1,X2) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + END SUBROUTINE DW_FREETRAC + END INTERFACE + END MODULE DW_FREETRAC__genmod diff --git a/x64/Debug/dw_freetrac__genmod.mod b/x64/Debug/dw_freetrac__genmod.mod new file mode 100644 index 0000000..7d424e0 Binary files /dev/null and b/x64/Debug/dw_freetrac__genmod.mod differ diff --git a/x64/Debug/dw_freetrac_dmotion__genmod.f90 b/x64/Debug/dw_freetrac_dmotion__genmod.f90 new file mode 100644 index 0000000..f4d6f17 --- /dev/null +++ b/x64/Debug/dw_freetrac_dmotion__genmod.f90 @@ -0,0 +1,11 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:50 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DW_FREETRAC_DMOTION__genmod + INTERFACE + SUBROUTINE DW_FREETRAC_DMOTION(X1,X2) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + END SUBROUTINE DW_FREETRAC_DMOTION + END INTERFACE + END MODULE DW_FREETRAC_DMOTION__genmod diff --git a/x64/Debug/dw_freetrac_dmotion__genmod.mod b/x64/Debug/dw_freetrac_dmotion__genmod.mod new file mode 100644 index 0000000..0af36f1 Binary files /dev/null and b/x64/Debug/dw_freetrac_dmotion__genmod.mod differ diff --git a/x64/Debug/dwbrakesound__genmod.f90 b/x64/Debug/dwbrakesound__genmod.f90 new file mode 100644 index 0000000..6b4a333 --- /dev/null +++ b/x64/Debug/dwbrakesound__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:49 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DWBRAKESOUND__genmod + INTERFACE + SUBROUTINE DWBRAKESOUND + END SUBROUTINE DWBRAKESOUND + END INTERFACE + END MODULE DWBRAKESOUND__genmod diff --git a/x64/Debug/dwbrakesound__genmod.mod b/x64/Debug/dwbrakesound__genmod.mod new file mode 100644 index 0000000..a902938 Binary files /dev/null and b/x64/Debug/dwbrakesound__genmod.mod differ diff --git a/x64/Debug/dwfixmodemotion__genmod.f90 b/x64/Debug/dwfixmodemotion__genmod.f90 new file mode 100644 index 0000000..46dd290 --- /dev/null +++ b/x64/Debug/dwfixmodemotion__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:40 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DWFIXMODEMOTION__genmod + INTERFACE + SUBROUTINE DWFIXMODEMOTION + END SUBROUTINE DWFIXMODEMOTION + END INTERFACE + END MODULE DWFIXMODEMOTION__genmod diff --git a/x64/Debug/dwfixmodemotion__genmod.mod b/x64/Debug/dwfixmodemotion__genmod.mod new file mode 100644 index 0000000..b6adb26 Binary files /dev/null and b/x64/Debug/dwfixmodemotion__genmod.mod differ diff --git a/x64/Debug/dwmalfunction_clutchdisengage__genmod.f90 b/x64/Debug/dwmalfunction_clutchdisengage__genmod.f90 new file mode 100644 index 0000000..17570c2 --- /dev/null +++ b/x64/Debug/dwmalfunction_clutchdisengage__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:37 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DWMALFUNCTION_CLUTCHDISENGAGE__genmod + INTERFACE + SUBROUTINE DWMALFUNCTION_CLUTCHDISENGAGE + END SUBROUTINE DWMALFUNCTION_CLUTCHDISENGAGE + END INTERFACE + END MODULE DWMALFUNCTION_CLUTCHDISENGAGE__genmod diff --git a/x64/Debug/dwmalfunction_clutchdisengage__genmod.mod b/x64/Debug/dwmalfunction_clutchdisengage__genmod.mod new file mode 100644 index 0000000..aa034b3 Binary files /dev/null and b/x64/Debug/dwmalfunction_clutchdisengage__genmod.mod differ diff --git a/x64/Debug/dwmalfunction_clutchengage__genmod.f90 b/x64/Debug/dwmalfunction_clutchengage__genmod.f90 new file mode 100644 index 0000000..fa806ce --- /dev/null +++ b/x64/Debug/dwmalfunction_clutchengage__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:43 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DWMALFUNCTION_CLUTCHENGAGE__genmod + INTERFACE + SUBROUTINE DWMALFUNCTION_CLUTCHENGAGE + END SUBROUTINE DWMALFUNCTION_CLUTCHENGAGE + END INTERFACE + END MODULE DWMALFUNCTION_CLUTCHENGAGE__genmod diff --git a/x64/Debug/dwmalfunction_clutchengage__genmod.mod b/x64/Debug/dwmalfunction_clutchengage__genmod.mod new file mode 100644 index 0000000..67f8860 Binary files /dev/null and b/x64/Debug/dwmalfunction_clutchengage__genmod.mod differ diff --git a/x64/Debug/dwmalfunction_motorfailure__genmod.f90 b/x64/Debug/dwmalfunction_motorfailure__genmod.f90 new file mode 100644 index 0000000..694572b --- /dev/null +++ b/x64/Debug/dwmalfunction_motorfailure__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:51 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DWMALFUNCTION_MOTORFAILURE__genmod + INTERFACE + SUBROUTINE DWMALFUNCTION_MOTORFAILURE + END SUBROUTINE DWMALFUNCTION_MOTORFAILURE + END INTERFACE + END MODULE DWMALFUNCTION_MOTORFAILURE__genmod diff --git a/x64/Debug/dwmalfunction_motorfailure__genmod.mod b/x64/Debug/dwmalfunction_motorfailure__genmod.mod new file mode 100644 index 0000000..182f283 Binary files /dev/null and b/x64/Debug/dwmalfunction_motorfailure__genmod.mod differ diff --git a/x64/Debug/dx__genmod.f90 b/x64/Debug/dx__genmod.f90 new file mode 100644 index 0000000..cc0dcbf --- /dev/null +++ b/x64/Debug/dx__genmod.f90 @@ -0,0 +1,14 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:50 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DX__genmod + INTERFACE + SUBROUTINE DX(X1,X2,X3,X4,X5) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + REAL(KIND=4) :: X3 + REAL(KIND=4) :: X4 + REAL(KIND=4) :: X5 + END SUBROUTINE DX + END INTERFACE + END MODULE DX__genmod diff --git a/x64/Debug/dx__genmod.mod b/x64/Debug/dx__genmod.mod new file mode 100644 index 0000000..91b3f95 Binary files /dev/null and b/x64/Debug/dx__genmod.mod differ diff --git a/x64/Debug/dy__genmod.f90 b/x64/Debug/dy__genmod.f90 new file mode 100644 index 0000000..bda060b --- /dev/null +++ b/x64/Debug/dy__genmod.f90 @@ -0,0 +1,14 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:50 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE DY__genmod + INTERFACE + SUBROUTINE DY(X1,X2,X3,X4,X5) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + REAL(KIND=4) :: X3 + REAL(KIND=4) :: X4 + REAL(KIND=4) :: X5 + END SUBROUTINE DY + END INTERFACE + END MODULE DY__genmod diff --git a/x64/Debug/dy__genmod.mod b/x64/Debug/dy__genmod.mod new file mode 100644 index 0000000..b807d3b Binary files /dev/null and b/x64/Debug/dy__genmod.mod differ diff --git a/x64/Debug/dynamicdoublearray.mod b/x64/Debug/dynamicdoublearray.mod new file mode 100644 index 0000000..65cd833 Binary files /dev/null and b/x64/Debug/dynamicdoublearray.mod differ diff --git a/x64/Debug/dynamicintegerarray.mod b/x64/Debug/dynamicintegerarray.mod new file mode 100644 index 0000000..3dc6b63 Binary files /dev/null and b/x64/Debug/dynamicintegerarray.mod differ diff --git a/x64/Debug/dynamiclogicalarray.mod b/x64/Debug/dynamiclogicalarray.mod new file mode 100644 index 0000000..fb8491f Binary files /dev/null and b/x64/Debug/dynamiclogicalarray.mod differ diff --git a/x64/Debug/dynamicrealarray.mod b/x64/Debug/dynamicrealarray.mod new file mode 100644 index 0000000..50e60cd Binary files /dev/null and b/x64/Debug/dynamicrealarray.mod differ diff --git a/x64/Debug/elementscreation__genmod.f90 b/x64/Debug/elementscreation__genmod.f90 new file mode 100644 index 0000000..9590c79 --- /dev/null +++ b/x64/Debug/elementscreation__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:40 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE ELEMENTSCREATION__genmod + INTERFACE + SUBROUTINE ELEMENTSCREATION + END SUBROUTINE ELEMENTSCREATION + END INTERFACE + END MODULE ELEMENTSCREATION__genmod diff --git a/x64/Debug/elementscreation__genmod.mod b/x64/Debug/elementscreation__genmod.mod new file mode 100644 index 0000000..c1edbef Binary files /dev/null and b/x64/Debug/elementscreation__genmod.mod differ diff --git a/x64/Debug/equipments_PowerLimit.obj b/x64/Debug/equipments_PowerLimit.obj new file mode 100644 index 0000000..2e8ebb3 Binary files /dev/null and b/x64/Debug/equipments_PowerLimit.obj differ diff --git a/x64/Debug/equipments_powerlimit.mod b/x64/Debug/equipments_powerlimit.mod new file mode 100644 index 0000000..489667a Binary files /dev/null and b/x64/Debug/equipments_powerlimit.mod differ diff --git a/x64/Debug/fillingwell_by_bellnipple__genmod.f90 b/x64/Debug/fillingwell_by_bellnipple__genmod.f90 new file mode 100644 index 0000000..d86504e --- /dev/null +++ b/x64/Debug/fillingwell_by_bellnipple__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:39 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE FILLINGWELL_BY_BELLNIPPLE__genmod + INTERFACE + SUBROUTINE FILLINGWELL_BY_BELLNIPPLE + END SUBROUTINE FILLINGWELL_BY_BELLNIPPLE + END INTERFACE + END MODULE FILLINGWELL_BY_BELLNIPPLE__genmod diff --git a/x64/Debug/fillingwell_by_bellnipple__genmod.mod b/x64/Debug/fillingwell_by_bellnipple__genmod.mod new file mode 100644 index 0000000..b0f003a Binary files /dev/null and b/x64/Debug/fillingwell_by_bellnipple__genmod.mod differ diff --git a/x64/Debug/flowstartup__genmod.f90 b/x64/Debug/flowstartup__genmod.f90 new file mode 100644 index 0000000..47f08cf --- /dev/null +++ b/x64/Debug/flowstartup__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:25 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE FLOWSTARTUP__genmod + INTERFACE + SUBROUTINE FLOWSTARTUP + END SUBROUTINE FLOWSTARTUP + END INTERFACE + END MODULE FLOWSTARTUP__genmod diff --git a/x64/Debug/flowstartup__genmod.mod b/x64/Debug/flowstartup__genmod.mod new file mode 100644 index 0000000..011d202 Binary files /dev/null and b/x64/Debug/flowstartup__genmod.mod differ diff --git a/x64/Debug/fluid_flow_solver__genmod.f90 b/x64/Debug/fluid_flow_solver__genmod.f90 new file mode 100644 index 0000000..b440eb9 --- /dev/null +++ b/x64/Debug/fluid_flow_solver__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:45 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE FLUID_FLOW_SOLVER__genmod + INTERFACE + SUBROUTINE FLUID_FLOW_SOLVER + END SUBROUTINE FLUID_FLOW_SOLVER + END INTERFACE + END MODULE FLUID_FLOW_SOLVER__genmod diff --git a/x64/Debug/fluid_flow_solver__genmod.mod b/x64/Debug/fluid_flow_solver__genmod.mod new file mode 100644 index 0000000..52198c4 Binary files /dev/null and b/x64/Debug/fluid_flow_solver__genmod.mod differ diff --git a/x64/Debug/fluid_flow_startup_vars.mod b/x64/Debug/fluid_flow_startup_vars.mod new file mode 100644 index 0000000..6a3e103 Binary files /dev/null and b/x64/Debug/fluid_flow_startup_vars.mod differ diff --git a/x64/Debug/fluidflowmain.mod b/x64/Debug/fluidflowmain.mod new file mode 100644 index 0000000..1c78709 Binary files /dev/null and b/x64/Debug/fluidflowmain.mod differ diff --git a/x64/Debug/formationinformationcalculator__genmod.f90 b/x64/Debug/formationinformationcalculator__genmod.f90 new file mode 100644 index 0000000..708a603 --- /dev/null +++ b/x64/Debug/formationinformationcalculator__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:44 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE FORMATIONINFORMATIONCALCULATOR__genmod + INTERFACE + SUBROUTINE FORMATIONINFORMATIONCALCULATOR + END SUBROUTINE FORMATIONINFORMATIONCALCULATOR + END INTERFACE + END MODULE FORMATIONINFORMATIONCALCULATOR__genmod diff --git a/x64/Debug/formationinformationcalculator__genmod.mod b/x64/Debug/formationinformationcalculator__genmod.mod new file mode 100644 index 0000000..243c788 Binary files /dev/null and b/x64/Debug/formationinformationcalculator__genmod.mod differ diff --git a/x64/Debug/fricpressdrop__genmod.f90 b/x64/Debug/fricpressdrop__genmod.f90 new file mode 100644 index 0000000..a53f22a --- /dev/null +++ b/x64/Debug/fricpressdrop__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:41 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE FRICPRESSDROP__genmod + INTERFACE + SUBROUTINE FRICPRESSDROP(ILOC) + INTEGER(KIND=4) :: ILOC + END SUBROUTINE FRICPRESSDROP + END INTERFACE + END MODULE FRICPRESSDROP__genmod diff --git a/x64/Debug/fricpressdrop__genmod.mod b/x64/Debug/fricpressdrop__genmod.mod new file mode 100644 index 0000000..577d2d9 Binary files /dev/null and b/x64/Debug/fricpressdrop__genmod.mod differ diff --git a/x64/Debug/fricpressdropvars.mod b/x64/Debug/fricpressdropvars.mod new file mode 100644 index 0000000..57dc709 Binary files /dev/null and b/x64/Debug/fricpressdropvars.mod differ diff --git a/x64/Debug/gaskickcalculator__genmod.f90 b/x64/Debug/gaskickcalculator__genmod.f90 new file mode 100644 index 0000000..1b53d1c --- /dev/null +++ b/x64/Debug/gaskickcalculator__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:31 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE GASKICKCALCULATOR__genmod + INTERFACE + SUBROUTINE GASKICKCALCULATOR + END SUBROUTINE GASKICKCALCULATOR + END INTERFACE + END MODULE GASKICKCALCULATOR__genmod diff --git a/x64/Debug/gaskickcalculator__genmod.mod b/x64/Debug/gaskickcalculator__genmod.mod new file mode 100644 index 0000000..b2edc0b Binary files /dev/null and b/x64/Debug/gaskickcalculator__genmod.mod differ diff --git a/x64/Debug/gaspocketflowelementtransformer__genmod.f90 b/x64/Debug/gaspocketflowelementtransformer__genmod.f90 new file mode 100644 index 0000000..e96a62c --- /dev/null +++ b/x64/Debug/gaspocketflowelementtransformer__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:44 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE GASPOCKETFLOWELEMENTTRANSFORMER__genmod + INTERFACE + SUBROUTINE GASPOCKETFLOWELEMENTTRANSFORMER + END SUBROUTINE GASPOCKETFLOWELEMENTTRANSFORMER + END INTERFACE + END MODULE GASPOCKETFLOWELEMENTTRANSFORMER__genmod diff --git a/x64/Debug/gaspocketflowelementtransformer__genmod.mod b/x64/Debug/gaspocketflowelementtransformer__genmod.mod new file mode 100644 index 0000000..c9a3cf7 Binary files /dev/null and b/x64/Debug/gaspocketflowelementtransformer__genmod.mod differ diff --git a/x64/Debug/geoelements_fluidmodule.mod b/x64/Debug/geoelements_fluidmodule.mod new file mode 100644 index 0000000..e638a89 Binary files /dev/null and b/x64/Debug/geoelements_fluidmodule.mod differ diff --git a/x64/Debug/geomain.mod b/x64/Debug/geomain.mod new file mode 100644 index 0000000..8031298 Binary files /dev/null and b/x64/Debug/geomain.mod differ diff --git a/x64/Debug/instructor_circulationmud_edit__genmod.f90 b/x64/Debug/instructor_circulationmud_edit__genmod.f90 new file mode 100644 index 0000000..474453c --- /dev/null +++ b/x64/Debug/instructor_circulationmud_edit__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:26 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE INSTRUCTOR_CIRCULATIONMUD_EDIT__genmod + INTERFACE + SUBROUTINE INSTRUCTOR_CIRCULATIONMUD_EDIT + END SUBROUTINE INSTRUCTOR_CIRCULATIONMUD_EDIT + END INTERFACE + END MODULE INSTRUCTOR_CIRCULATIONMUD_EDIT__genmod diff --git a/x64/Debug/instructor_circulationmud_edit__genmod.mod b/x64/Debug/instructor_circulationmud_edit__genmod.mod new file mode 100644 index 0000000..a921ef1 Binary files /dev/null and b/x64/Debug/instructor_circulationmud_edit__genmod.mod differ diff --git a/x64/Debug/jetimpactforce__genmod.f90 b/x64/Debug/jetimpactforce__genmod.f90 new file mode 100644 index 0000000..6a7d44b --- /dev/null +++ b/x64/Debug/jetimpactforce__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:33 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE JETIMPACTFORCE__genmod + INTERFACE + SUBROUTINE JETIMPACTFORCE + END SUBROUTINE JETIMPACTFORCE + END INTERFACE + END MODULE JETIMPACTFORCE__genmod diff --git a/x64/Debug/jetimpactforce__genmod.mod b/x64/Debug/jetimpactforce__genmod.mod new file mode 100644 index 0000000..d9f18b1 Binary files /dev/null and b/x64/Debug/jetimpactforce__genmod.mod differ diff --git a/x64/Debug/kick_contraction__genmod.f90 b/x64/Debug/kick_contraction__genmod.f90 new file mode 100644 index 0000000..6d2ebf2 --- /dev/null +++ b/x64/Debug/kick_contraction__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:46 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE KICK_CONTRACTION__genmod + INTERFACE + SUBROUTINE KICK_CONTRACTION + END SUBROUTINE KICK_CONTRACTION + END INTERFACE + END MODULE KICK_CONTRACTION__genmod diff --git a/x64/Debug/kick_contraction__genmod.mod b/x64/Debug/kick_contraction__genmod.mod new file mode 100644 index 0000000..c9cecad Binary files /dev/null and b/x64/Debug/kick_contraction__genmod.mod differ diff --git a/x64/Debug/kick_expansion__genmod.f90 b/x64/Debug/kick_expansion__genmod.f90 new file mode 100644 index 0000000..8fe5468 --- /dev/null +++ b/x64/Debug/kick_expansion__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:46 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE KICK_EXPANSION__genmod + INTERFACE + SUBROUTINE KICK_EXPANSION + END SUBROUTINE KICK_EXPANSION + END INTERFACE + END MODULE KICK_EXPANSION__genmod diff --git a/x64/Debug/kick_expansion__genmod.mod b/x64/Debug/kick_expansion__genmod.mod new file mode 100644 index 0000000..606fdcf Binary files /dev/null and b/x64/Debug/kick_expansion__genmod.mod differ diff --git a/x64/Debug/kick_influx__genmod.f90 b/x64/Debug/kick_influx__genmod.f90 new file mode 100644 index 0000000..84288cd --- /dev/null +++ b/x64/Debug/kick_influx__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:26 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE KICK_INFLUX__genmod + INTERFACE + SUBROUTINE KICK_INFLUX + END SUBROUTINE KICK_INFLUX + END INTERFACE + END MODULE KICK_INFLUX__genmod diff --git a/x64/Debug/kick_influx__genmod.mod b/x64/Debug/kick_influx__genmod.mod new file mode 100644 index 0000000..f98c14c Binary files /dev/null and b/x64/Debug/kick_influx__genmod.mod differ diff --git a/x64/Debug/kick_migration__genmod.f90 b/x64/Debug/kick_migration__genmod.f90 new file mode 100644 index 0000000..f58232b --- /dev/null +++ b/x64/Debug/kick_migration__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:48 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE KICK_MIGRATION__genmod + INTERFACE + SUBROUTINE KICK_MIGRATION + END SUBROUTINE KICK_MIGRATION + END INTERFACE + END MODULE KICK_MIGRATION__genmod diff --git a/x64/Debug/kick_migration__genmod.mod b/x64/Debug/kick_migration__genmod.mod new file mode 100644 index 0000000..311e00b Binary files /dev/null and b/x64/Debug/kick_migration__genmod.mod differ diff --git a/x64/Debug/kickfunctionscalculator__genmod.f90 b/x64/Debug/kickfunctionscalculator__genmod.f90 new file mode 100644 index 0000000..5745021 --- /dev/null +++ b/x64/Debug/kickfunctionscalculator__genmod.f90 @@ -0,0 +1,13 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:31 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE KICKFUNCTIONSCALCULATOR__genmod + INTERFACE + SUBROUTINE KICKFUNCTIONSCALCULATOR(EXITVALUE,GASPOCKETNO, & + &CALCMODE) + REAL(KIND=8) :: EXITVALUE + INTEGER(KIND=4) :: GASPOCKETNO + INTEGER(KIND=4) :: CALCMODE + END SUBROUTINE KICKFUNCTIONSCALCULATOR + END INTERFACE + END MODULE KICKFUNCTIONSCALCULATOR__genmod diff --git a/x64/Debug/kickfunctionscalculator__genmod.mod b/x64/Debug/kickfunctionscalculator__genmod.mod new file mode 100644 index 0000000..03b1c84 Binary files /dev/null and b/x64/Debug/kickfunctionscalculator__genmod.mod differ diff --git a/x64/Debug/kickvariables.mod b/x64/Debug/kickvariables.mod new file mode 100644 index 0000000..b3eba58 Binary files /dev/null and b/x64/Debug/kickvariables.mod differ diff --git a/x64/Debug/kill_line__genmod.f90 b/x64/Debug/kill_line__genmod.f90 new file mode 100644 index 0000000..28d31c3 --- /dev/null +++ b/x64/Debug/kill_line__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:32 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE KILL_LINE__genmod + INTERFACE + SUBROUTINE KILL_LINE + END SUBROUTINE KILL_LINE + END INTERFACE + END MODULE KILL_LINE__genmod diff --git a/x64/Debug/kill_line__genmod.mod b/x64/Debug/kill_line__genmod.mod new file mode 100644 index 0000000..2077ba1 Binary files /dev/null and b/x64/Debug/kill_line__genmod.mod differ diff --git a/x64/Debug/kill_line_sub__genmod.f90 b/x64/Debug/kill_line_sub__genmod.f90 new file mode 100644 index 0000000..cb88105 --- /dev/null +++ b/x64/Debug/kill_line_sub__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:32 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE KILL_LINE_SUB__genmod + INTERFACE + SUBROUTINE KILL_LINE_SUB + END SUBROUTINE KILL_LINE_SUB + END INTERFACE + END MODULE KILL_LINE_SUB__genmod diff --git a/x64/Debug/kill_line_sub__genmod.mod b/x64/Debug/kill_line_sub__genmod.mod new file mode 100644 index 0000000..fba5a51 Binary files /dev/null and b/x64/Debug/kill_line_sub__genmod.mod differ diff --git a/x64/Debug/killlinemain.mod b/x64/Debug/killlinemain.mod new file mode 100644 index 0000000..c94c3f4 Binary files /dev/null and b/x64/Debug/killlinemain.mod differ diff --git a/x64/Debug/loss_inputs__genmod.f90 b/x64/Debug/loss_inputs__genmod.f90 new file mode 100644 index 0000000..bb24b6e --- /dev/null +++ b/x64/Debug/loss_inputs__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:33 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE LOSS_INPUTS__genmod + INTERFACE + SUBROUTINE LOSS_INPUTS + END SUBROUTINE LOSS_INPUTS + END INTERFACE + END MODULE LOSS_INPUTS__genmod diff --git a/x64/Debug/loss_inputs__genmod.mod b/x64/Debug/loss_inputs__genmod.mod new file mode 100644 index 0000000..1627ef5 Binary files /dev/null and b/x64/Debug/loss_inputs__genmod.mod differ diff --git a/x64/Debug/loss_inputs_choke__genmod.f90 b/x64/Debug/loss_inputs_choke__genmod.f90 new file mode 100644 index 0000000..3c2576d --- /dev/null +++ b/x64/Debug/loss_inputs_choke__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:39 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE LOSS_INPUTS_CHOKE__genmod + INTERFACE + SUBROUTINE LOSS_INPUTS_CHOKE + END SUBROUTINE LOSS_INPUTS_CHOKE + END INTERFACE + END MODULE LOSS_INPUTS_CHOKE__genmod diff --git a/x64/Debug/loss_inputs_choke__genmod.mod b/x64/Debug/loss_inputs_choke__genmod.mod new file mode 100644 index 0000000..731dfd1 Binary files /dev/null and b/x64/Debug/loss_inputs_choke__genmod.mod differ diff --git a/x64/Debug/meshgeneration_fluidmodule__genmod.f90 b/x64/Debug/meshgeneration_fluidmodule__genmod.f90 new file mode 100644 index 0000000..ed5ab78 --- /dev/null +++ b/x64/Debug/meshgeneration_fluidmodule__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:37 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE MESHGENERATION_FLUIDMODULE__genmod + INTERFACE + SUBROUTINE MESHGENERATION_FLUIDMODULE + END SUBROUTINE MESHGENERATION_FLUIDMODULE + END INTERFACE + END MODULE MESHGENERATION_FLUIDMODULE__genmod diff --git a/x64/Debug/meshgeneration_fluidmodule__genmod.mod b/x64/Debug/meshgeneration_fluidmodule__genmod.mod new file mode 100644 index 0000000..3a81968 Binary files /dev/null and b/x64/Debug/meshgeneration_fluidmodule__genmod.mod differ diff --git a/x64/Debug/mudline_loss_inputs__genmod.f90 b/x64/Debug/mudline_loss_inputs__genmod.f90 new file mode 100644 index 0000000..4e70678 --- /dev/null +++ b/x64/Debug/mudline_loss_inputs__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:47 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE MUDLINE_LOSS_INPUTS__genmod + INTERFACE + SUBROUTINE MUDLINE_LOSS_INPUTS + END SUBROUTINE MUDLINE_LOSS_INPUTS + END INTERFACE + END MODULE MUDLINE_LOSS_INPUTS__genmod diff --git a/x64/Debug/mudline_loss_inputs__genmod.mod b/x64/Debug/mudline_loss_inputs__genmod.mod new file mode 100644 index 0000000..e183faa Binary files /dev/null and b/x64/Debug/mudline_loss_inputs__genmod.mod differ diff --git a/x64/Debug/mudline_losses__genmod.f90 b/x64/Debug/mudline_losses__genmod.f90 new file mode 100644 index 0000000..2296618 --- /dev/null +++ b/x64/Debug/mudline_losses__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:47 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE MUDLINE_LOSSES__genmod + INTERFACE + SUBROUTINE MUDLINE_LOSSES(MLNUMBER) + INTEGER(KIND=4) :: MLNUMBER + END SUBROUTINE MUDLINE_LOSSES + END INTERFACE + END MODULE MUDLINE_LOSSES__genmod diff --git a/x64/Debug/mudline_losses__genmod.mod b/x64/Debug/mudline_losses__genmod.mod new file mode 100644 index 0000000..3ec938c Binary files /dev/null and b/x64/Debug/mudline_losses__genmod.mod differ diff --git a/x64/Debug/mudsystem.mod b/x64/Debug/mudsystem.mod new file mode 100644 index 0000000..8428469 Binary files /dev/null and b/x64/Debug/mudsystem.mod differ diff --git a/x64/Debug/mudsystem_startup__genmod.f90 b/x64/Debug/mudsystem_startup__genmod.f90 new file mode 100644 index 0000000..e48793f --- /dev/null +++ b/x64/Debug/mudsystem_startup__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:47 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE MUDSYSTEM_STARTUP__genmod + INTERFACE + SUBROUTINE MUDSYSTEM_STARTUP + END SUBROUTINE MUDSYSTEM_STARTUP + END INTERFACE + END MODULE MUDSYSTEM_STARTUP__genmod diff --git a/x64/Debug/mudsystem_startup__genmod.mod b/x64/Debug/mudsystem_startup__genmod.mod new file mode 100644 index 0000000..e98d6b4 Binary files /dev/null and b/x64/Debug/mudsystem_startup__genmod.mod differ diff --git a/x64/Debug/mudsystemmain.mod b/x64/Debug/mudsystemmain.mod new file mode 100644 index 0000000..3840b0c Binary files /dev/null and b/x64/Debug/mudsystemmain.mod differ diff --git a/x64/Debug/mudsystemvariables.mod b/x64/Debug/mudsystemvariables.mod new file mode 100644 index 0000000..45f0201 Binary files /dev/null and b/x64/Debug/mudsystemvariables.mod differ diff --git a/x64/Debug/newgaskick__genmod.f90 b/x64/Debug/newgaskick__genmod.f90 new file mode 100644 index 0000000..4157531 --- /dev/null +++ b/x64/Debug/newgaskick__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:31 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE NEWGASKICK__genmod + INTERFACE + SUBROUTINE NEWGASKICK + END SUBROUTINE NEWGASKICK + END INTERFACE + END MODULE NEWGASKICK__genmod diff --git a/x64/Debug/newgaskick__genmod.mod b/x64/Debug/newgaskick__genmod.mod new file mode 100644 index 0000000..8cc5a91 Binary files /dev/null and b/x64/Debug/newgaskick__genmod.mod differ diff --git a/x64/Debug/normalcirculation_startup__genmod.f90 b/x64/Debug/normalcirculation_startup__genmod.f90 new file mode 100644 index 0000000..22296bb --- /dev/null +++ b/x64/Debug/normalcirculation_startup__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:47 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE NORMALCIRCULATION_STARTUP__genmod + INTERFACE + SUBROUTINE NORMALCIRCULATION_STARTUP + END SUBROUTINE NORMALCIRCULATION_STARTUP + END INTERFACE + END MODULE NORMALCIRCULATION_STARTUP__genmod diff --git a/x64/Debug/normalcirculation_startup__genmod.mod b/x64/Debug/normalcirculation_startup__genmod.mod new file mode 100644 index 0000000..53cf3b3 Binary files /dev/null and b/x64/Debug/normalcirculation_startup__genmod.mod differ diff --git a/x64/Debug/off_mode_simulation__genmod.f90 b/x64/Debug/off_mode_simulation__genmod.f90 new file mode 100644 index 0000000..6a4373e --- /dev/null +++ b/x64/Debug/off_mode_simulation__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:42 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE OFF_MODE_SIMULATION__genmod + INTERFACE + SUBROUTINE OFF_MODE_SIMULATION(PUMP_NO) + INTEGER(KIND=4) :: PUMP_NO + END SUBROUTINE OFF_MODE_SIMULATION + END INTERFACE + END MODULE OFF_MODE_SIMULATION__genmod diff --git a/x64/Debug/off_mode_simulation__genmod.mod b/x64/Debug/off_mode_simulation__genmod.mod new file mode 100644 index 0000000..170e409 Binary files /dev/null and b/x64/Debug/off_mode_simulation__genmod.mod differ diff --git a/x64/Debug/on_mode_simulation__genmod.f90 b/x64/Debug/on_mode_simulation__genmod.f90 new file mode 100644 index 0000000..034e0e5 --- /dev/null +++ b/x64/Debug/on_mode_simulation__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:52 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE ON_MODE_SIMULATION__genmod + INTERFACE + SUBROUTINE ON_MODE_SIMULATION(PUMP_NO) + INTEGER(KIND=4) :: PUMP_NO + END SUBROUTINE ON_MODE_SIMULATION + END INTERFACE + END MODULE ON_MODE_SIMULATION__genmod diff --git a/x64/Debug/on_mode_simulation__genmod.mod b/x64/Debug/on_mode_simulation__genmod.mod new file mode 100644 index 0000000..84822ce Binary files /dev/null and b/x64/Debug/on_mode_simulation__genmod.mod differ diff --git a/x64/Debug/partialderivativefrictoflowrate__genmod.f90 b/x64/Debug/partialderivativefrictoflowrate__genmod.f90 new file mode 100644 index 0000000..efdfbb6 --- /dev/null +++ b/x64/Debug/partialderivativefrictoflowrate__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:41 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PARTIALDERIVATIVEFRICTOFLOWRATE__genmod + INTERFACE + SUBROUTINE PARTIALDERIVATIVEFRICTOFLOWRATE(ILOC) + INTEGER(KIND=4) :: ILOC + END SUBROUTINE PARTIALDERIVATIVEFRICTOFLOWRATE + END INTERFACE + END MODULE PARTIALDERIVATIVEFRICTOFLOWRATE__genmod diff --git a/x64/Debug/partialderivativefrictoflowrate__genmod.mod b/x64/Debug/partialderivativefrictoflowrate__genmod.mod new file mode 100644 index 0000000..3d27a78 Binary files /dev/null and b/x64/Debug/partialderivativefrictoflowrate__genmod.mod differ diff --git a/x64/Debug/pipe_rams1__genmod.f90 b/x64/Debug/pipe_rams1__genmod.f90 new file mode 100644 index 0000000..8842b60 --- /dev/null +++ b/x64/Debug/pipe_rams1__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:37 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PIPE_RAMS1__genmod + INTERFACE + SUBROUTINE PIPE_RAMS1 + END SUBROUTINE PIPE_RAMS1 + END INTERFACE + END MODULE PIPE_RAMS1__genmod diff --git a/x64/Debug/pipe_rams1__genmod.mod b/x64/Debug/pipe_rams1__genmod.mod new file mode 100644 index 0000000..c654765 Binary files /dev/null and b/x64/Debug/pipe_rams1__genmod.mod differ diff --git a/x64/Debug/pipe_rams1_sub__genmod.f90 b/x64/Debug/pipe_rams1_sub__genmod.f90 new file mode 100644 index 0000000..6a9653a --- /dev/null +++ b/x64/Debug/pipe_rams1_sub__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:37 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PIPE_RAMS1_SUB__genmod + INTERFACE + SUBROUTINE PIPE_RAMS1_SUB + END SUBROUTINE PIPE_RAMS1_SUB + END INTERFACE + END MODULE PIPE_RAMS1_SUB__genmod diff --git a/x64/Debug/pipe_rams1_sub__genmod.mod b/x64/Debug/pipe_rams1_sub__genmod.mod new file mode 100644 index 0000000..8969d95 Binary files /dev/null and b/x64/Debug/pipe_rams1_sub__genmod.mod differ diff --git a/x64/Debug/pipe_rams2__genmod.f90 b/x64/Debug/pipe_rams2__genmod.f90 new file mode 100644 index 0000000..7b57dc5 --- /dev/null +++ b/x64/Debug/pipe_rams2__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:41 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PIPE_RAMS2__genmod + INTERFACE + SUBROUTINE PIPE_RAMS2 + END SUBROUTINE PIPE_RAMS2 + END INTERFACE + END MODULE PIPE_RAMS2__genmod diff --git a/x64/Debug/pipe_rams2__genmod.mod b/x64/Debug/pipe_rams2__genmod.mod new file mode 100644 index 0000000..e2cba5f Binary files /dev/null and b/x64/Debug/pipe_rams2__genmod.mod differ diff --git a/x64/Debug/pipe_rams2_sub__genmod.f90 b/x64/Debug/pipe_rams2_sub__genmod.f90 new file mode 100644 index 0000000..6658ef0 --- /dev/null +++ b/x64/Debug/pipe_rams2_sub__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:41 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PIPE_RAMS2_SUB__genmod + INTERFACE + SUBROUTINE PIPE_RAMS2_SUB + END SUBROUTINE PIPE_RAMS2_SUB + END INTERFACE + END MODULE PIPE_RAMS2_SUB__genmod diff --git a/x64/Debug/pipe_rams2_sub__genmod.mod b/x64/Debug/pipe_rams2_sub__genmod.mod new file mode 100644 index 0000000..31c2704 Binary files /dev/null and b/x64/Debug/pipe_rams2_sub__genmod.mod differ diff --git a/x64/Debug/pipe_rams_choke__genmod.f90 b/x64/Debug/pipe_rams_choke__genmod.f90 new file mode 100644 index 0000000..01694a7 --- /dev/null +++ b/x64/Debug/pipe_rams_choke__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:39 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PIPE_RAMS_CHOKE__genmod + INTERFACE + SUBROUTINE PIPE_RAMS_CHOKE(CHNUMBER) + INTEGER(KIND=4) :: CHNUMBER + END SUBROUTINE PIPE_RAMS_CHOKE + END INTERFACE + END MODULE PIPE_RAMS_CHOKE__genmod diff --git a/x64/Debug/pipe_rams_choke__genmod.mod b/x64/Debug/pipe_rams_choke__genmod.mod new file mode 100644 index 0000000..53e5fd5 Binary files /dev/null and b/x64/Debug/pipe_rams_choke__genmod.mod differ diff --git a/x64/Debug/piperams1main.mod b/x64/Debug/piperams1main.mod new file mode 100644 index 0000000..954f86c Binary files /dev/null and b/x64/Debug/piperams1main.mod differ diff --git a/x64/Debug/piperams2main.mod b/x64/Debug/piperams2main.mod new file mode 100644 index 0000000..b3a588f Binary files /dev/null and b/x64/Debug/piperams2main.mod differ diff --git a/x64/Debug/plotfinalmudelements__genmod.f90 b/x64/Debug/plotfinalmudelements__genmod.f90 new file mode 100644 index 0000000..6fcc374 --- /dev/null +++ b/x64/Debug/plotfinalmudelements__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:46 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PLOTFINALMUDELEMENTS__genmod + INTERFACE + SUBROUTINE PLOTFINALMUDELEMENTS + END SUBROUTINE PLOTFINALMUDELEMENTS + END INTERFACE + END MODULE PLOTFINALMUDELEMENTS__genmod diff --git a/x64/Debug/plotfinalmudelements__genmod.mod b/x64/Debug/plotfinalmudelements__genmod.mod new file mode 100644 index 0000000..1451cd4 Binary files /dev/null and b/x64/Debug/plotfinalmudelements__genmod.mod differ diff --git a/x64/Debug/powerlimits__genmod.f90 b/x64/Debug/powerlimits__genmod.f90 new file mode 100644 index 0000000..6a70acd --- /dev/null +++ b/x64/Debug/powerlimits__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:42 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE POWERLIMITS__genmod + INTERFACE + SUBROUTINE POWERLIMITS + END SUBROUTINE POWERLIMITS + END INTERFACE + END MODULE POWERLIMITS__genmod diff --git a/x64/Debug/powerlimits__genmod.mod b/x64/Debug/powerlimits__genmod.mod new file mode 100644 index 0000000..c759603 Binary files /dev/null and b/x64/Debug/powerlimits__genmod.mod differ diff --git a/x64/Debug/pressureannandohdistribution__genmod.f90 b/x64/Debug/pressureannandohdistribution__genmod.f90 new file mode 100644 index 0000000..2e1edae --- /dev/null +++ b/x64/Debug/pressureannandohdistribution__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:35 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PRESSUREANNANDOHDISTRIBUTION__genmod + INTERFACE + SUBROUTINE PRESSUREANNANDOHDISTRIBUTION + END SUBROUTINE PRESSUREANNANDOHDISTRIBUTION + END INTERFACE + END MODULE PRESSUREANNANDOHDISTRIBUTION__genmod diff --git a/x64/Debug/pressureannandohdistribution__genmod.mod b/x64/Debug/pressureannandohdistribution__genmod.mod new file mode 100644 index 0000000..2432839 Binary files /dev/null and b/x64/Debug/pressureannandohdistribution__genmod.mod differ diff --git a/x64/Debug/pressuredisplayvariables.mod b/x64/Debug/pressuredisplayvariables.mod new file mode 100644 index 0000000..ec0403c Binary files /dev/null and b/x64/Debug/pressuredisplayvariables.mod differ diff --git a/x64/Debug/pressurehorizandstringdistribution__genmod.f90 b/x64/Debug/pressurehorizandstringdistribution__genmod.f90 new file mode 100644 index 0000000..0079b3e --- /dev/null +++ b/x64/Debug/pressurehorizandstringdistribution__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:38 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PRESSUREHORIZANDSTRINGDISTRIBUTION__genmod + INTERFACE + SUBROUTINE PRESSUREHORIZANDSTRINGDISTRIBUTION + END SUBROUTINE PRESSUREHORIZANDSTRINGDISTRIBUTION + END INTERFACE + END MODULE PRESSUREHORIZANDSTRINGDISTRIBUTION__genmod diff --git a/x64/Debug/pressurehorizandstringdistribution__genmod.mod b/x64/Debug/pressurehorizandstringdistribution__genmod.mod new file mode 100644 index 0000000..e127a12 Binary files /dev/null and b/x64/Debug/pressurehorizandstringdistribution__genmod.mod differ diff --git a/x64/Debug/pump1_mainsolver__genmod.f90 b/x64/Debug/pump1_mainsolver__genmod.f90 new file mode 100644 index 0000000..a8808e2 --- /dev/null +++ b/x64/Debug/pump1_mainsolver__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:39 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMP1_MAINSOLVER__genmod + INTERFACE + SUBROUTINE PUMP1_MAINSOLVER + END SUBROUTINE PUMP1_MAINSOLVER + END INTERFACE + END MODULE PUMP1_MAINSOLVER__genmod diff --git a/x64/Debug/pump1_mainsolver__genmod.mod b/x64/Debug/pump1_mainsolver__genmod.mod new file mode 100644 index 0000000..38e2f5a Binary files /dev/null and b/x64/Debug/pump1_mainsolver__genmod.mod differ diff --git a/x64/Debug/pump1_offmode_solver__genmod.f90 b/x64/Debug/pump1_offmode_solver__genmod.f90 new file mode 100644 index 0000000..5836205 --- /dev/null +++ b/x64/Debug/pump1_offmode_solver__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:27 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMP1_OFFMODE_SOLVER__genmod + INTERFACE + SUBROUTINE PUMP1_OFFMODE_SOLVER(PUMP_NO) + INTEGER(KIND=4) :: PUMP_NO + END SUBROUTINE PUMP1_OFFMODE_SOLVER + END INTERFACE + END MODULE PUMP1_OFFMODE_SOLVER__genmod diff --git a/x64/Debug/pump1_offmode_solver__genmod.mod b/x64/Debug/pump1_offmode_solver__genmod.mod new file mode 100644 index 0000000..c9bb480 Binary files /dev/null and b/x64/Debug/pump1_offmode_solver__genmod.mod differ diff --git a/x64/Debug/pump1_onmode_solver__genmod.f90 b/x64/Debug/pump1_onmode_solver__genmod.f90 new file mode 100644 index 0000000..b8af89c --- /dev/null +++ b/x64/Debug/pump1_onmode_solver__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:42 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMP1_ONMODE_SOLVER__genmod + INTERFACE + SUBROUTINE PUMP1_ONMODE_SOLVER(PUMP_NO) + INTEGER(KIND=4) :: PUMP_NO + END SUBROUTINE PUMP1_ONMODE_SOLVER + END INTERFACE + END MODULE PUMP1_ONMODE_SOLVER__genmod diff --git a/x64/Debug/pump1_onmode_solver__genmod.mod b/x64/Debug/pump1_onmode_solver__genmod.mod new file mode 100644 index 0000000..23cff94 Binary files /dev/null and b/x64/Debug/pump1_onmode_solver__genmod.mod differ diff --git a/x64/Debug/pump2_mainsolver__genmod.f90 b/x64/Debug/pump2_mainsolver__genmod.f90 new file mode 100644 index 0000000..90d7ed7 --- /dev/null +++ b/x64/Debug/pump2_mainsolver__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:46 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMP2_MAINSOLVER__genmod + INTERFACE + SUBROUTINE PUMP2_MAINSOLVER + END SUBROUTINE PUMP2_MAINSOLVER + END INTERFACE + END MODULE PUMP2_MAINSOLVER__genmod diff --git a/x64/Debug/pump2_mainsolver__genmod.mod b/x64/Debug/pump2_mainsolver__genmod.mod new file mode 100644 index 0000000..c02dfa5 Binary files /dev/null and b/x64/Debug/pump2_mainsolver__genmod.mod differ diff --git a/x64/Debug/pump2_offmode_solver__genmod.f90 b/x64/Debug/pump2_offmode_solver__genmod.f90 new file mode 100644 index 0000000..d378943 --- /dev/null +++ b/x64/Debug/pump2_offmode_solver__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:33 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMP2_OFFMODE_SOLVER__genmod + INTERFACE + SUBROUTINE PUMP2_OFFMODE_SOLVER(PUMP_NO) + INTEGER(KIND=4) :: PUMP_NO + END SUBROUTINE PUMP2_OFFMODE_SOLVER + END INTERFACE + END MODULE PUMP2_OFFMODE_SOLVER__genmod diff --git a/x64/Debug/pump2_offmode_solver__genmod.mod b/x64/Debug/pump2_offmode_solver__genmod.mod new file mode 100644 index 0000000..35acbcf Binary files /dev/null and b/x64/Debug/pump2_offmode_solver__genmod.mod differ diff --git a/x64/Debug/pump2_onmode_solver__genmod.f90 b/x64/Debug/pump2_onmode_solver__genmod.f90 new file mode 100644 index 0000000..72c208d --- /dev/null +++ b/x64/Debug/pump2_onmode_solver__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:27 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMP2_ONMODE_SOLVER__genmod + INTERFACE + SUBROUTINE PUMP2_ONMODE_SOLVER(PUMP_NO) + INTEGER(KIND=4) :: PUMP_NO + END SUBROUTINE PUMP2_ONMODE_SOLVER + END INTERFACE + END MODULE PUMP2_ONMODE_SOLVER__genmod diff --git a/x64/Debug/pump2_onmode_solver__genmod.mod b/x64/Debug/pump2_onmode_solver__genmod.mod new file mode 100644 index 0000000..36116e7 Binary files /dev/null and b/x64/Debug/pump2_onmode_solver__genmod.mod differ diff --git a/x64/Debug/pump3_offmode_solver__genmod.f90 b/x64/Debug/pump3_offmode_solver__genmod.f90 new file mode 100644 index 0000000..50bd80c --- /dev/null +++ b/x64/Debug/pump3_offmode_solver__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:40 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMP3_OFFMODE_SOLVER__genmod + INTERFACE + SUBROUTINE PUMP3_OFFMODE_SOLVER + END SUBROUTINE PUMP3_OFFMODE_SOLVER + END INTERFACE + END MODULE PUMP3_OFFMODE_SOLVER__genmod diff --git a/x64/Debug/pump3_offmode_solver__genmod.mod b/x64/Debug/pump3_offmode_solver__genmod.mod new file mode 100644 index 0000000..dcf9942 Binary files /dev/null and b/x64/Debug/pump3_offmode_solver__genmod.mod differ diff --git a/x64/Debug/pump3_onmode_solver__genmod.f90 b/x64/Debug/pump3_onmode_solver__genmod.f90 new file mode 100644 index 0000000..0490c80 --- /dev/null +++ b/x64/Debug/pump3_onmode_solver__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:25 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMP3_ONMODE_SOLVER__genmod + INTERFACE + SUBROUTINE PUMP3_ONMODE_SOLVER + END SUBROUTINE PUMP3_ONMODE_SOLVER + END INTERFACE + END MODULE PUMP3_ONMODE_SOLVER__genmod diff --git a/x64/Debug/pump3_onmode_solver__genmod.mod b/x64/Debug/pump3_onmode_solver__genmod.mod new file mode 100644 index 0000000..a599420 Binary files /dev/null and b/x64/Debug/pump3_onmode_solver__genmod.mod differ diff --git a/x64/Debug/pump_and_tripin__genmod.f90 b/x64/Debug/pump_and_tripin__genmod.f90 new file mode 100644 index 0000000..f84c4e5 --- /dev/null +++ b/x64/Debug/pump_and_tripin__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:29 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMP_AND_TRIPIN__genmod + INTERFACE + SUBROUTINE PUMP_AND_TRIPIN + END SUBROUTINE PUMP_AND_TRIPIN + END INTERFACE + END MODULE PUMP_AND_TRIPIN__genmod diff --git a/x64/Debug/pump_and_tripin__genmod.mod b/x64/Debug/pump_and_tripin__genmod.mod new file mode 100644 index 0000000..220ebaa Binary files /dev/null and b/x64/Debug/pump_and_tripin__genmod.mod differ diff --git a/x64/Debug/pump_dia__genmod.f90 b/x64/Debug/pump_dia__genmod.f90 new file mode 100644 index 0000000..f266f8b --- /dev/null +++ b/x64/Debug/pump_dia__genmod.f90 @@ -0,0 +1,15 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:35 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMP_DIA__genmod + INTERFACE + SUBROUTINE PUMP_DIA(X1,X2,X3,X5,X6,PUMP_NO) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + REAL(KIND=4) :: X3 + REAL(KIND=4) :: X5 + REAL(KIND=4) :: X6 + INTEGER(KIND=4) :: PUMP_NO + END SUBROUTINE PUMP_DIA + END INTERFACE + END MODULE PUMP_DIA__genmod diff --git a/x64/Debug/pump_dia__genmod.mod b/x64/Debug/pump_dia__genmod.mod new file mode 100644 index 0000000..fc8027e Binary files /dev/null and b/x64/Debug/pump_dia__genmod.mod differ diff --git a/x64/Debug/pump_diff_eqs.obj b/x64/Debug/pump_diff_eqs.obj new file mode 100644 index 0000000..ba1445c Binary files /dev/null and b/x64/Debug/pump_diff_eqs.obj differ diff --git a/x64/Debug/pump_dw__genmod.f90 b/x64/Debug/pump_dw__genmod.f90 new file mode 100644 index 0000000..8efe867 --- /dev/null +++ b/x64/Debug/pump_dw__genmod.f90 @@ -0,0 +1,15 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:35 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMP_DW__genmod + INTERFACE + SUBROUTINE PUMP_DW(X1,X2,X3,X4,X5,PUMP_NO) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + REAL(KIND=4) :: X3 + REAL(KIND=4) :: X4 + REAL(KIND=4) :: X5 + INTEGER(KIND=4) :: PUMP_NO + END SUBROUTINE PUMP_DW + END INTERFACE + END MODULE PUMP_DW__genmod diff --git a/x64/Debug/pump_dw__genmod.mod b/x64/Debug/pump_dw__genmod.mod new file mode 100644 index 0000000..c5ad591 Binary files /dev/null and b/x64/Debug/pump_dw__genmod.mod differ diff --git a/x64/Debug/pump_dx__genmod.f90 b/x64/Debug/pump_dx__genmod.f90 new file mode 100644 index 0000000..4778bef --- /dev/null +++ b/x64/Debug/pump_dx__genmod.f90 @@ -0,0 +1,14 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:35 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMP_DX__genmod + INTERFACE + SUBROUTINE PUMP_DX(X1,X2,X3,X4,PUMP_NO) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + REAL(KIND=4) :: X3 + REAL(KIND=4) :: X4 + INTEGER(KIND=4) :: PUMP_NO + END SUBROUTINE PUMP_DX + END INTERFACE + END MODULE PUMP_DX__genmod diff --git a/x64/Debug/pump_dx__genmod.mod b/x64/Debug/pump_dx__genmod.mod new file mode 100644 index 0000000..3bd01c9 Binary files /dev/null and b/x64/Debug/pump_dx__genmod.mod differ diff --git a/x64/Debug/pump_inputs__genmod.f90 b/x64/Debug/pump_inputs__genmod.f90 new file mode 100644 index 0000000..9ac4c0d --- /dev/null +++ b/x64/Debug/pump_inputs__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:29 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMP_INPUTS__genmod + INTERFACE + SUBROUTINE PUMP_INPUTS + END SUBROUTINE PUMP_INPUTS + END INTERFACE + END MODULE PUMP_INPUTS__genmod diff --git a/x64/Debug/pump_inputs__genmod.mod b/x64/Debug/pump_inputs__genmod.mod new file mode 100644 index 0000000..32de5b0 Binary files /dev/null and b/x64/Debug/pump_inputs__genmod.mod differ diff --git a/x64/Debug/pump_solver__genmod.f90 b/x64/Debug/pump_solver__genmod.f90 new file mode 100644 index 0000000..171b897 --- /dev/null +++ b/x64/Debug/pump_solver__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:49 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMP_SOLVER__genmod + INTERFACE + SUBROUTINE PUMP_SOLVER(PUMP_NO) + INTEGER(KIND=4) :: PUMP_NO + END SUBROUTINE PUMP_SOLVER + END INTERFACE + END MODULE PUMP_SOLVER__genmod diff --git a/x64/Debug/pump_solver__genmod.mod b/x64/Debug/pump_solver__genmod.mod new file mode 100644 index 0000000..3db4833 Binary files /dev/null and b/x64/Debug/pump_solver__genmod.mod differ diff --git a/x64/Debug/pump_startup__genmod.f90 b/x64/Debug/pump_startup__genmod.f90 new file mode 100644 index 0000000..d25d027 --- /dev/null +++ b/x64/Debug/pump_startup__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:47 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMP_STARTUP__genmod + INTERFACE + SUBROUTINE PUMP_STARTUP + END SUBROUTINE PUMP_STARTUP + END INTERFACE + END MODULE PUMP_STARTUP__genmod diff --git a/x64/Debug/pump_startup__genmod.mod b/x64/Debug/pump_startup__genmod.mod new file mode 100644 index 0000000..b85d3da Binary files /dev/null and b/x64/Debug/pump_startup__genmod.mod differ diff --git a/x64/Debug/pump_total_counts__genmod.f90 b/x64/Debug/pump_total_counts__genmod.f90 new file mode 100644 index 0000000..1ba6a00 --- /dev/null +++ b/x64/Debug/pump_total_counts__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:35 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMP_TOTAL_COUNTS__genmod + INTERFACE + SUBROUTINE PUMP_TOTAL_COUNTS + END SUBROUTINE PUMP_TOTAL_COUNTS + END INTERFACE + END MODULE PUMP_TOTAL_COUNTS__genmod diff --git a/x64/Debug/pump_total_counts__genmod.mod b/x64/Debug/pump_total_counts__genmod.mod new file mode 100644 index 0000000..a141122 Binary files /dev/null and b/x64/Debug/pump_total_counts__genmod.mod differ diff --git a/x64/Debug/pump_traction_motor__genmod.f90 b/x64/Debug/pump_traction_motor__genmod.f90 new file mode 100644 index 0000000..c2176f5 --- /dev/null +++ b/x64/Debug/pump_traction_motor__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:38 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMP_TRACTION_MOTOR__genmod + INTERFACE + SUBROUTINE PUMP_TRACTION_MOTOR(PUMP_NO) + INTEGER(KIND=4) :: PUMP_NO + END SUBROUTINE PUMP_TRACTION_MOTOR + END INTERFACE + END MODULE PUMP_TRACTION_MOTOR__genmod diff --git a/x64/Debug/pump_traction_motor__genmod.mod b/x64/Debug/pump_traction_motor__genmod.mod new file mode 100644 index 0000000..3a62cc9 Binary files /dev/null and b/x64/Debug/pump_traction_motor__genmod.mod differ diff --git a/x64/Debug/pump_variables.mod b/x64/Debug/pump_variables.mod new file mode 100644 index 0000000..3b6b781 Binary files /dev/null and b/x64/Debug/pump_variables.mod differ diff --git a/x64/Debug/pumps_charge_bottle__genmod.f90 b/x64/Debug/pumps_charge_bottle__genmod.f90 new file mode 100644 index 0000000..4b830f0 --- /dev/null +++ b/x64/Debug/pumps_charge_bottle__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:34 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE PUMPS_CHARGE_BOTTLE__genmod + INTERFACE + SUBROUTINE PUMPS_CHARGE_BOTTLE + END SUBROUTINE PUMPS_CHARGE_BOTTLE + END INTERFACE + END MODULE PUMPS_CHARGE_BOTTLE__genmod diff --git a/x64/Debug/pumps_charge_bottle__genmod.mod b/x64/Debug/pumps_charge_bottle__genmod.mod new file mode 100644 index 0000000..2ff0d16 Binary files /dev/null and b/x64/Debug/pumps_charge_bottle__genmod.mod differ diff --git a/x64/Debug/pumpsmain.mod b/x64/Debug/pumpsmain.mod new file mode 100644 index 0000000..e97fb17 Binary files /dev/null and b/x64/Debug/pumpsmain.mod differ diff --git a/x64/Debug/removeannulusmudarrays__genmod.f90 b/x64/Debug/removeannulusmudarrays__genmod.f90 new file mode 100644 index 0000000..e85ecfc --- /dev/null +++ b/x64/Debug/removeannulusmudarrays__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:50 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE REMOVEANNULUSMUDARRAYS__genmod + INTERFACE + SUBROUTINE REMOVEANNULUSMUDARRAYS(ILOCAL) + INTEGER(KIND=4) :: ILOCAL + END SUBROUTINE REMOVEANNULUSMUDARRAYS + END INTERFACE + END MODULE REMOVEANNULUSMUDARRAYS__genmod diff --git a/x64/Debug/removeannulusmudarrays__genmod.mod b/x64/Debug/removeannulusmudarrays__genmod.mod new file mode 100644 index 0000000..7b919e3 Binary files /dev/null and b/x64/Debug/removeannulusmudarrays__genmod.mod differ diff --git a/x64/Debug/removegaspocket__genmod.f90 b/x64/Debug/removegaspocket__genmod.f90 new file mode 100644 index 0000000..d8143bf --- /dev/null +++ b/x64/Debug/removegaspocket__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:44 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE REMOVEGASPOCKET__genmod + INTERFACE + SUBROUTINE REMOVEGASPOCKET(ILOCAL) + INTEGER(KIND=4) :: ILOCAL + END SUBROUTINE REMOVEGASPOCKET + END INTERFACE + END MODULE REMOVEGASPOCKET__genmod diff --git a/x64/Debug/removegaspocket__genmod.mod b/x64/Debug/removegaspocket__genmod.mod new file mode 100644 index 0000000..92f2295 Binary files /dev/null and b/x64/Debug/removegaspocket__genmod.mod differ diff --git a/x64/Debug/removehzmudarrays__genmod.f90 b/x64/Debug/removehzmudarrays__genmod.f90 new file mode 100644 index 0000000..de9c749 --- /dev/null +++ b/x64/Debug/removehzmudarrays__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:50 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE REMOVEHZMUDARRAYS__genmod + INTERFACE + SUBROUTINE REMOVEHZMUDARRAYS(ILOCAL) + INTEGER(KIND=4) :: ILOCAL + END SUBROUTINE REMOVEHZMUDARRAYS + END INTERFACE + END MODULE REMOVEHZMUDARRAYS__genmod diff --git a/x64/Debug/removehzmudarrays__genmod.mod b/x64/Debug/removehzmudarrays__genmod.mod new file mode 100644 index 0000000..2b5d6f3 Binary files /dev/null and b/x64/Debug/removehzmudarrays__genmod.mod differ diff --git a/x64/Debug/removeopmudarrays__genmod.f90 b/x64/Debug/removeopmudarrays__genmod.f90 new file mode 100644 index 0000000..d44f679 --- /dev/null +++ b/x64/Debug/removeopmudarrays__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:50 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE REMOVEOPMUDARRAYS__genmod + INTERFACE + SUBROUTINE REMOVEOPMUDARRAYS(ILOCAL) + INTEGER(KIND=4) :: ILOCAL + END SUBROUTINE REMOVEOPMUDARRAYS + END INTERFACE + END MODULE REMOVEOPMUDARRAYS__genmod diff --git a/x64/Debug/removeopmudarrays__genmod.mod b/x64/Debug/removeopmudarrays__genmod.mod new file mode 100644 index 0000000..19f9555 Binary files /dev/null and b/x64/Debug/removeopmudarrays__genmod.mod differ diff --git a/x64/Debug/removestringmudarrays__genmod.f90 b/x64/Debug/removestringmudarrays__genmod.f90 new file mode 100644 index 0000000..4001789 --- /dev/null +++ b/x64/Debug/removestringmudarrays__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:50 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE REMOVESTRINGMUDARRAYS__genmod + INTERFACE + SUBROUTINE REMOVESTRINGMUDARRAYS(ILOCAL) + INTEGER(KIND=4) :: ILOCAL + END SUBROUTINE REMOVESTRINGMUDARRAYS + END INTERFACE + END MODULE REMOVESTRINGMUDARRAYS__genmod diff --git a/x64/Debug/removestringmudarrays__genmod.mod b/x64/Debug/removestringmudarrays__genmod.mod new file mode 100644 index 0000000..b9225ff Binary files /dev/null and b/x64/Debug/removestringmudarrays__genmod.mod differ diff --git a/x64/Debug/rop_maincalculation__genmod.f90 b/x64/Debug/rop_maincalculation__genmod.f90 new file mode 100644 index 0000000..fd562c3 --- /dev/null +++ b/x64/Debug/rop_maincalculation__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:33 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE ROP_MAINCALCULATION__genmod + INTERFACE + SUBROUTINE ROP_MAINCALCULATION + END SUBROUTINE ROP_MAINCALCULATION + END INTERFACE + END MODULE ROP_MAINCALCULATION__genmod diff --git a/x64/Debug/rop_maincalculation__genmod.mod b/x64/Debug/rop_maincalculation__genmod.mod new file mode 100644 index 0000000..e37d615 Binary files /dev/null and b/x64/Debug/rop_maincalculation__genmod.mod differ diff --git a/x64/Debug/rop_startup__genmod.f90 b/x64/Debug/rop_startup__genmod.f90 new file mode 100644 index 0000000..73be20e --- /dev/null +++ b/x64/Debug/rop_startup__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:40 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE ROP_STARTUP__genmod + INTERFACE + SUBROUTINE ROP_STARTUP + END SUBROUTINE ROP_STARTUP + END INTERFACE + END MODULE ROP_STARTUP__genmod diff --git a/x64/Debug/rop_startup__genmod.mod b/x64/Debug/rop_startup__genmod.mod new file mode 100644 index 0000000..2769a01 Binary files /dev/null and b/x64/Debug/rop_startup__genmod.mod differ diff --git a/x64/Debug/ropmain.mod b/x64/Debug/ropmain.mod new file mode 100644 index 0000000..540e8d0 Binary files /dev/null and b/x64/Debug/ropmain.mod differ diff --git a/x64/Debug/rotarytablemain.mod b/x64/Debug/rotarytablemain.mod new file mode 100644 index 0000000..349cec7 Binary files /dev/null and b/x64/Debug/rotarytablemain.mod differ diff --git a/x64/Debug/rtable_dia__genmod.f90 b/x64/Debug/rtable_dia__genmod.f90 new file mode 100644 index 0000000..f458a2d --- /dev/null +++ b/x64/Debug/rtable_dia__genmod.f90 @@ -0,0 +1,15 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:51 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE RTABLE_DIA__genmod + INTERFACE + SUBROUTINE RTABLE_DIA(X1,X2,X3,X5,X6,X7) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + REAL(KIND=4) :: X3 + REAL(KIND=4) :: X5 + REAL(KIND=4) :: X6 + REAL(KIND=4) :: X7 + END SUBROUTINE RTABLE_DIA + END INTERFACE + END MODULE RTABLE_DIA__genmod diff --git a/x64/Debug/rtable_dia__genmod.mod b/x64/Debug/rtable_dia__genmod.mod new file mode 100644 index 0000000..845b0d4 Binary files /dev/null and b/x64/Debug/rtable_dia__genmod.mod differ diff --git a/x64/Debug/rtable_dw__genmod.f90 b/x64/Debug/rtable_dw__genmod.f90 new file mode 100644 index 0000000..6c71e5d --- /dev/null +++ b/x64/Debug/rtable_dw__genmod.f90 @@ -0,0 +1,14 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:51 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE RTABLE_DW__genmod + INTERFACE + SUBROUTINE RTABLE_DW(X1,X2,X3,X4,X5) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + REAL(KIND=4) :: X3 + REAL(KIND=4) :: X4 + REAL(KIND=4) :: X5 + END SUBROUTINE RTABLE_DW + END INTERFACE + END MODULE RTABLE_DW__genmod diff --git a/x64/Debug/rtable_dw__genmod.mod b/x64/Debug/rtable_dw__genmod.mod new file mode 100644 index 0000000..2c07da9 Binary files /dev/null and b/x64/Debug/rtable_dw__genmod.mod differ diff --git a/x64/Debug/rtable_dx__genmod.f90 b/x64/Debug/rtable_dx__genmod.f90 new file mode 100644 index 0000000..d4158c5 --- /dev/null +++ b/x64/Debug/rtable_dx__genmod.f90 @@ -0,0 +1,14 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:51 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE RTABLE_DX__genmod + INTERFACE + SUBROUTINE RTABLE_DX(X1,X2,X3,X4,X5) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + REAL(KIND=4) :: X3 + REAL(KIND=4) :: X4 + REAL(KIND=4) :: X5 + END SUBROUTINE RTABLE_DX + END INTERFACE + END MODULE RTABLE_DX__genmod diff --git a/x64/Debug/rtable_dx__genmod.mod b/x64/Debug/rtable_dx__genmod.mod new file mode 100644 index 0000000..62ad8dd Binary files /dev/null and b/x64/Debug/rtable_dx__genmod.mod differ diff --git a/x64/Debug/rtable_dy__genmod.f90 b/x64/Debug/rtable_dy__genmod.f90 new file mode 100644 index 0000000..fe5ab4f --- /dev/null +++ b/x64/Debug/rtable_dy__genmod.f90 @@ -0,0 +1,14 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:51 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE RTABLE_DY__genmod + INTERFACE + SUBROUTINE RTABLE_DY(X1,X2,X3,X4,X5) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + REAL(KIND=4) :: X3 + REAL(KIND=4) :: X4 + REAL(KIND=4) :: X5 + END SUBROUTINE RTABLE_DY + END INTERFACE + END MODULE RTABLE_DY__genmod diff --git a/x64/Debug/rtable_dy__genmod.mod b/x64/Debug/rtable_dy__genmod.mod new file mode 100644 index 0000000..4a73260 Binary files /dev/null and b/x64/Debug/rtable_dy__genmod.mod differ diff --git a/x64/Debug/rtable_inputs__genmod.f90 b/x64/Debug/rtable_inputs__genmod.f90 new file mode 100644 index 0000000..80c6a92 --- /dev/null +++ b/x64/Debug/rtable_inputs__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:25 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE RTABLE_INPUTS__genmod + INTERFACE + SUBROUTINE RTABLE_INPUTS + END SUBROUTINE RTABLE_INPUTS + END INTERFACE + END MODULE RTABLE_INPUTS__genmod diff --git a/x64/Debug/rtable_inputs__genmod.mod b/x64/Debug/rtable_inputs__genmod.mod new file mode 100644 index 0000000..463d37b Binary files /dev/null and b/x64/Debug/rtable_inputs__genmod.mod differ diff --git a/x64/Debug/rtable_offmode__genmod.f90 b/x64/Debug/rtable_offmode__genmod.f90 new file mode 100644 index 0000000..8071fdb --- /dev/null +++ b/x64/Debug/rtable_offmode__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:27 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE RTABLE_OFFMODE__genmod + INTERFACE + SUBROUTINE RTABLE_OFFMODE + END SUBROUTINE RTABLE_OFFMODE + END INTERFACE + END MODULE RTABLE_OFFMODE__genmod diff --git a/x64/Debug/rtable_offmode__genmod.mod b/x64/Debug/rtable_offmode__genmod.mod new file mode 100644 index 0000000..9ce5406 Binary files /dev/null and b/x64/Debug/rtable_offmode__genmod.mod differ diff --git a/x64/Debug/rtable_solver__genmod.f90 b/x64/Debug/rtable_solver__genmod.f90 new file mode 100644 index 0000000..47d5dd5 --- /dev/null +++ b/x64/Debug/rtable_solver__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:29 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE RTABLE_SOLVER__genmod + INTERFACE + SUBROUTINE RTABLE_SOLVER + END SUBROUTINE RTABLE_SOLVER + END INTERFACE + END MODULE RTABLE_SOLVER__genmod diff --git a/x64/Debug/rtable_solver__genmod.mod b/x64/Debug/rtable_solver__genmod.mod new file mode 100644 index 0000000..e3e23a3 Binary files /dev/null and b/x64/Debug/rtable_solver__genmod.mod differ diff --git a/x64/Debug/rtable_startup__genmod.f90 b/x64/Debug/rtable_startup__genmod.f90 new file mode 100644 index 0000000..1bd0bb2 --- /dev/null +++ b/x64/Debug/rtable_startup__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:45 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE RTABLE_STARTUP__genmod + INTERFACE + SUBROUTINE RTABLE_STARTUP + END SUBROUTINE RTABLE_STARTUP + END INTERFACE + END MODULE RTABLE_STARTUP__genmod diff --git a/x64/Debug/rtable_startup__genmod.mod b/x64/Debug/rtable_startup__genmod.mod new file mode 100644 index 0000000..e385505 Binary files /dev/null and b/x64/Debug/rtable_startup__genmod.mod differ diff --git a/x64/Debug/rtable_traction_motor__genmod.f90 b/x64/Debug/rtable_traction_motor__genmod.f90 new file mode 100644 index 0000000..6cacf35 --- /dev/null +++ b/x64/Debug/rtable_traction_motor__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:31 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE RTABLE_TRACTION_MOTOR__genmod + INTERFACE + SUBROUTINE RTABLE_TRACTION_MOTOR + END SUBROUTINE RTABLE_TRACTION_MOTOR + END INTERFACE + END MODULE RTABLE_TRACTION_MOTOR__genmod diff --git a/x64/Debug/rtable_traction_motor__genmod.mod b/x64/Debug/rtable_traction_motor__genmod.mod new file mode 100644 index 0000000..3aac6ff Binary files /dev/null and b/x64/Debug/rtable_traction_motor__genmod.mod differ diff --git a/x64/Debug/rtable_variables.mod b/x64/Debug/rtable_variables.mod new file mode 100644 index 0000000..c7bc83b Binary files /dev/null and b/x64/Debug/rtable_variables.mod differ diff --git a/x64/Debug/rtmalfunction_motorfailure__genmod.f90 b/x64/Debug/rtmalfunction_motorfailure__genmod.f90 new file mode 100644 index 0000000..d672da2 --- /dev/null +++ b/x64/Debug/rtmalfunction_motorfailure__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:33 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE RTMALFUNCTION_MOTORFAILURE__genmod + INTERFACE + SUBROUTINE RTMALFUNCTION_MOTORFAILURE + END SUBROUTINE RTMALFUNCTION_MOTORFAILURE + END INTERFACE + END MODULE RTMALFUNCTION_MOTORFAILURE__genmod diff --git a/x64/Debug/rtmalfunction_motorfailure__genmod.mod b/x64/Debug/rtmalfunction_motorfailure__genmod.mod new file mode 100644 index 0000000..7a568fd Binary files /dev/null and b/x64/Debug/rtmalfunction_motorfailure__genmod.mod differ diff --git a/x64/Debug/rttorquelimit__genmod.f90 b/x64/Debug/rttorquelimit__genmod.f90 new file mode 100644 index 0000000..f2dc7a3 --- /dev/null +++ b/x64/Debug/rttorquelimit__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:51 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE RTTORQUELIMIT__genmod + INTERFACE + SUBROUTINE RTTORQUELIMIT + END SUBROUTINE RTTORQUELIMIT + END INTERFACE + END MODULE RTTORQUELIMIT__genmod diff --git a/x64/Debug/rttorquelimit__genmod.mod b/x64/Debug/rttorquelimit__genmod.mod new file mode 100644 index 0000000..51daa99 Binary files /dev/null and b/x64/Debug/rttorquelimit__genmod.mod differ diff --git a/x64/Debug/sROP_Module.obj b/x64/Debug/sROP_Module.obj new file mode 100644 index 0000000..c1e11f0 Binary files /dev/null and b/x64/Debug/sROP_Module.obj differ diff --git a/x64/Debug/sROP_Other_Variables.obj b/x64/Debug/sROP_Other_Variables.obj new file mode 100644 index 0000000..d1275b7 Binary files /dev/null and b/x64/Debug/sROP_Other_Variables.obj differ diff --git a/x64/Debug/sROP_Variables.obj b/x64/Debug/sROP_Variables.obj new file mode 100644 index 0000000..9d7cbb5 Binary files /dev/null and b/x64/Debug/sROP_Variables.obj differ diff --git a/x64/Debug/shear_rams__genmod.f90 b/x64/Debug/shear_rams__genmod.f90 new file mode 100644 index 0000000..4ba08b4 --- /dev/null +++ b/x64/Debug/shear_rams__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:46 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE SHEAR_RAMS__genmod + INTERFACE + SUBROUTINE SHEAR_RAMS + END SUBROUTINE SHEAR_RAMS + END INTERFACE + END MODULE SHEAR_RAMS__genmod diff --git a/x64/Debug/shear_rams__genmod.mod b/x64/Debug/shear_rams__genmod.mod new file mode 100644 index 0000000..4c362a6 Binary files /dev/null and b/x64/Debug/shear_rams__genmod.mod differ diff --git a/x64/Debug/shear_rams_sub__genmod.f90 b/x64/Debug/shear_rams_sub__genmod.f90 new file mode 100644 index 0000000..5af52a9 --- /dev/null +++ b/x64/Debug/shear_rams_sub__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:46 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE SHEAR_RAMS_SUB__genmod + INTERFACE + SUBROUTINE SHEAR_RAMS_SUB + END SUBROUTINE SHEAR_RAMS_SUB + END INTERFACE + END MODULE SHEAR_RAMS_SUB__genmod diff --git a/x64/Debug/shear_rams_sub__genmod.mod b/x64/Debug/shear_rams_sub__genmod.mod new file mode 100644 index 0000000..f7d0a1e Binary files /dev/null and b/x64/Debug/shear_rams_sub__genmod.mod differ diff --git a/x64/Debug/shoelostsub__genmod.f90 b/x64/Debug/shoelostsub__genmod.f90 new file mode 100644 index 0000000..f8f5b4e --- /dev/null +++ b/x64/Debug/shoelostsub__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:26 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE SHOELOSTSUB__genmod + INTERFACE + SUBROUTINE SHOELOSTSUB + END SUBROUTINE SHOELOSTSUB + END INTERFACE + END MODULE SHOELOSTSUB__genmod diff --git a/x64/Debug/shoelostsub__genmod.mod b/x64/Debug/shoelostsub__genmod.mod new file mode 100644 index 0000000..76c1019 Binary files /dev/null and b/x64/Debug/shoelostsub__genmod.mod differ diff --git a/x64/Debug/simulator.mod b/x64/Debug/simulator.mod new file mode 100644 index 0000000..14045a3 Binary files /dev/null and b/x64/Debug/simulator.mod differ diff --git a/x64/Debug/solve_linear_equations__genmod.f90 b/x64/Debug/solve_linear_equations__genmod.f90 new file mode 100644 index 0000000..3a3af45 --- /dev/null +++ b/x64/Debug/solve_linear_equations__genmod.f90 @@ -0,0 +1,14 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:38 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE SOLVE_LINEAR_EQUATIONS__genmod + INTERFACE + SUBROUTINE SOLVE_LINEAR_EQUATIONS(A,X,B,ERROR,DIM) + INTEGER(KIND=4), INTENT(IN) :: DIM + REAL(KIND=8), INTENT(IN) :: A(DIM,DIM) + REAL(KIND=4), INTENT(OUT) :: X(DIM) + REAL(KIND=8), INTENT(IN) :: B(DIM) + LOGICAL(KIND=4), INTENT(OUT) :: ERROR + END SUBROUTINE SOLVE_LINEAR_EQUATIONS + END INTERFACE + END MODULE SOLVE_LINEAR_EQUATIONS__genmod diff --git a/x64/Debug/solve_linear_equations__genmod.mod b/x64/Debug/solve_linear_equations__genmod.mod new file mode 100644 index 0000000..32a42c7 Binary files /dev/null and b/x64/Debug/solve_linear_equations__genmod.mod differ diff --git a/x64/Debug/srop_other_variables.mod b/x64/Debug/srop_other_variables.mod new file mode 100644 index 0000000..a9e477e Binary files /dev/null and b/x64/Debug/srop_other_variables.mod differ diff --git a/x64/Debug/srop_variables.mod b/x64/Debug/srop_variables.mod new file mode 100644 index 0000000..153a84e Binary files /dev/null and b/x64/Debug/srop_variables.mod differ diff --git a/x64/Debug/stringpropertycalculator__genmod.f90 b/x64/Debug/stringpropertycalculator__genmod.f90 new file mode 100644 index 0000000..0d592d5 --- /dev/null +++ b/x64/Debug/stringpropertycalculator__genmod.f90 @@ -0,0 +1,13 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:38 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE STRINGPROPERTYCALCULATOR__genmod + INTERFACE + SUBROUTINE STRINGPROPERTYCALCULATOR(MD,DEN,PRE,TEM) + INTEGER(KIND=4), INTENT(IN) :: MD + REAL(KIND=8), INTENT(INOUT) :: DEN + REAL(KIND=8), INTENT(INOUT) :: PRE + REAL(KIND=8), INTENT(INOUT) :: TEM + END SUBROUTINE STRINGPROPERTYCALCULATOR + END INTERFACE + END MODULE STRINGPROPERTYCALCULATOR__genmod diff --git a/x64/Debug/stringpropertycalculator__genmod.mod b/x64/Debug/stringpropertycalculator__genmod.mod new file mode 100644 index 0000000..0d2239e Binary files /dev/null and b/x64/Debug/stringpropertycalculator__genmod.mod differ diff --git a/x64/Debug/td_addcomponents__genmod.f90 b/x64/Debug/td_addcomponents__genmod.f90 new file mode 100644 index 0000000..9fc87df --- /dev/null +++ b/x64/Debug/td_addcomponents__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:51 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_ADDCOMPONENTS__genmod + INTERFACE + SUBROUTINE TD_ADDCOMPONENTS + END SUBROUTINE TD_ADDCOMPONENTS + END INTERFACE + END MODULE TD_ADDCOMPONENTS__genmod diff --git a/x64/Debug/td_addcomponents__genmod.mod b/x64/Debug/td_addcomponents__genmod.mod new file mode 100644 index 0000000..7727139 Binary files /dev/null and b/x64/Debug/td_addcomponents__genmod.mod differ diff --git a/x64/Debug/td_bopdiamcalculation__genmod.f90 b/x64/Debug/td_bopdiamcalculation__genmod.f90 new file mode 100644 index 0000000..137e5fc --- /dev/null +++ b/x64/Debug/td_bopdiamcalculation__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:50 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_BOPDIAMCALCULATION__genmod + INTERFACE + SUBROUTINE TD_BOPDIAMCALCULATION + END SUBROUTINE TD_BOPDIAMCALCULATION + END INTERFACE + END MODULE TD_BOPDIAMCALCULATION__genmod diff --git a/x64/Debug/td_bopdiamcalculation__genmod.mod b/x64/Debug/td_bopdiamcalculation__genmod.mod new file mode 100644 index 0000000..154f49b Binary files /dev/null and b/x64/Debug/td_bopdiamcalculation__genmod.mod differ diff --git a/x64/Debug/td_bouyancyfactor__genmod.f90 b/x64/Debug/td_bouyancyfactor__genmod.f90 new file mode 100644 index 0000000..4997a8c --- /dev/null +++ b/x64/Debug/td_bouyancyfactor__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:26 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_BOUYANCYFACTOR__genmod + INTERFACE + SUBROUTINE TD_BOUYANCYFACTOR(I) + INTEGER(KIND=4) :: I + END SUBROUTINE TD_BOUYANCYFACTOR + END INTERFACE + END MODULE TD_BOUYANCYFACTOR__genmod diff --git a/x64/Debug/td_bouyancyfactor__genmod.mod b/x64/Debug/td_bouyancyfactor__genmod.mod new file mode 100644 index 0000000..95315a0 Binary files /dev/null and b/x64/Debug/td_bouyancyfactor__genmod.mod differ diff --git a/x64/Debug/td_combinedmotiondata__genmod.f90 b/x64/Debug/td_combinedmotiondata__genmod.f90 new file mode 100644 index 0000000..b5780e5 --- /dev/null +++ b/x64/Debug/td_combinedmotiondata__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:48 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_COMBINEDMOTIONDATA__genmod + INTERFACE + SUBROUTINE TD_COMBINEDMOTIONDATA(I) + INTEGER(KIND=4) :: I + END SUBROUTINE TD_COMBINEDMOTIONDATA + END INTERFACE + END MODULE TD_COMBINEDMOTIONDATA__genmod diff --git a/x64/Debug/td_combinedmotiondata__genmod.mod b/x64/Debug/td_combinedmotiondata__genmod.mod new file mode 100644 index 0000000..b806f06 Binary files /dev/null and b/x64/Debug/td_combinedmotiondata__genmod.mod differ diff --git a/x64/Debug/td_drillstemcomponents.mod b/x64/Debug/td_drillstemcomponents.mod new file mode 100644 index 0000000..c7f0c1f Binary files /dev/null and b/x64/Debug/td_drillstemcomponents.mod differ diff --git a/x64/Debug/td_drillstemconfiguration__genmod.f90 b/x64/Debug/td_drillstemconfiguration__genmod.f90 new file mode 100644 index 0000000..83fecdb --- /dev/null +++ b/x64/Debug/td_drillstemconfiguration__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:32 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_DRILLSTEMCONFIGURATION__genmod + INTERFACE + SUBROUTINE TD_DRILLSTEMCONFIGURATION + END SUBROUTINE TD_DRILLSTEMCONFIGURATION + END INTERFACE + END MODULE TD_DRILLSTEMCONFIGURATION__genmod diff --git a/x64/Debug/td_drillstemconfiguration__genmod.mod b/x64/Debug/td_drillstemconfiguration__genmod.mod new file mode 100644 index 0000000..a967dbc Binary files /dev/null and b/x64/Debug/td_drillstemconfiguration__genmod.mod differ diff --git a/x64/Debug/td_drillstemreaddata__genmod.f90 b/x64/Debug/td_drillstemreaddata__genmod.f90 new file mode 100644 index 0000000..7f72bda --- /dev/null +++ b/x64/Debug/td_drillstemreaddata__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:41 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_DRILLSTEMREADDATA__genmod + INTERFACE + SUBROUTINE TD_DRILLSTEMREADDATA + END SUBROUTINE TD_DRILLSTEMREADDATA + END INTERFACE + END MODULE TD_DRILLSTEMREADDATA__genmod diff --git a/x64/Debug/td_drillstemreaddata__genmod.mod b/x64/Debug/td_drillstemreaddata__genmod.mod new file mode 100644 index 0000000..65d7794 Binary files /dev/null and b/x64/Debug/td_drillstemreaddata__genmod.mod differ diff --git a/x64/Debug/td_drillstemstartup__genmod.f90 b/x64/Debug/td_drillstemstartup__genmod.f90 new file mode 100644 index 0000000..823da50 --- /dev/null +++ b/x64/Debug/td_drillstemstartup__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:47 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_DRILLSTEMSTARTUP__genmod + INTERFACE + SUBROUTINE TD_DRILLSTEMSTARTUP + END SUBROUTINE TD_DRILLSTEMSTARTUP + END INTERFACE + END MODULE TD_DRILLSTEMSTARTUP__genmod diff --git a/x64/Debug/td_drillstemstartup__genmod.mod b/x64/Debug/td_drillstemstartup__genmod.mod new file mode 100644 index 0000000..e5b7e73 Binary files /dev/null and b/x64/Debug/td_drillstemstartup__genmod.mod differ diff --git a/x64/Debug/td_forcecalculation__genmod.f90 b/x64/Debug/td_forcecalculation__genmod.f90 new file mode 100644 index 0000000..a598d06 --- /dev/null +++ b/x64/Debug/td_forcecalculation__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:47 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_FORCECALCULATION__genmod + INTERFACE + SUBROUTINE TD_FORCECALCULATION + END SUBROUTINE TD_FORCECALCULATION + END INTERFACE + END MODULE TD_FORCECALCULATION__genmod diff --git a/x64/Debug/td_forcecalculation__genmod.mod b/x64/Debug/td_forcecalculation__genmod.mod new file mode 100644 index 0000000..9bb5695 Binary files /dev/null and b/x64/Debug/td_forcecalculation__genmod.mod differ diff --git a/x64/Debug/td_forcedownb__genmod.f90 b/x64/Debug/td_forcedownb__genmod.f90 new file mode 100644 index 0000000..1013e76 --- /dev/null +++ b/x64/Debug/td_forcedownb__genmod.f90 @@ -0,0 +1,11 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:32 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_FORCEDOWNB__genmod + INTERFACE + SUBROUTINE TD_FORCEDOWNB(I,TD_SEMIMUDVISC) + INTEGER(KIND=4) :: I + REAL(KIND=8) :: TD_SEMIMUDVISC + END SUBROUTINE TD_FORCEDOWNB + END INTERFACE + END MODULE TD_FORCEDOWNB__genmod diff --git a/x64/Debug/td_forcedownb__genmod.mod b/x64/Debug/td_forcedownb__genmod.mod new file mode 100644 index 0000000..6d1beb3 Binary files /dev/null and b/x64/Debug/td_forcedownb__genmod.mod differ diff --git a/x64/Debug/td_forcedownbrot__genmod.f90 b/x64/Debug/td_forcedownbrot__genmod.f90 new file mode 100644 index 0000000..00e9333 --- /dev/null +++ b/x64/Debug/td_forcedownbrot__genmod.f90 @@ -0,0 +1,11 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:30 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_FORCEDOWNBROT__genmod + INTERFACE + SUBROUTINE TD_FORCEDOWNBROT(I,TD_SEMIMUDVISC) + INTEGER(KIND=4) :: I + REAL(KIND=8) :: TD_SEMIMUDVISC + END SUBROUTINE TD_FORCEDOWNBROT + END INTERFACE + END MODULE TD_FORCEDOWNBROT__genmod diff --git a/x64/Debug/td_forcedownbrot__genmod.mod b/x64/Debug/td_forcedownbrot__genmod.mod new file mode 100644 index 0000000..64ef7b0 Binary files /dev/null and b/x64/Debug/td_forcedownbrot__genmod.mod differ diff --git a/x64/Debug/td_forcedownd__genmod.f90 b/x64/Debug/td_forcedownd__genmod.f90 new file mode 100644 index 0000000..7c79e1b --- /dev/null +++ b/x64/Debug/td_forcedownd__genmod.f90 @@ -0,0 +1,11 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:39 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_FORCEDOWND__genmod + INTERFACE + SUBROUTINE TD_FORCEDOWND(I,TD_SEMIMUDVISC) + INTEGER(KIND=4) :: I + REAL(KIND=8) :: TD_SEMIMUDVISC + END SUBROUTINE TD_FORCEDOWND + END INTERFACE + END MODULE TD_FORCEDOWND__genmod diff --git a/x64/Debug/td_forcedownd__genmod.mod b/x64/Debug/td_forcedownd__genmod.mod new file mode 100644 index 0000000..084b437 Binary files /dev/null and b/x64/Debug/td_forcedownd__genmod.mod differ diff --git a/x64/Debug/td_forcedowndrot__genmod.f90 b/x64/Debug/td_forcedowndrot__genmod.f90 new file mode 100644 index 0000000..a585e2e --- /dev/null +++ b/x64/Debug/td_forcedowndrot__genmod.f90 @@ -0,0 +1,11 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:25 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_FORCEDOWNDROT__genmod + INTERFACE + SUBROUTINE TD_FORCEDOWNDROT(I,TD_SEMIMUDVISC) + INTEGER(KIND=4) :: I + REAL(KIND=8) :: TD_SEMIMUDVISC + END SUBROUTINE TD_FORCEDOWNDROT + END INTERFACE + END MODULE TD_FORCEDOWNDROT__genmod diff --git a/x64/Debug/td_forcedowndrot__genmod.mod b/x64/Debug/td_forcedowndrot__genmod.mod new file mode 100644 index 0000000..e0d6046 Binary files /dev/null and b/x64/Debug/td_forcedowndrot__genmod.mod differ diff --git a/x64/Debug/td_forcedowns__genmod.f90 b/x64/Debug/td_forcedowns__genmod.f90 new file mode 100644 index 0000000..56738b6 --- /dev/null +++ b/x64/Debug/td_forcedowns__genmod.f90 @@ -0,0 +1,11 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:30 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_FORCEDOWNS__genmod + INTERFACE + SUBROUTINE TD_FORCEDOWNS(I,TD_SEMIMUDVISC) + INTEGER(KIND=4) :: I + REAL(KIND=8) :: TD_SEMIMUDVISC + END SUBROUTINE TD_FORCEDOWNS + END INTERFACE + END MODULE TD_FORCEDOWNS__genmod diff --git a/x64/Debug/td_forcedowns__genmod.mod b/x64/Debug/td_forcedowns__genmod.mod new file mode 100644 index 0000000..e11b9a6 Binary files /dev/null and b/x64/Debug/td_forcedowns__genmod.mod differ diff --git a/x64/Debug/td_forcedownsrot__genmod.f90 b/x64/Debug/td_forcedownsrot__genmod.f90 new file mode 100644 index 0000000..2065844 --- /dev/null +++ b/x64/Debug/td_forcedownsrot__genmod.f90 @@ -0,0 +1,11 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:49 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_FORCEDOWNSROT__genmod + INTERFACE + SUBROUTINE TD_FORCEDOWNSROT(I,TD_SEMIMUDVISC) + INTEGER(KIND=4) :: I + REAL(KIND=8) :: TD_SEMIMUDVISC + END SUBROUTINE TD_FORCEDOWNSROT + END INTERFACE + END MODULE TD_FORCEDOWNSROT__genmod diff --git a/x64/Debug/td_forcedownsrot__genmod.mod b/x64/Debug/td_forcedownsrot__genmod.mod new file mode 100644 index 0000000..490ecb3 Binary files /dev/null and b/x64/Debug/td_forcedownsrot__genmod.mod differ diff --git a/x64/Debug/td_forcereaddata__genmod.f90 b/x64/Debug/td_forcereaddata__genmod.f90 new file mode 100644 index 0000000..2c80a75 --- /dev/null +++ b/x64/Debug/td_forcereaddata__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:43 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_FORCEREADDATA__genmod + INTERFACE + SUBROUTINE TD_FORCEREADDATA + END SUBROUTINE TD_FORCEREADDATA + END INTERFACE + END MODULE TD_FORCEREADDATA__genmod diff --git a/x64/Debug/td_forcereaddata__genmod.mod b/x64/Debug/td_forcereaddata__genmod.mod new file mode 100644 index 0000000..ddae7ad Binary files /dev/null and b/x64/Debug/td_forcereaddata__genmod.mod differ diff --git a/x64/Debug/td_forceupb__genmod.f90 b/x64/Debug/td_forceupb__genmod.f90 new file mode 100644 index 0000000..585e6fd --- /dev/null +++ b/x64/Debug/td_forceupb__genmod.f90 @@ -0,0 +1,11 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:38 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_FORCEUPB__genmod + INTERFACE + SUBROUTINE TD_FORCEUPB(I,TD_SEMIMUDVISC) + INTEGER(KIND=4) :: I + REAL(KIND=8) :: TD_SEMIMUDVISC + END SUBROUTINE TD_FORCEUPB + END INTERFACE + END MODULE TD_FORCEUPB__genmod diff --git a/x64/Debug/td_forceupb__genmod.mod b/x64/Debug/td_forceupb__genmod.mod new file mode 100644 index 0000000..1f33907 Binary files /dev/null and b/x64/Debug/td_forceupb__genmod.mod differ diff --git a/x64/Debug/td_forceupbrot__genmod.f90 b/x64/Debug/td_forceupbrot__genmod.f90 new file mode 100644 index 0000000..cf4c20d --- /dev/null +++ b/x64/Debug/td_forceupbrot__genmod.f90 @@ -0,0 +1,11 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:47 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_FORCEUPBROT__genmod + INTERFACE + SUBROUTINE TD_FORCEUPBROT(I,TD_SEMIMUDVISC) + INTEGER(KIND=4) :: I + REAL(KIND=8) :: TD_SEMIMUDVISC + END SUBROUTINE TD_FORCEUPBROT + END INTERFACE + END MODULE TD_FORCEUPBROT__genmod diff --git a/x64/Debug/td_forceupbrot__genmod.mod b/x64/Debug/td_forceupbrot__genmod.mod new file mode 100644 index 0000000..cb3ff51 Binary files /dev/null and b/x64/Debug/td_forceupbrot__genmod.mod differ diff --git a/x64/Debug/td_forceupd__genmod.f90 b/x64/Debug/td_forceupd__genmod.f90 new file mode 100644 index 0000000..263c8fc --- /dev/null +++ b/x64/Debug/td_forceupd__genmod.f90 @@ -0,0 +1,11 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:45 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_FORCEUPD__genmod + INTERFACE + SUBROUTINE TD_FORCEUPD(I,TD_SEMIMUDVISC) + INTEGER(KIND=4) :: I + REAL(KIND=8) :: TD_SEMIMUDVISC + END SUBROUTINE TD_FORCEUPD + END INTERFACE + END MODULE TD_FORCEUPD__genmod diff --git a/x64/Debug/td_forceupd__genmod.mod b/x64/Debug/td_forceupd__genmod.mod new file mode 100644 index 0000000..d21d60f Binary files /dev/null and b/x64/Debug/td_forceupd__genmod.mod differ diff --git a/x64/Debug/td_forceupdrot__genmod.f90 b/x64/Debug/td_forceupdrot__genmod.f90 new file mode 100644 index 0000000..dd963a7 --- /dev/null +++ b/x64/Debug/td_forceupdrot__genmod.f90 @@ -0,0 +1,11 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:28 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_FORCEUPDROT__genmod + INTERFACE + SUBROUTINE TD_FORCEUPDROT(I,TD_SEMIMUDVISC) + INTEGER(KIND=4) :: I + REAL(KIND=8) :: TD_SEMIMUDVISC + END SUBROUTINE TD_FORCEUPDROT + END INTERFACE + END MODULE TD_FORCEUPDROT__genmod diff --git a/x64/Debug/td_forceupdrot__genmod.mod b/x64/Debug/td_forceupdrot__genmod.mod new file mode 100644 index 0000000..0ad4043 Binary files /dev/null and b/x64/Debug/td_forceupdrot__genmod.mod differ diff --git a/x64/Debug/td_forceups__genmod.f90 b/x64/Debug/td_forceups__genmod.f90 new file mode 100644 index 0000000..a7b3c82 --- /dev/null +++ b/x64/Debug/td_forceups__genmod.f90 @@ -0,0 +1,11 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:41 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_FORCEUPS__genmod + INTERFACE + SUBROUTINE TD_FORCEUPS(I,TD_SEMIMUDVISC) + INTEGER(KIND=4) :: I + REAL(KIND=8) :: TD_SEMIMUDVISC + END SUBROUTINE TD_FORCEUPS + END INTERFACE + END MODULE TD_FORCEUPS__genmod diff --git a/x64/Debug/td_forceups__genmod.mod b/x64/Debug/td_forceups__genmod.mod new file mode 100644 index 0000000..b4c52d0 Binary files /dev/null and b/x64/Debug/td_forceups__genmod.mod differ diff --git a/x64/Debug/td_forceupsrot__genmod.f90 b/x64/Debug/td_forceupsrot__genmod.f90 new file mode 100644 index 0000000..62143ec --- /dev/null +++ b/x64/Debug/td_forceupsrot__genmod.f90 @@ -0,0 +1,11 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:41 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_FORCEUPSROT__genmod + INTERFACE + SUBROUTINE TD_FORCEUPSROT(I,TD_SEMIMUDVISC) + INTEGER(KIND=4) :: I + REAL(KIND=8) :: TD_SEMIMUDVISC + END SUBROUTINE TD_FORCEUPSROT + END INTERFACE + END MODULE TD_FORCEUPSROT__genmod diff --git a/x64/Debug/td_forceupsrot__genmod.mod b/x64/Debug/td_forceupsrot__genmod.mod new file mode 100644 index 0000000..a6d5626 Binary files /dev/null and b/x64/Debug/td_forceupsrot__genmod.mod differ diff --git a/x64/Debug/td_generaldata.mod b/x64/Debug/td_generaldata.mod new file mode 100644 index 0000000..cdc6a11 Binary files /dev/null and b/x64/Debug/td_generaldata.mod differ diff --git a/x64/Debug/td_hookloadcalculation__genmod.f90 b/x64/Debug/td_hookloadcalculation__genmod.f90 new file mode 100644 index 0000000..bbac283 --- /dev/null +++ b/x64/Debug/td_hookloadcalculation__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:48 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_HOOKLOADCALCULATION__genmod + INTERFACE + SUBROUTINE TD_HOOKLOADCALCULATION + END SUBROUTINE TD_HOOKLOADCALCULATION + END INTERFACE + END MODULE TD_HOOKLOADCALCULATION__genmod diff --git a/x64/Debug/td_hookloadcalculation__genmod.mod b/x64/Debug/td_hookloadcalculation__genmod.mod new file mode 100644 index 0000000..bc87d42 Binary files /dev/null and b/x64/Debug/td_hookloadcalculation__genmod.mod differ diff --git a/x64/Debug/td_maincalculations__genmod.f90 b/x64/Debug/td_maincalculations__genmod.f90 new file mode 100644 index 0000000..21fb44d --- /dev/null +++ b/x64/Debug/td_maincalculations__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:26 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_MAINCALCULATIONS__genmod + INTERFACE + SUBROUTINE TD_MAINCALCULATIONS + END SUBROUTINE TD_MAINCALCULATIONS + END INTERFACE + END MODULE TD_MAINCALCULATIONS__genmod diff --git a/x64/Debug/td_maincalculations__genmod.mod b/x64/Debug/td_maincalculations__genmod.mod new file mode 100644 index 0000000..bea3251 Binary files /dev/null and b/x64/Debug/td_maincalculations__genmod.mod differ diff --git a/x64/Debug/td_mudpropertiesreaddata__genmod.f90 b/x64/Debug/td_mudpropertiesreaddata__genmod.f90 new file mode 100644 index 0000000..772a22d --- /dev/null +++ b/x64/Debug/td_mudpropertiesreaddata__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:45 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_MUDPROPERTIESREADDATA__genmod + INTERFACE + SUBROUTINE TD_MUDPROPERTIESREADDATA(I) + INTEGER(KIND=4) :: I + END SUBROUTINE TD_MUDPROPERTIESREADDATA + END INTERFACE + END MODULE TD_MUDPROPERTIESREADDATA__genmod diff --git a/x64/Debug/td_mudpropertiesreaddata__genmod.mod b/x64/Debug/td_mudpropertiesreaddata__genmod.mod new file mode 100644 index 0000000..808aba0 Binary files /dev/null and b/x64/Debug/td_mudpropertiesreaddata__genmod.mod differ diff --git a/x64/Debug/td_pipepropertiesreaddata__genmod.f90 b/x64/Debug/td_pipepropertiesreaddata__genmod.f90 new file mode 100644 index 0000000..452775d --- /dev/null +++ b/x64/Debug/td_pipepropertiesreaddata__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:30 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_PIPEPROPERTIESREADDATA__genmod + INTERFACE + SUBROUTINE TD_PIPEPROPERTIESREADDATA + END SUBROUTINE TD_PIPEPROPERTIESREADDATA + END INTERFACE + END MODULE TD_PIPEPROPERTIESREADDATA__genmod diff --git a/x64/Debug/td_pipepropertiesreaddata__genmod.mod b/x64/Debug/td_pipepropertiesreaddata__genmod.mod new file mode 100644 index 0000000..c16cce4 Binary files /dev/null and b/x64/Debug/td_pipepropertiesreaddata__genmod.mod differ diff --git a/x64/Debug/td_removecomponents__genmod.f90 b/x64/Debug/td_removecomponents__genmod.f90 new file mode 100644 index 0000000..de90668 --- /dev/null +++ b/x64/Debug/td_removecomponents__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:36 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_REMOVECOMPONENTS__genmod + INTERFACE + SUBROUTINE TD_REMOVECOMPONENTS + END SUBROUTINE TD_REMOVECOMPONENTS + END INTERFACE + END MODULE TD_REMOVECOMPONENTS__genmod diff --git a/x64/Debug/td_removecomponents__genmod.mod b/x64/Debug/td_removecomponents__genmod.mod new file mode 100644 index 0000000..ffb6187 Binary files /dev/null and b/x64/Debug/td_removecomponents__genmod.mod differ diff --git a/x64/Debug/td_startup__genmod.f90 b/x64/Debug/td_startup__genmod.f90 new file mode 100644 index 0000000..1f5c7f3 --- /dev/null +++ b/x64/Debug/td_startup__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:25 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_STARTUP__genmod + INTERFACE + SUBROUTINE TD_STARTUP + END SUBROUTINE TD_STARTUP + END INTERFACE + END MODULE TD_STARTUP__genmod diff --git a/x64/Debug/td_startup__genmod.mod b/x64/Debug/td_startup__genmod.mod new file mode 100644 index 0000000..294a755 Binary files /dev/null and b/x64/Debug/td_startup__genmod.mod differ diff --git a/x64/Debug/td_statichookloadcalculation__genmod.f90 b/x64/Debug/td_statichookloadcalculation__genmod.f90 new file mode 100644 index 0000000..59e9b34 --- /dev/null +++ b/x64/Debug/td_statichookloadcalculation__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:34 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_STATICHOOKLOADCALCULATION__genmod + INTERFACE + SUBROUTINE TD_STATICHOOKLOADCALCULATION + END SUBROUTINE TD_STATICHOOKLOADCALCULATION + END INTERFACE + END MODULE TD_STATICHOOKLOADCALCULATION__genmod diff --git a/x64/Debug/td_statichookloadcalculation__genmod.mod b/x64/Debug/td_statichookloadcalculation__genmod.mod new file mode 100644 index 0000000..13fdabb Binary files /dev/null and b/x64/Debug/td_statichookloadcalculation__genmod.mod differ diff --git a/x64/Debug/td_straincalculation__genmod.f90 b/x64/Debug/td_straincalculation__genmod.f90 new file mode 100644 index 0000000..beacd1a --- /dev/null +++ b/x64/Debug/td_straincalculation__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:28 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_STRAINCALCULATION__genmod + INTERFACE + SUBROUTINE TD_STRAINCALCULATION(I) + INTEGER(KIND=4) :: I + END SUBROUTINE TD_STRAINCALCULATION + END INTERFACE + END MODULE TD_STRAINCALCULATION__genmod diff --git a/x64/Debug/td_straincalculation__genmod.mod b/x64/Debug/td_straincalculation__genmod.mod new file mode 100644 index 0000000..71cdc13 Binary files /dev/null and b/x64/Debug/td_straincalculation__genmod.mod differ diff --git a/x64/Debug/td_stringconnectiondata.mod b/x64/Debug/td_stringconnectiondata.mod new file mode 100644 index 0000000..8b4ae20 Binary files /dev/null and b/x64/Debug/td_stringconnectiondata.mod differ diff --git a/x64/Debug/td_stringconnectionmodes__genmod.f90 b/x64/Debug/td_stringconnectionmodes__genmod.f90 new file mode 100644 index 0000000..7b7da62 --- /dev/null +++ b/x64/Debug/td_stringconnectionmodes__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:28 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_STRINGCONNECTIONMODES__genmod + INTERFACE + SUBROUTINE TD_STRINGCONNECTIONMODES + END SUBROUTINE TD_STRINGCONNECTIONMODES + END INTERFACE + END MODULE TD_STRINGCONNECTIONMODES__genmod diff --git a/x64/Debug/td_stringconnectionmodes__genmod.mod b/x64/Debug/td_stringconnectionmodes__genmod.mod new file mode 100644 index 0000000..215a22b Binary files /dev/null and b/x64/Debug/td_stringconnectionmodes__genmod.mod differ diff --git a/x64/Debug/td_torquecalculation__genmod.f90 b/x64/Debug/td_torquecalculation__genmod.f90 new file mode 100644 index 0000000..1bc3e67 --- /dev/null +++ b/x64/Debug/td_torquecalculation__genmod.f90 @@ -0,0 +1,10 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:36 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_TORQUECALCULATION__genmod + INTERFACE + SUBROUTINE TD_TORQUECALCULATION(I) + INTEGER(KIND=4) :: I + END SUBROUTINE TD_TORQUECALCULATION + END INTERFACE + END MODULE TD_TORQUECALCULATION__genmod diff --git a/x64/Debug/td_torquecalculation__genmod.mod b/x64/Debug/td_torquecalculation__genmod.mod new file mode 100644 index 0000000..830fab4 Binary files /dev/null and b/x64/Debug/td_torquecalculation__genmod.mod differ diff --git a/x64/Debug/td_viscousdragforce__genmod.f90 b/x64/Debug/td_viscousdragforce__genmod.f90 new file mode 100644 index 0000000..49d3d4b --- /dev/null +++ b/x64/Debug/td_viscousdragforce__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:27 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_VISCOUSDRAGFORCE__genmod + INTERFACE + SUBROUTINE TD_VISCOUSDRAGFORCE + END SUBROUTINE TD_VISCOUSDRAGFORCE + END INTERFACE + END MODULE TD_VISCOUSDRAGFORCE__genmod diff --git a/x64/Debug/td_viscousdragforce__genmod.mod b/x64/Debug/td_viscousdragforce__genmod.mod new file mode 100644 index 0000000..84329b4 Binary files /dev/null and b/x64/Debug/td_viscousdragforce__genmod.mod differ diff --git a/x64/Debug/td_weightonbitcalculation__genmod.f90 b/x64/Debug/td_weightonbitcalculation__genmod.f90 new file mode 100644 index 0000000..ce22515 --- /dev/null +++ b/x64/Debug/td_weightonbitcalculation__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:49 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_WEIGHTONBITCALCULATION__genmod + INTERFACE + SUBROUTINE TD_WEIGHTONBITCALCULATION + END SUBROUTINE TD_WEIGHTONBITCALCULATION + END INTERFACE + END MODULE TD_WEIGHTONBITCALCULATION__genmod diff --git a/x64/Debug/td_weightonbitcalculation__genmod.mod b/x64/Debug/td_weightonbitcalculation__genmod.mod new file mode 100644 index 0000000..e256183 Binary files /dev/null and b/x64/Debug/td_weightonbitcalculation__genmod.mod differ diff --git a/x64/Debug/td_wellelements.mod b/x64/Debug/td_wellelements.mod new file mode 100644 index 0000000..415aeb0 Binary files /dev/null and b/x64/Debug/td_wellelements.mod differ diff --git a/x64/Debug/td_wellelementsconfiguration__genmod.f90 b/x64/Debug/td_wellelementsconfiguration__genmod.f90 new file mode 100644 index 0000000..54081e6 --- /dev/null +++ b/x64/Debug/td_wellelementsconfiguration__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:36 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_WELLELEMENTSCONFIGURATION__genmod + INTERFACE + SUBROUTINE TD_WELLELEMENTSCONFIGURATION + END SUBROUTINE TD_WELLELEMENTSCONFIGURATION + END INTERFACE + END MODULE TD_WELLELEMENTSCONFIGURATION__genmod diff --git a/x64/Debug/td_wellelementsconfiguration__genmod.mod b/x64/Debug/td_wellelementsconfiguration__genmod.mod new file mode 100644 index 0000000..5400509 Binary files /dev/null and b/x64/Debug/td_wellelementsconfiguration__genmod.mod differ diff --git a/x64/Debug/td_wellelementsreaddata__genmod.f90 b/x64/Debug/td_wellelementsreaddata__genmod.f90 new file mode 100644 index 0000000..d995dff --- /dev/null +++ b/x64/Debug/td_wellelementsreaddata__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:48 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_WELLELEMENTSREADDATA__genmod + INTERFACE + SUBROUTINE TD_WELLELEMENTSREADDATA + END SUBROUTINE TD_WELLELEMENTSREADDATA + END INTERFACE + END MODULE TD_WELLELEMENTSREADDATA__genmod diff --git a/x64/Debug/td_wellelementsreaddata__genmod.mod b/x64/Debug/td_wellelementsreaddata__genmod.mod new file mode 100644 index 0000000..d7567cf Binary files /dev/null and b/x64/Debug/td_wellelementsreaddata__genmod.mod differ diff --git a/x64/Debug/td_wellgeoconfiguration__genmod.f90 b/x64/Debug/td_wellgeoconfiguration__genmod.f90 new file mode 100644 index 0000000..69901f9 --- /dev/null +++ b/x64/Debug/td_wellgeoconfiguration__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:43 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_WELLGEOCONFIGURATION__genmod + INTERFACE + SUBROUTINE TD_WELLGEOCONFIGURATION + END SUBROUTINE TD_WELLGEOCONFIGURATION + END INTERFACE + END MODULE TD_WELLGEOCONFIGURATION__genmod diff --git a/x64/Debug/td_wellgeoconfiguration__genmod.mod b/x64/Debug/td_wellgeoconfiguration__genmod.mod new file mode 100644 index 0000000..9e5e4aa Binary files /dev/null and b/x64/Debug/td_wellgeoconfiguration__genmod.mod differ diff --git a/x64/Debug/td_wellgeometry.mod b/x64/Debug/td_wellgeometry.mod new file mode 100644 index 0000000..8a536cf Binary files /dev/null and b/x64/Debug/td_wellgeometry.mod differ diff --git a/x64/Debug/td_wellreaddata__genmod.f90 b/x64/Debug/td_wellreaddata__genmod.f90 new file mode 100644 index 0000000..49a1887 --- /dev/null +++ b/x64/Debug/td_wellreaddata__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:34 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TD_WELLREADDATA__genmod + INTERFACE + SUBROUTINE TD_WELLREADDATA + END SUBROUTINE TD_WELLREADDATA + END INTERFACE + END MODULE TD_WELLREADDATA__genmod diff --git a/x64/Debug/td_wellreaddata__genmod.mod b/x64/Debug/td_wellreaddata__genmod.mod new file mode 100644 index 0000000..c13fed9 Binary files /dev/null and b/x64/Debug/td_wellreaddata__genmod.mod differ diff --git a/x64/Debug/tds_dia__genmod.f90 b/x64/Debug/tds_dia__genmod.f90 new file mode 100644 index 0000000..5a3cb84 --- /dev/null +++ b/x64/Debug/tds_dia__genmod.f90 @@ -0,0 +1,15 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:44 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TDS_DIA__genmod + INTERFACE + SUBROUTINE TDS_DIA(X1,X2,X3,X5,X6,X7) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + REAL(KIND=4) :: X3 + REAL(KIND=4) :: X5 + REAL(KIND=4) :: X6 + REAL(KIND=4) :: X7 + END SUBROUTINE TDS_DIA + END INTERFACE + END MODULE TDS_DIA__genmod diff --git a/x64/Debug/tds_dia__genmod.mod b/x64/Debug/tds_dia__genmod.mod new file mode 100644 index 0000000..094d942 Binary files /dev/null and b/x64/Debug/tds_dia__genmod.mod differ diff --git a/x64/Debug/tds_dw__genmod.f90 b/x64/Debug/tds_dw__genmod.f90 new file mode 100644 index 0000000..1fa15d5 --- /dev/null +++ b/x64/Debug/tds_dw__genmod.f90 @@ -0,0 +1,14 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:44 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TDS_DW__genmod + INTERFACE + SUBROUTINE TDS_DW(X1,X2,X3,X4,X5) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + REAL(KIND=4) :: X3 + REAL(KIND=4) :: X4 + REAL(KIND=4) :: X5 + END SUBROUTINE TDS_DW + END INTERFACE + END MODULE TDS_DW__genmod diff --git a/x64/Debug/tds_dw__genmod.mod b/x64/Debug/tds_dw__genmod.mod new file mode 100644 index 0000000..b697160 Binary files /dev/null and b/x64/Debug/tds_dw__genmod.mod differ diff --git a/x64/Debug/tds_dx__genmod.f90 b/x64/Debug/tds_dx__genmod.f90 new file mode 100644 index 0000000..8956b75 --- /dev/null +++ b/x64/Debug/tds_dx__genmod.f90 @@ -0,0 +1,14 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:44 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TDS_DX__genmod + INTERFACE + SUBROUTINE TDS_DX(X1,X2,X3,X4,X5) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + REAL(KIND=4) :: X3 + REAL(KIND=4) :: X4 + REAL(KIND=4) :: X5 + END SUBROUTINE TDS_DX + END INTERFACE + END MODULE TDS_DX__genmod diff --git a/x64/Debug/tds_dx__genmod.mod b/x64/Debug/tds_dx__genmod.mod new file mode 100644 index 0000000..b3e3a6b Binary files /dev/null and b/x64/Debug/tds_dx__genmod.mod differ diff --git a/x64/Debug/tds_dy__genmod.f90 b/x64/Debug/tds_dy__genmod.f90 new file mode 100644 index 0000000..f6e4e0e --- /dev/null +++ b/x64/Debug/tds_dy__genmod.f90 @@ -0,0 +1,14 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:44 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TDS_DY__genmod + INTERFACE + SUBROUTINE TDS_DY(X1,X2,X3,X4,X5) + REAL(KIND=4) :: X1 + REAL(KIND=4) :: X2 + REAL(KIND=4) :: X3 + REAL(KIND=4) :: X4 + REAL(KIND=4) :: X5 + END SUBROUTINE TDS_DY + END INTERFACE + END MODULE TDS_DY__genmod diff --git a/x64/Debug/tds_dy__genmod.mod b/x64/Debug/tds_dy__genmod.mod new file mode 100644 index 0000000..15742e9 Binary files /dev/null and b/x64/Debug/tds_dy__genmod.mod differ diff --git a/x64/Debug/testoperationscenarios.mod b/x64/Debug/testoperationscenarios.mod new file mode 100644 index 0000000..28bbc40 Binary files /dev/null and b/x64/Debug/testoperationscenarios.mod differ diff --git a/x64/Debug/testoperationscenariosvariables.mod b/x64/Debug/testoperationscenariosvariables.mod new file mode 100644 index 0000000..cb554c9 Binary files /dev/null and b/x64/Debug/testoperationscenariosvariables.mod differ diff --git a/x64/Debug/topdrive_inputs__genmod.f90 b/x64/Debug/topdrive_inputs__genmod.f90 new file mode 100644 index 0000000..b795517 --- /dev/null +++ b/x64/Debug/topdrive_inputs__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:49 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TOPDRIVE_INPUTS__genmod + INTERFACE + SUBROUTINE TOPDRIVE_INPUTS + END SUBROUTINE TOPDRIVE_INPUTS + END INTERFACE + END MODULE TOPDRIVE_INPUTS__genmod diff --git a/x64/Debug/topdrive_inputs__genmod.mod b/x64/Debug/topdrive_inputs__genmod.mod new file mode 100644 index 0000000..db0be89 Binary files /dev/null and b/x64/Debug/topdrive_inputs__genmod.mod differ diff --git a/x64/Debug/topdrive_malfunction_motorfailure__genmod.f90 b/x64/Debug/topdrive_malfunction_motorfailure__genmod.f90 new file mode 100644 index 0000000..7b9a534 --- /dev/null +++ b/x64/Debug/topdrive_malfunction_motorfailure__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:27 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TOPDRIVE_MALFUNCTION_MOTORFAILURE__genmod + INTERFACE + SUBROUTINE TOPDRIVE_MALFUNCTION_MOTORFAILURE + END SUBROUTINE TOPDRIVE_MALFUNCTION_MOTORFAILURE + END INTERFACE + END MODULE TOPDRIVE_MALFUNCTION_MOTORFAILURE__genmod diff --git a/x64/Debug/topdrive_malfunction_motorfailure__genmod.mod b/x64/Debug/topdrive_malfunction_motorfailure__genmod.mod new file mode 100644 index 0000000..eb222c2 Binary files /dev/null and b/x64/Debug/topdrive_malfunction_motorfailure__genmod.mod differ diff --git a/x64/Debug/topdrive_offmode__genmod.f90 b/x64/Debug/topdrive_offmode__genmod.f90 new file mode 100644 index 0000000..c87e4ed --- /dev/null +++ b/x64/Debug/topdrive_offmode__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:37 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TOPDRIVE_OFFMODE__genmod + INTERFACE + SUBROUTINE TOPDRIVE_OFFMODE + END SUBROUTINE TOPDRIVE_OFFMODE + END INTERFACE + END MODULE TOPDRIVE_OFFMODE__genmod diff --git a/x64/Debug/topdrive_offmode__genmod.mod b/x64/Debug/topdrive_offmode__genmod.mod new file mode 100644 index 0000000..7b24bf1 Binary files /dev/null and b/x64/Debug/topdrive_offmode__genmod.mod differ diff --git a/x64/Debug/topdrive_solver__genmod.f90 b/x64/Debug/topdrive_solver__genmod.f90 new file mode 100644 index 0000000..aaf73b6 --- /dev/null +++ b/x64/Debug/topdrive_solver__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:28 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TOPDRIVE_SOLVER__genmod + INTERFACE + SUBROUTINE TOPDRIVE_SOLVER + END SUBROUTINE TOPDRIVE_SOLVER + END INTERFACE + END MODULE TOPDRIVE_SOLVER__genmod diff --git a/x64/Debug/topdrive_solver__genmod.mod b/x64/Debug/topdrive_solver__genmod.mod new file mode 100644 index 0000000..eb38ab5 Binary files /dev/null and b/x64/Debug/topdrive_solver__genmod.mod differ diff --git a/x64/Debug/topdrive_startup__genmod.f90 b/x64/Debug/topdrive_startup__genmod.f90 new file mode 100644 index 0000000..2b3e032 --- /dev/null +++ b/x64/Debug/topdrive_startup__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:40 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TOPDRIVE_STARTUP__genmod + INTERFACE + SUBROUTINE TOPDRIVE_STARTUP + END SUBROUTINE TOPDRIVE_STARTUP + END INTERFACE + END MODULE TOPDRIVE_STARTUP__genmod diff --git a/x64/Debug/topdrive_startup__genmod.mod b/x64/Debug/topdrive_startup__genmod.mod new file mode 100644 index 0000000..f30e58d Binary files /dev/null and b/x64/Debug/topdrive_startup__genmod.mod differ diff --git a/x64/Debug/topdrive_torquelimit__genmod.f90 b/x64/Debug/topdrive_torquelimit__genmod.f90 new file mode 100644 index 0000000..8e6365a --- /dev/null +++ b/x64/Debug/topdrive_torquelimit__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:50 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TOPDRIVE_TORQUELIMIT__genmod + INTERFACE + SUBROUTINE TOPDRIVE_TORQUELIMIT + END SUBROUTINE TOPDRIVE_TORQUELIMIT + END INTERFACE + END MODULE TOPDRIVE_TORQUELIMIT__genmod diff --git a/x64/Debug/topdrive_torquelimit__genmod.mod b/x64/Debug/topdrive_torquelimit__genmod.mod new file mode 100644 index 0000000..41a1c14 Binary files /dev/null and b/x64/Debug/topdrive_torquelimit__genmod.mod differ diff --git a/x64/Debug/topdrive_traction_motor__genmod.f90 b/x64/Debug/topdrive_traction_motor__genmod.f90 new file mode 100644 index 0000000..03814b4 --- /dev/null +++ b/x64/Debug/topdrive_traction_motor__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:51 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TOPDRIVE_TRACTION_MOTOR__genmod + INTERFACE + SUBROUTINE TOPDRIVE_TRACTION_MOTOR + END SUBROUTINE TOPDRIVE_TRACTION_MOTOR + END INTERFACE + END MODULE TOPDRIVE_TRACTION_MOTOR__genmod diff --git a/x64/Debug/topdrive_traction_motor__genmod.mod b/x64/Debug/topdrive_traction_motor__genmod.mod new file mode 100644 index 0000000..ad8fb4a Binary files /dev/null and b/x64/Debug/topdrive_traction_motor__genmod.mod differ diff --git a/x64/Debug/topdrive_variables.mod b/x64/Debug/topdrive_variables.mod new file mode 100644 index 0000000..dd666a6 Binary files /dev/null and b/x64/Debug/topdrive_variables.mod differ diff --git a/x64/Debug/topdrivemain.mod b/x64/Debug/topdrivemain.mod new file mode 100644 index 0000000..3cd29c6 Binary files /dev/null and b/x64/Debug/topdrivemain.mod differ diff --git a/x64/Debug/torquedragmain.mod b/x64/Debug/torquedragmain.mod new file mode 100644 index 0000000..28be379 Binary files /dev/null and b/x64/Debug/torquedragmain.mod differ diff --git a/x64/Debug/tripout_and_pump__genmod.f90 b/x64/Debug/tripout_and_pump__genmod.f90 new file mode 100644 index 0000000..752a079 --- /dev/null +++ b/x64/Debug/tripout_and_pump__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:42 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TRIPOUT_AND_PUMP__genmod + INTERFACE + SUBROUTINE TRIPOUT_AND_PUMP + END SUBROUTINE TRIPOUT_AND_PUMP + END INTERFACE + END MODULE TRIPOUT_AND_PUMP__genmod diff --git a/x64/Debug/tripout_and_pump__genmod.mod b/x64/Debug/tripout_and_pump__genmod.mod new file mode 100644 index 0000000..d9412d0 Binary files /dev/null and b/x64/Debug/tripout_and_pump__genmod.mod differ diff --git a/x64/Debug/tvd_calculator__genmod.f90 b/x64/Debug/tvd_calculator__genmod.f90 new file mode 100644 index 0000000..ac70aef --- /dev/null +++ b/x64/Debug/tvd_calculator__genmod.f90 @@ -0,0 +1,11 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:49 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE TVD_CALCULATOR__genmod + INTERFACE + SUBROUTINE TVD_CALCULATOR(MEASUREDDEPTH,VERTICALDEPTH) + REAL(KIND=8) :: MEASUREDDEPTH + REAL(KIND=8) :: VERTICALDEPTH + END SUBROUTINE TVD_CALCULATOR + END INTERFACE + END MODULE TVD_CALCULATOR__genmod diff --git a/x64/Debug/tvd_calculator__genmod.mod b/x64/Debug/tvd_calculator__genmod.mod new file mode 100644 index 0000000..cb811f8 Binary files /dev/null and b/x64/Debug/tvd_calculator__genmod.mod differ diff --git a/x64/Debug/utube1_and_tripin__genmod.f90 b/x64/Debug/utube1_and_tripin__genmod.f90 new file mode 100644 index 0000000..c87197d --- /dev/null +++ b/x64/Debug/utube1_and_tripin__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:31 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE UTUBE1_AND_TRIPIN__genmod + INTERFACE + SUBROUTINE UTUBE1_AND_TRIPIN + END SUBROUTINE UTUBE1_AND_TRIPIN + END INTERFACE + END MODULE UTUBE1_AND_TRIPIN__genmod diff --git a/x64/Debug/utube1_and_tripin__genmod.mod b/x64/Debug/utube1_and_tripin__genmod.mod new file mode 100644 index 0000000..695a8ca Binary files /dev/null and b/x64/Debug/utube1_and_tripin__genmod.mod differ diff --git a/x64/Debug/utube2_and_tripin__genmod.f90 b/x64/Debug/utube2_and_tripin__genmod.f90 new file mode 100644 index 0000000..d04aaad --- /dev/null +++ b/x64/Debug/utube2_and_tripin__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:35 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE UTUBE2_AND_TRIPIN__genmod + INTERFACE + SUBROUTINE UTUBE2_AND_TRIPIN + END SUBROUTINE UTUBE2_AND_TRIPIN + END INTERFACE + END MODULE UTUBE2_AND_TRIPIN__genmod diff --git a/x64/Debug/utube2_and_tripin__genmod.mod b/x64/Debug/utube2_and_tripin__genmod.mod new file mode 100644 index 0000000..d81c5aa Binary files /dev/null and b/x64/Debug/utube2_and_tripin__genmod.mod differ diff --git a/x64/Debug/utube__genmod.f90 b/x64/Debug/utube__genmod.f90 new file mode 100644 index 0000000..e15680c --- /dev/null +++ b/x64/Debug/utube__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:28 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE UTUBE__genmod + INTERFACE + SUBROUTINE UTUBE + END SUBROUTINE UTUBE + END INTERFACE + END MODULE UTUBE__genmod diff --git a/x64/Debug/utube__genmod.mod b/x64/Debug/utube__genmod.mod new file mode 100644 index 0000000..27d7a10 Binary files /dev/null and b/x64/Debug/utube__genmod.mod differ diff --git a/x64/Debug/utubevars.mod b/x64/Debug/utubevars.mod new file mode 100644 index 0000000..472e77f Binary files /dev/null and b/x64/Debug/utubevars.mod differ diff --git a/x64/Debug/variables.mod b/x64/Debug/variables.mod new file mode 100644 index 0000000..d164ef3 Binary files /dev/null and b/x64/Debug/variables.mod differ diff --git a/x64/Debug/vc170.pdb b/x64/Debug/vc170.pdb new file mode 100644 index 0000000..e8c4dec Binary files /dev/null and b/x64/Debug/vc170.pdb differ diff --git a/x64/Debug/wellpressuredatatransfer__genmod.f90 b/x64/Debug/wellpressuredatatransfer__genmod.f90 new file mode 100644 index 0000000..a1030d4 --- /dev/null +++ b/x64/Debug/wellpressuredatatransfer__genmod.f90 @@ -0,0 +1,9 @@ + !COMPILER-GENERATED INTERFACE MODULE: Mon Jan 30 12:46:44 2023 + ! This source file is for reference only and may not completely + ! represent the generated interface used by the compiler. + MODULE WELLPRESSUREDATATRANSFER__genmod + INTERFACE + SUBROUTINE WELLPRESSUREDATATRANSFER + END SUBROUTINE WELLPRESSUREDATATRANSFER + END INTERFACE + END MODULE WELLPRESSUREDATATRANSFER__genmod diff --git a/x64/Debug/wellpressuredatatransfer__genmod.mod b/x64/Debug/wellpressuredatatransfer__genmod.mod new file mode 100644 index 0000000..9c9c6bb Binary files /dev/null and b/x64/Debug/wellpressuredatatransfer__genmod.mod differ diff --git a/مستتندات شبیه ساز.docx b/مستتندات شبیه ساز.docx new file mode 100644 index 0000000..c68d3fe Binary files /dev/null and b/مستتندات شبیه ساز.docx differ