subroutine ElementsCreation ! is called in subroutine Fluid_Flow_Solver Use GeoElements_FluidModule USE CMudPropertiesVariables USE MudSystemVARIABLES USE Pumps_VARIABLES !USE CHOKEVARIABLES !USE CDataDisplayConsoleVariables , StandPipePressureDataDisplay=>StandPipePressure !use CManifolds use CDrillWatchVariables !use CHOKEVARIABLES !use CChokeManifoldVariables ! !use CTanksVariables, TripTankVolume2 => DrillingWatch%TripTankVolume, TripTankDensity2 => TripTankDensity USE sROP_Other_Variables USE sROP_Variables use KickVARIABLESModule use CError implicit none integer jelement, jmud, jsection,ielement,i integer jopelement,jopmud,jopsection,iisection,isection,OpSection !===========================================================WELL============================================================ !===========================================================WELL============================================================ if(allocated(MudSystem%Xstart_PipeSection)) deallocate(MudSystem%Xstart_PipeSection) if(allocated(MudSystem%Xend_PipeSection)) deallocate(MudSystem%Xend_PipeSection) if(allocated(MudSystem%PipeSection_VolumeCapacity)) deallocate(MudSystem%PipeSection_VolumeCapacity) if(allocated(MudSystem%Area_PipeSectionFt)) deallocate(MudSystem%Area_PipeSectionFt) if(allocated(MudSystem%GeoType)) deallocate(MudSystem%GeoType) if(allocated(MudSystem%OD_PipeSectionInch)) deallocate(MudSystem%OD_PipeSectionInch) if(allocated(MudSystem%ID_PipeSectionInch)) deallocate(MudSystem%ID_PipeSectionInch) if(allocated(MudSystem%Angle_PipeSection)) deallocate(MudSystem%Angle_PipeSection) if(allocated(MudSystem%Xstart_OpSection)) deallocate(MudSystem%Xstart_OpSection) if(allocated(MudSystem%Xend_OpSection)) deallocate(MudSystem%Xend_OpSection) if(allocated(MudSystem%OpSection_VolumeCapacity)) deallocate(MudSystem%OpSection_VolumeCapacity) if(allocated(MudSystem%Area_OpSectionFt)) deallocate(MudSystem%Area_OpSectionFt) if(allocated(MudSystem%GeoTypeOp)) deallocate(MudSystem%GeoTypeOp) if(allocated(MudSystem%OD_OpSectionInch)) deallocate(MudSystem%OD_OpSectionInch) if(allocated(MudSystem%ID_OpSectionInch)) deallocate(MudSystem%ID_OpSectionInch) if(allocated(MudSystem%Angle_OpSection)) deallocate(MudSystem%Angle_OpSection) ALLOCATE (MudSystem%Xstart_PipeSection(F_Counts%StringIntervalCounts+F_Counts%AnnulusIntervalCounts),MudSystem%Xend_PipeSection(F_Counts%StringIntervalCounts+F_Counts%AnnulusIntervalCounts) & ,MudSystem%PipeSection_VolumeCapacity(F_Counts%StringIntervalCounts+F_Counts%AnnulusIntervalCounts),MudSystem%Area_PipeSectionFt(F_Counts%StringIntervalCounts+F_Counts%AnnulusIntervalCounts), & MudSystem%GeoType(F_Counts%StringIntervalCounts+F_Counts%AnnulusIntervalCounts),MudSystem%OD_PipeSectionInch(F_Counts%StringIntervalCounts+F_Counts%AnnulusIntervalCounts),MudSystem%ID_PipeSectionInch(F_Counts%StringIntervalCounts+F_Counts%AnnulusIntervalCounts)) ALLOCATE (MudSystem%Xstart_OpSection(F_Counts%BottomHoleIntervalCounts),MudSystem%Xend_OpSection(F_Counts%BottomHoleIntervalCounts) & ,MudSystem%OpSection_VolumeCapacity(F_Counts%BottomHoleIntervalCounts),MudSystem%Area_OpSectionFt(F_Counts%BottomHoleIntervalCounts), & MudSystem%GeoTypeOp(F_Counts%BottomHoleIntervalCounts),MudSystem%OD_OpSectionInch(F_Counts%BottomHoleIntervalCounts),MudSystem%ID_OpSectionInch(F_Counts%BottomHoleIntervalCounts)) MudSystem%OpSection=0 MudSystem%isection=0 DO iisection=1, F_Counts%IntervalsTotalCounts IF (F_Interval(iisection)%GeoType == 1) THEN MudSystem%OpSection= MudSystem%OpSection+1 MudSystem%Xstart_OpSection(MudSystem%OpSection)= (F_Interval(iisection)%StartDepth) MudSystem%Xend_OpSection(MudSystem%OpSection)= (F_Interval(iisection)%EndDepth) MudSystem%Area_OpSectionFt(MudSystem%OpSection)= PII*((F_Interval(iisection)%OD/12.0d0)**2-(F_Interval(iisection)%ID/12.0d0)**2)/4.0d0 !D(in), AREA(ft^2) MudSystem%OD_OpSectionInch(MudSystem%OpSection)= (F_Interval(iisection)%OD) MudSystem%ID_OpSectionInch(MudSystem%OpSection)= (F_Interval(iisection)%ID) !REAL(F_Interval(iisection)%Volume) MudSystem%GeoTypeOp(MudSystem%OpSection)= F_Interval(iisection)%GeoType ! niaz nist ehtemalan !Angle_OpSection(OpSection)= F_Interval(iisection)%Angle !write(*,*) 'iisection=' , iisection !write(*,*) 'StartDepth=' , F_Interval(iisection)%StartDepth !write(*,*) 'EndDepth=' , F_Interval(iisection)%EndDepth !write(*,*) 'OD=' , F_Interval(iisection)%OD !write(*,*) 'ID=' , F_Interval(iisection)%ID ELSE MudSystem%isection= MudSystem%isection+1 MudSystem%Xstart_PipeSection(MudSystem%isection)= (F_Interval(iisection)%StartDepth) !write(*,*) 'F_Interval(iisection)%StartDepth=' , F_Interval(iisection)%StartDepth MudSystem%Xend_PipeSection(MudSystem%isection)= (F_Interval(iisection)%EndDepth) !write(*,*) 'F_Interval(iisection)%EndDepth=' , F_Interval(iisection)%EndDepth MudSystem%OD_PipeSectionInch(MudSystem%isection)= (F_Interval(iisection)%OD) MudSystem%Area_PipeSectionFt(MudSystem%isection)= PII*((F_Interval(iisection)%OD/12.0d0)**2-(F_Interval(iisection)%ID/12.0d0)**2)/4.0d0 !D(in), AREA(ft^2) MudSystem%ID_PipeSectionInch(MudSystem%isection)= (F_Interval(iisection)%ID) !PipeSection_VolumeCapacity(isection)= Area_PipeSectionFt(isection)* ABS(Xend_PipeSection(isection)-Xstart_PipeSection(isection))* 7.48051948 !REAL(F_Interval(iisection)%Volume) ! (gal) MudSystem%GeoType(MudSystem%isection)= F_Interval(iisection)%GeoType !Angle_PipeSection(isection)= F_Interval(iisection)%Angle ENDIF ENDDO call MudSystem%Xstart_MudElement%Empty() call MudSystem%Xstart_MudElement%Add(MudSystem%Xstart_PipeSection(1)) call MudSystem%Xstart_OpMudElement%Empty() call MudSystem%Xstart_OpMudElement%Add(MudSystem%Xstart_OpSection(1)) call MudSystem%TVDstart_MudElement%Empty() call TVD_Calculator(MudSystem%Xstart_PipeSection(1),MudSystem%MudCircVerticalDepth) call MudSystem%TVDstart_MudElement%Add(MudSystem%MudCircVerticalDepth) call MudSystem%TVDstart_OpMudElement%Empty() call TVD_Calculator(MudSystem%Xstart_OpSection(1),MudSystem%MudCircVerticalDepth) call MudSystem%TVDstart_OpMudElement%Add(MudSystem%MudCircVerticalDepth) MudSystem%NoPipeSections= MudSystem%isection ! sections in string and annulus(GeoType 0 & 2) DO OpSection= 1,F_Counts%BottomHoleIntervalCounts MudSystem%OpSection_VolumeCapacity(OpSection)= MudSystem%Area_OpSectionFt(OpSection)* ABS(MudSystem%Xend_OpSection(OpSection)-MudSystem%Xstart_OpSection(OpSection))* 7.48051948d0 !REAL(F_Interval(iisection)%Volume) ENDDO MudSystem%OpSection=OpSection DO isection= 1,MudSystem%NoPipeSections MudSystem%PipeSection_VolumeCapacity(isection)= MudSystem%Area_PipeSectionFt(isection)* ABS(MudSystem%Xend_PipeSection(isection)-MudSystem%Xstart_PipeSection(isection))* 7.48051948d0 !REAL(F_Interval(iisection)%Volume) ! (gal) ENDDO MudSystem%isection = isection !types: Mud= 0 Kick=1 !=========================================== if (MudSystem%FirstMudSet==0) then call MudSystem%Hz_MudDischarged_Volume%AddToFirst(MudSystem%PipeSection_VolumeCapacity(1)) !startup initial call MudSystem%Hz_Mud_Backhead_X%AddToFirst (MudSystem%Xstart_PipeSection(1)) call MudSystem%Hz_Mud_Backhead_section%AddToFirst (1) call MudSystem%Hz_Mud_Forehead_X%AddToFirst (MudSystem%Xend_PipeSection(1)) call MudSystem%Hz_Mud_Forehead_section%AddToFirst (1) call MudSystem%Hz_Density%AddToFirst (MudProperties%ActiveDensity) ! initial(ppg) call MudSystem%Hz_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call MudSystem%Hz_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call MudSystem%Hz_MudOrKick%AddToFirst (0) call MudSystem%St_MudDischarged_Volume%AddToFirst(sum(MudSystem%PipeSection_VolumeCapacity(2:F_Counts%StringIntervalCounts))) !startup initial call MudSystem%St_Mud_Backhead_X%AddToFirst (MudSystem%Xstart_PipeSection(2)) call MudSystem%St_Mud_Backhead_section%AddToFirst (2) call MudSystem%St_Mud_Forehead_X%AddToFirst (MudSystem%Xend_PipeSection(F_Counts%StringIntervalCounts)) call MudSystem%St_Mud_Forehead_section%AddToFirst (F_Counts%StringIntervalCounts) call MudSystem%St_Density%AddToFirst (MudProperties%ActiveDensity) ! initial(ppg) call MudSystem%St_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call MudSystem%St_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call MudSystem%St_MudOrKick%AddToFirst (0) call MudSystem%Ann_MudDischarged_Volume%AddToFirst(sum(MudSystem%PipeSection_VolumeCapacity(F_Counts%StringIntervalCounts+1:MudSystem%NoPipeSections))) call MudSystem%Ann_Mud_Backhead_X%AddToFirst (MudSystem%Xstart_PipeSection(F_Counts%StringIntervalCounts+1)) call MudSystem%Ann_Mud_Backhead_section%AddToFirst (F_Counts%StringIntervalCounts+1) call MudSystem%Ann_Mud_Forehead_X%AddToFirst (MudSystem%Xend_PipeSection(MudSystem%NoPipeSections)) call MudSystem%Ann_Mud_Forehead_section%AddToFirst (MudSystem%NoPipeSections) call MudSystem%Ann_Density%AddToFirst (MudProperties%ActiveDensity) ! initial(ppg) call MudSystem%Ann_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call MudSystem%Ann_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call MudSystem%Ann_MudOrKick%AddToFirst (0) call MudSystem%Ann_CuttingMud%AddToFirst (0) MudSystem%OldPosition= MudSystem%Xend_PipeSection(F_Counts%StringIntervalCounts) MudSystem%OldAnnulusCapacity= sum(MudSystem%PipeSection_VolumeCapacity(F_Counts%StringIntervalCounts+1:MudSystem%NoPipeSections)) call MudSystem%ChokeLine_MudDischarged_Volume%AddToFirst(MudSystem%ChokeLine_VolumeCapacity) call MudSystem%ChokeLine_Mud_Backhead_X%AddToFirst (0.0d0) call MudSystem%ChokeLine_Mud_Backhead_section%AddToFirst (1) call MudSystem%ChokeLine_Mud_Forehead_X%AddToFirst (BopStackSpecification%ChokeLineLength) call MudSystem%ChokeLine_Mud_Forehead_section%AddToFirst (1) call MudSystem%ChokeLine_Density%AddToFirst (MudProperties%ActiveDensity) ! initial(ppg) call MudSystem%ChokeLine_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call MudSystem%ChokeLine_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call MudSystem%ChokeLine_MudOrKick%AddToFirst (0) call MudSystem%Op_MudDischarged_Volume%AddToFirst (sum(MudSystem%OpSection_VolumeCapacity(1:F_Counts%BottomHoleIntervalCounts))) call MudSystem%Op_Mud_Backhead_X%AddToFirst (MudSystem%Xstart_OpSection(1)) call MudSystem%Op_Mud_Backhead_section%AddToFirst (1) call MudSystem%Op_Mud_Forehead_X%AddToFirst (MudSystem%Xend_OpSection(F_Counts%BottomHoleIntervalCounts)) call MudSystem%Op_Mud_Forehead_section%AddToFirst (F_Counts%BottomHoleIntervalCounts) call MudSystem%Op_Density%AddToFirst (MudProperties%ActiveDensity) call MudSystem%Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call MudSystem%Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call MudSystem%Op_MudOrKick%AddToFirst (0) !F_StringIntervalCountsOld= F_StringIntervalCounts ! is used for adding new pipe to string MudSystem%F_StringIntervalCounts_Old= F_Counts%StringIntervalCounts ! is used for adding new pipe to string MudSystem%FirstMudSet= 1 endif !===================== Trip Detection ================ !DeltaVolumeOp > 0 : Trip in !DeltaVolumeOp < 0 : Trip out MudSystem%DeltaVolumeOp= ((MudSystem%Xend_PipeSection(F_Counts%StringIntervalCounts)-MudSystem%OldPosition)*PII*((MudSystem%OD_PipeSectionInch(F_Counts%StringIntervalCounts+1)/12.0d0)**2)/4.0d0)* 7.48051948d0! ft^3 to gal ! D(in) MudSystem%DeltaVolumeOp = INT(MudSystem%DeltaVolumeOp * 100000.d0) / 100000.d0 MudSystem%DeltaVolumePipe= ((MudSystem%Xend_PipeSection(F_Counts%StringIntervalCounts)-MudSystem%OldPosition)*PII*((MudSystem%ID_PipeSectionInch(F_Counts%StringIntervalCounts+F_Counts%AnnulusIntervalCounts)/12.0d0)**2)/4.0d0)* 7.48051948d0! ft^3 to gal MudSystem%DeltaVolumePipe = INT(MudSystem%DeltaVolumePipe * 100000.d0) / 100000.d0 !DeltaVolumeAnnulusCapacity= ((Xend_PipeSection(F_Counts%StringIntervalCounts)-OldPosition))*Area_PipeSectionFt(NoPipeSections)* 7.48051948d0! ft^3 to gal KickVARIABLES%DrillStringSpeed = (MudSystem%Xend_PipeSection(F_Counts%StringIntervalCounts)-MudSystem%OldPosition) / 0.1 MudSystem%DeltaVolumeAnnulusCapacity= sum(MudSystem%PipeSection_VolumeCapacity(F_Counts%StringIntervalCounts+1:MudSystem%NoPipeSections)) - MudSystem%OldAnnulusCapacity !write(*,*) 'DeltaVolumeAnnulusCapacity= ' , DeltaVolumeAnnulusCapacity !write(*,*) 'DeltaVolumePipe=' , DeltaVolumePipe !write(*,*) 'DeltaVolumeOp=' , DeltaVolumeOp ! ! !write(*,*) 'Bit here=' , Xend_PipeSection(F_Counts%StringIntervalCounts) MudSystem%OldAnnulusCapacity= sum(MudSystem%PipeSection_VolumeCapacity(F_Counts%StringIntervalCounts+1:MudSystem%NoPipeSections)) MudSystem%OldPosition= MudSystem%Xend_PipeSection(F_Counts%StringIntervalCounts) ! Needed for trip in or out: if (MudSystem%Hz_Mud_Backhead_X%Length() == 0) then CALL ErrorStop('Hz_Mud_Backhead_X Length is 0') endif MudSystem%Hz_Mud_Backhead_X%Array(1)= MudSystem%Xstart_PipeSection(1) MudSystem%Hz_Mud_Backhead_section%Array(1)= 1 MudSystem%AddedElementsToString = F_Counts%StringIntervalCounts - MudSystem%F_StringIntervalCounts_Old MudSystem%St_Mud_Backhead_X%Array(1)= MudSystem%Xstart_PipeSection(2) MudSystem%St_Mud_Backhead_section%Array(1)= 2 MudSystem%Ann_Mud_Backhead_X%Array(1)= MudSystem%Xstart_PipeSection(F_Counts%StringIntervalCounts+1) MudSystem%Ann_Mud_Backhead_section%Array(1)= F_Counts%StringIntervalCounts+1 MudSystem%Op_Mud_Backhead_X%Array(1)= MudSystem%Xstart_OpSection(1) MudSystem%Op_Mud_Backhead_section%Array(1)= 1 MudSystem%ChokeLine_Mud_Backhead_X%Array(1)= 0. MudSystem%ChokeLine_Mud_Backhead_section%Array(1)= 1 MudSystem%F_StringIntervalCounts_Old= F_Counts%StringIntervalCounts !write(*,*) 'Xstart_PipeSection(2)' , Xstart_PipeSection(2) !write(*,*) 'Xend_PipeSection(1)' , Xend_PipeSection(1) !=================================================== ! !DeltaWellCap= sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) - WellCapOld !WellCapOld= sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) !write(*,*) 'DeltaWellCap=' , DeltaWellCap ! ! ! !DeltaAnnCap= sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) - AnnCapOld !AnnCapOld= sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) !write(*,*) 'DeltaAnnCap=' , DeltaAnnCap end subroutine ElementsCreation