SUBROUTINE Utube1_and_TripIn ! is called in subroutine CirculationCodeSelect string to annulus Use UTUBEVARS Use GeoElements_FluidModule USE CMudPropertiesVariables USE MudSystemVARIABLES USE Pumps_VARIABLES USE sROP_Variables use CDrillWatchVariables !use CTanksVariables, TripTankVolume2 => DrillingWatch%TripTankVolume, TripTankDensity2 => TripTankDensity Use CShoeVariables Use CUnityOutputs implicit none write(*,*) 'Utube1 code' !===========================================================WELL============================================================ !===========================================================WELL============================================================ MudSystemDotUtubeMode1Activated= .true. !write(*,*) 'QUTubeInput=' , QUTubeInput !Qinput=5000. MudSystemDotStringFlowRate= QUTubeInput ! (gpm) MudSystemDotAnnulusFlowRate= QUTubeInput MudSystemDotStringFlowRateFinal= MudSystemDotStringFlowRate MudSystemDotAnnulusFlowRateFinal= MudSystemDotAnnulusFlowRate !=========================================== if (MudSystemDotFirstSetUtube1==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 MudSystemDotHz_Density_Utube= 0.0 MudSystemDotHz_MudOrKick_Utube= 104 MudSystemDotFirstSetUtube1= 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() - MudSystemDotHz_Density_Utube) >= MudSystemDotDensityMixTol) then ! new mud is pumped call St_Density%AddToFirst (MudSystemDotHz_Density_Utube) call MudSystemDotSt_MudDischarged_Volume%AddToFirst (0.0d0) call MudSystemDotSt_Mud_Forehead_X%AddToFirst (MudSystemDotXstart_PipeSection(2)) call St_Mud_Forehead_section%AddToFirst (2) call MudSystemDotSt_Mud_Backhead_X%AddToFirst (MudSystemDotXstart_PipeSection(2)) call St_Mud_Backhead_section%AddToFirst (2) call MudSystemDotSt_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call MudSystemDotSt_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call St_MudOrKick%AddToFirst (MudSystemDotHz_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 MudSystemDotSt_MudDischarged_Volume%Array(1)= MudSystemDotSt_MudDischarged_Volume%Array(1)+ ((MudSystemDotStringFlowRate/60.d0)*DeltaT_Mudline) !(gal) MudSystemDotimud=0 do while (MudSystemDotimud < MudSystemDotSt_Mud_Forehead_X%Length()) MudSystemDotimud = MudSystemDotimud + 1 if (MudSystemDotimud> 1) then MudSystemDotSt_Mud_Backhead_X%Array(MudSystemDotimud)= MudSystemDotSt_Mud_Forehead_X%Array(MudSystemDotimud-1) St_Mud_Backhead_section%Array(MudSystemDotimud)= St_Mud_Forehead_section%Array(MudSystemDotimud-1) endif MudSystemDotDirectionCoef= (MudSystemDotXend_PipeSection(St_Mud_Backhead_section%Array(MudSystemDotimud))-MudSystemDotXstart_PipeSection(St_Mud_Backhead_section%Array(MudSystemDotimud))) & / ABS(MudSystemDotXend_PipeSection(St_Mud_Backhead_section%Array(MudSystemDotimud))-MudSystemDotXstart_PipeSection(St_Mud_Backhead_section%Array(MudSystemDotimud))) ! +1 for string , -1 for annulus MudSystemDotSt_EmptyVolume_inBackheadLocation%Array(MudSystemDotimud)= MudSystemDotDirectionCoef* (MudSystemDotXend_PipeSection(St_Mud_Backhead_section%Array(MudSystemDotimud))- MudSystemDotSt_Mud_Backhead_X%Array(MudSystemDotimud))* & MudSystemDotArea_PipeSectionFt(St_Mud_Backhead_section%Array(MudSystemDotimud)) !(ft^3) MudSystemDotSt_EmptyVolume_inBackheadLocation%Array(MudSystemDotimud)= MudSystemDotSt_EmptyVolume_inBackheadLocation%Array(MudSystemDotimud)* 7.48051948d0 ! ft^3 to gal if ( MudSystemDotSt_MudDischarged_Volume%Array(MudSystemDotimud) <= MudSystemDotSt_EmptyVolume_inBackheadLocation%Array(MudSystemDotimud)) then St_Mud_Forehead_section%Array(MudSystemDotimud)= St_Mud_Backhead_section%Array(MudSystemDotimud) MudSystemDotSt_Mud_Forehead_X%Array(MudSystemDotimud)= MudSystemDotSt_Mud_Backhead_X%Array(MudSystemDotimud)+ MudSystemDotDirectionCoef*(MudSystemDotSt_MudDischarged_Volume%Array(MudSystemDotimud)/7.48051948d0)/MudSystemDotArea_PipeSectionFt(St_Mud_Backhead_section%Array(MudSystemDotimud)) ! 7.48 is for gal to ft^3 else MudSystemDotisection= St_Mud_Backhead_section%Array(MudSystemDotimud)+1 MudSystemDotSt_RemainedVolume_in_LastSection%Array(MudSystemDotimud)= MudSystemDotSt_MudDischarged_Volume%Array(MudSystemDotimud)- MudSystemDotSt_EmptyVolume_inBackheadLocation%Array(MudSystemDotimud) do if (MudSystemDotisection > F_StringIntervalCounts) then ! last pipe section(string exit) F_StringIntervalCounts includes Horizontal line MudSystemDotSt_MudDischarged_Volume%Array(MudSystemDotimud)= MudSystemDotSt_MudDischarged_Volume%Array(MudSystemDotimud)- MudSystemDotSt_RemainedVolume_in_LastSection%Array(MudSystemDotimud) MudSystemDotSt_Mud_Forehead_X%Array(MudSystemDotimud)= MudSystemDotXend_PipeSection(F_StringIntervalCounts) St_Mud_Forehead_section%Array(MudSystemDotimud)= F_StringIntervalCounts if (MudSystemDotSt_MudDischarged_Volume%Array(MudSystemDotimud)<= 0.0d0) then ! imud is completely exited form the string call RemoveStringMudArrays(MudSystemDotimud) endif exit endif MudSystemDotxx= MudSystemDotSt_RemainedVolume_in_LastSection%Array(MudSystemDotimud)/ MudSystemDotPipeSection_VolumeCapacity(MudSystemDotisection) !(gal) if (MudSystemDotxx<= 1.0) then St_Mud_Forehead_section%Array(MudSystemDotimud)= MudSystemDotisection MudSystemDotSt_Mud_Forehead_X%Array(MudSystemDotimud)= (MudSystemDotxx * (MudSystemDotXend_PipeSection(MudSystemDotisection)- MudSystemDotXstart_PipeSection(MudSystemDotisection)))+ MudSystemDotXstart_PipeSection(MudSystemDotisection) exit else MudSystemDotSt_RemainedVolume_in_LastSection%Array(MudSystemDotimud)= MudSystemDotSt_RemainedVolume_in_LastSection%Array(MudSystemDotimud)- MudSystemDotPipeSection_VolumeCapacity(MudSystemDotisection) MudSystemDotisection= MudSystemDotisection+ 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 MudSystemDotimud=0 do while (MudSystemDotimud < MudSystemDotOp_Mud_Forehead_X%Length()) MudSystemDotimud = MudSystemDotimud + 1 if (MudSystemDotimud> 1) then MudSystemDotOp_Mud_Backhead_X%Array(MudSystemDotimud)= MudSystemDotOp_Mud_Forehead_X%Array(MudSystemDotimud-1) Op_Mud_Backhead_section%Array(MudSystemDotimud)= Op_Mud_Forehead_section%Array(MudSystemDotimud-1) endif MudSystemDotDirectionCoef= (MudSystemDotXend_OpSection(Op_Mud_Backhead_section%Array(MudSystemDotimud))-MudSystemDotXstart_OpSection(Op_Mud_Backhead_section%Array(MudSystemDotimud))) & / ABS(MudSystemDotXend_OpSection(Op_Mud_Backhead_section%Array(MudSystemDotimud))-MudSystemDotXstart_OpSection(Op_Mud_Backhead_section%Array(MudSystemDotimud))) ! +1 for string , -1 for annulus MudSystemDotOp_EmptyVolume_inBackheadLocation%Array(MudSystemDotimud)= MudSystemDotDirectionCoef* (MudSystemDotXend_OpSection(Op_Mud_Backhead_section%Array(MudSystemDotimud))- MudSystemDotOp_Mud_Backhead_X%Array(MudSystemDotimud))* & MudSystemDotArea_OpSectionFt(Op_Mud_Backhead_section%Array(MudSystemDotimud)) !(ft^3) MudSystemDotOp_EmptyVolume_inBackheadLocation%Array(MudSystemDotimud)= MudSystemDotOp_EmptyVolume_inBackheadLocation%Array(MudSystemDotimud)* 7.48051948d0 ! ft^3 to gal if ( MudSystemDotOp_MudDischarged_Volume%Array(MudSystemDotimud) <= MudSystemDotOp_EmptyVolume_inBackheadLocation%Array(MudSystemDotimud)) then Op_Mud_Forehead_section%Array(MudSystemDotimud)= Op_Mud_Backhead_section%Array(MudSystemDotimud) MudSystemDotOp_Mud_Forehead_X%Array(MudSystemDotimud)= MudSystemDotOp_Mud_Backhead_X%Array(MudSystemDotimud)+ MudSystemDotDirectionCoef*(MudSystemDotOp_MudDischarged_Volume%Array(MudSystemDotimud)/7.48051948d0)/MudSystemDotArea_OpSectionFt(Op_Mud_Backhead_section%Array(MudSystemDotimud)) ! 7.48 is for gal to ft^3 else MudSystemDotisection= Op_Mud_Backhead_section%Array(MudSystemDotimud)+1 MudSystemDotOp_RemainedVolume_in_LastSection%Array(MudSystemDotimud)= MudSystemDotOp_MudDischarged_Volume%Array(MudSystemDotimud)- MudSystemDotOp_EmptyVolume_inBackheadLocation%Array(MudSystemDotimud) do if (MudSystemDotisection > F_BottomHoleIntervalCounts) then ! last pipe section(well exit) if( MudSystemDotimud==1) MudSystemDotKickDeltaVinAnnulus= MudSystemDotOp_RemainedVolume_in_LastSection%Array(MudSystemDotimud) ! Kick enters Annulus space MudSystemDotOp_MudDischarged_Volume%Array(MudSystemDotimud)= MudSystemDotOp_MudDischarged_Volume%Array(MudSystemDotimud)- MudSystemDotOp_RemainedVolume_in_LastSection%Array(MudSystemDotimud) MudSystemDotOp_Mud_Forehead_X%Array(MudSystemDotimud)= MudSystemDotXend_OpSection(F_BottomHoleIntervalCounts) Op_Mud_Forehead_section%Array(MudSystemDotimud)= F_BottomHoleIntervalCounts if (MudSystemDotOp_MudDischarged_Volume%Array(MudSystemDotimud)<= 0.0d0) then ! imud is completely exited form the well call RemoveOpMudArrays(MudSystemDotimud) endif exit endif MudSystemDotxx= MudSystemDotOp_RemainedVolume_in_LastSection%Array(MudSystemDotimud)/ MudSystemDotOpSection_VolumeCapacity(MudSystemDotisection) !(gal) if (MudSystemDotxx<= 1.0) then Op_Mud_Forehead_section%Array(MudSystemDotimud)= MudSystemDotisection MudSystemDotOp_Mud_Forehead_X%Array(MudSystemDotimud)= (MudSystemDotxx * (MudSystemDotXend_OpSection(MudSystemDotisection)- MudSystemDotXstart_OpSection(MudSystemDotisection)))+ MudSystemDotXstart_OpSection(MudSystemDotisection) exit else MudSystemDotOp_RemainedVolume_in_LastSection%Array(MudSystemDotimud)= MudSystemDotOp_RemainedVolume_in_LastSection%Array(MudSystemDotimud)- MudSystemDotOpSection_VolumeCapacity(MudSystemDotisection) MudSystemDotisection= MudSystemDotisection+ 1 endif enddo endif if (MudSystemDotOp_Mud_Forehead_X%Array(MudSystemDotimud)== MudSystemDotXend_OpSection(F_BottomHoleIntervalCounts)) then MudSystemDottotalLength = MudSystemDotOp_MudDischarged_Volume%Length() do while(MudSystemDotimud < MudSystemDottotalLength) !imud = imud + 1 call RemoveOpMudArrays(MudSystemDottotalLength) MudSystemDottotalLength = MudSystemDottotalLength - 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 (MudSystemDotiLoc == 1) then MudSystemDotMudSection= F_StringIntervalCounts+1 MudSystemDotBackheadX= MudSystemDotXstart_PipeSection(F_StringIntervalCounts+1) elseif (MudSystemDotiLoc == 2) then MudSystemDotMudSection= MudSystemDotKick_Forehead_section MudSystemDotBackheadX= MudSystemDotKick_Forehead_X endif !========================ANNULUS ENTRANCE==================== !write(*,*) 'iloc=====' , iLoc if ((ABS(AnnulusSuctionDensity_Old - St_Density%Last()) >= MudSystemDotDensityMixTol) .OR. (MudSystemDotDeltaVolumeOp == 0.0 .and. ABS(Ann_Density%Array(MudSystemDotiLoc)-St_Density%Last())>=MudSystemDotDensityMixTol .and. MudSystemDotAnnulusFlowRate/=0.0d0) ) then ! new mud is pumped call Ann_Density%AddTo (MudSystemDotiLoc,St_Density%Last()) call MudSystemDotAnn_MudDischarged_Volume%AddTo (MudSystemDotiLoc,0.0d0) call Ann_Mud_Forehead_X%AddTo (MudSystemDotiLoc,MudSystemDotBackheadX) call Ann_Mud_Forehead_section%AddTo (MudSystemDotiLoc,MudSystemDotMudSection) call Ann_Mud_Backhead_X%AddTo (MudSystemDotiLoc,MudSystemDotBackheadX) call Ann_Mud_Backhead_section%AddTo (MudSystemDotiLoc,MudSystemDotMudSection) call Ann_RemainedVolume_in_LastSection%AddTo (MudSystemDotiLoc,0.0d0) call Ann_EmptyVolume_inBackheadLocation%AddTo (MudSystemDotiLoc,0.0d0) call Ann_MudOrKick%AddTo (MudSystemDotiLoc,0) call Ann_CuttingMud%AddTo (MudSystemDotiLoc,0) AnnulusSuctionDensity_Old= St_Density%Last() MudSystemDotMudIsChanged= .true. endif MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotiLoc)= MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotiLoc)+ ((MudSystemDotAnnulusFlowRate/60.0d0)*DeltaT_Mudline) !(gal) !========================Tripping In==================== !write(*,*) 'DeltaVolumeOp=' , DeltaVolumeOp if (MudSystemDotDeltaVolumeOp > 0.0 .and. MudSystemDotMudIsChanged== .false.) then !.and. DrillingMode== .false.) then ! trip in mode(loole paeen) !write(*,*) 'Tripping In' NewDensity= (St_Density%Last()*((MudSystemDotAnnulusFlowRate/60.)*DeltaT_Mudline)+MudSystemDotOp_Density%Last()*MudSystemDotDeltaVolumeOp)/(((MudSystemDotAnnulusFlowRate/60.0d0)*DeltaT_Mudline)+MudSystemDotDeltaVolumeOp) MudSystemDotNewVolume= ((MudSystemDotAnnulusFlowRate/60.)*DeltaT_Mudline)+MudSystemDotDeltaVolumeOp !write(*,*) 'Ann_MudDischarged_Volume%Array(1)=', Ann_MudDischarged_Volume%Array(1), 'NewVolume=', NewVolume if (abs(Ann_Density%Array(MudSystemDotiLoc)-NewDensity)< MudSystemDotDensityMixTol) then ! 1-Pockets are Merged - (ROP is 0) Ann_Density%Array(MudSystemDotiLoc)= (Ann_Density%Array(MudSystemDotiLoc)*MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotiLoc)+NewDensity*MudSystemDotNewVolume)/(MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotiLoc)+MudSystemDotNewVolume) MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotiLoc)= MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotiLoc)+MudSystemDotDeltaVolumeOp Ann_Mud_Forehead_X%Array(MudSystemDotiLoc)= MudSystemDotBackheadX Ann_Mud_Forehead_section%Array(MudSystemDotiLoc)= MudSystemDotMudSection Ann_Mud_Backhead_X%Array(MudSystemDotiLoc)= MudSystemDotBackheadX Ann_Mud_Backhead_section%Array(MudSystemDotiLoc)= MudSystemDotMudSection Ann_RemainedVolume_in_LastSection%Array(MudSystemDotiLoc)= (0.0d0) Ann_EmptyVolume_inBackheadLocation%Array(MudSystemDotiLoc)= (0.0d0) else ! 2-Merging conditions are not meeted, so new pocket call Ann_Density%AddTo (MudSystemDotiLoc,NewDensity) call MudSystemDotAnn_MudDischarged_Volume%AddTo (MudSystemDotiLoc,MudSystemDotNewVolume) call Ann_Mud_Forehead_X%AddTo (MudSystemDotiLoc,MudSystemDotBackheadX) call Ann_Mud_Forehead_section%AddTo (MudSystemDotiLoc,MudSystemDotMudSection) call Ann_Mud_Backhead_X%AddTo (MudSystemDotiLoc,MudSystemDotBackheadX) call Ann_Mud_Backhead_section%AddTo (MudSystemDotiLoc,MudSystemDotMudSection) call Ann_RemainedVolume_in_LastSection%AddTo (MudSystemDotiLoc,0.0d0) call Ann_EmptyVolume_inBackheadLocation%AddTo (MudSystemDotiLoc,0.0d0) call Ann_MudOrKick%AddTo (MudSystemDotiLoc,0) call Ann_CuttingMud%AddTo (MudSystemDotiLoc,0) endif elseif (MudSystemDotDeltaVolumeOp > 0.0 .and. MudSystemDotMudIsChanged== .true. .and. Rate_of_Penetration==0.) then Ann_Density%Array(MudSystemDotiLoc)= NewDensity MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotiLoc)= MudSystemDotNewVolume Ann_Mud_Forehead_X%Array(MudSystemDotiLoc)= MudSystemDotBackheadX Ann_Mud_Forehead_section%Array(MudSystemDotiLoc)= MudSystemDotMudSection Ann_Mud_Backhead_X%Array(MudSystemDotiLoc)= MudSystemDotBackheadX Ann_Mud_Backhead_section%Array(MudSystemDotiLoc)= MudSystemDotMudSection Ann_RemainedVolume_in_LastSection%Array(MudSystemDotiLoc)= (0.0d0) Ann_EmptyVolume_inBackheadLocation%Array(MudSystemDotiLoc)= (0.0d0) endif !========================Tripping In - End==================== !======================== ANNULUS ==================== MudSystemDotMudIsChanged= .false. MudSystemDotimud= 0 do while (MudSystemDotimud < Ann_Mud_Forehead_X%Length()) MudSystemDotimud = MudSystemDotimud + 1 if (MudSystemDotimud> 1) then Ann_Mud_Backhead_X%Array(MudSystemDotimud)= Ann_Mud_Forehead_X%Array(MudSystemDotimud-1) Ann_Mud_Backhead_section%Array(MudSystemDotimud)= Ann_Mud_Forehead_section%Array(MudSystemDotimud-1) endif ! <<< Fracture Shoe Lost IF ( MudSystemDotShoeLost .and. MudSystemDotLostInTripOutIsDone== .false. .and. Shoe%ShoeDepth < Ann_Mud_Backhead_X%Array(MudSystemDotimud) .and. Shoe%ShoeDepth >= Ann_Mud_Forehead_X%Array(MudSystemDotimud) ) then !write(*,*) 'ShoeLost imud,AnnVolume(imud), VolumeLost:' , imud,Ann_MudDischarged_Volume%Array(imud), (( Qlost/60.0d0)*DeltaT_Mudline) MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotimud)= MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotimud)-((MudSystemDotQlost/60.0d0)*DeltaT_Mudline) !(gal) if (MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotimud) < 0.0) then !write(*,*) 'mud is removed by shoe lost, imud=' , imud call RemoveAnnulusMudArrays(MudSystemDotimud) MudSystemDotimud= MudSystemDotimud-1 cycle endif ENDIF ! Fracture Shoe Lost >>> MudSystemDotDirectionCoef= (MudSystemDotXend_PipeSection(Ann_Mud_Backhead_section%Array(MudSystemDotimud))-MudSystemDotXstart_PipeSection(Ann_Mud_Backhead_section%Array(MudSystemDotimud))) & / ABS(MudSystemDotXend_PipeSection(Ann_Mud_Backhead_section%Array(MudSystemDotimud))-MudSystemDotXstart_PipeSection(Ann_Mud_Backhead_section%Array(MudSystemDotimud))) ! +1 for string , -1 for annulus Ann_EmptyVolume_inBackheadLocation%Array(MudSystemDotimud)= MudSystemDotDirectionCoef* (MudSystemDotXend_PipeSection(Ann_Mud_Backhead_section%Array(MudSystemDotimud))- Ann_Mud_Backhead_X%Array(MudSystemDotimud))* & MudSystemDotArea_PipeSectionFt(Ann_Mud_Backhead_section%Array(MudSystemDotimud)) !(ft^3) Ann_EmptyVolume_inBackheadLocation%Array(MudSystemDotimud)= Ann_EmptyVolume_inBackheadLocation%Array(MudSystemDotimud)* 7.48051948d0 ! ft^3 to gal if ( MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotimud) <= Ann_EmptyVolume_inBackheadLocation%Array(MudSystemDotimud)) then Ann_Mud_Forehead_section%Array(MudSystemDotimud)= Ann_Mud_Backhead_section%Array(MudSystemDotimud) Ann_Mud_Forehead_X%Array(MudSystemDotimud)= Ann_Mud_Backhead_X%Array(MudSystemDotimud)+ MudSystemDotDirectionCoef*(MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotimud)/7.48051948d0)/MudSystemDotArea_PipeSectionFt(Ann_Mud_Backhead_section%Array(MudSystemDotimud)) ! 7.48 is for gal to ft^3 else MudSystemDotisection= Ann_Mud_Backhead_section%Array(MudSystemDotimud)+1 Ann_RemainedVolume_in_LastSection%Array(MudSystemDotimud)= MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotimud)- Ann_EmptyVolume_inBackheadLocation%Array(MudSystemDotimud) do if (MudSystemDotisection > MudSystemDotNoPipeSections) then ! last pipe section(well exit) MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotimud)= MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotimud)- Ann_RemainedVolume_in_LastSection%Array(MudSystemDotimud) Ann_Mud_Forehead_X%Array(MudSystemDotimud)= MudSystemDotXend_PipeSection(MudSystemDotNoPipeSections) Ann_Mud_Forehead_section%Array(MudSystemDotimud)= MudSystemDotNoPipeSections if (MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotimud)<= 0.0d0) then ! imud is completely exited form the well call RemoveAnnulusMudArrays(MudSystemDotimud) endif exit endif MudSystemDotxx= Ann_RemainedVolume_in_LastSection%Array(MudSystemDotimud)/ MudSystemDotPipeSection_VolumeCapacity(MudSystemDotisection) !(gal) if (MudSystemDotxx<= 1.0) then Ann_Mud_Forehead_section%Array(MudSystemDotimud)= MudSystemDotisection Ann_Mud_Forehead_X%Array(MudSystemDotimud)= (MudSystemDotxx * (MudSystemDotXend_PipeSection(MudSystemDotisection)- MudSystemDotXstart_PipeSection(MudSystemDotisection)))+ MudSystemDotXstart_PipeSection(MudSystemDotisection) exit else Ann_RemainedVolume_in_LastSection%Array(MudSystemDotimud)= Ann_RemainedVolume_in_LastSection%Array(MudSystemDotimud)- MudSystemDotPipeSection_VolumeCapacity(MudSystemDotisection) MudSystemDotisection= MudSystemDotisection+ 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