module CHookVariables use CRealEventHandlerCollection use CHookActions implicit none Type :: HookType real :: HookHeight_S = 0.0 real :: HookHeight type(RealEventHandlerCollection) :: OnHookHeightChange end type HookType Type(HookType)::Hook contains subroutine Set_HookHeight(v) use CDrillingConsoleVariables implicit none real , intent(in) :: v #ifdef ExcludeExtraChanges if(Hook%HookHeight == v) return #endif Hook%HookHeight = v if(associated(HookHeightPtr)) then call HookHeightPtr(Hook%HookHeight) end if #ifdef deb print*, 'HookHeight=', Hook%HookHeight #endif call Hook%OnHookHeightChange%RunAll(Hook%HookHeight) end subroutine subroutine Set_HookHeight_S(v) implicit none real , intent(in) :: v if(v == Hook%HookHeight) then return elseif (v > Hook%HookHeight) then loop1: do call Set_HookHeight(Hook%HookHeight + 0.2) if(abs(v - Hook%HookHeight) <= 0.1) then call Set_HookHeight(v) exit loop1 endif call sleepqq(100) enddo loop1 else ! v < HookHeight loop2: do call Set_HookHeight(Hook%HookHeight - 0.2) if(abs(Hook%HookHeight - v) <= 0.1) then call Set_HookHeight(v) exit loop2 endif call sleepqq(100) enddo loop2 endif end subroutine subroutine Set_HookHeight_WN(v) !DEC$ ATTRIBUTES DLLEXPORT :: Set_HookHeight_WN !DEC$ ATTRIBUTES ALIAS: 'Set_HookHeight_WN' :: Set_HookHeight_WN implicit none real , intent(in) :: v !call Set_HookHeight(v) Hook%HookHeight_S = v end subroutine subroutine Update_HookHeight_From_Snapshot() implicit none call Set_HookHeight_S(Hook%HookHeight_S) end subroutine end module CHookVariables