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(MudSystemDotXstart_PipeSection)) deallocate(MudSystemDotXstart_PipeSection) if(allocated(MudSystemDotXend_PipeSection)) deallocate(MudSystemDotXend_PipeSection) if(allocated(MudSystemDotPipeSection_VolumeCapacity)) deallocate(MudSystemDotPipeSection_VolumeCapacity) if(allocated(MudSystemDotArea_PipeSectionFt)) deallocate(MudSystemDotArea_PipeSectionFt) if(allocated(MudSystemDotGeoType)) deallocate(MudSystemDotGeoType) if(allocated(MudSystemDotOD_PipeSectionInch)) deallocate(MudSystemDotOD_PipeSectionInch) if(allocated(MudSystemDotID_PipeSectionInch)) deallocate(MudSystemDotID_PipeSectionInch) if(allocated(MudSystemDotAngle_PipeSection)) deallocate(MudSystemDotAngle_PipeSection) if(allocated(MudSystemDotXstart_OpSection)) deallocate(MudSystemDotXstart_OpSection) if(allocated(MudSystemDotXend_OpSection)) deallocate(MudSystemDotXend_OpSection) if(allocated(MudSystemDotOpSection_VolumeCapacity)) deallocate(MudSystemDotOpSection_VolumeCapacity) if(allocated(MudSystemDotArea_OpSectionFt)) deallocate(MudSystemDotArea_OpSectionFt) if(allocated(MudSystemDotGeoTypeOp)) deallocate(MudSystemDotGeoTypeOp) if(allocated(MudSystemDotOD_OpSectionInch)) deallocate(MudSystemDotOD_OpSectionInch) if(allocated(MudSystemDotID_OpSectionInch)) deallocate(MudSystemDotID_OpSectionInch) if(allocated(MudSystemDotAngle_OpSection)) deallocate(MudSystemDotAngle_OpSection) ALLOCATE (MudSystemDotXstart_PipeSection(F_StringIntervalCounts+F_AnnulusIntervalCounts),MudSystemDotXend_PipeSection(F_StringIntervalCounts+F_AnnulusIntervalCounts) & ,MudSystemDotPipeSection_VolumeCapacity(F_StringIntervalCounts+F_AnnulusIntervalCounts),MudSystemDotArea_PipeSectionFt(F_StringIntervalCounts+F_AnnulusIntervalCounts), & MudSystemDotGeoType(F_StringIntervalCounts+F_AnnulusIntervalCounts),MudSystemDotOD_PipeSectionInch(F_StringIntervalCounts+F_AnnulusIntervalCounts),MudSystemDotID_PipeSectionInch(F_StringIntervalCounts+F_AnnulusIntervalCounts)) ALLOCATE (MudSystemDotXstart_OpSection(F_BottomHoleIntervalCounts),MudSystemDotXend_OpSection(F_BottomHoleIntervalCounts) & ,MudSystemDotOpSection_VolumeCapacity(F_BottomHoleIntervalCounts),MudSystemDotArea_OpSectionFt(F_BottomHoleIntervalCounts), & MudSystemDotGeoTypeOp(F_BottomHoleIntervalCounts),MudSystemDotOD_OpSectionInch(F_BottomHoleIntervalCounts),MudSystemDotID_OpSectionInch(F_BottomHoleIntervalCounts)) MudSystemDotOpSection=0 MudSystemDotisection=0 DO MudSystemDotiisection=1, F_IntervalsTotalCounts IF (F_Interval(MudSystemDotiisection)%GeoType == 1) THEN MudSystemDotOpSection= MudSystemDotOpSection+1 MudSystemDotXstart_OpSection(MudSystemDotOpSection)= (F_Interval(MudSystemDotiisection)%StartDepth) MudSystemDotXend_OpSection(MudSystemDotOpSection)= (F_Interval(MudSystemDotiisection)%EndDepth) MudSystemDotArea_OpSectionFt(MudSystemDotOpSection)= PII*((F_Interval(MudSystemDotiisection)%OD/12.0d0)**2-(F_Interval(MudSystemDotiisection)%ID/12.0d0)**2)/4.0d0 !D(in), AREA(ft^2) MudSystemDotOD_OpSectionInch(MudSystemDotOpSection)= (F_Interval(MudSystemDotiisection)%OD) MudSystemDotID_OpSectionInch(MudSystemDotOpSection)= (F_Interval(MudSystemDotiisection)%ID) !REAL(F_Interval(iisection)%Volume) MudSystemDotGeoTypeOp(MudSystemDotOpSection)= F_Interval(MudSystemDotiisection)%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 MudSystemDotisection= MudSystemDotisection+1 MudSystemDotXstart_PipeSection(MudSystemDotisection)= (F_Interval(MudSystemDotiisection)%StartDepth) !write(*,*) 'F_Interval(iisection)%StartDepth=' , F_Interval(iisection)%StartDepth MudSystemDotXend_PipeSection(MudSystemDotisection)= (F_Interval(MudSystemDotiisection)%EndDepth) !write(*,*) 'F_Interval(iisection)%EndDepth=' , F_Interval(iisection)%EndDepth MudSystemDotOD_PipeSectionInch(MudSystemDotisection)= (F_Interval(MudSystemDotiisection)%OD) MudSystemDotArea_PipeSectionFt(MudSystemDotisection)= PII*((F_Interval(MudSystemDotiisection)%OD/12.0d0)**2-(F_Interval(MudSystemDotiisection)%ID/12.0d0)**2)/4.0d0 !D(in), AREA(ft^2) MudSystemDotID_PipeSectionInch(MudSystemDotisection)= (F_Interval(MudSystemDotiisection)%ID) !PipeSection_VolumeCapacity(isection)= Area_PipeSectionFt(isection)* ABS(Xend_PipeSection(isection)-Xstart_PipeSection(isection))* 7.48051948 !REAL(F_Interval(iisection)%Volume) ! (gal) MudSystemDotGeoType(MudSystemDotisection)= F_Interval(MudSystemDotiisection)%GeoType !Angle_PipeSection(isection)= F_Interval(iisection)%Angle ENDIF ENDDO call Xstart_MudElement%Empty() call Xstart_MudElement%Add(MudSystemDotXstart_PipeSection(1)) call Xstart_OpMudElement%Empty() call Xstart_OpMudElement%Add(MudSystemDotXstart_OpSection(1)) call TVDstart_MudElement%Empty() call TVD_Calculator(MudSystemDotXstart_PipeSection(1),MudSystemDotMudCircVerticalDepth) call TVDstart_MudElement%Add(MudSystemDotMudCircVerticalDepth) call TVDstart_OPMudElement%Empty() call TVD_Calculator(MudSystemDotXstart_OpSection(1),MudSystemDotMudCircVerticalDepth) call TVDstart_OPMudElement%Add(MudSystemDotMudCircVerticalDepth) MudSystemDotNoPipeSections= MudSystemDotisection ! sections in string and annulus(GeoType 0 & 2) DO MudSystemDotOpSection= 1,F_BottomHoleIntervalCounts MudSystemDotOpSection_VolumeCapacity(MudSystemDotOpSection)= MudSystemDotArea_OpSectionFt(MudSystemDotOpSection)* ABS(MudSystemDotXend_OpSection(MudSystemDotOpSection)-MudSystemDotXstart_OpSection(MudSystemDotOpSection))* 7.48051948d0 !REAL(F_Interval(iisection)%Volume) ENDDO DO MudSystemDotisection= 1,MudSystemDotNoPipeSections MudSystemDotPipeSection_VolumeCapacity(MudSystemDotisection)= MudSystemDotArea_PipeSectionFt(MudSystemDotisection)* ABS(MudSystemDotXend_PipeSection(MudSystemDotisection)-MudSystemDotXstart_PipeSection(MudSystemDotisection))* 7.48051948d0 !REAL(F_Interval(iisection)%Volume) ! (gal) ENDDO !types: Mud= 0 Kick=1 !=========================================== if (MudSystemDotFirstMudSet==0) then call MudSystemDotHz_MudDischarged_Volume%AddToFirst(MudSystemDotPipeSection_VolumeCapacity(1)) !startup initial call MudSystemDotHz_Mud_Backhead_X%AddToFirst (MudSystemDotXstart_PipeSection(1)) call Hz_Mud_Backhead_section%AddToFirst (1) call MudSystemDotHz_Mud_Forehead_X%AddToFirst (MudSystemDotXend_PipeSection(1)) call Hz_Mud_Forehead_section%AddToFirst (1) call MudSystemDotHz_Density%AddToFirst (MudProperties%ActiveDensity) ! initial(ppg) call MudSystemDotHz_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call MudSystemDotHz_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call Hz_MudOrKick%AddToFirst (0) call MudSystemDotSt_MudDischarged_Volume%AddToFirst(sum(MudSystemDotPipeSection_VolumeCapacity(2:F_StringIntervalCounts))) !startup initial call MudSystemDotSt_Mud_Backhead_X%AddToFirst (MudSystemDotXstart_PipeSection(2)) call St_Mud_Backhead_section%AddToFirst (2) call MudSystemDotSt_Mud_Forehead_X%AddToFirst (MudSystemDotXend_PipeSection(F_StringIntervalCounts)) call St_Mud_Forehead_section%AddToFirst (F_StringIntervalCounts) call St_Density%AddToFirst (MudProperties%ActiveDensity) ! initial(ppg) call MudSystemDotSt_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call MudSystemDotSt_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call St_MudOrKick%AddToFirst (0) call MudSystemDotAnn_MudDischarged_Volume%AddToFirst(sum(MudSystemDotPipeSection_VolumeCapacity(F_StringIntervalCounts+1:MudSystemDotNoPipeSections))) call Ann_Mud_Backhead_X%AddToFirst (MudSystemDotXstart_PipeSection(F_StringIntervalCounts+1)) call Ann_Mud_Backhead_section%AddToFirst (F_StringIntervalCounts+1) call Ann_Mud_Forehead_X%AddToFirst (MudSystemDotXend_PipeSection(MudSystemDotNoPipeSections)) call Ann_Mud_Forehead_section%AddToFirst (MudSystemDotNoPipeSections) 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) MudSystemDotOldPosition= MudSystemDotXend_PipeSection(F_StringIntervalCounts) MudSystemDotOldAnnulusCapacity= sum(MudSystemDotPipeSection_VolumeCapacity(F_StringIntervalCounts+1:MudSystemDotNoPipeSections)) call MudSystemDotChokeLine_MudDischarged_Volume%AddToFirst(MudSystemDotChokeLine_VolumeCapacity) call MudSystemDotChokeLine_Mud_Backhead_X%AddToFirst (0.0d0) call ChokeLine_Mud_Backhead_section%AddToFirst (1) call MudSystemDotChokeLine_Mud_Forehead_X%AddToFirst (BopStackSpecification%ChokeLineLength) call ChokeLine_Mud_Forehead_section%AddToFirst (1) call MudSystemDotChokeLine_Density%AddToFirst (MudProperties%ActiveDensity) ! initial(ppg) call MudSystemDotChokeLine_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call MudSystemDotChokeLine_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call ChokeLine_MudOrKick%AddToFirst (0) call MudSystemDotOp_MudDischarged_Volume%AddToFirst (sum(MudSystemDotOpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts))) call MudSystemDotOp_Mud_Backhead_X%AddToFirst (MudSystemDotXstart_OpSection(1)) call Op_Mud_Backhead_section%AddToFirst (1) call MudSystemDotOp_Mud_Forehead_X%AddToFirst (MudSystemDotXend_OpSection(F_BottomHoleIntervalCounts)) call Op_Mud_Forehead_section%AddToFirst (F_BottomHoleIntervalCounts) call MudSystemDotOp_Density%AddToFirst (MudProperties%ActiveDensity) call MudSystemDotOp_RemainedVolume_in_LastSection%AddToFirst (0.0d0) call MudSystemDotOp_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0) call Op_MudOrKick%AddToFirst (0) !F_StringIntervalCountsOld= F_StringIntervalCounts ! is used for adding new pipe to string MudSystemDotF_StringIntervalCounts_Old= F_StringIntervalCounts ! is used for adding new pipe to string MudSystemDotFirstMudSet= 1 endif !===================== Trip Detection ================ !DeltaVolumeOp > 0 : Trip in !DeltaVolumeOp < 0 : Trip out MudSystemDotDeltaVolumeOp= ((MudSystemDotXend_PipeSection(F_StringIntervalCounts)-MudSystemDotOldPosition)*PII*((MudSystemDotOD_PipeSectionInch(F_StringIntervalCounts+1)/12.0d0)**2)/4.0d0)* 7.48051948d0! ft^3 to gal ! D(in) MudSystemDotDeltaVolumeOp = INT(MudSystemDotDeltaVolumeOp * 100000.d0) / 100000.d0 MudSystemDotDeltaVolumePipe= ((MudSystemDotXend_PipeSection(F_StringIntervalCounts)-MudSystemDotOldPosition)*PII*((MudSystemDotID_PipeSectionInch(F_StringIntervalCounts+F_AnnulusIntervalCounts)/12.0d0)**2)/4.0d0)* 7.48051948d0! ft^3 to gal MudSystemDotDeltaVolumePipe = INT(MudSystemDotDeltaVolumePipe * 100000.d0) / 100000.d0 !DeltaVolumeAnnulusCapacity= ((Xend_PipeSection(F_StringIntervalCounts)-OldPosition))*Area_PipeSectionFt(NoPipeSections)* 7.48051948d0! ft^3 to gal DrillStringSpeed = (MudSystemDotXend_PipeSection(F_StringIntervalCounts)-MudSystemDotOldPosition) / 0.1 MudSystemDotDeltaVolumeAnnulusCapacity= sum(MudSystemDotPipeSection_VolumeCapacity(F_StringIntervalCounts+1:MudSystemDotNoPipeSections)) - MudSystemDotOldAnnulusCapacity !write(*,*) 'DeltaVolumeAnnulusCapacity= ' , DeltaVolumeAnnulusCapacity !write(*,*) 'DeltaVolumePipe=' , DeltaVolumePipe !write(*,*) 'DeltaVolumeOp=' , DeltaVolumeOp ! ! !write(*,*) 'Bit here=' , Xend_PipeSection(F_StringIntervalCounts) MudSystemDotOldAnnulusCapacity= sum(MudSystemDotPipeSection_VolumeCapacity(F_StringIntervalCounts+1:MudSystemDotNoPipeSections)) MudSystemDotOldPosition= MudSystemDotXend_PipeSection(F_StringIntervalCounts) ! Needed for trip in or out: if (MudSystemDotHz_Mud_Backhead_X%Length() == 0) then CALL ErrorStop('Hz_Mud_Backhead_X Length is 0') endif MudSystemDotHz_Mud_Backhead_X%Array(1)= MudSystemDotXstart_PipeSection(1) Hz_Mud_Backhead_section%Array(1)= 1 MudSystemDotAddedElementsToString = F_StringIntervalCounts - MudSystemDotF_StringIntervalCounts_Old MudSystemDotSt_Mud_Backhead_X%Array(1)= MudSystemDotXstart_PipeSection(2) St_Mud_Backhead_section%Array(1)= 2 Ann_Mud_Backhead_X%Array(1)= MudSystemDotXstart_PipeSection(F_StringIntervalCounts+1) Ann_Mud_Backhead_section%Array(1)= F_StringIntervalCounts+1 MudSystemDotOp_Mud_Backhead_X%Array(1)= MudSystemDotXstart_OpSection(1) Op_Mud_Backhead_section%Array(1)= 1 MudSystemDotChokeLine_Mud_Backhead_X%Array(1)= 0. ChokeLine_Mud_Backhead_section%Array(1)= 1 MudSystemDotF_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