!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 = Formation%Count !??????????????????????????????????????????? Drilling_Depth = TD_WellTotalLength !????????????????????????? change to vertical depth of well do i= 1,No_of_Formations !??????????????????????????????????????? FormationTopDepth = Formation%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 = StringConfiguration%BitDefinition%BitSize ! unit : [in.] (Typical Range: 3.0 to 30.0) Number_of_Bit_Nozzles = StringConfiguration%BitDefinition%BitNozzleNo ! (Typical Values: 1 to 10) Diameter_of_Bit_Nozzle = StringConfiguration%BitDefinition%BitNozzleSize ! unit : [1/32 in.] (Typical Range: 8.0 to 32.0) Critical_Mud_Density = Formation%Formations(FormationNumber)%PorePressureGradient/.465*9. ! unit : [ppg] or [lb/gal] (Typical Range: 0 to 10.0) Critical_Weight_on_Bit = (Formation%Formations(FormationNumber)%ThresholdWeight/5.)-(.06*(Formation%Formations(FormationNumber)%ThresholdWeight-10.)) ! unit : [klb/in] (Typical Range: 0 to 10 ----> 0.6 to 2) Mud_Viscosity = MudProperties%ActivePlasticViscosity !????????????????????????????????? Mud_Density = MudProperties%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(Formation%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 = Formation%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