subroutine TD_DrillStemConfiguration

   Use CStringConfigurationVariables
   Use CNearFloorConnection
   Use CDataDisplayConsoleVariables
   Use CDrillWatchVariables
   Use COperationConditionEnumVariables
   Use CKellyConnectionEnumVariables
   Use TD_DrillStemComponents
   Use TD_WellElements
   Use TD_WellGeometry
   Use TD_StringConnectionData
   Use sROP_Variables
   
   
   implicit none 

   Integer :: i , j , k , kk , TD_Status
  

   
   
   
   
!====================================================
!      Drill Stem Components Data Modification
!====================================================
   
   
!=====> Drill Stem Total Length&Weight Calculation
   TD_DrillStemTotalLength    = 0.0d0
   TD_DrillStemTotalLengthIni = 0.0d0
   TD_DrillStemTotalWeight    = 0.0d0
   Do i= 1,TD_DrillStemComponentsNumbs
       TD_DrillStemTotalLength    = TD_DrillStemTotalLength+TD_DrillStems(i)%Length
       TD_DrillStemTotalLengthIni = TD_DrillStemTotalLengthIni+TD_DrillStems(i)%LengthIni
       TD_DrillStemTotalWeight    = TD_DrillStemTotalWeight+TD_DrillStems(i)%Weight
   End Do
   
   
   
   
   
   
   
!=====> Top&Down Depth Calculation Of Initial Drill Stem Components (Graphic)
   TD_DrillStems(1)%DownDepth = TD_DrillStemTotalLength-TD_ConnectionHeight
   TD_DrillStemBottom         = TD_DrillStems(1)%DownDepth
   if ( TD_DrillStems(1)%DownDepth>=TD_WellTotalLength ) then
       !if (  TD_HookHeight>=TD_HookHeightOld .and. Rate_of_Penetration==0. ) then
       !    TD_GRigidConnectionHeight = TD_GRigidConnectionHeight
       !else
           TD_GRigidConnectionHeight      = TD_GRigidConnectionHeight-(TD_WellTotalLength-TD_DrillStems(1)%DownDepthIniG)
           TD_DrillStems(1)%DownDepthIniG = TD_WellTotalLength           !???????????
       !    !TD_GRigidConnectionHeight     = TD_GRigidConnectionHeight
       !end if
   else
       TD_GRigidConnectionHeight      = TD_ConnectionHeight
       TD_DrillStems(1)%DownDepthIniG = TD_DrillStemTotalLengthIni-TD_GRigidConnectionHeight
   end if
   
   !TD_DrillStems(1)%DownDepthIniG     = TD_DrillStemTotalLengthIni-TD_GRigidConnectionHeight
   !if ( TD_DrillStems(1)%DownDepthIniG>TD_WellTotalLength ) then
   !    TD_GRigidConnectionHeight      = TD_GRigidConnectionHeight+(TD_DrillStems(1)%DownDepthIniG-TD_WellTotalLength)
   !    TD_DrillStems(1)%DownDepthIniG = TD_WellTotalLength       !???????????
   !end if
   TD_DrillStems(1)%TopDepthIniG      = TD_DrillStems(1)%DownDepthIniG-TD_DrillStems(1)%LengthIni
   Do i = 2,TD_DrillStemComponentsNumbs
       TD_DrillStems(i)%TopDepthIniG  = TD_DrillStems(i-1)%TopDepthIniG-TD_DrillStems(i)%LengthIni
       TD_DrillStems(i)%DownDepthIniG = TD_DrillStems(i-1)%DownDepthIniG-TD_DrillStems(i-1)%LengthIni
   End Do
   
   
   
   
   
   
   
   
!=====> Top&Down Depth Calculation Of Initial Drill Stem Components (for fluid module)
   if ( TD_DrillStems(1)%DownDepthIniG>=(TD_WellTotalLength-.1d0) ) then
       TD_RigidConnectionHeight = TD_GRigidConnectionHeight+(.1d0-(TD_WellTotalLength-TD_DrillStems(1)%DownDepthIniG))
   else
       TD_RigidConnectionHeight = TD_GRigidConnectionHeight
   end if
   
   TD_DrillStems(1)%DownDepthIni = TD_DrillStemTotalLengthIni-TD_RigidConnectionHeight
   TD_DrillStems(1)%TopDepthIni  = TD_DrillStems(1)%DownDepthIni-TD_DrillStems(1)%LengthIni
   
   Do i = 2,TD_DrillStemComponentsNumbs
       TD_DrillStems(i)%TopDepthIni  = TD_DrillStems(i-1)%TopDepthIni-TD_DrillStems(i)%LengthIni
       TD_DrillStems(i)%DownDepthIni = TD_DrillStems(i-1)%DownDepthIni-TD_DrillStems(i-1)%LengthIni
   End Do
   
   
   
   
   
   
   
   
   
!=====> Top&Down Depth Calculation Of Drill Stem Components
   TD_DrillStems(1)%TopDepth  = TD_DrillStemTotalLength-TD_DrillStems(1)%Length-TD_GRigidConnectionHeight
   TD_DrillStems(1)%DownDepth = TD_DrillStemTotalLength-TD_GRigidConnectionHeight
   
   Do i = 2,TD_DrillStemComponentsNumbs
       TD_DrillStems(i)%TopDepth  = TD_DrillStems(i-1)%TopDepth-TD_DrillStems(i)%Length
       TD_DrillStems(i)%DownDepth = TD_DrillStems(i-1)%DownDepth-TD_DrillStems(i-1)%Length
   End Do
   
   !TD_DrillStemBottom = TD_DrillStems(1)%DownDepth
   
   
   
   
   
   
   
   
   
!=====> Hole Type & Inclination Determination Of Drill Stem Components
   Do i = 1,TD_DrillStemComponentsNumbs
       
       
      if (TD_DrillStems(i)%TopDepth .ge. 0.d0) then
          
          
          Do j = 1,TD_WellIntervalsCount
              if (TD_DrillStems(i)%TopDepth>TD_WellGeo(j)%TopDepth .and. TD_DrillStems(i)%TopDepth<TD_WellGeo(j)%DownDepth) then
                  TD_DrillStems(i)%HoleType = TD_WellGeo(j)%HoleType
                  
                  
                  
                  if (TD_DrillStems(i)%HoleType == 1) then
                      TD_DrillStems(i)%StartAngle = TD_WellGeo(j)%StartAngle+(((TD_DrillStems(i)%TopDepth-TD_WellGeo(j)%TopDepth)/TD_WellGeo(j)%RCurvature))  ![rad]
                      TD_DrillStems(i)%EndAngle   = TD_WellGeo(j)%StartAngle+(((TD_DrillStems(i)%DownDepth-TD_WellGeo(j)%TopDepth)/TD_WellGeo(j)%RCurvature))
                      TD_DrillStems(i)%RCurvature = TD_WellGeo(j)%RCurvature
                  else if (TD_DrillStems(i)%HoleType == 2) then
                      TD_DrillStems(i)%StartAngle = TD_WellGeo(j)%StartAngle-(((TD_DrillStems(i)%TopDepth-TD_WellGeo(j)%TopDepth)/TD_WellGeo(j)%RCurvature))
                      TD_DrillStems(i)%EndAngle   = TD_WellGeo(j)%StartAngle-(((TD_DrillStems(i)%DownDepth-TD_WellGeo(j)%TopDepth)/TD_WellGeo(j)%RCurvature))
                      TD_DrillStems(i)%RCurvature = TD_WellGeo(j)%RCurvature
                  else
                      TD_DrillStems(i)%StartAngle = TD_WellGeo(j)%EndAngle   !Straight
                      TD_DrillStems(i)%EndAngle   = TD_DrillStems(i)%StartAngle
                  end if
              
                  
              end if
          End Do
          
          
      else 
          TD_DrillStems(i)%HoleType   = 0      !Straight
          TD_DrillStems(i)%StartAngle = 0.0d0   
          TD_DrillStems(i)%EndAngle   = 0.0d0
      end if
      
      
   End Do

   
   
   
   
   
   
   
   
   
!=====> Hole(Well) Diameter Determination Of Drill Stem Components
   Do i = 1,TD_DrillStemComponentsNumbs
       If (TD_DrillStems(i)%TopDepth>TD_Casing(1)%TopDepth .and. TD_DrillStems(i)%TopDepth<TD_Casing(1)%DownDepth) then
           TD_DrillStems(i)%HoleDiameter = TD_Casing(1)%Id
       Else if (TD_Liner(1)%Length/=0.d0 .and. TD_DrillStems(i)%TopDepth>TD_Liner(1)%TopDepth .and. TD_DrillStems(i)%TopDepth<TD_Liner(1)%DownDepth) then
           TD_DrillStems(i)%HoleDiameter = TD_Liner(1)%Id
       Else if (TD_OpenHole(1)%Length/=0.d0 .and. TD_DrillStems(i)%TopDepth>TD_OpenHole(1)%TopDepth .and. TD_DrillStems(i)%TopDepth<TD_OpenHole(1)%DownDepth) then
           TD_DrillStems(i)%HoleDiameter = TD_OpenHole(1)%Id
       Else if (TD_ROPHole(1)%Length/=0.d0 .and. TD_DrillStems(i)%TopDepth>TD_ROPHole(1)%TopDepth .and. TD_DrillStems(i)%TopDepth<TD_ROPHole(1)%DownDepth) then
           TD_DrillStems(i)%HoleDiameter = TD_ROPHole(1)%Id      !????????? check
       End If
       
       !=====> Viscosity Correction Coefficient Calculation
       if (TD_DrillStems(i)%HoleType == 1 .or. TD_DrillStems(i)%HoleType == 2) then
           TD_DrillStems(i)%MudVisCorrectCoef = (2.0d0/pi)*atan(sqrt(TD_DrillStems(i)%HoleDiameter**2-(TD_DrillStems(i)%Od**2)) &
                                                / (TD_DrillStems(i)%Od))*(4.0d0/pi-1.0d0) + 1.0d0
       else if (TD_DrillStems(i)%HoleType == 0) then
           TD_DrillStems(i)%MudVisCorrectCoef = 1.d0
       end if
   End Do
    
   
   
   
   
   
   
   
   
!=====> Out_of_Well Length Of DrillStem
   if (TD_DrillStems(TD_DrillStemComponentsNumbs)%TopDepth<0.) then
       TD_OutOfWellLength = abs(TD_DrillStems(TD_DrillStemComponentsNumbs)%TopDepth)
   else
       TD_OutOfWellLength = 0.d0
   end if
   
   
   
   
   
   
   
!=====> Near Floor Connection
   Do i = TD_DrillStemComponentsNumbs, 1, -1
       if ( TD_DrillStems(i)%TopDepth<=0.d0 ) then
           TD_NearFloorConnectionNo = i
           TD_NearFloorConnectionHeight = abs(TD_DrillStems(i)%TopDepth)
       end if
       if (TD_DrillStems(i)%TopDepth>0.d0) then
           exit
       end if
   End Do
   Call Set_NearFloorConnection(real(TD_NearFloorConnectionHeight))
   
   
   
   
   
   
   
   
!=====> Graphic Output
   kk = 0
   k  = 0
   Do i= 1,TD_StringConfigurationCount
       k = k+1
       if ( TD_DrillStems(k)%DownDepthIniG>0.d0 ) then
           kk = kk+1
           if (TD_DrillStems(k+TD_DrillStem(i)%Numbs-1)%TopDepthIniG<=0.d0) then
               exit
           end if
           k  = k+TD_DrillStem(i)%Numbs-1
       end if
   End Do
   
   if (allocated(G_StringElement)) deallocate(G_StringElement)
   allocate(G_StringElement(kk))
   k = 0
   Do i= 1,kk
       G_StringElement(kk-i+1)%Id            = TD_DrillStem(i)%Id
       G_StringElement(kk-i+1)%Od            = TD_DrillStem(i)%Od
       if ( TD_DrillStem(i)%ComponentType>4 ) then
           G_StringElement(kk-i+1)%ComponentType = 3
       else
           G_StringElement(kk-i+1)%ComponentType = TD_DrillStem(i)%ComponentType
       end if
       G_StringElement(kk-i+1)%TopDepth      = TD_DrillStems(k+TD_DrillStem(i)%Numbs)%TopDepthIniG
       G_StringElement(kk-i+1)%DownDepth     = TD_DrillStems(k+1)%DownDepthIniG
       k = k+TD_DrillStem(i)%Numbs
   End Do
   if (G_StringElement(1)%TopDepth<=0.d0) then
       G_StringElement(1)%TopDepth = 0.d0
   end if
   
   Call SetString(kk, G_StringElement)
   
   
   if(TD_DrillStems(1)%DownDepth<0.d0) then
       BitPosition = TD_DrillStems(1)%DownDepth
   else
       BitPosition = G_StringElement(kk)%DownDepth   !???????????
       !if ( G_StringElement(kk)%DownDepth>TD_WellTotalLength ) then
       !    BitPosition = TD_WellTotalLength        !???????????
       !end if
   end if
   
   !print*, 'kk=' , kk
   !Do i=1,kk
   !    print*, 'Number/' , 'downDepth/' , 'topDepth/' 
   !    print*, 'ID/' , 'OD/' , 'Type/'
   !    print*, i , G_StringElement(i)%DownDepth , G_StringElement(i)%TopDepth 
   !    print*, G_StringElement(i)%Id , G_StringElement(i)%Od , G_StringElement(i)%ComponentType
   !End Do
   
   
   
   
   
   
   !print*, 'Top Joint Height before=' , TD_TopJointHeight
!=====> Top Joint Height
   if ( Get_OperationCondition()==OPERATION_DRILL .and. Get_KellyConnection() == KELLY_CONNECTION_STRING ) then
       TD_TopJointHeight = abs(TD_DrillStems(TD_DrillStemComponentsNumbs-1)%TopDepth)
       !print*, 'TopDepth1=' , TD_DrillStems(TD_DrillStemComponentsNumbs-1)%TopDepth
       !print*, 'numb1=' , TD_DrillStemComponentsNumbs-1
       !print*, 'TD_TopJointHeight1=' , TD_TopJointHeight
   else
       TD_TopJointHeight = abs(TD_DrillStems(TD_DrillStemComponentsNumbs)%TopDepth)
       !print*, 'TopDepth2=' , TD_DrillStems(TD_DrillStemComponentsNumbs)%TopDepth
       !print*, 'numb2=' , TD_DrillStemComponentsNumbs
       !print*, 'TD_TopJointHeight2=' , TD_TopJointHeight
   end if
   
   !print*, 'TD_DrillStemComponentsNumbs_=' , TD_DrillStemComponentsNumbs
   !print*, 'TD_TopJointHeight_=' , TD_TopJointHeight
   !Print*, 'TD_ConnectionHeight_=' , TD_ConnectionHeight
   !Print*, 'TD_StringConnectionMode_=' , TD_StringConnectionMode
   !
   !print*, 'Top Joint Height after=' , TD_TopJointHeight
   

    
   
   
       
end subroutine