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(MudSystem%PipeSection_VolumeCapacity(F_Counts%StringIntervalCounts+1:MudSystem%NoPipeSections)) + sum(MudSystem%OpSection_VolumeCapacity(1:F_Counts%BottomHoleIntervalCounts)) MudSystem%DeltaWellCap= sum(MudSystem%PipeSection_VolumeCapacity(F_Counts%StringIntervalCounts+1:MudSystem%NoPipeSections)) + sum(MudSystem%OpSection_VolumeCapacity(1:F_Counts%BottomHoleIntervalCounts)) - MudSystem%WellCapOld MudSystem%WellCapOld= sum(MudSystem%PipeSection_VolumeCapacity(F_Counts%StringIntervalCounts+1:MudSystem%NoPipeSections)) + sum(MudSystem%OpSection_VolumeCapacity(1:F_Counts%BottomHoleIntervalCounts)) write(*,*) 'cap_reset,DeltaWellCap=' , MudSystem%DeltaWellCap endif !========================ANNULUS END================= if ((MudSystem%Ann_Mud_Forehead_X%Last() - BopStackSpecification%AboveAnnularHeight) > 0.8 .or. MudSystem%Ann_Density%Last()==0.0) then ! for Line (BellNippleToWell-NonFullWell) MudSystem%WellisNOTFull= .true. else MudSystem%WellisNOTFull= .false. endif !WRITE(*,*) 'Ann_Mud_Forehead_X%Last() , KillHeight', Ann_Mud_Forehead_X%Last() , KillHeight if ((MudSystem%Ann_Mud_Forehead_X%Last() - BopStackSpecification%KillHeight)>0.8 .or. MudSystem%Ann_Density%Last()==0.0) then ! for Line j4 , WellToChokeManifold(Through 26) MudSystem%ChokeLineNOTFull= .true. else MudSystem%ChokeLineNOTFull= .false. endif !========================================================= jmud= 1 jsection= 1 jelement= 0 ! number of final mud elements call MudSystem%Xend_MudElement%Empty() call MudSystem%TVDend_MudElement%Empty() call MudSystem%Density_MudElement%Empty() call MudSystem%MudGeoType%Empty() call MudSystem%PipeID_MudElement%Empty() call MudSystem%PipeOD_MudElement%Empty() !call Angle_MudElement%Empty() call MudSystem%MudType_MudElement%Empty() DO WHILE(jmud <= MudSystem%Hz_Mud_Forehead_X%Length() .and. jsection<=1) jelement= jelement+1 MudSystem%TrueMinValue= min(MudSystem%Hz_Mud_Forehead_X%Array(jmud), MudSystem%Xend_PipeSection(jsection)) call MudSystem%Xend_MudElement%Add(MudSystem%TrueMinValue) call TVD_Calculator(MudSystem%TrueMinValue,MudSystem%MudCircVerticalDepth) call MudSystem%TVDend_MudElement%Add(MudSystem%MudCircVerticalDepth) call MudSystem%Density_MudElement%Add(MudSystem%Hz_Density%Array(jmud)) call MudSystem%PipeID_MudElement%Add(MudSystem%ID_PipeSectionInch(jsection)) call MudSystem%PipeOD_MudElement%Add(MudSystem%OD_PipeSectionInch(jsection)) !call Angle_MudElement%Add(Angle_PipeSection(jsection)) call MudSystem%MudType_MudElement%Add(MudSystem%Hz_MudOrKick%Array(jmud)) if (MudSystem%Xend_MudElement%Array(jelement)== MudSystem%Hz_Mud_Forehead_X%Array(jmud)) then jmud= jmud+1 else jsection= jsection+1 endif ENDDO MudSystem%NoHorizontalMudElements= jelement jmud= 1 jsection= 2 DO WHILE(jmud <= MudSystem%St_Mud_Forehead_X%Length() .and. jsection<=F_Counts%StringIntervalCounts) jelement= jelement+1 MudSystem%TrueMinValue= min(MudSystem%St_Mud_Forehead_X%Array(jmud), MudSystem%Xend_PipeSection(jsection)) call MudSystem%Xend_MudElement%Add(MudSystem%TrueMinValue) call TVD_Calculator(MudSystem%TrueMinValue,MudSystem%MudCircVerticalDepth) call MudSystem%TVDend_MudElement%Add(MudSystem%MudCircVerticalDepth) call MudSystem%Density_MudElement%Add(MudSystem%St_Density%Array(jmud)) call MudSystem%PipeID_MudElement%Add(MudSystem%ID_PipeSectionInch(jsection)) call MudSystem%PipeOD_MudElement%Add(MudSystem%OD_PipeSectionInch(jsection)) !call Angle_MudElement%Add(Angle_PipeSection(jsection)) call MudSystem%MudType_MudElement%Add(MudSystem%St_MudOrKick%Array(jmud)) if (MudSystem%Xend_MudElement%Array(jelement)== MudSystem%St_Mud_Forehead_X%Array(jmud)) then jmud= jmud+1 else jsection= jsection+1 endif ENDDO MudSystem%NoStringMudElements= jelement- MudSystem%NoHorizontalMudElements jmud= 1 jsection= F_Counts%StringIntervalCounts+1 DO WHILE(jmud<= MudSystem%Ann_Mud_Forehead_X%Length() .and. jsection<=MudSystem%NoPipeSections) jelement= jelement+1 MudSystem%TrueMinValue= max(MudSystem%Ann_Mud_Forehead_X%Array(jmud), MudSystem%Xend_PipeSection(jsection)) call MudSystem%Xend_MudElement%Add(MudSystem%TrueMinValue) call TVD_Calculator(MudSystem%TrueMinValue,MudSystem%MudCircVerticalDepth) call MudSystem%TVDend_MudElement%Add(MudSystem%MudCircVerticalDepth) call MudSystem%Density_MudElement%Add(MudSystem%Ann_Density%Array(jmud)) call MudSystem%PipeID_MudElement%Add(MudSystem%ID_PipeSectionInch(jsection)) call MudSystem%PipeOD_MudElement%Add(MudSystem%OD_PipeSectionInch(jsection)) !call Angle_MudElement%Add(Angle_PipeSection(jsection)) call MudSystem%MudType_MudElement%Add(MudSystem%Ann_MudOrKick%Array(jmud)) if (MudSystem%Xend_MudElement%Array(jelement)== MudSystem%Ann_Mud_Forehead_X%Array(jmud)) then jmud= jmud+1 else jsection= jsection+1 endif ENDDO do i= 2, MudSystem%Xend_MudElement%Length() if ( i== MudSystem%NoHorizontalMudElements+MudSystem%NoStringMudElements+1) then call MudSystem%Xstart_MudElement%Add (MudSystem%Ann_Mud_Backhead_X%Array(1)) ! start of annulus call TVD_Calculator(MudSystem%Ann_Mud_Backhead_X%Array(1),MudSystem%MudCircVerticalDepth) call MudSystem%TVDstart_MudElement%Add(MudSystem%MudCircVerticalDepth) elseif ( i== MudSystem%NoHorizontalMudElements+1 ) then call MudSystem%Xstart_MudElement%Add (MudSystem%St_Mud_Backhead_X%Array(1)) ! start of stirng call TVD_Calculator(MudSystem%St_Mud_Backhead_X%Array(1),MudSystem%MudCircVerticalDepth) call MudSystem%TVDstart_MudElement%Add(MudSystem%MudCircVerticalDepth) else call MudSystem%Xstart_MudElement%Add(MudSystem%Xend_MudElement%Array(i-1)) ! normal calculation call MudSystem%TVDstart_MudElement%Add(MudSystem%TVDend_MudElement%Array(i-1)) ! normal calculation endif enddo MudSystem%NoCasingMudElements = jelement- MudSystem%NoStringMudElements- MudSystem%NoHorizontalMudElements !=========================For Torque and Drag======================== if (allocated(MudSystem%TDXstart_MudElementArray)) deallocate(MudSystem%TDXstart_MudElementArray) allocate(MudSystem%TDXstart_MudElementArray(MudSystem%NoHorizontalMudElements+MudSystem%NoStringMudElements+MudSystem%NoCasingMudElements)) if (allocated(MudSystem%TDXend_MudElementArray)) deallocate(MudSystem%TDXend_MudElementArray) allocate(MudSystem%TDXend_MudElementArray(MudSystem%NoHorizontalMudElements+MudSystem%NoStringMudElements+MudSystem%NoCasingMudElements)) if (allocated(MudSystem%TDDensity_MudElementArray)) deallocate(MudSystem%TDDensity_MudElementArray) allocate(MudSystem%TDDensity_MudElementArray(MudSystem%NoHorizontalMudElements+MudSystem%NoStringMudElements+MudSystem%NoCasingMudElements)) MudSystem%TDNoHorizontalMudElements= MudSystem%NoHorizontalMudElements MudSystem%TDNoStringMudElements= MudSystem%NoStringMudElements MudSystem%TDNoCasingMudElements= MudSystem%NoCasingMudElements MudSystem%TDXstart_MudElementArray(:) = MudSystem%Xstart_MudElement%Array(:) MudSystem%TDXend_MudElementArray(:) = MudSystem%Xend_MudElement%Array(:) MudSystem%TDDensity_MudElementArray(:) = MudSystem%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 MudSystem%Xend_OpMudElement%Empty() call MudSystem%TVDend_OpMudElement%Empty() call MudSystem%Density_OpMudElement%Empty() call MudSystem%PipeID_OpMudElement%Empty() call MudSystem%PipeOD_OpMudElement%Empty() !call Angle_OpMudElement%Empty() call MudSystem%MudTypeOp_MudElement%Empty() DO WHILE(jopmud<= MudSystem%Op_Mud_Forehead_X%Length() .and. jopsection<=F_Counts%BottomHoleIntervalCounts) jopelement= jopelement+1 MudSystem%TrueMinValue= max(MudSystem%Op_Mud_Forehead_X%Array(jopmud), MudSystem%Xend_OpSection(jopsection)) call MudSystem%Xend_OpMudElement%Add(MudSystem%TrueMinValue) call TVD_Calculator(MudSystem%TrueMinValue,MudSystem%MudCircVerticalDepth) call MudSystem%TVDend_OpMudElement%Add(MudSystem%MudCircVerticalDepth) call MudSystem%Density_OpMudElement%Add(MudSystem%Op_Density%Array(jopmud)) call MudSystem%PipeID_OpMudElement%Add(MudSystem%ID_OpSectionInch(jopsection)) call MudSystem%PipeOD_OpMudElement%Add(MudSystem%OD_OpSectionInch(jopsection)) !call Angle_MudElement%Add(Angle_PipeSection(jopsection)) call MudSystem%MudTypeOp_MudElement%Add(MudSystem%Op_MudOrKick%Array(jopmud)) if (MudSystem%Xend_OpMudElement%Array(jopelement)== MudSystem%Op_Mud_Forehead_X%Array(jopmud)) then jopmud= jopmud+1 else jopsection= jopsection+1 endif ENDDO do i= 2, MudSystem%Xend_OpMudElement%Length() call MudSystem%Xstart_OpMudElement%Add(MudSystem%Xend_OpMudElement%Array(i-1)) call MudSystem%TVDstart_OpMudElement%Add(MudSystem%TVDend_OpMudElement%Array(i-1)) enddo MudSystem%NoBottomHoleMudElements = jopelement !================================================================ if(allocated(MudSystem%StringMudElement)) deallocate(MudSystem%StringMudElement) allocate(MudSystem%StringMudElement(MudSystem%NoStringMudElements)) if(allocated(MudSystem%CasingMudElement)) deallocate(MudSystem%CasingMudElement) allocate(MudSystem%CasingMudElement(MudSystem%NoCasingMudElements+MudSystem%NoBottomHoleMudElements)) MudSystem%istring=0 MudSystem%icasing=0 MudSystem%BitMudDensity= MudSystem%Density_MudElement%Array(MudSystem%NoHorizontalMudElements+MudSystem%NoStringMudElements) ! (for ROP module) !================================================================ !============================ UTUBE ============================= !IF (UtubePossibility== .true. .and. Get_KellyConnection() /= KELLY_CONNECTION_STRING .and. WellHeadIsOpen) THEN IF (MudSystem%UtubePossibility== .true. .and. TD_StConn%FluidStringConnectionMode==0 .and. MudSystem%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(MudSystem%Op_MudDischarged_Volume%Array(:))) .OR. ANY(MudSystem%Op_MudDischarged_Volume%Array(:) <= 0.0)) THEN do i = 1 , MudSystem%Op_MudOrKick%Length() write(*,555) i,'Op_Volume(i), type=' ,MudSystem%Op_MudDischarged_Volume%Array(i) , MudSystem%Op_MudOrKick%Array(i) , MudSystem%Op_Density%Array(i) end do call ErrorStop('NaN in Op Volume-Plot or Op Volume <=0') END IF IF (ANY(IEEE_Is_NaN(MudSystem%Ann_MudDischarged_Volume%Array(:))) .OR. ANY(MudSystem%Ann_MudDischarged_Volume%Array(:) <= 0.0)) THEN do i = 1 , MudSystem%Ann_MudOrKick%Length() write(*,555) i,'Ann_Volume(i), type=' ,MudSystem%Ann_MudDischarged_Volume%Array(i) , MudSystem%Ann_MudOrKick%Array(i) , MudSystem%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)) MudSystem%NoStringMudElementsForPlot= MudSystem%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=MudSystem%NoHorizontalMudElements+1, MudSystem%NoHorizontalMudElements+MudSystem%NoStringMudElements ! 2-string elements if (MudSystem%Xend_MudElement%Array(i) <= 0.0) then MudSystem%NoStringMudElementsForPlot= MudSystem%NoStringMudElementsForPlot-1 cycle endif MudSystem%istring= MudSystem%istring+1 MudSystem%StringMudElement(MudSystem%istring)%StartMd = MudSystem%Xstart_MudElement%Array(i) MudSystem%StringMudElement(MudSystem%istring)%EndMd = MudSystem%Xend_MudElement%Array(i) !StringMudElement(istring)%Id = PipeID_MudElement%Array(i) !StringMudElement(istring)%Od = PipeOD_MudElement%Array(i) MudSystem%StringMudElement(MudSystem%istring)%Density = MudSystem%Density_MudElement%Array(i) if (MudSystem%MudType_MudElement%Array(i) == 104) then MudSystem%MudType_MudElement%Array(i)= 4 ! air elseif (MudSystem%MudType_MudElement%Array(i) > 0 .and. MudSystem%MudType_MudElement%Array(i) < 100) then ! all kicks MudSystem%MudType_MudElement%Array(i)= 1 ! gas kick endif MudSystem%StringMudElement(MudSystem%istring)%MudType = MudSystem%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=MudSystem%Xend_MudElement%Length(), MudSystem%NoHorizontalMudElements+MudSystem%NoStringMudElements+1 , -1 ! 3-casing elements MudSystem%icasing= MudSystem%icasing+1 MudSystem%CasingMudElement(MudSystem%icasing)%StartMd = MudSystem%Xend_MudElement%Array(i) MudSystem%CasingMudElement(MudSystem%icasing)%EndMd = MudSystem%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) MudSystem%CasingMudElement(MudSystem%icasing)%Density = MudSystem%Density_MudElement%Array(i) if (MudSystem%MudType_MudElement%Array(i) == 104) then MudSystem%MudType_MudElement%Array(i)= 4 ! air elseif (MudSystem%MudType_MudElement%Array(i) > 0 .and. MudSystem%MudType_MudElement%Array(i) < 100) then MudSystem%MudType_MudElement%Array(i)= 1 ! gas kick endif MudSystem%CasingMudElement(MudSystem%icasing)%MudType = MudSystem%MudType_MudElement%Array(i) enddo do i= MudSystem%NoBottomHoleMudElements, 1 , -1 ! 4-open hole elements MudSystem%icasing= MudSystem%icasing+1 MudSystem%CasingMudElement(MudSystem%icasing)%StartMd = MudSystem%Xend_OpMudElement%Array(i) MudSystem%CasingMudElement(MudSystem%icasing)%EndMd = MudSystem%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) MudSystem%CasingMudElement(MudSystem%icasing)%Density = MudSystem%Density_OpMudElement%Array(i) if (MudSystem%MudTypeOp_MudElement%Array(i) == 104) then MudSystem%MudTypeOp_MudElement%Array(i)= 4 ! air elseif (MudSystem%MudTypeOp_MudElement%Array(i) > 0 .and. MudSystem%MudTypeOp_MudElement%Array(i) < 100) then MudSystem%MudTypeOp_MudElement%Array(i)= 1 ! gas kick endif MudSystem%CasingMudElement(MudSystem%icasing)%MudType = MudSystem%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(MudSystem%NoStringMudElementsForPlot, MudSystem%StringMudElement) !for data display in string call SetAnnalusFluids(MudSystem%NoCasingMudElements+MudSystem%NoBottomHoleMudElements, MudSystem%CasingMudElement) !for data display in casing !=========================================================================================================================== !=========================================================================================================================== end subroutine PlotFinalMudElements