SUBROUTINE Utube2_and_TripIn ! is called in subroutine CirculationCodeSelect annulus to string use UTUBEVARSModule Use GeoElements_FluidModule USE CMudPropertiesVariables USE MudSystemVARIABLES use SimulationVariables !@@@ use SimulationVariables use SimulationVariables !@ !use CTanks !@use ConfigurationVariables, TripTankVolume2 => data%Equipments%DrillingWatch%TripTankVolume, TripTankDensity2 => TripTankDensity Use CShoeVariables implicit none write(*,*) 'Utube2 code' !===========================================================WELL============================================================ !===========================================================WELL============================================================ data%State%MudSystem%UtubeMode2Activated= .true. write(*,*) 'QUtubeOutput=' , UTUBEVARS%QUtubeOutput !QUTubeInput=5000. data%State%MudSystem%StringFlowRate= UTUBEVARS%QUtubeOutput ! (gpm) data%State%MudSystem%AnnulusFlowRate= UTUBEVARS%QUtubeOutput data%State%MudSystem%StringFlowRateFinal= data%State%MudSystem%StringFlowRate data%State%MudSystem%AnnulusFlowRateFinal= data%State%MudSystem%AnnulusFlowRate !=========================================== if (data%State%MudSystem%FirstSetUtube2==0) then ! call St_MudDischarged_Volume%AddToFirst (REAL(sum(data%State%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 data%State%MudSystem%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(data%State%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 data%State%MudSystem%Hz_Density_Utube= 0.0 data%State%MudSystem%Hz_MudOrKick_Utube= 104 data%State%MudSystem%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)+ ((data%State%MudSystem%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(data%State%MudSystem%AnnulusSuctionDensity_Old - data%State%MudSystem%Hz_Density_Utube) >= data%State%MudSystem%DensityMixTol ) then ! new mud is pumped call data%State%MudSystem%Ann_Density%Add (data%State%MudSystem%Hz_Density_Utube) call data%State%MudSystem%Ann_MudDischarged_Volume%Add (0.0d0) call data%State%MudSystem%Ann_Mud_Forehead_X%Add (data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%NoPipeSections)) call data%State%MudSystem%Ann_Mud_Forehead_section%Add (data%State%MudSystem%NoPipeSections) call data%State%MudSystem%Ann_Mud_Backhead_X%Add (data%State%MudSystem%Xstart_PipeSection(data%State%MudSystem%NoPipeSections)) call data%State%MudSystem%Ann_Mud_Backhead_section%Add (data%State%MudSystem%NoPipeSections) call data%State%MudSystem%Ann_RemainedVolume_in_LastSection%Add (0.0d0) call data%State%MudSystem%Ann_EmptyVolume_inBackheadLocation%Add (0.0d0) call data%State%MudSystem%Ann_MudOrKick%Add (data%State%MudSystem%Hz_MudOrKick_Utube) ! Hz_MudOrKick%Last() = 104 call data%State%MudSystem%Ann_CuttingMud%Add (0) data%State%MudSystem%AnnulusSuctionDensity_Old= data%State%MudSystem%Hz_Density_Utube endif !========================ANNULUS==================== data%State%MudSystem%Ann_MudDischarged_Volume%Array(data%State%MudSystem%Ann_MudDischarged_Volume%Length())= data%State%MudSystem%Ann_MudDischarged_Volume%Last()+ ((data%State%MudSystem%AnnulusFlowRate/60.)*data%State%MudSystem%DeltaT_Mudline) !(gal) imud= data%State%MudSystem%Ann_Mud_Forehead_X%Length() + 1 do while (imud > 1) imud = imud - 1 if (imud< data%State%MudSystem%Ann_Mud_Forehead_X%Length()) then data%State%MudSystem%Ann_Mud_Forehead_X%Array(imud)= data%State%MudSystem%Ann_Mud_Backhead_X%Array(imud+1) data%State%MudSystem%Ann_Mud_Forehead_section%Array(imud)= data%State%MudSystem%Ann_Mud_Backhead_section%Array(imud+1) endif ! <<< Fracture Shoe Lost IF ( data%State%MudSystem%ShoeLost .and. data%State%MudSystem%LostInTripOutIsDone== .false. .and. data%Configuration%Shoe%ShoeDepth < data%State%MudSystem%Ann_Mud_Backhead_X%Array(imud) .and. data%Configuration%Shoe%ShoeDepth >= data%State%MudSystem%Ann_Mud_Forehead_X%Array(imud) ) then !write(*,*) 'ShoeLost imud,AnnVolume(imud), VolumeLost:' , imud,Ann_MudDischarged_Volume%Array(imud), (( Qlost/60.0d0)*DeltaT_Mudline) data%State%MudSystem%Ann_MudDischarged_Volume%Array(imud)= data%State%MudSystem%Ann_MudDischarged_Volume%Array(imud)-((data%State%MudSystem%Qlost/60.0d0)*data%State%MudSystem%DeltaT_Mudline) !(gal) if (data%State%MudSystem%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 >>> data%State%MudSystem%DirectionCoef= (data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%Ann_Mud_Forehead_section%Array(imud))-data%State%MudSystem%Xstart_PipeSection(data%State%MudSystem%Ann_Mud_Forehead_section%Array(imud))) & / ABS(data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%Ann_Mud_Forehead_section%Array(imud))-data%State%MudSystem%Xstart_PipeSection(data%State%MudSystem%Ann_Mud_Forehead_section%Array(imud))) ! +1 for string , -1 for annulus data%State%MudSystem%Ann_EmptyVolume_inBackheadLocation%Array(imud)= data%State%MudSystem%DirectionCoef* (data%State%MudSystem%Ann_Mud_Forehead_X%Array(imud)- data%State%MudSystem%Xstart_PipeSection(data%State%MudSystem%Ann_Mud_Forehead_section%Array(imud)))* & data%State%MudSystem%Area_PipeSectionFt(data%State%MudSystem%Ann_Mud_Forehead_section%Array(imud)) !(ft^3) data%State%MudSystem%Ann_EmptyVolume_inBackheadLocation%Array(imud)= data%State%MudSystem%Ann_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal if ( data%State%MudSystem%Ann_MudDischarged_Volume%Array(imud) <= data%State%MudSystem%Ann_EmptyVolume_inBackheadLocation%Array(imud)) then data%State%MudSystem%Ann_Mud_Backhead_section%Array(imud)= data%State%MudSystem%Ann_Mud_Forehead_section%Array(imud) data%State%MudSystem%Ann_Mud_Backhead_X%Array(imud)= data%State%MudSystem%Ann_Mud_Forehead_X%Array(imud)- data%State%MudSystem%DirectionCoef*(data%State%MudSystem%Ann_MudDischarged_Volume%Array(imud)/7.48051948d0)/data%State%MudSystem%Area_PipeSectionFt(data%State%MudSystem%Ann_Mud_Forehead_section%Array(imud)) ! 7.48051948 is for gal to ft^3 else data%State%MudSystem%isection= data%State%MudSystem%Ann_Mud_Forehead_section%Array(imud)-1 data%State%MudSystem%Ann_RemainedVolume_in_LastSection%Array(imud)= data%State%MudSystem%Ann_MudDischarged_Volume%Array(imud)- data%State%MudSystem%Ann_EmptyVolume_inBackheadLocation%Array(imud) do if (data%State%MudSystem%isection < data%State%F_Counts%StringIntervalCounts+1) then ! last pipe section(well exit) data%State%F_Counts%StringIntervalCounts+1 is the first section in Annulus data%State%MudSystem%Ann_MudDischarged_Volume%Array(imud)= data%State%MudSystem%Ann_MudDischarged_Volume%Array(imud)- data%State%MudSystem%Ann_RemainedVolume_in_LastSection%Array(imud) data%State%MudSystem%Ann_Mud_Backhead_X%Array(imud)= data%State%MudSystem%Xstart_PipeSection(data%State%F_Counts%StringIntervalCounts+1) data%State%MudSystem%Ann_Mud_Backhead_section%Array(imud)= data%State%F_Counts%StringIntervalCounts+1 if (data%State%MudSystem%Ann_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the well call RemoveAnnulusMudArrays(imud) endif exit endif data%State%MudSystem%xx= data%State%MudSystem%Ann_RemainedVolume_in_LastSection%Array(imud)/ data%State%MudSystem%PipeSection_VolumeCapacity(data%State%MudSystem%isection) !(gal) if (data%State%MudSystem%xx<= 1.0) then data%State%MudSystem%Ann_Mud_Backhead_section%Array(imud)= data%State%MudSystem%isection data%State%MudSystem%Ann_Mud_Backhead_X%Array(imud)= (data%State%MudSystem%xx * (data%State%MudSystem%Xstart_PipeSection(data%State%MudSystem%isection)- data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%isection)))+ data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%isection) exit else data%State%MudSystem%Ann_RemainedVolume_in_LastSection%Array(imud)= data%State%MudSystem%Ann_RemainedVolume_in_LastSection%Array(imud)- data%State%MudSystem%PipeSection_VolumeCapacity(data%State%MudSystem%isection) data%State%MudSystem%isection= data%State%MudSystem%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 < data%State%MudSystem%Op_Mud_Forehead_X%Length()) imud = imud + 1 if (imud> 1) then data%State%MudSystem%Op_Mud_Backhead_X%Array(imud)= data%State%MudSystem%Op_Mud_Forehead_X%Array(imud-1) data%State%MudSystem%Op_Mud_Backhead_section%Array(imud)= data%State%MudSystem%Op_Mud_Forehead_section%Array(imud-1) endif data%State%MudSystem%DirectionCoef= (data%State%MudSystem%Xend_OpSection(data%State%MudSystem%Op_Mud_Backhead_section%Array(imud))-data%State%MudSystem%Xstart_OpSection(data%State%MudSystem%Op_Mud_Backhead_section%Array(imud))) & / ABS(data%State%MudSystem%Xend_OpSection(data%State%MudSystem%Op_Mud_Backhead_section%Array(imud))-data%State%MudSystem%Xstart_OpSection(data%State%MudSystem%Op_Mud_Backhead_section%Array(imud))) ! +1 for string , -1 for annulus data%State%MudSystem%Op_EmptyVolume_inBackheadLocation%Array(imud)= data%State%MudSystem%DirectionCoef* (data%State%MudSystem%Xend_OpSection(data%State%MudSystem%Op_Mud_Backhead_section%Array(imud))- data%State%MudSystem%Op_Mud_Backhead_X%Array(imud))* & data%State%MudSystem%Area_OpSectionFt(data%State%MudSystem%Op_Mud_Backhead_section%Array(imud)) !(ft^3) data%State%MudSystem%Op_EmptyVolume_inBackheadLocation%Array(imud)= data%State%MudSystem%Op_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal if ( data%State%MudSystem%Op_MudDischarged_Volume%Array(imud) <= data%State%MudSystem%Op_EmptyVolume_inBackheadLocation%Array(imud)) then data%State%MudSystem%Op_Mud_Forehead_section%Array(imud)= data%State%MudSystem%Op_Mud_Backhead_section%Array(imud) data%State%MudSystem%Op_Mud_Forehead_X%Array(imud)= data%State%MudSystem%Op_Mud_Backhead_X%Array(imud)+ data%State%MudSystem%DirectionCoef*(data%State%MudSystem%Op_MudDischarged_Volume%Array(imud)/7.48051948d0)/data%State%MudSystem%Area_OpSectionFt(data%State%MudSystem%Op_Mud_Backhead_section%Array(imud)) ! 7.48051948 is for gal to ft^3 else data%State%MudSystem%isection= data%State%MudSystem%Op_Mud_Backhead_section%Array(imud)+1 data%State%MudSystem%Op_RemainedVolume_in_LastSection%Array(imud)= data%State%MudSystem%Op_MudDischarged_Volume%Array(imud)- data%State%MudSystem%Op_EmptyVolume_inBackheadLocation%Array(imud) do if (data%State%MudSystem%isection > data%State%F_Counts%BottomHoleIntervalCounts) then ! last pipe section(well exit) if( imud==1) data%State%MudSystem%KickDeltaVinAnnulus= data%State%MudSystem%Op_RemainedVolume_in_LastSection%Array(imud) ! Kick enters Annulus space data%State%MudSystem%Op_MudDischarged_Volume%Array(imud)= data%State%MudSystem%Op_MudDischarged_Volume%Array(imud)- data%State%MudSystem%Op_RemainedVolume_in_LastSection%Array(imud) data%State%MudSystem%Op_Mud_Forehead_X%Array(imud)= data%State%MudSystem%Xend_OpSection(data%State%F_Counts%BottomHoleIntervalCounts) data%State%MudSystem%Op_Mud_Forehead_section%Array(imud)= data%State%F_Counts%BottomHoleIntervalCounts if (data%State%MudSystem%Op_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the well call RemoveOpMudArrays(imud) endif exit endif data%State%MudSystem%xx= data%State%MudSystem%Op_RemainedVolume_in_LastSection%Array(imud)/ data%State%MudSystem%OpSection_VolumeCapacity(data%State%MudSystem%isection) !(gal) if (data%State%MudSystem%xx<= 1.0) then data%State%MudSystem%Op_Mud_Forehead_section%Array(imud)= data%State%MudSystem%isection data%State%MudSystem%Op_Mud_Forehead_X%Array(imud)= (data%State%MudSystem%xx * (data%State%MudSystem%Xend_OpSection(data%State%MudSystem%isection)- data%State%MudSystem%Xstart_OpSection(data%State%MudSystem%isection)))+ data%State%MudSystem%Xstart_OpSection(data%State%MudSystem%isection) exit else data%State%MudSystem%Op_RemainedVolume_in_LastSection%Array(imud)= data%State%MudSystem%Op_RemainedVolume_in_LastSection%Array(imud)- data%State%MudSystem%OpSection_VolumeCapacity(data%State%MudSystem%isection) data%State%MudSystem%isection= data%State%MudSystem%isection+ 1 endif enddo endif if (data%State%MudSystem%Op_Mud_Forehead_X%Array(imud)== data%State%MudSystem%Xend_OpSection(data%State%F_Counts%BottomHoleIntervalCounts)) then data%State%MudSystem%totalLength = data%State%MudSystem%Op_MudDischarged_Volume%Length() do while(imud < data%State%MudSystem%totalLength) !imud = imud + 1 call RemoveOpMudArrays(data%State%MudSystem%totalLength) data%State%MudSystem%totalLength = data%State%MudSystem%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(data%State%MudSystem%St_Density%Last() - data%State%MudSystem%Ann_Density%First()) >= data%State%MudSystem%DensityMixTol) .OR. (data%State%MudSystem%DeltaVolumeOp == 0.0 .and. data%State%MudSystem%St_Density%Last() /= data%State%MudSystem%Ann_Density%Array(1) .and. data%State%MudSystem%StringFlowRate/=0.0d0)) then ! new mud is pumped !if ((ABS(StringDensity_Old - Ann_Density%First()) >= DensityMixTol) .OR. (DeltaVolumeOp == 0.0 .and. data%State%MudSystem%St_Density%Last() /= Ann_Density%Array(1) .and. data%State%MudSystem%StringFlowRate/=0.0d0)) then ! new mud is pumped call data%State%MudSystem%St_Density%Add (data%State%MudSystem%Ann_Density%First()) call data%State%MudSystem%St_MudDischarged_Volume%Add (0.0d0) call data%State%MudSystem%St_Mud_Forehead_X%Add (data%State%MudSystem%Xend_PipeSection(data%State%F_Counts%StringIntervalCounts)) call data%State%MudSystem%St_Mud_Forehead_section%Add (data%State%F_Counts%StringIntervalCounts) call data%State%MudSystem%St_Mud_Backhead_X%Add (data%State%MudSystem%Xstart_PipeSection(data%State%F_Counts%StringIntervalCounts)) call data%State%MudSystem%St_Mud_Backhead_section%Add (data%State%F_Counts%StringIntervalCounts) call data%State%MudSystem%St_RemainedVolume_in_LastSection%Add (0.0d0) call data%State%MudSystem%St_EmptyVolume_inBackheadLocation%Add (0.0d0) call data%State%MudSystem%St_MudOrKick%Add (0) !StringDensity_Old= Ann_Density%First() data%State%MudSystem%MudIsChanged= .true. endif data%State%MudSystem%St_MudDischarged_Volume%Array(data%State%MudSystem%St_MudDischarged_Volume%Length())= data%State%MudSystem%St_MudDischarged_Volume%Last()+ ((data%State%MudSystem%StringFlowRate/60.0d0)*data%State%MudSystem%DeltaT_Mudline) !(gal) !========================Tripping In==================== !write(*,*) 'DeltaVolumeOp=' , DeltaVolumeOp write(*,*) 'DeltaVolumeOp=' , data%State%MudSystem%DeltaVolumeOp if (data%State%MudSystem%DeltaVolumeOp > 0.0 .and. data%State%MudSystem%MudIsChanged== .false.) then !.and. DrillingMode== .false.) then ! trip in mode(loole paeen) !write(*,*) 'Tripping In' data%State%MudSystem%NewDensity= (data%State%MudSystem%Ann_Density%First()*((data%State%MudSystem%StringFlowRate/60.0d0)*data%State%MudSystem%DeltaT_Mudline)+data%State%MudSystem%Op_Density%Last()*data%State%MudSystem%DeltaVolumeOp)/(((data%State%MudSystem%StringFlowRate/60.0d0)*data%State%MudSystem%DeltaT_Mudline)+data%State%MudSystem%DeltaVolumeOp) data%State%MudSystem%NewVolume= ((data%State%MudSystem%StringFlowRate/60.0d0)*data%State%MudSystem%DeltaT_Mudline)+data%State%MudSystem%DeltaVolumeOp !write(*,*) 'St_MudDischarged_Volume%Last()=', St_MudDischarged_Volume%Last(), 'NewVolume=', NewVolume if (abs(data%State%MudSystem%St_Density%Last()-data%State%MudSystem%NewDensity)< data%State%MudSystem%DensityMixTol) then ! .OR. (St_MudDischarged_Volume%Last()< 42.) ) then !+ NewVolume)< 42.) then ! 1-Pockets are Merged data%State%MudSystem%St_Density%Array(data%State%MudSystem%St_Density%Length())= (data%State%MudSystem%St_Density%Last()*data%State%MudSystem%St_MudDischarged_Volume%Last()+data%State%MudSystem%NewDensity*data%State%MudSystem%NewVolume)/(data%State%MudSystem%St_MudDischarged_Volume%Last()+data%State%MudSystem%NewVolume) data%State%MudSystem%St_MudDischarged_Volume%Array(data%State%MudSystem%St_Density%Length())= data%State%MudSystem%St_MudDischarged_Volume%Last()+data%State%MudSystem%DeltaVolumeOp data%State%MudSystem%St_Mud_Forehead_X%Array(data%State%MudSystem%St_Density%Length())= (data%State%MudSystem%Xend_PipeSection(data%State%F_Counts%StringIntervalCounts)) data%State%MudSystem%St_Mud_Forehead_section%Array(data%State%MudSystem%St_Density%Length())= (data%State%F_Counts%StringIntervalCounts) data%State%MudSystem%St_Mud_Backhead_X%Array(data%State%MudSystem%St_Density%Length())= (data%State%MudSystem%Xstart_PipeSection(data%State%F_Counts%StringIntervalCounts)) data%State%MudSystem%St_Mud_Backhead_section%Array(data%State%MudSystem%St_Density%Length())= (data%State%F_Counts%StringIntervalCounts) data%State%MudSystem%St_RemainedVolume_in_LastSection%Array(data%State%MudSystem%St_Density%Length())= (0.0d0) data%State%MudSystem%St_EmptyVolume_inBackheadLocation%Array(data%State%MudSystem%St_Density%Length())= (0.0d0) else ! 2-Merging conditions are not meeted, so new pocket call data%State%MudSystem%St_Density%Add (data%State%MudSystem%NewDensity) call data%State%MudSystem%St_MudDischarged_Volume%Add (data%State%MudSystem%NewVolume) call data%State%MudSystem%St_Mud_Forehead_X%Add (data%State%MudSystem%Xend_PipeSection(data%State%F_Counts%StringIntervalCounts)) call data%State%MudSystem%St_Mud_Forehead_section%Add (data%State%F_Counts%StringIntervalCounts) call data%State%MudSystem%St_Mud_Backhead_X%Add (data%State%MudSystem%Xstart_PipeSection(data%State%F_Counts%StringIntervalCounts)) call data%State%MudSystem%St_Mud_Backhead_section%Add (data%State%F_Counts%StringIntervalCounts) call data%State%MudSystem%St_RemainedVolume_in_LastSection%Add (0.0d0) call data%State%MudSystem%St_EmptyVolume_inBackheadLocation%Add (0.0d0) call data%State%MudSystem%St_MudOrKick%Add (0) endif elseif (data%State%MudSystem%DeltaVolumeOp > 0.0 .and. data%State%MudSystem%MudIsChanged== .true.) then data%State%MudSystem%St_Density%Array(data%State%MudSystem%St_Density%Length())= data%State%MudSystem%NewDensity data%State%MudSystem%St_MudDischarged_Volume%Array(data%State%MudSystem%St_Density%Length())= data%State%MudSystem%NewVolume data%State%MudSystem%St_Mud_Forehead_X%Array(data%State%MudSystem%St_Density%Length())= (data%State%MudSystem%Xend_PipeSection(data%State%F_Counts%StringIntervalCounts)) data%State%MudSystem%St_Mud_Forehead_section%Array(data%State%MudSystem%St_Density%Length())= (data%State%F_Counts%StringIntervalCounts) data%State%MudSystem%St_Mud_Backhead_X%Array(data%State%MudSystem%St_Density%Length())= (data%State%MudSystem%Xstart_PipeSection(data%State%F_Counts%StringIntervalCounts)) data%State%MudSystem%St_Mud_Backhead_section%Array(data%State%MudSystem%St_Density%Length())= (data%State%F_Counts%StringIntervalCounts) data%State%MudSystem%St_RemainedVolume_in_LastSection%Array(data%State%MudSystem%St_Density%Length())= (0.0d0) data%State%MudSystem%St_EmptyVolume_inBackheadLocation%Array(data%State%MudSystem%St_Density%Length())= (0.0d0) endif !========================Tripping In - End==================== !======================== STRING ==================== data%State%MudSystem%MudIsChanged= .false. imud= data%State%MudSystem%St_Mud_Forehead_X%Length() + 1 do while (imud > 1) imud = imud - 1 if (imud< data%State%MudSystem%St_Mud_Forehead_X%Length()) then data%State%MudSystem%St_Mud_Forehead_X%Array(imud)= data%State%MudSystem%St_Mud_Backhead_X%Array(imud+1) data%State%MudSystem%St_Mud_Forehead_section%Array(imud)= data%State%MudSystem%St_Mud_Backhead_section%Array(imud+1) endif data%State%MudSystem%DirectionCoef= (data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%St_Mud_Forehead_section%Array(imud))-data%State%MudSystem%Xstart_PipeSection(data%State%MudSystem%St_Mud_Forehead_section%Array(imud))) & / ABS(data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%St_Mud_Forehead_section%Array(imud))-data%State%MudSystem%Xstart_PipeSection(data%State%MudSystem%St_Mud_Forehead_section%Array(imud))) ! +1 for string , -1 for annulus data%State%MudSystem%St_EmptyVolume_inBackheadLocation%Array(imud)= data%State%MudSystem%DirectionCoef* (data%State%MudSystem%St_Mud_Forehead_X%Array(imud)- data%State%MudSystem%Xstart_PipeSection(data%State%MudSystem%St_Mud_Forehead_section%Array(imud)))* & data%State%MudSystem%Area_PipeSectionFt(data%State%MudSystem%St_Mud_Backhead_section%Array(imud)) !(ft^3) data%State%MudSystem%St_EmptyVolume_inBackheadLocation%Array(imud)= data%State%MudSystem%St_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal if ( data%State%MudSystem%St_MudDischarged_Volume%Array(imud) <= data%State%MudSystem%St_EmptyVolume_inBackheadLocation%Array(imud)) then data%State%MudSystem%St_Mud_Backhead_section%Array(imud)= data%State%MudSystem%St_Mud_Forehead_section%Array(imud) data%State%MudSystem%St_Mud_Backhead_X%Array(imud)= data%State%MudSystem%St_Mud_Forehead_X%Array(imud)- data%State%MudSystem%DirectionCoef*(data%State%MudSystem%St_MudDischarged_Volume%Array(imud)/7.48051948d0)/data%State%MudSystem%Area_PipeSectionFt(data%State%MudSystem%St_Mud_Forehead_section%Array(imud)) ! 7.48051948 is for gal to ft^3 else data%State%MudSystem%isection= data%State%MudSystem%St_Mud_Backhead_section%Array(imud)-1 data%State%MudSystem%St_RemainedVolume_in_LastSection%Array(imud)= data%State%MudSystem%St_MudDischarged_Volume%Array(imud)- data%State%MudSystem%St_EmptyVolume_inBackheadLocation%Array(imud) do if (data%State%MudSystem%isection < 1) then ! last pipe section(string exit) data%State%MudSystem%St_MudDischarged_Volume%Array(imud)= data%State%MudSystem%St_MudDischarged_Volume%Array(imud)- data%State%MudSystem%St_RemainedVolume_in_LastSection%Array(imud) data%State%MudSystem%St_Mud_Backhead_X%Array(imud)= data%State%MudSystem%Xstart_PipeSection(2) data%State%MudSystem%St_Mud_Backhead_section%Array(imud)= 2 if (data%State%MudSystem%St_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the string call RemoveStringMudArrays(imud) endif exit endif data%State%MudSystem%xx= data%State%MudSystem%St_RemainedVolume_in_LastSection%Array(imud)/ data%State%MudSystem%PipeSection_VolumeCapacity(data%State%MudSystem%isection) !(gal) if (data%State%MudSystem%xx<= 1.0) then data%State%MudSystem%St_Mud_Backhead_section%Array(imud)= data%State%MudSystem%isection data%State%MudSystem%St_Mud_Backhead_X%Array(imud)= (data%State%MudSystem%xx * (data%State%MudSystem%Xstart_PipeSection(data%State%MudSystem%isection)- data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%isection)))+ data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%isection) exit else data%State%MudSystem%St_RemainedVolume_in_LastSection%Array(imud)= data%State%MudSystem%St_RemainedVolume_in_LastSection%Array(imud)- data%State%MudSystem%PipeSection_VolumeCapacity(data%State%MudSystem%isection) data%State%MudSystem%isection= data%State%MudSystem%isection- 1 endif enddo endif enddo !========================STRING END================= end subroutine Utube2_and_TripIn