Simulation Core
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

534 lines
38 KiB

  1. SUBROUTINE Utube1_and_TripIn ! is called in subroutine CirculationCodeSelect string to annulus
  2. use UTUBEVARSModule
  3. Use GeoElements_FluidModule
  4. USE CMudPropertiesVariables
  5. USE MudSystemVARIABLES
  6. use SimulationVariables !@@@
  7. use SimulationVariables
  8. USE sROP_Variables
  9. use SimulationVariables !@
  10. !use CTanks
  11. !@use ConfigurationVariables, TripTankVolume2 => data%EquipmentControl%DrillingWatch%TripTankVolume, TripTankDensity2 => TripTankDensity
  12. Use CShoeVariables
  13. Use CUnityOutputs
  14. implicit none
  15. write(*,*) 'Utube1 code'
  16. !===========================================================WELL============================================================
  17. !===========================================================WELL============================================================
  18. data%State%MudSystem%UtubeMode1Activated= .true.
  19. !write(*,*) 'QUTubeInput=' , QUTubeInput
  20. !Qinput=5000.
  21. data%State%MudSystem%StringFlowRate= UTUBEVARS%QUTubeInput ! (gpm)
  22. data%State%MudSystem%AnnulusFlowRate= UTUBEVARS%QUTubeInput
  23. data%State%MudSystem%StringFlowRateFinal= data%State%MudSystem%StringFlowRate
  24. data%State%MudSystem%AnnulusFlowRateFinal= data%State%MudSystem%AnnulusFlowRate
  25. !===========================================
  26. if (data%State%MudSystem%FirstSetUtube1==0) then
  27. ! call St_MudDischarged_Volume%AddToFirst (REAL(sum(data%State%F_Interval(1:F_StringIntervalCounts)%Volume))) !startup initial
  28. ! call St_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(1))
  29. ! call St_Mud_Backhead_section%AddToFirst (1)
  30. ! call St_Mud_Forehead_X%AddToFirst (Xend_PipeSection(F_StringIntervalCounts))
  31. ! call St_Mud_Forehead_section%AddToFirst (F_StringIntervalCounts)
  32. ! call data%State%MudSystem%St_Density%AddToFirst (REAL(ActiveDensity)) ! initial(ppg)
  33. ! call St_RemainedVolume_in_LastSection%AddToFirst (0.0d0)
  34. ! call St_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0)
  35. !
  36. ! call Ann_MudDischarged_Volume%AddToFirst (REAL(sum(data%State%F_Interval((F_StringIntervalCounts+F_BottomHoleIntervalCounts+1):F_IntervalsTotalCounts)%Volume))) !startup initial
  37. ! call Ann_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(F_StringIntervalCounts+1))
  38. ! call Ann_Mud_Backhead_section%AddToFirst (F_StringIntervalCounts+1)
  39. ! call Ann_Mud_Forehead_X%AddToFirst (Xend_PipeSection(NoPipeSections))
  40. ! call Ann_Mud_Forehead_section%AddToFirst (NoPipeSections)
  41. ! call Ann_Density%AddToFirst (REAL(ActiveDensity)) ! initial(ppg)
  42. ! call Ann_RemainedVolume_in_LastSection%AddToFirst (0.0d0)
  43. ! call Ann_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0)
  44. !Hz_Density%Array(:)= 0.0 !commented
  45. !Hz_MudOrKick%Array(:)= 104 !commented
  46. data%State%MudSystem%Hz_Density_Utube= 0.0
  47. data%State%MudSystem%Hz_MudOrKick_Utube= 104
  48. data%State%MudSystem%FirstSetUtube1= 1
  49. endif
  50. !========================Horizontal PIPE ENTRANCE=================
  51. !if (SuctionDensity_Old >= (ActiveDensity+0.05) .or. SuctionDensity_Old <= (ActiveDensity-0.05)) then ! new mud is pumped
  52. ! !ImudCount= ImudCount+1
  53. ! !SuctionMud= ImudCount
  54. ! call Hz_Density%AddToFirst (REAL(ActiveDensity)) !ActiveDensity : badan in moteghayer bayad avaz beshe
  55. ! call Hz_MudDischarged_Volume%AddToFirst (0.0d0)
  56. ! call Hz_Mud_Forehead_X%AddToFirst (Xstart_PipeSection(1))
  57. ! call Hz_Mud_Forehead_section%AddToFirst (1)
  58. ! call Hz_Mud_Backhead_X%AddToFirst (Xstart_PipeSection(1))
  59. ! call Hz_Mud_Backhead_section%AddToFirst (1)
  60. ! call Hz_RemainedVolume_in_LastSection%AddToFirst (0.0d0)
  61. ! call Hz_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0)
  62. ! call Hz_MudOrKick%AddToFirst (0)
  63. !
  64. ! SuctionDensity_Old= ActiveDensity
  65. !endif
  66. !========================Horizontal PIPE STRING=================
  67. !commented
  68. ! Hz_MudDischarged_Volume%Array(1)= Hz_MudDischarged_Volume%Array(1)+ ((data%State%MudSystem%StringFlowRate/60.)*DeltaT_Mudline) !(gal)
  69. !
  70. !imud=0
  71. ! do while (imud < Hz_Mud_Forehead_X%Length())
  72. ! imud = imud + 1
  73. !
  74. ! if (imud> 1) then
  75. ! Hz_Mud_Backhead_X%Array(imud)= Hz_Mud_Forehead_X%Array(imud-1)
  76. ! Hz_Mud_Backhead_section%Array(imud)= Hz_Mud_Forehead_section%Array(imud-1)
  77. ! endif
  78. !
  79. !
  80. ! DirectionCoef= (Xend_PipeSection(Hz_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(Hz_Mud_Backhead_section%Array(imud))) &
  81. ! / ABS(Xend_PipeSection(Hz_Mud_Backhead_section%Array(imud))-Xstart_PipeSection(Hz_Mud_Backhead_section%Array(imud)))
  82. ! ! +1 for string , -1 for annulus
  83. !
  84. !
  85. ! Hz_EmptyVolume_inBackheadLocation%Array(imud)= DirectionCoef* (Xend_PipeSection(Hz_Mud_Backhead_section%Array(imud))- Hz_Mud_Backhead_X%Array(imud))* &
  86. ! Area_PipeSectionFt(Hz_Mud_Backhead_section%Array(imud)) !(ft^3)
  87. ! Hz_EmptyVolume_inBackheadLocation%Array(imud)= Hz_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948 ! ft^3 to gal
  88. !
  89. !
  90. ! if ( Hz_MudDischarged_Volume%Array(imud) <= Hz_EmptyVolume_inBackheadLocation%Array(imud)) then
  91. ! Hz_Mud_Forehead_section%Array(imud)= Hz_Mud_Backhead_section%Array(imud)
  92. ! Hz_Mud_Forehead_X%Array(imud)= Hz_Mud_Backhead_X%Array(imud)+ DirectionCoef*(Hz_MudDischarged_Volume%Array(imud)/7.48051948)/Area_PipeSectionFt(Hz_Mud_Backhead_section%Array(imud))
  93. ! ! 7.48 is for gal to ft^3
  94. ! else
  95. !
  96. ! isection= Hz_Mud_Backhead_section%Array(imud)+1
  97. ! Hz_RemainedVolume_in_LastSection%Array(imud)= Hz_MudDischarged_Volume%Array(imud)- Hz_EmptyVolume_inBackheadLocation%Array(imud)
  98. !
  99. ! do
  100. ! if (isection > 1) then ! (horizontal pipe exit)
  101. ! Hz_MudDischarged_Volume%Array(imud)= Hz_MudDischarged_Volume%Array(imud)- Hz_RemainedVolume_in_LastSection%Array(imud)
  102. ! Hz_Mud_Forehead_X%Array(imud)= Xend_PipeSection(1)
  103. ! Hz_Mud_Forehead_section%Array(imud)= 1
  104. ! if (Hz_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the string
  105. ! call Hz_MudDischarged_Volume%Remove (imud)
  106. ! call Hz_Mud_Backhead_X%Remove (imud)
  107. ! call Hz_Mud_Backhead_section%Remove (imud)
  108. ! call Hz_Mud_Forehead_X%Remove (imud)
  109. ! call Hz_Mud_Forehead_section%Remove (imud)
  110. ! call Hz_Density%Remove (imud)
  111. ! call Hz_RemainedVolume_in_LastSection%Remove (imud)
  112. ! call Hz_EmptyVolume_inBackheadLocation%Remove (imud)
  113. ! call Hz_MudOrKick%Remove (imud)
  114. !
  115. ! endif
  116. ! exit
  117. ! endif
  118. !
  119. ! xx= Hz_RemainedVolume_in_LastSection%Array(imud)/ PipeSection_VolumeCapacity(isection) !(gal)
  120. !
  121. ! if (xx<= 1.0) then
  122. ! Hz_Mud_Forehead_section%Array(imud)= isection
  123. ! Hz_Mud_Forehead_X%Array(imud)= (xx * (Xend_PipeSection(isection)- Xstart_PipeSection(isection)))+ Xstart_PipeSection(isection)
  124. ! exit
  125. ! else
  126. ! Hz_RemainedVolume_in_LastSection%Array(imud)= Hz_RemainedVolume_in_LastSection%Array(imud)- PipeSection_VolumeCapacity(isection)
  127. ! isection= isection+ 1
  128. !
  129. !
  130. ! endif
  131. !
  132. ! enddo
  133. !
  134. ! endif
  135. !
  136. ! enddo
  137. !commented
  138. !========================Horizontal PIPE END=================
  139. !========================STRING ENTRANCE=================
  140. !write(*,*) 'a) data%State%MudSystem%St_Density%Length()=' , data%State%MudSystem%St_Density%Length()
  141. if (ABS(data%State%MudSystem%St_Density%First() - data%State%MudSystem%Hz_Density_Utube) >= data%State%MudSystem%DensityMixTol) then ! new mud is pumped
  142. call data%State%MudSystem%St_Density%AddToFirst (data%State%MudSystem%Hz_Density_Utube)
  143. call data%State%MudSystem%St_MudDischarged_Volume%AddToFirst (0.0d0)
  144. call data%State%MudSystem%St_Mud_Forehead_X%AddToFirst (data%State%MudSystem%Xstart_PipeSection(2))
  145. call data%State%MudSystem%St_Mud_Forehead_section%AddToFirst (2)
  146. call data%State%MudSystem%St_Mud_Backhead_X%AddToFirst (data%State%MudSystem%Xstart_PipeSection(2))
  147. call data%State%MudSystem%St_Mud_Backhead_section%AddToFirst (2)
  148. call data%State%MudSystem%St_RemainedVolume_in_LastSection%AddToFirst (0.0d0)
  149. call data%State%MudSystem%St_EmptyVolume_inBackheadLocation%AddToFirst (0.0d0)
  150. call data%State%MudSystem%St_MudOrKick%AddToFirst (data%State%MudSystem%Hz_MudOrKick_Utube) ! Hz_MudOrKick%Last() = 104
  151. !StringDensity_Old= Hz_Density_Utube
  152. endif
  153. !write(*,*) 'b) data%State%MudSystem%St_Density%Length()=' , data%State%MudSystem%St_Density%Length()
  154. !write(*,*) 'b) data%State%MudSystem%St_Density%Array(1)=' , data%State%MudSystem%St_Density%Array(1)
  155. !write(*,*) 'b) St_MudOrKick%Array(1)=' , St_MudOrKick%Array(1)
  156. !========================STRING=================
  157. !WRITE (*,*) 'Utube1 data%State%MudSystem%StringFlowRate', data%State%MudSystem%StringFlowRate
  158. data%State%MudSystem%St_MudDischarged_Volume%Array(1)= data%State%MudSystem%St_MudDischarged_Volume%Array(1)+ ((data%State%MudSystem%StringFlowRate/60.d0)*data%State%MudSystem%DeltaT_Mudline) !(gal)
  159. imud=0
  160. do while (imud < data%State%MudSystem%St_Mud_Forehead_X%Length())
  161. imud = imud + 1
  162. if (imud> 1) then
  163. data%State%MudSystem%St_Mud_Backhead_X%Array(imud)= data%State%MudSystem%St_Mud_Forehead_X%Array(imud-1)
  164. data%State%MudSystem%St_Mud_Backhead_section%Array(imud)= data%State%MudSystem%St_Mud_Forehead_section%Array(imud-1)
  165. endif
  166. data%State%MudSystem%DirectionCoef= (data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%St_Mud_Backhead_section%Array(imud))-data%State%MudSystem%Xstart_PipeSection(data%State%MudSystem%St_Mud_Backhead_section%Array(imud))) &
  167. / ABS(data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%St_Mud_Backhead_section%Array(imud))-data%State%MudSystem%Xstart_PipeSection(data%State%MudSystem%St_Mud_Backhead_section%Array(imud)))
  168. ! +1 for string , -1 for annulus
  169. data%State%MudSystem%St_EmptyVolume_inBackheadLocation%Array(imud)= data%State%MudSystem%DirectionCoef* (data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%St_Mud_Backhead_section%Array(imud))- data%State%MudSystem%St_Mud_Backhead_X%Array(imud))* &
  170. data%State%MudSystem%Area_PipeSectionFt(data%State%MudSystem%St_Mud_Backhead_section%Array(imud)) !(ft^3)
  171. data%State%MudSystem%St_EmptyVolume_inBackheadLocation%Array(imud)= data%State%MudSystem%St_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal
  172. if ( data%State%MudSystem%St_MudDischarged_Volume%Array(imud) <= data%State%MudSystem%St_EmptyVolume_inBackheadLocation%Array(imud)) then
  173. data%State%MudSystem%St_Mud_Forehead_section%Array(imud)= data%State%MudSystem%St_Mud_Backhead_section%Array(imud)
  174. data%State%MudSystem%St_Mud_Forehead_X%Array(imud)= data%State%MudSystem%St_Mud_Backhead_X%Array(imud)+ data%State%MudSystem%DirectionCoef*(data%State%MudSystem%St_MudDischarged_Volume%Array(imud)/7.48051948d0)/data%State%MudSystem%Area_PipeSectionFt(data%State%MudSystem%St_Mud_Backhead_section%Array(imud))
  175. ! 7.48 is for gal to ft^3
  176. else
  177. data%State%MudSystem%isection= data%State%MudSystem%St_Mud_Backhead_section%Array(imud)+1
  178. data%State%MudSystem%St_RemainedVolume_in_LastSection%Array(imud)= data%State%MudSystem%St_MudDischarged_Volume%Array(imud)- data%State%MudSystem%St_EmptyVolume_inBackheadLocation%Array(imud)
  179. do
  180. if (data%State%MudSystem%isection > data%State%F_Counts%StringIntervalCounts) then ! last pipe section(string exit) data%State%F_Counts%StringIntervalCounts includes Horizontal line
  181. data%State%MudSystem%St_MudDischarged_Volume%Array(imud)= data%State%MudSystem%St_MudDischarged_Volume%Array(imud)- data%State%MudSystem%St_RemainedVolume_in_LastSection%Array(imud)
  182. data%State%MudSystem%St_Mud_Forehead_X%Array(imud)= data%State%MudSystem%Xend_PipeSection(data%State%F_Counts%StringIntervalCounts)
  183. data%State%MudSystem%St_Mud_Forehead_section%Array(imud)= data%State%F_Counts%StringIntervalCounts
  184. if (data%State%MudSystem%St_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the string
  185. call RemoveStringMudArrays(imud)
  186. endif
  187. exit
  188. endif
  189. data%State%MudSystem%xx= data%State%MudSystem%St_RemainedVolume_in_LastSection%Array(imud)/ data%State%MudSystem%PipeSection_VolumeCapacity(data%State%MudSystem%isection) !(gal)
  190. if (data%State%MudSystem%xx<= 1.0) then
  191. data%State%MudSystem%St_Mud_Forehead_section%Array(imud)= data%State%MudSystem%isection
  192. data%State%MudSystem%St_Mud_Forehead_X%Array(imud)= (data%State%MudSystem%xx * (data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%isection)- data%State%MudSystem%Xstart_PipeSection(data%State%MudSystem%isection)))+ data%State%MudSystem%Xstart_PipeSection(data%State%MudSystem%isection)
  193. exit
  194. else
  195. data%State%MudSystem%St_RemainedVolume_in_LastSection%Array(imud)= data%State%MudSystem%St_RemainedVolume_in_LastSection%Array(imud)- data%State%MudSystem%PipeSection_VolumeCapacity(data%State%MudSystem%isection)
  196. data%State%MudSystem%isection= data%State%MudSystem%isection+ 1
  197. endif
  198. enddo
  199. endif
  200. enddo
  201. !========================STRING END=================
  202. !========================== tripping in for OP remove ===============================
  203. !if (DeltaVolumeOp>0. .and. DeltaVolumeOp< Op_MudDischarged_Volume%Last()) then
  204. ! Op_MudDischarged_Volume%Array(Op_MudDischarged_Volume%Length())= Op_MudDischarged_Volume%Array(Op_MudDischarged_Volume%Length()) - DeltaVolumeOp
  205. !else
  206. ! Op_MudDischarged_Volume%Array(Op_MudDischarged_Volume%Length()-1)= Op_MudDischarged_Volume%Array(Op_MudDischarged_Volume%Length()-1) - (DeltaVolumeOp-Op_MudDischarged_Volume%Last())
  207. !
  208. ! call Op_MudDischarged_Volume%Remove (Op_MudDischarged_Volume%Length())
  209. ! call Op_Mud_Backhead_X%Remove (Op_MudDischarged_Volume%Length())
  210. ! call Op_Mud_Backhead_section%Remove (Op_MudDischarged_Volume%Length())
  211. ! call Op_Mud_Forehead_X%Remove (Op_MudDischarged_Volume%Length())
  212. ! call Op_Mud_Forehead_section%Remove (Op_MudDischarged_Volume%Length())
  213. ! call Op_Density%Remove (Op_MudDischarged_Volume%Length())
  214. ! call Op_RemainedVolume_in_LastSection%Remove (Op_MudDischarged_Volume%Length())
  215. ! call Op_EmptyVolume_inBackheadLocation%Remove (Op_MudDischarged_Volume%Length())
  216. ! call Op_MudOrKick%Remove (Op_MudDischarged_Volume%Length())
  217. !endif
  218. !
  219. !============================= Bottom Hole ==============================
  220. !Op_MudDischarged_Volume%Array(1)= Op_MudDischarged_Volume%Array(1)+ ((KickVARIABLES%GasKickPumpFlowRate/60.)*DeltaT_Mudline) !(gal) due to KickFlux
  221. imud=0
  222. do while (imud < data%State%MudSystem%Op_Mud_Forehead_X%Length())
  223. imud = imud + 1
  224. if (imud> 1) then
  225. data%State%MudSystem%Op_Mud_Backhead_X%Array(imud)= data%State%MudSystem%Op_Mud_Forehead_X%Array(imud-1)
  226. data%State%MudSystem%Op_Mud_Backhead_section%Array(imud)= data%State%MudSystem%Op_Mud_Forehead_section%Array(imud-1)
  227. endif
  228. data%State%MudSystem%DirectionCoef= (data%State%MudSystem%Xend_OpSection(data%State%MudSystem%Op_Mud_Backhead_section%Array(imud))-data%State%MudSystem%Xstart_OpSection(data%State%MudSystem%Op_Mud_Backhead_section%Array(imud))) &
  229. / ABS(data%State%MudSystem%Xend_OpSection(data%State%MudSystem%Op_Mud_Backhead_section%Array(imud))-data%State%MudSystem%Xstart_OpSection(data%State%MudSystem%Op_Mud_Backhead_section%Array(imud)))
  230. ! +1 for string , -1 for annulus
  231. data%State%MudSystem%Op_EmptyVolume_inBackheadLocation%Array(imud)= data%State%MudSystem%DirectionCoef* (data%State%MudSystem%Xend_OpSection(data%State%MudSystem%Op_Mud_Backhead_section%Array(imud))- data%State%MudSystem%Op_Mud_Backhead_X%Array(imud))* &
  232. data%State%MudSystem%Area_OpSectionFt(data%State%MudSystem%Op_Mud_Backhead_section%Array(imud)) !(ft^3)
  233. data%State%MudSystem%Op_EmptyVolume_inBackheadLocation%Array(imud)= data%State%MudSystem%Op_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal
  234. if ( data%State%MudSystem%Op_MudDischarged_Volume%Array(imud) <= data%State%MudSystem%Op_EmptyVolume_inBackheadLocation%Array(imud)) then
  235. data%State%MudSystem%Op_Mud_Forehead_section%Array(imud)= data%State%MudSystem%Op_Mud_Backhead_section%Array(imud)
  236. data%State%MudSystem%Op_Mud_Forehead_X%Array(imud)= data%State%MudSystem%Op_Mud_Backhead_X%Array(imud)+ data%State%MudSystem%DirectionCoef*(data%State%MudSystem%Op_MudDischarged_Volume%Array(imud)/7.48051948d0)/data%State%MudSystem%Area_OpSectionFt(data%State%MudSystem%Op_Mud_Backhead_section%Array(imud))
  237. ! 7.48 is for gal to ft^3
  238. else
  239. data%State%MudSystem%isection= data%State%MudSystem%Op_Mud_Backhead_section%Array(imud)+1
  240. data%State%MudSystem%Op_RemainedVolume_in_LastSection%Array(imud)= data%State%MudSystem%Op_MudDischarged_Volume%Array(imud)- data%State%MudSystem%Op_EmptyVolume_inBackheadLocation%Array(imud)
  241. do
  242. if (data%State%MudSystem%isection > data%State%F_Counts%BottomHoleIntervalCounts) then ! last pipe section(well exit)
  243. if( imud==1) data%State%MudSystem%KickDeltaVinAnnulus= data%State%MudSystem%Op_RemainedVolume_in_LastSection%Array(imud) ! Kick enters Annulus space
  244. data%State%MudSystem%Op_MudDischarged_Volume%Array(imud)= data%State%MudSystem%Op_MudDischarged_Volume%Array(imud)- data%State%MudSystem%Op_RemainedVolume_in_LastSection%Array(imud)
  245. data%State%MudSystem%Op_Mud_Forehead_X%Array(imud)= data%State%MudSystem%Xend_OpSection(data%State%F_Counts%BottomHoleIntervalCounts)
  246. data%State%MudSystem%Op_Mud_Forehead_section%Array(imud)= data%State%F_Counts%BottomHoleIntervalCounts
  247. if (data%State%MudSystem%Op_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the well
  248. call RemoveOpMudArrays(imud)
  249. endif
  250. exit
  251. endif
  252. data%State%MudSystem%xx= data%State%MudSystem%Op_RemainedVolume_in_LastSection%Array(imud)/ data%State%MudSystem%OpSection_VolumeCapacity(data%State%MudSystem%isection) !(gal)
  253. if (data%State%MudSystem%xx<= 1.0) then
  254. data%State%MudSystem%Op_Mud_Forehead_section%Array(imud)= data%State%MudSystem%isection
  255. data%State%MudSystem%Op_Mud_Forehead_X%Array(imud)= (data%State%MudSystem%xx * (data%State%MudSystem%Xend_OpSection(data%State%MudSystem%isection)- data%State%MudSystem%Xstart_OpSection(data%State%MudSystem%isection)))+ data%State%MudSystem%Xstart_OpSection(data%State%MudSystem%isection)
  256. exit
  257. else
  258. data%State%MudSystem%Op_RemainedVolume_in_LastSection%Array(imud)= data%State%MudSystem%Op_RemainedVolume_in_LastSection%Array(imud)- data%State%MudSystem%OpSection_VolumeCapacity(data%State%MudSystem%isection)
  259. data%State%MudSystem%isection= data%State%MudSystem%isection+ 1
  260. endif
  261. enddo
  262. endif
  263. if (data%State%MudSystem%Op_Mud_Forehead_X%Array(imud)== data%State%MudSystem%Xend_OpSection(data%State%F_Counts%BottomHoleIntervalCounts)) then
  264. data%State%MudSystem%totalLength = data%State%MudSystem%Op_MudDischarged_Volume%Length()
  265. do while(imud < data%State%MudSystem%totalLength)
  266. !imud = imud + 1
  267. call RemoveOpMudArrays(data%State%MudSystem%totalLength)
  268. data%State%MudSystem%totalLength = data%State%MudSystem%totalLength - 1
  269. enddo
  270. exit !
  271. endif
  272. !WRITE(*,*) imud,'Op_MudDischarged_Volume%Array(imud)' , Op_MudDischarged_Volume%Array(imud), Op_Density%Array(imud)
  273. enddo
  274. !write(*,*) 'Op_Mud_Forehead_X%Length()' , Op_Mud_Forehead_X%Length()
  275. !
  276. ! WRITE(*,*) 'Xend_PipeSection(F_StringIntervalCounts)' , Xend_PipeSection(F_StringIntervalCounts)
  277. ! WRITE(*,*) 'Op_Mud_Backhead_X%Array(1)' , Op_Mud_Backhead_X%Array(1)
  278. ! WRITE(*,*) 'Op_Mud_Forehead_X%Array(1)' , Op_Mud_Forehead_X%Array(1)
  279. ! WRITE(*,*) 'Op_Mud_Backhead_X%Array(2)' , Op_Mud_Backhead_X%Array(2)
  280. ! WRITE(*,*) 'Op_Mud_Forehead_X%Array(2)' , Op_Mud_Forehead_X%Array(2)
  281. !========================Bottom Hole END=================
  282. if (data%State%MudSystem%iLoc == 1) then
  283. data%State%MudSystem%MudSection= data%State%F_Counts%StringIntervalCounts+1
  284. data%State%MudSystem%BackheadX= data%State%MudSystem%Xstart_PipeSection(data%State%F_Counts%StringIntervalCounts+1)
  285. elseif (data%State%MudSystem%iLoc == 2) then
  286. data%State%MudSystem%MudSection= data%State%MudSystem%Kick_Forehead_section
  287. data%State%MudSystem%BackheadX= data%State%MudSystem%Kick_Forehead_X
  288. endif
  289. !========================ANNULUS ENTRANCE====================
  290. !write(*,*) 'iloc=====' , iLoc
  291. if ((ABS(data%State%MudSystem%AnnulusSuctionDensity_Old - data%State%MudSystem%St_Density%Last()) >= data%State%MudSystem%DensityMixTol) .OR. (data%State%MudSystem%DeltaVolumeOp == 0.0 .and. ABS(data%State%MudSystem%Ann_Density%Array(data%State%MudSystem%iLoc)-data%State%MudSystem%St_Density%Last())>=data%State%MudSystem%DensityMixTol .and. data%State%MudSystem%AnnulusFlowRate/=0.0d0) ) then ! new mud is pumped
  292. call data%State%MudSystem%Ann_Density%AddTo (data%State%MudSystem%iLoc,data%State%MudSystem%St_Density%Last())
  293. call data%State%MudSystem%Ann_MudDischarged_Volume%AddTo (data%State%MudSystem%iLoc,0.0d0)
  294. call data%State%MudSystem%Ann_Mud_Forehead_X%AddTo (data%State%MudSystem%iLoc,data%State%MudSystem%BackheadX)
  295. call data%State%MudSystem%Ann_Mud_Forehead_section%AddTo (data%State%MudSystem%iLoc,data%State%MudSystem%MudSection)
  296. call data%State%MudSystem%Ann_Mud_Backhead_X%AddTo (data%State%MudSystem%iLoc,data%State%MudSystem%BackheadX)
  297. call data%State%MudSystem%Ann_Mud_Backhead_section%AddTo (data%State%MudSystem%iLoc,data%State%MudSystem%MudSection)
  298. call data%State%MudSystem%Ann_RemainedVolume_in_LastSection%AddTo (data%State%MudSystem%iLoc,0.0d0)
  299. call data%State%MudSystem%Ann_EmptyVolume_inBackheadLocation%AddTo (data%State%MudSystem%iLoc,0.0d0)
  300. call data%State%MudSystem%Ann_MudOrKick%AddTo (data%State%MudSystem%iLoc,0)
  301. call data%State%MudSystem%Ann_CuttingMud%AddTo (data%State%MudSystem%iLoc,0)
  302. data%State%MudSystem%AnnulusSuctionDensity_Old= data%State%MudSystem%St_Density%Last()
  303. data%State%MudSystem%MudIsChanged= .true.
  304. endif
  305. data%State%MudSystem%Ann_MudDischarged_Volume%Array(data%State%MudSystem%iLoc)= data%State%MudSystem%Ann_MudDischarged_Volume%Array(data%State%MudSystem%iLoc)+ ((data%State%MudSystem%AnnulusFlowRate/60.0d0)*data%State%MudSystem%DeltaT_Mudline) !(gal)
  306. !========================Tripping In====================
  307. !write(*,*) 'DeltaVolumeOp=' , DeltaVolumeOp
  308. if (data%State%MudSystem%DeltaVolumeOp > 0.0 .and. data%State%MudSystem%MudIsChanged== .false.) then !.and. DrillingMode== .false.) then ! trip in mode(loole paeen)
  309. !write(*,*) 'Tripping In'
  310. data%State%MudSystem%NewDensity= (data%State%MudSystem%St_Density%Last()*((data%State%MudSystem%AnnulusFlowRate/60.)*data%State%MudSystem%DeltaT_Mudline)+data%State%MudSystem%Op_Density%Last()*data%State%MudSystem%DeltaVolumeOp)/(((data%State%MudSystem%AnnulusFlowRate/60.0d0)*data%State%MudSystem%DeltaT_Mudline)+data%State%MudSystem%DeltaVolumeOp)
  311. data%State%MudSystem%NewVolume= ((data%State%MudSystem%AnnulusFlowRate/60.)*data%State%MudSystem%DeltaT_Mudline)+data%State%MudSystem%DeltaVolumeOp
  312. !write(*,*) 'Ann_MudDischarged_Volume%Array(1)=', Ann_MudDischarged_Volume%Array(1), 'NewVolume=', NewVolume
  313. if (abs(data%State%MudSystem%Ann_Density%Array(data%State%MudSystem%iLoc)-data%State%MudSystem%NewDensity)< data%State%MudSystem%DensityMixTol) then ! 1-Pockets are Merged - (ROP is 0)
  314. data%State%MudSystem%Ann_Density%Array(data%State%MudSystem%iLoc)= (data%State%MudSystem%Ann_Density%Array(data%State%MudSystem%iLoc)*data%State%MudSystem%Ann_MudDischarged_Volume%Array(data%State%MudSystem%iLoc)+data%State%MudSystem%NewDensity*data%State%MudSystem%NewVolume)/(data%State%MudSystem%Ann_MudDischarged_Volume%Array(data%State%MudSystem%iLoc)+data%State%MudSystem%NewVolume)
  315. data%State%MudSystem%Ann_MudDischarged_Volume%Array(data%State%MudSystem%iLoc)= data%State%MudSystem%Ann_MudDischarged_Volume%Array(data%State%MudSystem%iLoc)+data%State%MudSystem%DeltaVolumeOp
  316. data%State%MudSystem%Ann_Mud_Forehead_X%Array(data%State%MudSystem%iLoc)= data%State%MudSystem%BackheadX
  317. data%State%MudSystem%Ann_Mud_Forehead_section%Array(data%State%MudSystem%iLoc)= data%State%MudSystem%MudSection
  318. data%State%MudSystem%Ann_Mud_Backhead_X%Array(data%State%MudSystem%iLoc)= data%State%MudSystem%BackheadX
  319. data%State%MudSystem%Ann_Mud_Backhead_section%Array(data%State%MudSystem%iLoc)= data%State%MudSystem%MudSection
  320. data%State%MudSystem%Ann_RemainedVolume_in_LastSection%Array(data%State%MudSystem%iLoc)= (0.0d0)
  321. data%State%MudSystem%Ann_EmptyVolume_inBackheadLocation%Array(data%State%MudSystem%iLoc)= (0.0d0)
  322. else ! 2-Merging conditions are not meeted, so new pocket
  323. call data%State%MudSystem%Ann_Density%AddTo (data%State%MudSystem%iLoc,data%State%MudSystem%NewDensity)
  324. call data%State%MudSystem%Ann_MudDischarged_Volume%AddTo (data%State%MudSystem%iLoc,data%State%MudSystem%NewVolume)
  325. call data%State%MudSystem%Ann_Mud_Forehead_X%AddTo (data%State%MudSystem%iLoc,data%State%MudSystem%BackheadX)
  326. call data%State%MudSystem%Ann_Mud_Forehead_section%AddTo (data%State%MudSystem%iLoc,data%State%MudSystem%MudSection)
  327. call data%State%MudSystem%Ann_Mud_Backhead_X%AddTo (data%State%MudSystem%iLoc,data%State%MudSystem%BackheadX)
  328. call data%State%MudSystem%Ann_Mud_Backhead_section%AddTo (data%State%MudSystem%iLoc,data%State%MudSystem%MudSection)
  329. call data%State%MudSystem%Ann_RemainedVolume_in_LastSection%AddTo (data%State%MudSystem%iLoc,0.0d0)
  330. call data%State%MudSystem%Ann_EmptyVolume_inBackheadLocation%AddTo (data%State%MudSystem%iLoc,0.0d0)
  331. call data%State%MudSystem%Ann_MudOrKick%AddTo (data%State%MudSystem%iLoc,0)
  332. call data%State%MudSystem%Ann_CuttingMud%AddTo (data%State%MudSystem%iLoc,0)
  333. endif
  334. elseif (data%State%MudSystem%DeltaVolumeOp > 0.0 .and. data%State%MudSystem%MudIsChanged== .true. .and. data%State%ROP_Bit%RateOfPenetration==0.) then
  335. data%State%MudSystem%Ann_Density%Array(data%State%MudSystem%iLoc)= data%State%MudSystem%NewDensity
  336. data%State%MudSystem%Ann_MudDischarged_Volume%Array(data%State%MudSystem%iLoc)= data%State%MudSystem%NewVolume
  337. data%State%MudSystem%Ann_Mud_Forehead_X%Array(data%State%MudSystem%iLoc)= data%State%MudSystem%BackheadX
  338. data%State%MudSystem%Ann_Mud_Forehead_section%Array(data%State%MudSystem%iLoc)= data%State%MudSystem%MudSection
  339. data%State%MudSystem%Ann_Mud_Backhead_X%Array(data%State%MudSystem%iLoc)= data%State%MudSystem%BackheadX
  340. data%State%MudSystem%Ann_Mud_Backhead_section%Array(data%State%MudSystem%iLoc)= data%State%MudSystem%MudSection
  341. data%State%MudSystem%Ann_RemainedVolume_in_LastSection%Array(data%State%MudSystem%iLoc)= (0.0d0)
  342. data%State%MudSystem%Ann_EmptyVolume_inBackheadLocation%Array(data%State%MudSystem%iLoc)= (0.0d0)
  343. endif
  344. !========================Tripping In - End====================
  345. !======================== ANNULUS ====================
  346. data%State%MudSystem%MudIsChanged= .false.
  347. imud= 0
  348. do while (imud < data%State%MudSystem%Ann_Mud_Forehead_X%Length())
  349. imud = imud + 1
  350. if (imud> 1) then
  351. data%State%MudSystem%Ann_Mud_Backhead_X%Array(imud)= data%State%MudSystem%Ann_Mud_Forehead_X%Array(imud-1)
  352. data%State%MudSystem%Ann_Mud_Backhead_section%Array(imud)= data%State%MudSystem%Ann_Mud_Forehead_section%Array(imud-1)
  353. endif
  354. ! <<< Fracture Shoe Lost
  355. IF ( data%State%MudSystem%ShoeLost .and. data%State%MudSystem%LostInTripOutIsDone== .false. .and. Shoe%ShoeDepth < data%State%MudSystem%Ann_Mud_Backhead_X%Array(imud) .and. Shoe%ShoeDepth >= data%State%MudSystem%Ann_Mud_Forehead_X%Array(imud) ) then
  356. !write(*,*) 'ShoeLost imud,AnnVolume(imud), VolumeLost:' , imud,Ann_MudDischarged_Volume%Array(imud), (( Qlost/60.0d0)*DeltaT_Mudline)
  357. data%State%MudSystem%Ann_MudDischarged_Volume%Array(imud)= data%State%MudSystem%Ann_MudDischarged_Volume%Array(imud)-((data%State%MudSystem%Qlost/60.0d0)*data%State%MudSystem%DeltaT_Mudline) !(gal)
  358. if (data%State%MudSystem%Ann_MudDischarged_Volume%Array(imud) < 0.0) then
  359. !write(*,*) 'mud is removed by shoe lost, imud=' , imud
  360. call RemoveAnnulusMudArrays(imud)
  361. imud= imud-1
  362. cycle
  363. endif
  364. ENDIF
  365. ! Fracture Shoe Lost >>>
  366. data%State%MudSystem%DirectionCoef= (data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%Ann_Mud_Backhead_section%Array(imud))-data%State%MudSystem%Xstart_PipeSection(data%State%MudSystem%Ann_Mud_Backhead_section%Array(imud))) &
  367. / ABS(data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%Ann_Mud_Backhead_section%Array(imud))-data%State%MudSystem%Xstart_PipeSection(data%State%MudSystem%Ann_Mud_Backhead_section%Array(imud)))
  368. ! +1 for string , -1 for annulus
  369. data%State%MudSystem%Ann_EmptyVolume_inBackheadLocation%Array(imud)= data%State%MudSystem%DirectionCoef* (data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%Ann_Mud_Backhead_section%Array(imud))- data%State%MudSystem%Ann_Mud_Backhead_X%Array(imud))* &
  370. data%State%MudSystem%Area_PipeSectionFt(data%State%MudSystem%Ann_Mud_Backhead_section%Array(imud)) !(ft^3)
  371. data%State%MudSystem%Ann_EmptyVolume_inBackheadLocation%Array(imud)= data%State%MudSystem%Ann_EmptyVolume_inBackheadLocation%Array(imud)* 7.48051948d0 ! ft^3 to gal
  372. if ( data%State%MudSystem%Ann_MudDischarged_Volume%Array(imud) <= data%State%MudSystem%Ann_EmptyVolume_inBackheadLocation%Array(imud)) then
  373. data%State%MudSystem%Ann_Mud_Forehead_section%Array(imud)= data%State%MudSystem%Ann_Mud_Backhead_section%Array(imud)
  374. data%State%MudSystem%Ann_Mud_Forehead_X%Array(imud)= data%State%MudSystem%Ann_Mud_Backhead_X%Array(imud)+ data%State%MudSystem%DirectionCoef*(data%State%MudSystem%Ann_MudDischarged_Volume%Array(imud)/7.48051948d0)/data%State%MudSystem%Area_PipeSectionFt(data%State%MudSystem%Ann_Mud_Backhead_section%Array(imud))
  375. ! 7.48 is for gal to ft^3
  376. else
  377. data%State%MudSystem%isection= data%State%MudSystem%Ann_Mud_Backhead_section%Array(imud)+1
  378. data%State%MudSystem%Ann_RemainedVolume_in_LastSection%Array(imud)= data%State%MudSystem%Ann_MudDischarged_Volume%Array(imud)- data%State%MudSystem%Ann_EmptyVolume_inBackheadLocation%Array(imud)
  379. do
  380. if (data%State%MudSystem%isection > data%State%MudSystem%NoPipeSections) then ! last pipe section(well exit)
  381. data%State%MudSystem%Ann_MudDischarged_Volume%Array(imud)= data%State%MudSystem%Ann_MudDischarged_Volume%Array(imud)- data%State%MudSystem%Ann_RemainedVolume_in_LastSection%Array(imud)
  382. data%State%MudSystem%Ann_Mud_Forehead_X%Array(imud)= data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%NoPipeSections)
  383. data%State%MudSystem%Ann_Mud_Forehead_section%Array(imud)= data%State%MudSystem%NoPipeSections
  384. if (data%State%MudSystem%Ann_MudDischarged_Volume%Array(imud)<= 0.0d0) then ! imud is completely exited form the well
  385. call RemoveAnnulusMudArrays(imud)
  386. endif
  387. exit
  388. endif
  389. data%State%MudSystem%xx= data%State%MudSystem%Ann_RemainedVolume_in_LastSection%Array(imud)/ data%State%MudSystem%PipeSection_VolumeCapacity(data%State%MudSystem%isection) !(gal)
  390. if (data%State%MudSystem%xx<= 1.0) then
  391. data%State%MudSystem%Ann_Mud_Forehead_section%Array(imud)= data%State%MudSystem%isection
  392. data%State%MudSystem%Ann_Mud_Forehead_X%Array(imud)= (data%State%MudSystem%xx * (data%State%MudSystem%Xend_PipeSection(data%State%MudSystem%isection)- data%State%MudSystem%Xstart_PipeSection(data%State%MudSystem%isection)))+ data%State%MudSystem%Xstart_PipeSection(data%State%MudSystem%isection)
  393. exit
  394. else
  395. data%State%MudSystem%Ann_RemainedVolume_in_LastSection%Array(imud)= data%State%MudSystem%Ann_RemainedVolume_in_LastSection%Array(imud)- data%State%MudSystem%PipeSection_VolumeCapacity(data%State%MudSystem%isection)
  396. data%State%MudSystem%isection= data%State%MudSystem%isection+ 1
  397. endif
  398. enddo
  399. endif
  400. enddo
  401. !========================ANNULUS END=================
  402. !if ( WellisNOTFull == .false. ) then
  403. ! write(*,*) 'data%State%MudSystem%AnnulusFlowRate==' , data%State%MudSystem%AnnulusFlowRate
  404. ! call Set_FlowRate(real(100.*min(data%State%MudSystem%AnnulusFlowRate,PedalMeter)/(PedalMeter/10.), 8))
  405. !
  406. !
  407. !endif
  408. end subroutine Utube1_and_TripIn