subroutine Kick_Expansion ! is called in subroutine CirculationCodeSelect Use GeoElements_FluidModule USE CMudPropertiesVariables USE MudSystemVARIABLES USE Pumps_VARIABLES use CDrillWatchVariables !use CTanksVariables, TripTankVolume2 => DrillingWatch%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(MudSystemDotNewInfluxNumber - MudSystemDotKickNumber + 1) * 7.48 IF ( MudSystemDotKickexpansion_DueToMudLost ) ExpansionVolume = ((MudSystemDotQlost/60.0d0)*DeltaT_Mudline) !============================== kick zire mate bashad ============================== if (MudSystemDotOp_KickLoc > 0 .and. MudSystemDotAnn_KickLoc==0) then ! .and. Op_KickLoc /= Op_MudOrKick%Length ()) then !write(*,*) 'expansion (1)' MudSystemDotOp_MudDischarged_Volume%Array(MudSystemDotOp_KickLoc)= MudSystemDotOp_MudDischarged_Volume%Array(MudSystemDotOp_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 (MudSystemDotAnn_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 MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotAnn_KickLoc)= MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotAnn_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 (MudSystemDotChokeLine_KickLoc > 0 .and. MudSystemDotAnn_KickLoc==0) then MudSystemDotChokeLine_MudDischarged_Volume%Array(MudSystemDotChokeLine_KickLoc)= MudSystemDotChokeLine_MudDischarged_Volume%Array(MudSystemDotChokeLine_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 Pumps_VARIABLES use CDrillWatchVariables !use CTanksVariables, TripTankVolume2 => DrillingWatch%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= MPumps%Total_Pump_GPM StringFlowRate= MUD(2)%Q AnnulusFlowRate= MUD(2)%Q if (MudSystemDotNewPipeFilling == 0) then MudSystemDotStringFlowRate= 0. MudSystemDotAnnulusFlowRate= 0. endif !if (WellHeadIsOpen) then ContractionVolume= - GasPocketDeltaVol%Array(MudSystemDotNewInfluxNumber - MudSystemDotKickNumber + 1) * 7.48 !else !ContractionVolume = (StringFlowRate/60.0d0)*DeltaT_Mudline + DeltaVolumePipe if (MudSystemDotKickNumber == 1 .and. WellHeadIsOpen==.false.) ContractionVolume = ContractionVolume + (MudSystemDotStringFlowRate/60.0d0)*DeltaT_Mudline + MudSystemDotDeltaVolumePipe !endif !************************************************************************************************************************************************************************** ! pump mud is added in "pump&TripIn" code IF (MudSystemDotOp_KickLoc > 0 .and. MudSystemDotAnn_KickLoc == 0) then ! All of kick is under bit (iloc == 1) MudSystemDotOp_MudDischarged_Volume%Array(MudSystemDotOp_KickLoc)= MudSystemDotOp_MudDischarged_Volume%Array(MudSystemDotOp_KickLoc) - ( ContractionVolume ) ELSE IF (MudSystemDotOp_KickLoc == 0 .AND. MudSystemDotAnn_KickLoc > 0 .AND. MudSystemDotChokeLine_KickLoc == 0) THEN ! All of kick is an Annulus (iloc == 1) MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotAnn_KickLoc)= MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotAnn_KickLoc) - ( ContractionVolume ) ELSE IF (MudSystemDotAnn_KickLoc == 0 .AND. MudSystemDotChokeLine_KickLoc > 0) THEN ! kick is in chokeline only MudSystemDotChokeLine_MudDischarged_Volume%Array(MudSystemDotChokeLine_KickLoc)= MudSystemDotChokeLine_MudDischarged_Volume%Array(MudSystemDotChokeLine_KickLoc) - ( ContractionVolume ) ELSE IF (MudSystemDotOp_KickLoc > 0 .AND. MudSystemDotAnn_KickLoc > 0) THEN ! Kick is around bit (iloc==2) if (MudSystemDotAnn_MudDischarged_Volume%Array(1) > ContractionVolume ) then MudSystemDotAnn_MudDischarged_Volume%Array(1)= MudSystemDotAnn_MudDischarged_Volume%Array(1) - ( ContractionVolume ) elseif (MudSystemDotOp_MudDischarged_Volume%Last() > ContractionVolume ) then MudSystemDotOp_MudDischarged_Volume%Array(MudSystemDotOp_MudDischarged_Volume%Length())= MudSystemDotOp_MudDischarged_Volume%Array(MudSystemDotOp_MudDischarged_Volume%Length()) - ( ContractionVolume ) else Call ErrorStop ('kick contraction error 1') endif ELSE IF (MudSystemDotAnn_KickLoc > 0 .AND. MudSystemDotChokeLine_KickLoc > 0) THEN if (MudSystemDotChokeLine_MudDischarged_Volume%Array(1) > ContractionVolume ) then MudSystemDotChokeLine_MudDischarged_Volume%Array(1) = MudSystemDotChokeLine_MudDischarged_Volume%Array(1) - ( ContractionVolume ) elseif (MudSystemDotAnn_MudDischarged_Volume%Last() > ContractionVolume ) then MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotAnn_MudDischarged_Volume%Length())= MudSystemDotAnn_MudDischarged_Volume%Array(MudSystemDotAnn_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