subroutine Kick_Migration ! 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 integer jelement, jmud, jsection,ielement,i integer jopelement,jopmud,jopsection,CuttingValue !MUD(2)%Q= total_pumps%Total_Pump_GPM !StringFlowRate= MUD(2)%Q !AnnulusFlowRate= MUD(2)%Q ! !if (NewPipeFilling == 0) then ! StringFlowRate= 0. ! AnnulusFlowRate= 0. !endif !StringFlowRateFinal= StringFlowRate !AnnulusFlowRateFinal= AnnulusFlowRate !write(*,*) 'MUD(2)%Q=====' , MUD(2)%Q !write(*,*) 'Kick Migration,NewInfluxNumber:' , NewInfluxNumber !FirstSetKickMigration !write(*,*) 'NewInfluxNumber=' , NewInfluxNumber DO KickNumber= NewInfluxNumber-NoGasPocket+1 , NewInfluxNumber !write(*,*) 'KickNumber=' , KickNumber if (KickFlux .AND. NOT(KickOffBottom) .and. KickNumber == NewInfluxNumber) cycle if ( KickNumber == Ann_MudOrKick%Last() ) cycle ! when the last element in Annulus is kick, Migration is not called !write(*,*) 'Migration will be done for,KickNumber=' ,KickNumber !=================== Bottom Hole ENTRANCE(due to Kick) =================== !KickDx= (AutoMigrationRate/60.)*DeltaT_Mudline !3600 (ft/min)= 6 ft set in start up Op_KickLoc= 0 Ann_KickLoc= 0 ChokeLine_KickLoc= 0 do i = 1, Op_MudOrKick%Length () if (Op_MudOrKick%Array(i) == KickNumber) then Op_KickLoc = i exit endif end do do i = 1, Ann_MudOrKick%Length () if (Ann_MudOrKick%Array(i) == KickNumber) then Ann_KickLoc = i exit endif end do do i = 1, ChokeLine_MudOrKick%Length () if (ChokeLine_MudOrKick%Array(i) == KickNumber) then ChokeLine_KickLoc = i exit endif end do !write(*,*) 'Op_KickLoc=' , Op_KickLoc !write(*,*) 'Ann_KickLoc=' , Ann_KickLoc !!write(*,*) 'ChokeLine_KickLoc=' , ChokeLine_KickLoc ! ! !write(*,*) 'Op_MudOrKick%Length ()=' , Op_MudOrKick%Length () ! ! !============================== foreheade kick be mate reside bashad *3 ============================== if (Op_KickLoc == Op_MudOrKick%Length () .and. Ann_KickLoc==0 ) then !write(*,*) '****3' iloc= 2 KickDv= Area_OpSectionFt(Op_Mud_Forehead_section%Array(Op_KickLoc)) * KickDx * 7.48051948d0 ! ft^3 to gal MinKickDv= min( KickDv,Ann_MudDischarged_Volume%Array (1), Op_MudDischarged_Volume%Last () ) NewDensity= Ann_Density%Array (1) NewVolume= MinKickDv if ( MinKickDv == KickDv ) then !eleman bala sari baghi mimund, paeeni(kick) ham baghi mimund Ann_MudDischarged_Volume%Array (1)= Ann_MudDischarged_Volume%Array (1) - MinKickDv call Ann_Density%AddToFirst (Op_Density%Last()) call Ann_MudDischarged_Volume%AddToFirst (MinKickDv) call Ann_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) call Ann_Mud_Forehead_section%AddToFirst (F_StringIntervalCounts+1) call Ann_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) call Ann_Mud_Backhead_section%AddToFirst (F_StringIntervalCounts+1) call Ann_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call Ann_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call Ann_MudOrKick%AddToFirst (KickNumber) call Ann_CuttingMud%AddToFirst (0) Op_MudDischarged_Volume%Array (Op_KickLoc)= Op_MudDischarged_Volume%Array (Op_KickLoc) - MinKickDv ! backheade kick zire mate bashad if (Op_KickLoc > 1) then !if ( Op_Density%Array (Op_KickLoc-1) /= NewDensity ) then if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) >= DensityMixTol ) then Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) call Op_Density%AddTo (Op_KickLoc,NewDensity) call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) call Op_MudOrKick%AddTo (Op_KickLoc,0) else !Op_Density%Array (imudKick-1) == NewDensity Op_Density%Array(Op_KickLoc-1)= (Op_Density%Array(Op_KickLoc-1)*Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewDensity*NewVolume)/(Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewVolume) Op_MudDischarged_Volume%Array(Op_KickLoc-1)= Op_MudDischarged_Volume%Array(Op_KickLoc-1) + NewVolume endif else !if Op_KickLoc == 1 (*****Migration Start*****) *3-1=============================== !write(*,*) '****3-1' call Op_Density%AddToFirst (NewDensity) call Op_MudDischarged_Volume%AddToFirst (NewVolume) call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call Op_MudOrKick%AddToFirst (0) endif elseif ( MinKickDv == Ann_MudDischarged_Volume%Array (1) ) then ! eleman bala sari baghi nemimund Ann_Density%Array(1)= Op_Density%Last() Ann_MudOrKick%Array(1)= KickNumber Op_MudDischarged_Volume%Array (Op_KickLoc)= Op_MudDischarged_Volume%Array (Op_KickLoc) - MinKickDv ! backheade kick zire mate bashad if (Op_KickLoc > 1) then !if ( Op_Density%Array (Op_KickLoc-1) /= NewDensity ) then if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) >= DensityMixTol ) then Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) call Op_Density%AddTo (Op_KickLoc,NewDensity) call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) call Op_MudOrKick%AddTo (Op_KickLoc,0) else !Op_Density%Array (imudKick-1) == NewDensity Op_Density%Array(Op_KickLoc-1)= (Op_Density%Array(Op_KickLoc-1)*Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewDensity*NewVolume)/(Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewVolume) Op_MudDischarged_Volume%Array(Op_KickLoc-1)= Op_MudDischarged_Volume%Array(Op_KickLoc-1) + NewVolume endif else !if Op_KickLoc == 1 (*****Migration Start*****) *3-2=============================== !write(*,*) '****3-2' call Op_Density%AddToFirst (NewDensity) call Op_MudDischarged_Volume%AddToFirst (NewVolume) call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call Op_MudOrKick%AddToFirst (0) endif ! elseif ( MinKickDv == Op_MudDischarged_Volume%Last () ) then ! eleman balaee baghi mimund, kick hazf mishod Ann_MudDischarged_Volume%Array (1)= Ann_MudDischarged_Volume%Array (1) - MinKickDv call Ann_Density%AddToFirst (Op_Density%Last()) call Ann_MudDischarged_Volume%AddToFirst (MinKickDv) call Ann_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) call Ann_Mud_Forehead_section%AddToFirst (F_StringIntervalCounts+1) call Ann_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) call Ann_Mud_Backhead_section%AddToFirst (F_StringIntervalCounts+1) call Ann_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call Ann_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call Ann_MudOrKick%AddToFirst (KickNumber) call Ann_CuttingMud%AddToFirst (0) Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) call Op_MudDischarged_Volume%Remove (Op_KickLoc) call Op_Mud_Backhead_X%Remove (Op_KickLoc) call Op_Mud_Backhead_section%Remove (Op_KickLoc) call Op_Mud_Forehead_X%Remove (Op_KickLoc) call Op_Mud_Forehead_section%Remove (Op_KickLoc) call Op_Density%Remove (Op_KickLoc) call Op_RemainedVolume_in_LastSection%Remove (Op_KickLoc) call Op_EmptyVolume_inBackheadLocation%Remove (Op_KickLoc) call Op_MudOrKick%Remove (Op_KickLoc) ! backheade kick zire mate bashad if (Op_KickLoc > 1) then !if ( Op_Density%Array (Op_KickLoc-1) /= NewDensity ) then if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) >= DensityMixTol ) then call Op_Density%AddTo (Op_KickLoc,NewDensity) call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) call Op_MudOrKick%AddTo (Op_KickLoc,0) else !Op_Density%Array (imudKick-1) == NewDensity Op_Density%Array(Op_KickLoc-1)= (Op_Density%Array(Op_KickLoc-1)*Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewDensity*NewVolume)/(Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewVolume) Op_MudDischarged_Volume%Array(Op_KickLoc-1)= Op_MudDischarged_Volume%Array(Op_KickLoc-1) + NewVolume endif else !if Op_KickLoc == 1 (*****Migration Start*****) *3-3=============================== !write(*,*) '****3-3' call Op_Density%AddToFirst (NewDensity) call Op_MudDischarged_Volume%AddToFirst (NewVolume) call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call Op_MudOrKick%AddToFirst (0) endif endif endif !======================================================================================== !============================== foreheade kick be mate reside bashad *3 with pump ============================== ! if (Op_KickLoc == Op_MudOrKick%Length () .and. Ann_KickLoc==0 .and. AnnulusFlowRate /= 0.0 ) then ! write(*,*) '****3 with pump' ! ! KickMigration_2SideBit= .true. ! !iloc= 2 ! ! !KickDv= Area_OpSectionFt(Op_Mud_Forehead_section%Array(Op_KickLoc)) * KickDx * 7.48051948 ! ft^3 to gal ! !!farz mikonam baraye in yek iteration kick az OP hazf nemishavad va hajme aan bishtar az pump flow ast ! ! KickDv= ((AnnulusFlowRate/60.0d0)*DeltaT_Mudline) ! ! call Ann_Density%AddToFirst (Kick_Density) ! call Ann_MudDischarged_Volume%AddToFirst (KickDv) ! call Ann_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) ! call Ann_Mud_Forehead_section%AddToFirst (F_StringIntervalCounts+1) ! call Ann_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1)) ! call Ann_Mud_Backhead_section%AddToFirst (F_StringIntervalCounts+1) ! call Ann_RemainedVolume_in_LastSection%AddToFirst (0.0d0) ! call Ann_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) ! call Ann_MudOrKick%AddToFirst (KickNumber) ! call Ann_CuttingMud%AddToFirst (0) ! ! Op_MudDischarged_Volume%Array (Op_KickLoc)= Op_MudDischarged_Volume%Array (Op_KickLoc) - MinKickDv ! ! ! ! !if ( ((AnnulusFlowRate/60.)*DeltaT_Mudline) >= KickDv ) then ! sorate pump bishtar az kick bashad ! ! ! ! KickDv= ((AnnulusFlowRate/60.)*DeltaT_Mudline) ! ! ! ! ! BackHead: ! if ( Op_Density%Array (Op_KickLoc-1) /= St_Density%Last() ) then ! ! ! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) ! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) ! ! call Op_Density%AddTo (Op_KickLoc,St_Density%Last()) ! call Op_MudDischarged_Volume%AddTo (Op_KickLoc,KickDv) ! call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) ! call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) ! call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) ! call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) ! call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) ! call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) ! call Op_MudOrKick%AddTo (Op_KickLoc,0) ! ! ! else !Op_Density%Array (imudKick-1) == NewDensity ! ! Op_MudDischarged_Volume%Array (Op_KickLoc-1)= Op_MudDischarged_Volume%Array (Op_KickLoc-1) + KickDv ! ! endif ! ! ! ! ! endif !======================================================================================== !============================= tamame kick zire mate bashad *1 ================================ if ( Op_KickLoc>0 .and. Op_KickLoc < Op_MudOrKick%Length () ) then !write(*,*) '****1' !iloc= 1 KickDv= Area_OpSectionFt(Op_Mud_Forehead_section%Array(Op_KickLoc)) * KickDx * 7.48051948d0 ! ft^3 to gal Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) if ( KickDv < Op_MudDischarged_Volume%Array (Op_KickLoc+1) ) then !eleman bala sari baghi mimund !write(*,*) 'cond 11111111111111' Op_MudDischarged_Volume%Array (Op_KickLoc+1)= Op_MudDischarged_Volume%Array (Op_KickLoc+1) - KickDv NewDensity= Op_Density%Array (Op_KickLoc+1) NewVolume= KickDv else !KickDv > Op_MudDischarged_Volume%Array (imudKick+1) eleman baghi nemimund ! write(*,*) 'cond 22222222222222222' KickDv= Op_MudDischarged_Volume%Array (Op_KickLoc+1) NewVolume= KickDv NewDensity= Op_Density%Array (Op_KickLoc+1) call Op_MudDischarged_Volume%Remove (Op_KickLoc+1) call Op_Mud_Backhead_X%Remove (Op_KickLoc+1) call Op_Mud_Backhead_section%Remove (Op_KickLoc+1) call Op_Mud_Forehead_X%Remove (Op_KickLoc+1) call Op_Mud_Forehead_section%Remove (Op_KickLoc+1) call Op_Density%Remove (Op_KickLoc+1) call Op_RemainedVolume_in_LastSection%Remove (Op_KickLoc+1) call Op_EmptyVolume_inBackheadLocation%Remove (Op_KickLoc+1) call Op_MudOrKick%Remove (Op_KickLoc+1) endif ! backheade kick zire mate bashad if (Op_KickLoc > 1) then !if ( Op_Density%Array (Op_KickLoc-1) /= NewDensity ) then if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) >= DensityMixTol ) then call Op_Density%AddTo (Op_KickLoc,NewDensity) call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) call Op_MudOrKick%AddTo (Op_KickLoc,0) else !Op_Density%Array (Op_KickLoc-1) == NewDensity Op_Density%Array(Op_KickLoc-1)= (Op_Density%Array(Op_KickLoc-1)*Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewDensity*NewVolume)/(Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewVolume) Op_MudDischarged_Volume%Array(Op_KickLoc-1)= Op_MudDischarged_Volume%Array(Op_KickLoc-1) + NewVolume endif else !if Op_KickLoc == 1 (*****Migration Start*****) *5-1=============================== !write(*,*) '****5-1' call Op_Density%AddToFirst (NewDensity) call Op_MudDischarged_Volume%AddToFirst (NewVolume) call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call Op_MudOrKick%AddToFirst (0) endif endif !======================================================================================== !write(*,*) 'a) density and cutting:' , Ann_Density%Length() , Ann_CuttingMud%Length() !=========================== tamame kick balaye mate bashad *2 ================================== if ( Ann_KickLoc > 0 .and. Op_KickLoc==0 ) then !write(*,*) '****2' !iloc= 1 KickDv= Area_PipeSectionFt(Ann_Mud_Forehead_section%Array(Ann_KickLoc)) * KickDx * 7.48051948d0 ! ft^3 to gal NewDensity= Ann_Density%Array (Ann_KickLoc+1) NewVolume= KickDv CuttingValue= Ann_CuttingMud%Array (Ann_KickLoc+1) if ( KickDv < Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) ) then !eleman bala sari baghi mimund Ann_MudDischarged_Volume%Array (Ann_KickLoc+1)= Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) - KickDv else !KickDv > Ann_MudDischarged_Volume%Array (imudKick+1) eleman baghi nemimund KickDv= Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) NewVolume= KickDv call Ann_MudDischarged_Volume%Remove (Ann_KickLoc+1) call Ann_Mud_Backhead_X%Remove (Ann_KickLoc+1) call Ann_Mud_Backhead_section%Remove (Ann_KickLoc+1) call Ann_Mud_Forehead_X%Remove (Ann_KickLoc+1) call Ann_Mud_Forehead_section%Remove (Ann_KickLoc+1) call Ann_Density%Remove (Ann_KickLoc+1) call Ann_RemainedVolume_in_LastSection%Remove (Ann_KickLoc+1) call Ann_EmptyVolume_inBackheadLocation%Remove (Ann_KickLoc+1) call Ann_MudOrKick%Remove (Ann_KickLoc+1) call Ann_CuttingMud%Remove (Ann_KickLoc+1) endif ! backheade kick balaye mate bashad if (Ann_KIckLoc > 1) then !if ( Ann_Density%Array (Ann_KickLoc-1) /= NewDensity ) then if ( ABS(Ann_Density%Array (Ann_KickLoc-1) - NewDensity) >= DensityMixTol ) then Old_KickBackHead_X= Ann_Mud_Backhead_X%Array (Ann_KickLoc) Old_KickBackHead_Section= Ann_Mud_Backhead_section%Array (Ann_KickLoc) call Ann_Density%AddTo (Ann_KickLoc,NewDensity) call Ann_MudDischarged_Volume%AddTo (Ann_KickLoc,NewVolume) call Ann_Mud_Forehead_X%AddTo (Ann_KickLoc,Old_KickBackHead_X) call Ann_Mud_Forehead_section%AddTo (Ann_KickLoc,Old_KickBackHead_Section) call Ann_Mud_Backhead_X%AddTo (Ann_KickLoc,Old_KickBackHead_X) call Ann_Mud_Backhead_section%AddTo (Ann_KickLoc,Old_KickBackHead_Section) call Ann_RemainedVolume_in_LastSection%AddTo (Ann_KickLoc,0.0d0) call Ann_EmptyVolume_inBackheadLocation%AddTo (Ann_KickLoc,0.0d0) call Ann_MudOrKick%AddTo (Ann_KickLoc,0) call Ann_CuttingMud%AddTo (Ann_KickLoc,0) else !Op_Density%Array (imudKick-1) == NewDensity Ann_Density%Array(Ann_KickLoc-1)= (Ann_Density%Array(Ann_KickLoc-1)*Ann_MudDischarged_Volume%Array(Ann_KickLoc-1)+NewDensity*NewVolume)/(Ann_MudDischarged_Volume%Array(Ann_KickLoc-1)+NewVolume) Ann_MudDischarged_Volume%Array(Ann_KickLoc-1)= Ann_MudDischarged_Volume%Array(Ann_KickLoc-1) + NewVolume endif else !if Ann_KickLoc == 1 *6 =============================== !write(*,*) '****6' Old_KickBackHead_X= Ann_Mud_Backhead_X%Array (Ann_KickLoc) Old_KickBackHead_Section= Ann_Mud_Backhead_section%Array (Ann_KickLoc) call Ann_Density%AddToFirst (NewDensity) call Ann_MudDischarged_Volume%AddToFirst (NewVolume) call Ann_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) call Ann_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) call Ann_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) call Ann_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) call Ann_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call Ann_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call Ann_MudOrKick%AddToFirst (0) call Ann_CuttingMud%AddToFirst (CuttingValue) endif endif !======================================================================================== !============================== kick 2 tarafe mate bashad *4 ============================== if ( Ann_KickLoc > 0 .and. Op_KickLoc > 0 ) then !write(*,*) '****4' iloc= 2 KickDv= Area_PipeSectionFt(Ann_Mud_Forehead_section%Array(Ann_KickLoc)) * KickDx * 7.48051948d0 ! ft^3 to gal MinKickDv= min( KickDv,Ann_MudDischarged_Volume%Array (Ann_KickLoc+1), Op_MudDischarged_Volume%Last () ) ! Ann_KickLoc+1=2 Op_MudDischarged_Volume%Last ()=kick NewDensity= Ann_Density%Array (Ann_KickLoc+1) NewVolume= MinKickDv if ( MinKickDv == KickDv ) then !eleman bala sari baghi mimund, paeeni(kick) dar OP ham baghi mimund !write(*,*) '****4----1' Ann_MudDischarged_Volume%Array (Ann_KickLoc+1)= Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) - MinKickDv Ann_MudDischarged_Volume%Array (Ann_KickLoc)= Ann_MudDischarged_Volume%Array (Ann_KickLoc) + MinKickDv ! Ann_KickLoc= 1 Op_MudDischarged_Volume%Array (Op_KickLoc)= Op_MudDischarged_Volume%Array (Op_KickLoc) - MinKickDv ! Op_KickLoc= last ! backheade kick zire mate bashad if ( Op_KickLoc>1) then !if ( Op_Density%Array (Op_KickLoc-1) /= NewDensity ) then if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) >= DensityMixTol ) then Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) call Op_Density%AddTo (Op_KickLoc,NewDensity) call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) call Op_MudOrKick%AddTo (Op_KickLoc,0) else ! merge Op_Density%Array(Op_KickLoc-1)= (Op_Density%Array(Op_KickLoc-1)*Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewDensity*NewVolume)/(Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewVolume) Op_MudDischarged_Volume%Array(Op_KickLoc-1)= Op_MudDischarged_Volume%Array(Op_KickLoc-1) + NewVolume endif else !if Op_KickLoc == 1 (*****Migration Start*****) *5-2=============================== !write(*,*) '****5-2' Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) call Op_Density%AddToFirst (NewDensity) call Op_MudDischarged_Volume%AddToFirst (NewVolume) call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call Op_MudOrKick%AddToFirst (0) endif elseif ( MinKickDv == Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) ) then ! eleman bala sari baghi nemimund !write(*,*) '****4----2' call Ann_MudDischarged_Volume%Remove (Ann_KickLoc+1) call Ann_Mud_Backhead_X%Remove (Ann_KickLoc+1) call Ann_Mud_Backhead_section%Remove (Ann_KickLoc+1) call Ann_Mud_Forehead_X%Remove (Ann_KickLoc+1) call Ann_Mud_Forehead_section%Remove (Ann_KickLoc+1) call Ann_Density%Remove (Ann_KickLoc+1) call Ann_RemainedVolume_in_LastSection%Remove (Ann_KickLoc+1) call Ann_EmptyVolume_inBackheadLocation%Remove (Ann_KickLoc+1) call Ann_MudOrKick%Remove (Ann_KickLoc+1) call Ann_CuttingMud%Remove (Ann_KickLoc+1) Ann_MudDischarged_Volume%Array (Ann_KickLoc)= Ann_MudDischarged_Volume%Array (Ann_KickLoc) + MinKickDv ! Ann_KickLoc= 1 Op_MudDischarged_Volume%Array (Op_KickLoc)= Op_MudDischarged_Volume%Array (Op_KickLoc) - MinKickDv ! Op_KickLoc= last ! backheade kick zire mate bashad if (Op_KickLoc > 1) then !if ( Op_Density%Array (Op_KickLoc-1) /= NewDensity ) then if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) >= DensityMixTol ) then Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) call Op_Density%AddTo (Op_KickLoc,NewDensity) call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) call Op_MudOrKick%AddTo (Op_KickLoc,0) else !Op_Density%Array (imudKick-1) == NewDensity Op_Density%Array(Op_KickLoc-1)= (Op_Density%Array(Op_KickLoc-1)*Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewDensity*NewVolume)/(Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewVolume) Op_MudDischarged_Volume%Array(Op_KickLoc-1)= Op_MudDischarged_Volume%Array(Op_KickLoc-1) + NewVolume endif else !if Op_KickLoc == 1 (*****Migration Start*****) *5-2=============================== Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) call Op_Density%AddToFirst (NewDensity) call Op_MudDischarged_Volume%AddToFirst (NewVolume) call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call Op_MudOrKick%AddToFirst (0) endif elseif ( MinKickDv == Op_MudDischarged_Volume%Last () ) then ! eleman balaee baghi mimund, kick az OP kamel kharej mishod !write(*,*) '****4----3' Ann_MudDischarged_Volume%Array (Ann_KickLoc+1)= Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) - MinKickDv Ann_MudDischarged_Volume%Array (Ann_KickLoc)= Ann_MudDischarged_Volume%Array (Ann_KickLoc) + MinKickDv ! Ann_KickLoc= 1 Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) call Op_MudDischarged_Volume%Remove (Op_KickLoc) ! Op_KickLoc= last call Op_Mud_Backhead_X%Remove (Op_KickLoc) call Op_Mud_Backhead_section%Remove (Op_KickLoc) call Op_Mud_Forehead_X%Remove (Op_KickLoc) call Op_Mud_Forehead_section%Remove (Op_KickLoc) call Op_Density%Remove (Op_KickLoc) call Op_RemainedVolume_in_LastSection%Remove (Op_KickLoc) call Op_EmptyVolume_inBackheadLocation%Remove (Op_KickLoc) call Op_MudOrKick%Remove (Op_KickLoc) ! backheade kick zire mate bashad if (Op_KickLoc > 1) then !if ( Op_Density%Array (Op_KickLoc-1) /= NewDensity ) then if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) >= DensityMixTol ) then call Op_Density%AddTo (Op_KickLoc,NewDensity) call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) call Op_MudOrKick%AddTo (Op_KickLoc,0) else !Op_Density%Array (imudKick-1) == NewDensity Op_Density%Array(Op_KickLoc-1)= (Op_Density%Array(Op_KickLoc-1)*Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewDensity*NewVolume)/(Op_MudDischarged_Volume%Array(Op_KickLoc-1)+NewVolume) Op_MudDischarged_Volume%Array(Op_KickLoc-1)= Op_MudDischarged_Volume%Array(Op_KickLoc-1) + NewVolume endif else !if Op_KickLoc == 1 (*****Migration Start*****) *5-2=============================== call Op_Density%AddToFirst (NewDensity) call Op_MudDischarged_Volume%AddToFirst (NewVolume) call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call Op_MudOrKick%AddToFirst (0) endif iloc= 1 ! ok endif endif !======================================================================================== !============================== kick 2 tarafe mate bashad *4 with pump ============================== ! !if ( Ann_KickLoc > 0 .and. Op_KickLoc > 0 .and. AnnulusFlowRate /= 0.0 ) then ! write(*,*) '****4 with pump' ! ! KickMigration_2SideBit= .true. ! ! !iloc= 2 ! ! KickDv= Area_PipeSectionFt(Ann_Mud_Forehead_section%Array(Ann_KickLoc)) * KickDx * 7.48051948d0 ! ft^3 to gal ! !MinKickDv= min( KickDv,Ann_MudDischarged_Volume%Array (Ann_KickLoc+1), Op_MudDischarged_Volume%Last () ) ! Ann_KickLoc+1=2 Op_MudDischarged_Volume%Last ()=kick ! ! ! !MinKickDv= min( KickDv,Ann_MudDischarged_Volume%Array (Ann_KickLoc+1), Op_MudDischarged_Volume%Last () ) ! Ann_KickLoc+1=2 Op_MudDischarged_Volume%Last ()=kick ! ! ! !NewDensity= Ann_Density%Array (Ann_KickLoc+1) ! !NewVolume= MinKickDv ! ! ! if ( ((AnnulusFlowRate/60.0d0)*DeltaT_Mudline) >= KickDv ) then ! sorate pump bishtar az kick bashad---tu in halat aslan kari be elemane balaiye kick tuye Ann nadarim ! !WRITE(*,*) '*****sorate pump bishtar az kick*******' ! MinKickDv= ((AnnulusFlowRate/60.0d0)*DeltaT_Mudline) ! dar asl maxKickDv ast ! ! ! ! ! ! ! ! ! if ( Op_MudDischarged_Volume%Last () > MinKickDv ) then !eleman paeeni(kick) dar OP baghi mimund ! ! Ann_MudDischarged_Volume%Array (Ann_KickLoc)= Ann_MudDischarged_Volume%Array (Ann_KickLoc) + MinKickDv ! Ann_KickLoc= 1 ! ! Op_MudDischarged_Volume%Array (Op_KickLoc)= Op_MudDischarged_Volume%Array (Op_KickLoc) - MinKickDv ! Op_KickLoc= last ! ! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) ! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) ! ! backheade kick zire mate bashad ! if ( Op_KickLoc>1) then ! ! if ( Op_Density%Array (Op_KickLoc-1) /= St_Density%Last() ) then ! ! ! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) ! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) ! ! call Op_Density%AddTo (Op_KickLoc,St_Density%Last()) ! call Op_MudDischarged_Volume%AddTo (Op_KickLoc,MinKickDv) ! call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) ! call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) ! call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) ! call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) ! call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) ! call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) ! call Op_MudOrKick%AddTo (Op_KickLoc,0) ! ! ! else !Op_Density%Array (imudKick-1) == NewDensity ! ! Op_MudDischarged_Volume%Array (Op_KickLoc-1)= Op_MudDischarged_Volume%Array (Op_KickLoc-1) + NewVolume ! ! endif ! ! else !if Op_KickLoc == 1 (*****Migration Start*****) *5-2=============================== ! write(*,*) '****5-2 with pump' ! ! ! !Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) ! !Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) ! ! ! call Op_Density%AddToFirst (St_Density%Last()) ! call Op_MudDischarged_Volume%AddToFirst (MinKickDv) ! call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) ! call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) ! call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) ! call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) ! call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) ! call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) ! call Op_MudOrKick%AddToFirst (0) ! ! endif ! ! elseif ( Op_MudDischarged_Volume%Last () <= MinKickDv ) then !eleman paeeni(kick) dar OP baghi nemimund yani kick az OP kamel kharej mishod ! ! MinKickDv= Op_MudDischarged_Volume%Last () ! ! ! write(*,*) '****4----3 with pump a' ! ! ! Ann_MudDischarged_Volume%Array (Ann_KickLoc+1)= Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) + ((AnnulusFlowRate/60.0d0)*DeltaT_Mudline)-MinKickDv ! ! Ann_MudDischarged_Volume%Array (Ann_KickLoc)= Ann_MudDischarged_Volume%Array (Ann_KickLoc) + MinKickDv ! Ann_KickLoc= 1 ! ! call Op_MudDischarged_Volume%Remove (Op_KickLoc) ! Op_KickLoc= last ! call Op_Mud_Backhead_X%Remove (Op_KickLoc) ! call Op_Mud_Backhead_section%Remove (Op_KickLoc) ! call Op_Mud_Forehead_X%Remove (Op_KickLoc) ! call Op_Mud_Forehead_section%Remove (Op_KickLoc) ! call Op_Density%Remove (Op_KickLoc) ! call Op_RemainedVolume_in_LastSection%Remove (Op_KickLoc) ! call Op_EmptyVolume_inBackheadLocation%Remove (Op_KickLoc) ! call Op_MudOrKick%Remove (Op_KickLoc) ! ! ! ! backheade kick zire mate bashad ! if (Op_KickLoc > 1) then ! ! if ( Op_Density%Array (Op_KickLoc-1) /= St_Density%Last() ) then ! ! ! !Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) ! !Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) ! ! call Op_Density%AddTo (Op_KickLoc,St_Density%Last()) ! call Op_MudDischarged_Volume%AddTo (Op_KickLoc,MinKickDv) ! call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) ! call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) ! call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) ! call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) ! call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) ! call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) ! call Op_MudOrKick%AddTo (Op_KickLoc,0) ! ! ! ! else !Op_Density%Array (imudKick-1) == NewDensity ! ! ! Op_MudDischarged_Volume%Array (Op_KickLoc-1)= Op_MudDischarged_Volume%Array (Op_KickLoc-1) + MinKickDv ! ! endif ! ! else !if Op_KickLoc == 1 (*****Migration Start*****) *5-2=============================== ! ! ! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) ! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) ! ! ! call Op_Density%AddToFirst (St_Density%Last()) ! call Op_MudDischarged_Volume%AddToFirst (MinKickDv) ! call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) ! call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) ! call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) ! call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) ! call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) ! call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) ! call Op_MudOrKick%AddToFirst (0) ! ! endif ! ! ! endif ! ende 2 halat ke kick tuye Op baghi bemune ya namune- dar halati ke ((AnnulusFlowRate/60.)*DeltaT_Mudline) >= KickDv ) ! sorate pump bishtar az kick bashad ! ! ! ! ! else !if( ((AnnulusFlowRate/60.)*DeltaT_Mudline) < KickDv ) then ! sorate pump kamtar az kick bashad ! !WRITE(*,*) '*****sorate pump kamtar az kick*******' ! ! ! ! ! MinKickDv= min( KickDv,Ann_MudDischarged_Volume%Array (Ann_KickLoc+1), Op_MudDischarged_Volume%Last () ) ! Ann_KickLoc+1=2 Op_MudDischarged_Volume%Last ()=kick ! ! ! ! !write(*,*) 'MinKickDv=' , MinKickDv ! ! ! if ( MinKickDv == KickDv ) then !eleman bala sari baghi mimund, paeeni(kick) dar OP ham baghi mimund ! !write(*,*) '****4----1 with pump' ! !write(*,*) 'St_Density%Last()=' , St_Density%Last() ! !write(*,*) '((AnnulusFlowRate/60.)*DeltaT_Mudline)=' , ((AnnulusFlowRate/60.)*DeltaT_Mudline) ! !write(*,*) 'Ann_Density%Array(Ann_KickLoc+1)=' , Ann_Density%Array(Ann_KickLoc+1) ! !write(*,*) '(MinKickDv-((AnnulusFlowRate/60.)*DeltaT_Mudline))=' , (MinKickDv-((AnnulusFlowRate/60.)*DeltaT_Mudline)) ! ! ! NewDensity= (St_Density%Last()*((AnnulusFlowRate/60.0d0)*DeltaT_Mudline) + Ann_Density%Array(Ann_KickLoc+1)*(MinKickDv-((AnnulusFlowRate/60.0d0)*DeltaT_Mudline))) & ! / (((AnnulusFlowRate/60.0d0)*DeltaT_Mudline) + (MinKickDv-((AnnulusFlowRate/60.0d0)*DeltaT_Mudline))) ! NewVolume= MinKickDv ! ! ! Ann_MudDischarged_Volume%Array (Ann_KickLoc+1)= Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) - (MinKickDv-((AnnulusFlowRate/60.0d0)*DeltaT_Mudline)) ! ! Ann_MudDischarged_Volume%Array (Ann_KickLoc)= Ann_MudDischarged_Volume%Array (Ann_KickLoc) + MinKickDv ! Ann_KickLoc= 1 ! ! Op_MudDischarged_Volume%Array (Op_KickLoc)= Op_MudDischarged_Volume%Array (Op_KickLoc) - MinKickDv ! Op_KickLoc= last ! ! ! ! backheade kick zire mate bashad ! if ( Op_KickLoc>1) then ! ! ! ! if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) > DensityMixTol) then ! .OR. (Op_MudDischarged_Volume%Array (Op_KickLoc-1)>42.) ) then ! ! ! ! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) ! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) ! ! call Op_Density%AddTo (Op_KickLoc,NewDensity) ! call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) ! call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) ! call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) ! call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) ! call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) ! call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) ! call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) ! call Op_MudOrKick%AddTo (Op_KickLoc,0) ! ! ! else !Merge Condition ! ! Op_MudDischarged_Volume%Array (Op_KickLoc-1)= Op_MudDischarged_Volume%Array (Op_KickLoc-1) + NewVolume ! Op_Density%Array (Op_KickLoc-1)= (Op_MudDischarged_Volume%Array (Op_KickLoc-1)*Op_Density%Array (Op_KickLoc-1)+NewVolume*NewDensity) / & ! (Op_MudDischarged_Volume%Array (Op_KickLoc-1)+NewVolume) ! ! ! endif ! ! else !if Op_KickLoc == 1 (*****Migration Start*****) *5-2=============================== ! write(*,*) '****5-2 with pump' ! ! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) ! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) ! ! ! call Op_Density%AddToFirst (NewDensity) ! call Op_MudDischarged_Volume%AddToFirst (NewVolume) ! call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) ! call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) ! call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) ! call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) ! call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) ! call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) ! call Op_MudOrKick%AddToFirst (0) ! ! endif ! ! ! ! elseif ( MinKickDv == Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) ) then ! eleman bala sari baghi nemimund ! write(*,*) '****4----2 with pump' ! ! NewDensity= (St_Density%Last()*((AnnulusFlowRate/60.0d0)*DeltaT_Mudline) + Ann_Density%Array(Ann_KickLoc+1)*(MinKickDv-((AnnulusFlowRate/60.0d0)*DeltaT_Mudline))) & ! / (((AnnulusFlowRate/60.0d0)*DeltaT_Mudline) + Ann_MudDischarged_Volume%Array (Ann_KickLoc+1)) ! NewVolume= MinKickDv ! ! call RemoveAnnulusMudArrays(Ann_KickLoc+1) ! ! Ann_MudDischarged_Volume%Array (Ann_KickLoc)= Ann_MudDischarged_Volume%Array (Ann_KickLoc) + MinKickDv ! Ann_KickLoc= 1 ! ! Op_MudDischarged_Volume%Array (Op_KickLoc)= Op_MudDischarged_Volume%Array (Op_KickLoc) - MinKickDv ! Op_KickLoc= last ! ! ! backheade kick zire mate bashad ! if (Op_KickLoc > 1) then ! ! if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) > DensityMixTol) then ! .OR. (Op_MudDischarged_Volume%Array (Op_KickLoc-1)>42.) ) then ! ! ! ! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) ! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) ! ! call Op_Density%AddTo (Op_KickLoc,NewDensity) ! call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) ! call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) ! call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) ! call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) ! call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) ! call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) ! call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) ! call Op_MudOrKick%AddTo (Op_KickLoc,0) ! ! ! else !Merge Condition ! ! Op_MudDischarged_Volume%Array (Op_KickLoc-1)= Op_MudDischarged_Volume%Array (Op_KickLoc-1) + NewVolume ! Op_Density%Array (Op_KickLoc-1)= (Op_MudDischarged_Volume%Array (Op_KickLoc-1)*Op_Density%Array (Op_KickLoc-1)+NewVolume*NewDensity) / & ! (Op_MudDischarged_Volume%Array (Op_KickLoc-1)+NewVolume) ! ! ! ! endif ! ! else !if Op_KickLoc == 1 (*****Migration Start*****) *5-2=============================== ! ! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) ! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) ! ! ! call Op_Density%AddToFirst (NewDensity) ! call Op_MudDischarged_Volume%AddToFirst (NewVolume) ! call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) ! call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) ! call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) ! call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) ! call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) ! call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) ! call Op_MudOrKick%AddToFirst (0) ! ! endif ! ! ! elseif ( MinKickDv == Op_MudDischarged_Volume%Last () ) then ! eleman balaee baghi mimund, kick az OP kamel kharej mishod ! write(*,*) '****4----3 with pump b' ! ! NewDensity= St_Density%Last() ! NewVolume= MinKickDv ! ! ! Old_KickBackHead_X= Op_Mud_Backhead_X%Array (Op_KickLoc) ! Old_KickBackHead_Section= Op_Mud_Backhead_section%Array (Op_KickLoc) ! ! ! !Ann_MudDischarged_Volume%Array (Ann_KickLoc+1)= Ann_MudDischarged_Volume%Array (Ann_KickLoc+1) - MinKickDv farz kardam dast be elemane balaee nazanam ! ! Ann_MudDischarged_Volume%Array (Ann_KickLoc)= Ann_MudDischarged_Volume%Array (Ann_KickLoc) + MinKickDv ! Ann_KickLoc= 1 ! !write(*,*) 'pointer 1' ! call Op_MudDischarged_Volume%Remove (Op_KickLoc) ! Op_KickLoc= last ! call Op_Mud_Backhead_X%Remove (Op_KickLoc) ! call Op_Mud_Backhead_section%Remove (Op_KickLoc) ! call Op_Mud_Forehead_X%Remove (Op_KickLoc) ! call Op_Mud_Forehead_section%Remove (Op_KickLoc) ! call Op_Density%Remove (Op_KickLoc) ! call Op_RemainedVolume_in_LastSection%Remove (Op_KickLoc) ! call Op_EmptyVolume_inBackheadLocation%Remove (Op_KickLoc) ! call Op_MudOrKick%Remove (Op_KickLoc) ! ! !write(*,*) 'pointer 2' ! ! ! backheade kick zire mate bashad ! if (Op_KickLoc > 1) then ! ! if ( ABS(Op_Density%Array (Op_KickLoc-1) - NewDensity) > DensityMixTol) then ! .OR. (Op_MudDischarged_Volume%Array (Op_KickLoc-1)>42.) ) then ! !write(*,*) 'pointer 3' ! ! ! ! ! call Op_Density%AddTo (Op_KickLoc,NewDensity) ! call Op_MudDischarged_Volume%AddTo (Op_KickLoc,NewVolume) ! call Op_Mud_Forehead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) ! call Op_Mud_Forehead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) ! call Op_Mud_Backhead_X%AddTo (Op_KickLoc,Old_KickBackHead_X) ! call Op_Mud_Backhead_section%AddTo (Op_KickLoc,Old_KickBackHead_Section) ! call Op_RemainedVolume_in_LastSection%AddTo (Op_KickLoc,0.0d0) ! call Op_EmptyVolume_inBackheadLocation%AddTo (Op_KickLoc,0.0d0) ! call Op_MudOrKick%AddTo (Op_KickLoc,0) ! ! !write(*,*) 'pointer 4' ! ! else !Merge Condition ! ! Op_MudDischarged_Volume%Array (Op_KickLoc-1)= Op_MudDischarged_Volume%Array (Op_KickLoc-1) + NewVolume ! Op_Density%Array (Op_KickLoc-1)= (Op_MudDischarged_Volume%Array (Op_KickLoc-1)*Op_Density%Array (Op_KickLoc-1)+NewVolume*NewDensity) / & ! (Op_MudDischarged_Volume%Array (Op_KickLoc-1)+NewVolume) ! ! endif ! ! else !if Op_KickLoc == 1 (*****Migration Start*****) *5-2=============================== ! !write(*,*) 'pointer 5' ! ! ! !write(*,*) 'pointer 6' ! ! ! call Op_Density%AddToFirst (NewDensity) ! call Op_MudDischarged_Volume%AddToFirst (NewVolume) ! call Op_Mud_Forehead_X%AddToFirst (Old_KickBackHead_X) ! call Op_Mud_Forehead_section%AddToFirst (Old_KickBackHead_Section) ! call Op_Mud_Backhead_X%AddToFirst (Old_KickBackHead_X) ! call Op_Mud_Backhead_section%AddToFirst (Old_KickBackHead_Section) ! call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) ! call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) ! call Op_MudOrKick%AddToFirst (0) ! !write(*,*) 'pointer 7' ! ! endif ! ! ! endif ! ! ! ! endif !( ((AnnulusFlowRate/60.)*DeltaT_Mudline) < KickDv ) ! sorate pump kamtar az kick bashad ! ! ! ! ! endif !======================================================================================== ENDDO ! KickNumber= 1, NewInfluxNumber !write(*,*) 'c)Ann_MudDischarged_Volume%Array(:)=' , sum(Ann_MudDischarged_Volume%Array(:)) end subroutine Kick_Migration