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 KickVariables use CError implicit none integer jelement, jmud, jsection,ielement,i integer jopelement,jopmud,jopsection !===========================================================WELL============================================================ !===========================================================WELL============================================================ if(allocated(Xstart_PipeSection)) deallocate(Xstart_PipeSection) if(allocated(Xend_PipeSection)) deallocate(Xend_PipeSection) if(allocated(PipeSection_VolumeCapacity)) deallocate(PipeSection_VolumeCapacity) if(allocated(Area_PipeSectionFt)) deallocate(Area_PipeSectionFt) if(allocated(GeoType)) deallocate(GeoType) if(allocated(OD_PipeSectionInch)) deallocate(OD_PipeSectionInch) if(allocated(ID_PipeSectionInch)) deallocate(ID_PipeSectionInch) if(allocated(Angle_PipeSection)) deallocate(Angle_PipeSection) if(allocated(Xstart_OpSection)) deallocate(Xstart_OpSection) if(allocated(Xend_OpSection)) deallocate(Xend_OpSection) if(allocated(OpSection_VolumeCapacity)) deallocate(OpSection_VolumeCapacity) if(allocated(Area_OpSectionFt)) deallocate(Area_OpSectionFt) if(allocated(GeoTypeOp)) deallocate(GeoTypeOp) if(allocated(OD_OpSectionInch)) deallocate(OD_OpSectionInch) if(allocated(ID_OpSectionInch)) deallocate(ID_OpSectionInch) if(allocated(Angle_OpSection)) deallocate(Angle_OpSection) ALLOCATE (Xstart_PipeSection(F_StringIntervalCounts+F_AnnulusIntervalCounts),Xend_PipeSection(F_StringIntervalCounts+F_AnnulusIntervalCounts) & ,PipeSection_VolumeCapacity(F_StringIntervalCounts+F_AnnulusIntervalCounts),Area_PipeSectionFt(F_StringIntervalCounts+F_AnnulusIntervalCounts), & GeoType(F_StringIntervalCounts+F_AnnulusIntervalCounts),OD_PipeSectionInch(F_StringIntervalCounts+F_AnnulusIntervalCounts),ID_PipeSectionInch(F_StringIntervalCounts+F_AnnulusIntervalCounts)) ALLOCATE (Xstart_OpSection(F_BottomHoleIntervalCounts),Xend_OpSection(F_BottomHoleIntervalCounts) & ,OpSection_VolumeCapacity(F_BottomHoleIntervalCounts),Area_OpSectionFt(F_BottomHoleIntervalCounts), & GeoTypeOp(F_BottomHoleIntervalCounts),OD_OpSectionInch(F_BottomHoleIntervalCounts),ID_OpSectionInch(F_BottomHoleIntervalCounts)) OpSection=0 isection=0 DO iisection=1, F_IntervalsTotalCounts IF (F_Interval(iisection)%GeoType == 1) THEN OpSection= OpSection+1 Xstart_OpSection(OpSection)= (F_Interval(iisection)%StartDepth) Xend_OpSection(OpSection)= (F_Interval(iisection)%EndDepth) Area_OpSectionFt(OpSection)= PII*((F_Interval(iisection)%OD/12.0d0)**2-(F_Interval(iisection)%ID/12.0d0)**2)/4.0d0 !D(in), AREA(ft^2) OD_OpSectionInch(OpSection)= (F_Interval(iisection)%OD) ID_OpSectionInch(OpSection)= (F_Interval(iisection)%ID) !REAL(F_Interval(iisection)%Volume) GeoTypeOp(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 isection= isection+1 Xstart_PipeSection(isection)= (F_Interval(iisection)%StartDepth) !write(*,*) 'F_Interval(iisection)%StartDepth=' , F_Interval(iisection)%StartDepth Xend_PipeSection(isection)= (F_Interval(iisection)%EndDepth) !write(*,*) 'F_Interval(iisection)%EndDepth=' , F_Interval(iisection)%EndDepth OD_PipeSectionInch(isection)= (F_Interval(iisection)%OD) Area_PipeSectionFt(isection)= PII*((F_Interval(iisection)%OD/12.0d0)**2-(F_Interval(iisection)%ID/12.0d0)**2)/4.0d0 !D(in), AREA(ft^2) ID_PipeSectionInch(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) GeoType(isection)= F_Interval(iisection)%GeoType !Angle_PipeSection(isection)= F_Interval(iisection)%Angle ENDIF ENDDO call Xstart_MudElement%Empty() call Xstart_MudElement%Add(Xstart_PipeSection(1)) call Xstart_OpMudElement%Empty() call Xstart_OpMudElement%Add(Xstart_OpSection(1)) call TVDstart_MudElement%Empty() call TVD_Calculator(Xstart_PipeSection(1),MudCircVerticalDepth) call TVDstart_MudElement%Add(MudCircVerticalDepth) call TVDstart_OPMudElement%Empty() call TVD_Calculator(Xstart_OpSection(1),MudCircVerticalDepth) call TVDstart_OPMudElement%Add(MudCircVerticalDepth) NoPipeSections= isection ! sections in string and annulus(GeoType 0 & 2) DO OpSection= 1,F_BottomHoleIntervalCounts OpSection_VolumeCapacity(OpSection)= Area_OpSectionFt(OpSection)* ABS(Xend_OpSection(OpSection)-Xstart_OpSection(OpSection))* 7.48051948d0 !REAL(F_Interval(iisection)%Volume) ENDDO DO isection= 1,NoPipeSections PipeSection_VolumeCapacity(isection)= Area_PipeSectionFt(isection)* ABS(Xend_PipeSection(isection)-Xstart_PipeSection(isection))* 7.48051948d0 !REAL(F_Interval(iisection)%Volume) ! (gal) ENDDO !types: Mud= 0 Kick=1 !=========================================== if (FirstMudSet==0) then call Hz_MudDischarged_Volume%AddToFirst(PipeSection_VolumeCapacity(1)) !startup initial call Hz_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(1)) call Hz_Mud_Backhead_section%AddToFirst (1) call Hz_Mud_Forehead_X%AddToFirst (Xend_PipeSection(1)) call Hz_Mud_Forehead_section%AddToFirst (1) call Hz_Density%AddToFirst (MudProperties%ActiveDensity) ! initial(ppg) call Hz_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call Hz_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call Hz_MudOrKick%AddToFirst (0) call St_MudDischarged_Volume%AddToFirst(sum(PipeSection_VolumeCapacity(2:F_StringIntervalCounts))) !startup initial call St_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(2)) call St_Mud_Backhead_section%AddToFirst (2) call St_Mud_Forehead_X%AddToFirst (Xend_PipeSection(F_StringIntervalCounts)) call St_Mud_Forehead_section%AddToFirst (F_StringIntervalCounts) call St_Density%AddToFirst (MudProperties%ActiveDensity) ! initial(ppg) call St_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call St_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call St_MudOrKick%AddToFirst (0) call Ann_MudDischarged_Volume%AddToFirst(sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections))) 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 (MudProperties%ActiveDensity) ! initial(ppg) call Ann_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call Ann_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call Ann_MudOrKick%AddToFirst (0) call Ann_CuttingMud%AddToFirst (0) OldPosition= Xend_PipeSection(F_StringIntervalCounts) OldAnnulusCapacity= sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) call ChokeLine_MudDischarged_Volume%AddToFirst(ChokeLine_VolumeCapacity) call ChokeLine_Mud_Backhead_X%AddToFirst (0.0d0) call ChokeLine_Mud_Backhead_section%AddToFirst (1) call ChokeLine_Mud_Forehead_X%AddToFirst (BopStackSpecification%ChokeLineLength) call ChokeLine_Mud_Forehead_section%AddToFirst (1) call ChokeLine_Density%AddToFirst (MudProperties%ActiveDensity) ! initial(ppg) call ChokeLine_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call ChokeLine_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call ChokeLine_MudOrKick%AddToFirst (0) call Op_MudDischarged_Volume%AddToFirst (sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts))) call Op_Mud_Backhead_X%AddToFirst (Xstart_OpSection(1)) call Op_Mud_Backhead_section%AddToFirst (1) call Op_Mud_Forehead_X%AddToFirst (Xend_OpSection(F_BottomHoleIntervalCounts)) call Op_Mud_Forehead_section%AddToFirst (F_BottomHoleIntervalCounts) call Op_Density%AddToFirst (MudProperties%ActiveDensity) call Op_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call Op_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call Op_MudOrKick%AddToFirst (0) !F_StringIntervalCountsOld= F_StringIntervalCounts ! is used for adding new pipe to string F_StringIntervalCounts_Old= F_StringIntervalCounts ! is used for adding new pipe to string FirstMudSet= 1 endif !===================== Trip Detection ================ !DeltaVolumeOp > 0 : Trip in !DeltaVolumeOp < 0 : Trip out DeltaVolumeOp= ((Xend_PipeSection(F_StringIntervalCounts)-OldPosition)*PII*((OD_PipeSectionInch(F_StringIntervalCounts+1)/12.0d0)**2)/4.0d0)* 7.48051948d0! ft^3 to gal ! D(in) DeltaVolumeOp = INT(DeltaVolumeOp * 100000.d0) / 100000.d0 DeltaVolumePipe= ((Xend_PipeSection(F_StringIntervalCounts)-OldPosition)*PII*((ID_PipeSectionInch(F_StringIntervalCounts+F_AnnulusIntervalCounts)/12.0d0)**2)/4.0d0)* 7.48051948d0! ft^3 to gal DeltaVolumePipe = INT(DeltaVolumePipe * 100000.d0) / 100000.d0 !DeltaVolumeAnnulusCapacity= ((Xend_PipeSection(F_StringIntervalCounts)-OldPosition))*Area_PipeSectionFt(NoPipeSections)* 7.48051948d0! ft^3 to gal DrillStringSpeed = (Xend_PipeSection(F_StringIntervalCounts)-OldPosition) / 0.1 DeltaVolumeAnnulusCapacity= sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) - OldAnnulusCapacity !write(*,*) 'DeltaVolumeAnnulusCapacity= ' , DeltaVolumeAnnulusCapacity !write(*,*) 'DeltaVolumePipe=' , DeltaVolumePipe !write(*,*) 'DeltaVolumeOp=' , DeltaVolumeOp ! ! !write(*,*) 'Bit here=' , Xend_PipeSection(F_StringIntervalCounts) OldAnnulusCapacity= sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) OldPosition= Xend_PipeSection(F_StringIntervalCounts) ! Needed for trip in or out: if (Hz_Mud_Backhead_X%Length() == 0) then CALL ErrorStop('Hz_Mud_Backhead_X Length is 0') endif Hz_Mud_Backhead_X%Array(1)= Xstart_PipeSection(1) Hz_Mud_Backhead_section%Array(1)= 1 AddedElementsToString = F_StringIntervalCounts - F_StringIntervalCounts_Old St_Mud_Backhead_X%Array(1)= Xstart_PipeSection(2) St_Mud_Backhead_section%Array(1)= 2 Ann_Mud_Backhead_X%Array(1)= Xstart_PipeSection(F_StringIntervalCounts+1) Ann_Mud_Backhead_section%Array(1)= F_StringIntervalCounts+1 Op_Mud_Backhead_X%Array(1)= Xstart_OpSection(1) Op_Mud_Backhead_section%Array(1)= 1 ChokeLine_Mud_Backhead_X%Array(1)= 0. ChokeLine_Mud_Backhead_section%Array(1)= 1 F_StringIntervalCounts_Old= F_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