MODULE FricPressDropVarsModule !! Record of revisions !! Date Programmer Discription of change !! ------ ------------ ----------------------- !! 1396/07/26 Sheikh Original code !! IMPLICIT NONE TYPE :: FricPressDropVarsTYPE 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 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 :: 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 END TYPE FricPressDropVarsTYPE INTEGER :: ShoeFlowElNo ! the flow element that starts from shoe, in other word the number of upper element adjacent to shoe 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] 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 FricPressDropVarsModule MODULE UTUBEVARSModule TYPE :: UTUBEVARSTYPE 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 TYPE UTUBEVARSTYPE TYPE(UTUBEVARSTYPE) :: UTUBEVARS END MODULE UTUBEVARSModule SUBROUTINE DeallocateFlowTypes USE FricPressDropVarsModule use PressureDisplayVARIABLESModule use KickVARIABLESModule 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 DeallocateFlowTypes