subroutine PlotFinalMudElements ! is called in subroutine CirculationCodeSelect Use GeoElements_FluidModule USE CMudPropertiesVariables USE MudSystemVARIABLES USE Pumps_VARIABLES Use TD_StringConnectionData !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 CKellyConnectionEnumVariables USE UTUBEVARS use CLog1 Use CError Use , intrinsic :: IEEE_Arithmetic implicit none integer jelement, jmud, jsection,ielement,i integer jopelement,jopmud,jopsection character(len=120) :: temp1, temp2 if (ChokeControlPanel%ChokePanelStrokeResetSwitch == 1) then write(*,*) 'well cap=' , sum(PipeSection_VolumeCapacity(F_StringIntervalCounts+1:NoPipeSections)) + sum(OpSection_VolumeCapacity(1:F_BottomHoleIntervalCounts)) 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(*,*) 'cap_reset,DeltaWellCap=' , DeltaWellCap endif !========================ANNULUS END================= if ((Ann_Mud_Forehead_X%Last() - BopStackSpecification%AboveAnnularHeight) > 0.8 .or. Ann_Density%Last()==0.0) then ! for Line (BellNippleToWell-NonFullWell) WellisNOTFull= .true. else WellisNOTFull= .false. endif !WRITE(*,*) 'Ann_Mud_Forehead_X%Last() , KillHeight', Ann_Mud_Forehead_X%Last() , KillHeight if ((Ann_Mud_Forehead_X%Last() - BopStackSpecification%KillHeight)>0.8 .or. Ann_Density%Last()==0.0) then ! for Line j4 , WellToChokeManifold(Through 26) ChokeLineNOTFull= .true. else ChokeLineNOTFull= .false. endif !========================================================= jmud= 1 jsection= 1 jelement= 0 ! number of final mud elements call Xend_MudElement%Empty() call TVDend_MudElement%Empty() call Density_MudElement%Empty() call MudGeoType%Empty() call PipeID_MudElement%Empty() call PipeOD_MudElement%Empty() !call Angle_MudElement%Empty() call MudType_MudElement%Empty() DO WHILE(jmud <= Hz_Mud_Forehead_X%Length() .and. jsection<=1) jelement= jelement+1 TrueMinValue= min(Hz_Mud_Forehead_X%Array(jmud), Xend_PipeSection(jsection)) call Xend_MudElement%Add(TrueMinValue) call TVD_Calculator(TrueMinValue,MudCircVerticalDepth) call TVDend_MudElement%Add(MudCircVerticalDepth) call Density_MudElement%Add(Hz_Density%Array(jmud)) call PipeID_MudElement%Add(ID_PipeSectionInch(jsection)) call PipeOD_MudElement%Add(OD_PipeSectionInch(jsection)) !call Angle_MudElement%Add(Angle_PipeSection(jsection)) call MudType_MudElement%Add(Hz_MudOrKick%Array(jmud)) if (Xend_MudElement%Array(jelement)== Hz_Mud_Forehead_X%Array(jmud)) then jmud= jmud+1 else jsection= jsection+1 endif ENDDO NoHorizontalMudElements= jelement jmud= 1 jsection= 2 DO WHILE(jmud <= St_Mud_Forehead_X%Length() .and. jsection<=F_StringIntervalCounts) jelement= jelement+1 TrueMinValue= min(St_Mud_Forehead_X%Array(jmud), Xend_PipeSection(jsection)) call Xend_MudElement%Add(TrueMinValue) call TVD_Calculator(TrueMinValue,MudCircVerticalDepth) call TVDend_MudElement%Add(MudCircVerticalDepth) call Density_MudElement%Add(St_Density%Array(jmud)) call PipeID_MudElement%Add(ID_PipeSectionInch(jsection)) call PipeOD_MudElement%Add(OD_PipeSectionInch(jsection)) !call Angle_MudElement%Add(Angle_PipeSection(jsection)) call MudType_MudElement%Add(St_MudOrKick%Array(jmud)) if (Xend_MudElement%Array(jelement)== St_Mud_Forehead_X%Array(jmud)) then jmud= jmud+1 else jsection= jsection+1 endif ENDDO NoStringMudElements= jelement- NoHorizontalMudElements jmud= 1 jsection= F_StringIntervalCounts+1 DO WHILE(jmud<= Ann_Mud_Forehead_X%Length() .and. jsection<=NoPipeSections) jelement= jelement+1 TrueMinValue= max(Ann_Mud_Forehead_X%Array(jmud), Xend_PipeSection(jsection)) call Xend_MudElement%Add(TrueMinValue) call TVD_Calculator(TrueMinValue,MudCircVerticalDepth) call TVDend_MudElement%Add(MudCircVerticalDepth) call Density_MudElement%Add(Ann_Density%Array(jmud)) call PipeID_MudElement%Add(ID_PipeSectionInch(jsection)) call PipeOD_MudElement%Add(OD_PipeSectionInch(jsection)) !call Angle_MudElement%Add(Angle_PipeSection(jsection)) call MudType_MudElement%Add(Ann_MudOrKick%Array(jmud)) if (Xend_MudElement%Array(jelement)== Ann_Mud_Forehead_X%Array(jmud)) then jmud= jmud+1 else jsection= jsection+1 endif ENDDO do i= 2, Xend_MudElement%Length() if ( i== NoHorizontalMudElements+NoStringMudElements+1) then call Xstart_MudElement%Add (Ann_Mud_Backhead_X%Array(1)) ! start of annulus call TVD_Calculator(Ann_Mud_Backhead_X%Array(1),MudCircVerticalDepth) call TVDstart_MudElement%Add(MudCircVerticalDepth) elseif ( i== NoHorizontalMudElements+1 ) then call Xstart_MudElement%Add (St_Mud_Backhead_X%Array(1)) ! start of stirng call TVD_Calculator(St_Mud_Backhead_X%Array(1),MudCircVerticalDepth) call TVDstart_MudElement%Add(MudCircVerticalDepth) else call Xstart_MudElement%Add(Xend_MudElement%Array(i-1)) ! normal calculation call TVDstart_MudElement%Add(TVDend_MudElement%Array(i-1)) ! normal calculation endif enddo NoCasingMudElements = jelement- NoStringMudElements- NoHorizontalMudElements !=========================For Torque and Drag======================== if (allocated(TDXstart_MudElementArray)) deallocate(TDXstart_MudElementArray) allocate(TDXstart_MudElementArray(NoHorizontalMudElements+NoStringMudElements+NoCasingMudElements)) if (allocated(TDXend_MudElementArray)) deallocate(TDXend_MudElementArray) allocate(TDXend_MudElementArray(NoHorizontalMudElements+NoStringMudElements+NoCasingMudElements)) if (allocated(TDDensity_MudElementArray)) deallocate(TDDensity_MudElementArray) allocate(TDDensity_MudElementArray(NoHorizontalMudElements+NoStringMudElements+NoCasingMudElements)) TDNoHorizontalMudElements= NoHorizontalMudElements TDNoStringMudElements= NoStringMudElements TDNoCasingMudElements= NoCasingMudElements TDXstart_MudElementArray(:) = Xstart_MudElement%Array(:) TDXend_MudElementArray(:) = Xend_MudElement%Array(:) TDDensity_MudElementArray(:) = Density_MudElement%Array(:) !===================================================================== !do i=NoHorizontalMudElements+1, NoHorizontalMudElements+NoStringMudElements ! 2-string elements ! write(*,333) 'STRING:', i,'Xstart\=', Xstart_MudElement%Array(i), 'Xend=' , Xend_MudElement%Array(i), 'Density=' , Density_MudElement%Array(i), 'MudType=' , MudType_MudElement%Array(i) !enddo !================================================================ ! Open Hole Mud Elements jopmud= 1 jopsection= 1 jopelement= 0 ! number of final mud elements call Xend_OpMudElement%Empty() call TVDend_OpMudElement%Empty() call Density_OpMudElement%Empty() call PipeID_OpMudElement%Empty() call PipeOD_OpMudElement%Empty() !call Angle_OpMudElement%Empty() call MudTypeOp_MudElement%Empty() DO WHILE(jopmud<= Op_Mud_Forehead_X%Length() .and. jopsection<=F_BottomHoleIntervalCounts) jopelement= jopelement+1 TrueMinValue= max(Op_Mud_Forehead_X%Array(jopmud), Xend_OpSection(jopsection)) call Xend_OpMudElement%Add(TrueMinValue) call TVD_Calculator(TrueMinValue,MudCircVerticalDepth) call TVDend_OpMudElement%Add(MudCircVerticalDepth) call Density_OpMudElement%Add(Op_Density%Array(jopmud)) call PipeID_OpMudElement%Add(ID_OpSectionInch(jopsection)) call PipeOD_OpMudElement%Add(OD_OpSectionInch(jopsection)) !call Angle_MudElement%Add(Angle_PipeSection(jopsection)) call MudTypeOp_MudElement%Add(Op_MudOrKick%Array(jopmud)) if (Xend_OpMudElement%Array(jopelement)== Op_Mud_Forehead_X%Array(jopmud)) then jopmud= jopmud+1 else jopsection= jopsection+1 endif ENDDO do i= 2, Xend_OpMudElement%Length() call Xstart_OpMudElement%Add(Xend_OpMudElement%Array(i-1)) call TVDstart_OpMudElement%Add(TVDend_OpMudElement%Array(i-1)) enddo NoBottomHoleMudElements = jopelement !================================================================ if(allocated(StringMudElement)) deallocate(StringMudElement) allocate(StringMudElement(NoStringMudElements)) if(allocated(CasingMudElement)) deallocate(CasingMudElement) allocate(CasingMudElement(NoCasingMudElements+NoBottomHoleMudElements)) istring=0 icasing=0 BitMudDensity= Density_MudElement%Array(NoHorizontalMudElements+NoStringMudElements) ! (for ROP module) !================================================================ !============================ UTUBE ============================= !IF (UtubePossibility== .true. .and. Get_KellyConnection() /= KELLY_CONNECTION_STRING .and. WellHeadIsOpen) THEN IF (UtubePossibility== .true. .and. TD_FluidStringConnectionMode==0 .and. WellHeadIsOpen .AND. NoGasPocket == 0) THEN CALL WellPressureDataTransfer !WRITE (*,*) ' U-Tube Done 1' CALL Utube !WRITE (*,*) ' U-Tube Done 2' if (QUtubeInput> 0.0) call Utube1_and_TripIn if (QUtubeOutput> 0.0) call Utube2_and_TripIn END IF !========================== UTUBE- end ========================= ! do imud=1, st_MudDischarged_Volume%Length() ! write(*,*) 'st-plot:', imud, St_MudDischarged_Volume%Array(imud), St_Mud_Backhead_X%Array(imud) ,St_Mud_Forehead_X%Array(imud) !enddo !==================== Display ======================== !do i=1, St_MudOrKick%Length() ! write(*,555) i,'St_Volume(i), type=' ,St_MudDischarged_Volume%Array(i),St_MudOrKick%Array(i) ! ! IF (IEEE_Is_NaN(St_MudDischarged_Volume%Array(i))) call ErrorStop('NaN in St Volume-Plot') ! IF (St_MudDischarged_Volume%Array(i)<0.) call ErrorStop('St Volume <0' , St_MudDischarged_Volume%Array(i)) !enddo IF (ANY(IEEE_Is_NaN(Op_MudDischarged_Volume%Array(:))) .OR. ANY(Op_MudDischarged_Volume%Array(:) <= 0.0)) THEN do i = 1 , Op_MudOrKick%Length() write(*,555) i,'Op_Volume(i), type=' ,Op_MudDischarged_Volume%Array(i) , Op_MudOrKick%Array(i) , Op_Density%Array(i) end do call ErrorStop('NaN in Op Volume-Plot or Op Volume <=0') END IF IF (ANY(IEEE_Is_NaN(Ann_MudDischarged_Volume%Array(:))) .OR. ANY(Ann_MudDischarged_Volume%Array(:) <= 0.0)) THEN do i = 1 , Ann_MudOrKick%Length() write(*,555) i,'Ann_Volume(i), type=' ,Ann_MudDischarged_Volume%Array(i) , Ann_MudOrKick%Array(i) , Ann_Density%Array(i) end do call ErrorStop('NaN in Ann Volume-Plot or Ann Volume <=0') END IF !do i=1, Ann_MudOrKick%Length() ! !write(*,555) i,'Ann_Volume(i), type=' ,Ann_MudDischarged_Volume%Array(i),Ann_MudOrKick%Array(i),Ann_Density%Array(i) ! ! IF (IEEE_Is_NaN(Ann_MudDischarged_Volume%Array(i))) call ErrorStop('NaN in Ann Volume-Plot') ! IF (Ann_MudDischarged_Volume%Array(i)<=0.) call ErrorStop('Ann Volume <=0' , Ann_MudDischarged_Volume%Array(i)) !enddo 555 FORMAT(I3,5X,A42,(f12.5),5X,I3,5X,(f12.5)) NoStringMudElementsForPlot= NoStringMudElements ! 1-Horizontal Mud Elements are not shown !write(*,333) 'Horiz:', 1,'Xstart\=', Xstart_MudElement%Array(1), 'Xend=' , Xend_MudElement%Array(1), 'Density=' , Density_MudElement%Array(1), 'MudType=' , MudType_MudElement%Array(1) do i=NoHorizontalMudElements+1, NoHorizontalMudElements+NoStringMudElements ! 2-string elements if (Xend_MudElement%Array(i) <= 0.0) then NoStringMudElementsForPlot= NoStringMudElementsForPlot-1 cycle endif istring= istring+1 StringMudElement(istring)%StartMd = Xstart_MudElement%Array(i) StringMudElement(istring)%EndMd = Xend_MudElement%Array(i) !StringMudElement(istring)%Id = PipeID_MudElement%Array(i) !StringMudElement(istring)%Od = PipeOD_MudElement%Array(i) StringMudElement(istring)%Density = Density_MudElement%Array(i) if (MudType_MudElement%Array(i) == 104) then MudType_MudElement%Array(i)= 4 ! air elseif (MudType_MudElement%Array(i) > 0 .and. MudType_MudElement%Array(i) < 100) then ! all kicks MudType_MudElement%Array(i)= 1 ! gas kick endif StringMudElement(istring)%MudType = MudType_MudElement%Array(i) !write(*,333) 'STRING:', i,'Xstart\=', Xstart_MudElement%Array(i), 'Xend=' , Xend_MudElement%Array(i), 'Density=' , Density_MudElement%Array(i), 'MudType=' , MudType_MudElement%Array(i) enddo do i=Xend_MudElement%Length(), NoHorizontalMudElements+NoStringMudElements+1 , -1 ! 3-casing elements icasing= icasing+1 CasingMudElement(icasing)%StartMd = Xend_MudElement%Array(i) CasingMudElement(icasing)%EndMd = Xstart_MudElement%Array(i) !CasingMudElement(icasing)%Id = PipeID_MudElement%Array(i) !CasingMudElement(icasing)%Od = PipeOD_MudElement%Array(i) !write(*,333) 'CASING:', i,'Xstart\=', Xstart_MudElement%Array(i), 'Xend=' , Xend_MudElement%Array(i), 'Density=' , Density_MudElement%Array(i), 'MudType=' , MudType_MudElement%Array(i) !call Log_1(temp1) !write(*,444) 'CASING:', i,'Xstart\=', Xstart_MudElement%Array(i), 'Xend=' , Xend_MudElement%Array(i), 'PipeID_MudElement%Array(i)=' , PipeID_MudElement%Array(i), 'PipeOD_MudElement%Array(i)=' , PipeOD_MudElement%Array(i) CasingMudElement(icasing)%Density = Density_MudElement%Array(i) if (MudType_MudElement%Array(i) == 104) then MudType_MudElement%Array(i)= 4 ! air elseif (MudType_MudElement%Array(i) > 0 .and. MudType_MudElement%Array(i) < 100) then MudType_MudElement%Array(i)= 1 ! gas kick endif CasingMudElement(icasing)%MudType = MudType_MudElement%Array(i) enddo do i= NoBottomHoleMudElements, 1 , -1 ! 4-open hole elements icasing= icasing+1 CasingMudElement(icasing)%StartMd = Xend_OpMudElement%Array(i) CasingMudElement(icasing)%EndMd = Xstart_OpMudElement%Array(i) !CasingMudElement(icasing)%Id = PipeID_OpMudElement%Array(i) !CasingMudElement(icasing)%Od = PipeOD_OpMudElement%Array(i) !write(*,333) 'OpenHole:',i,'Xstart\=', Xstart_OpMudElement%Array(i), 'Xend=' , Xend_OpMudElement%Array(i), 'Density=' , Density_OpMudElement%Array(i), 'MudType=' , MudTypeOp_MudElement%Array(i) !call Log_1(temp2) !write(*,444) 'OpenHole:',i,'Xstart\=', Xstart_OpMudElement%Array(i), 'Xend=' , Xend_OpMudElement%Array(i), 'PipeID_MudElement%Array(i)=' , PipeID_MudElement%Array(i), 'PipeOD_MudElement%Array(i)=' , PipeOD_MudElement%Array(i) CasingMudElement(icasing)%Density = Density_OpMudElement%Array(i) if (MudTypeOp_MudElement%Array(i) == 104) then MudTypeOp_MudElement%Array(i)= 4 ! air elseif (MudTypeOp_MudElement%Array(i) > 0 .and. MudTypeOp_MudElement%Array(i) < 100) then MudTypeOp_MudElement%Array(i)= 1 ! gas kick endif CasingMudElement(icasing)%MudType = MudTypeOp_MudElement%Array(i) enddo 333 FORMAT(A10,I3,5X,A8,(f12.5),5X,A8,(f12.5),5X,A8,(f12.5),5X,A8,I3) 444 FORMAT(A10,I2,5X,A8,(f12.3),5X,A8,(f12.3),5X,A8,(f12.3),5X,A8,(f12.3)) ! shomare gozari be tartib HZ mud, ST mud, Casing ! shomare gzari OpenHole jodagane ast az 1 call SetStringFluids(NoStringMudElementsForPlot, StringMudElement) !for data display in string call SetAnnalusFluids(NoCasingMudElements+NoBottomHoleMudElements, CasingMudElement) !for data display in casing !=========================================================================================================================== !=========================================================================================================================== end subroutine PlotFinalMudElements