! ***********************************************************************
!
!   Copyright (C) 2010  Bill Paxton
!
!   this file is part of mesa.
!
!   mesa is free software; you can redistribute it and/or modify
!   it under the terms of the gnu general library public license as published
!   by the free software foundation; either version 2 of the license, or
!   (at your option) any later version.
!
!   mesa is distributed in the hope that it will be useful, 
!   but without any warranty; without even the implied warranty of
!   merchantability or fitness for a particular purpose.  see the
!   gnu library general public license for more details.
!
!   you should have received a copy of the gnu library general public license
!   along with this software; if not, write to the free software
!   foundation, inc., 59 temple place, suite 330, boston, ma 02111-1307 usa
!
! ***********************************************************************
 
      module run_star_extras

      use star_lib
      use star_def
      use const_def
      
      implicit none
      
      
      integer :: time0, time1, clock_rate
      double precision, parameter :: expected_runtime = 12 ! minutes


      contains
      
      subroutine extras_controls(s, ierr)
         type (star_info), pointer :: s
         integer, intent(out) :: ierr
         ierr = 0
      end subroutine extras_controls
      
      
      integer function extras_startup(s, id, restart, ierr)
         type (star_info), pointer :: s
         integer, intent(in) :: id
         logical, intent(in) :: restart
         integer, intent(out) :: ierr
         ierr = 0
         extras_startup = 0
         call system_clock(time0,clock_rate)
         call check_for_super_eddington(s,restart)
      end function extras_startup
      

      ! returns either keep_going, retry, backup, or terminate.
      integer function extras_check_model(s, id, id_extra)
         type (star_info), pointer :: s
         integer, intent(in) :: id, id_extra
         extras_check_model = keep_going         
      end function extras_check_model


      integer function how_many_extra_log_columns(s, id, id_extra)
         type (star_info), pointer :: s
         integer, intent(in) :: id, id_extra
         how_many_extra_log_columns = 0
      end function how_many_extra_log_columns
      
      
      subroutine data_for_extra_log_columns(s, id, id_extra, n, names, vals, ierr)
         type (star_info), pointer :: s
         integer, intent(in) :: id, id_extra, n
         character (len=maxlen_log_column_name) :: names(n)
         double precision :: vals(n)
         integer, intent(out) :: ierr
         ierr = 0
      end subroutine data_for_extra_log_columns

      
      integer function how_many_extra_profile_columns(s, id, id_extra)
         type (star_info), pointer :: s
         integer, intent(in) :: id, id_extra
         how_many_extra_profile_columns = 0
      end function how_many_extra_profile_columns
      
      
      subroutine data_for_extra_profile_columns(s, id, id_extra, n, nz, names, vals, ierr)
         type (star_info), pointer :: s
         integer, intent(in) :: id, id_extra, n, nz
         character (len=maxlen_profile_column_name) :: names(n)
         double precision :: vals(nz,n)
         integer, intent(out) :: ierr
         integer :: k
         ierr = 0
      end subroutine data_for_extra_profile_columns
      

      ! returns either keep_going, retry, backup, or terminate.
      integer function extras_finish_step(s, id, id_extra)
         type (star_info), pointer :: s
         integer, intent(in) :: id, id_extra
         double precision :: val, val1
         integer :: k
         include 'formats.dek'
         extras_finish_step = keep_going
         call check_for_super_eddington(s,.false.)
      end function extras_finish_step
      
      
      subroutine check_for_super_eddington(s,restart)
         type (star_info), pointer :: s
         logical, intent(in) :: restart
         double precision :: Ledd, L
         include 'formats.dek'
         
         return   ! DISABLED FOR NOW
         
         
         Ledd = pi4*clight*s% cgrav(1)*s% mstar/s% opacity(1)
         L = s% L(1)
         if (L > Ledd) then
            if (s% tau_factor == 1 .or. restart) then
               write(*,*) 'change to special parameters for L > Ledd'
               s% tau_factor = 300
               s% delta_lgT_limit = 0.5
               s% delta_lgTeff_limit = 0.1  
               s% delta_lgTeff_hard_limit = 0.3
            end if
         else if (L < Ledd/10) then
            if (s% tau_factor > 1) then
               write(*,*) 'change parameters back to normal for L < Ledd'
               s% tau_factor = 1
               s% delta_lgT_limit = 0.05
               s% delta_lgTeff_limit = 0.01  
               s% delta_lgTeff_hard_limit = 0.03
            end if
         end if
      end subroutine check_for_super_eddington
      
      
      subroutine extras_after_evolve(s, id, id_extra, ierr)
         type (star_info), pointer :: s
         integer, intent(in) :: id, id_extra
         integer, intent(out) :: ierr
         double precision :: dt
         ierr = 0
         call system_clock(time1,clock_rate)
         dt = dble(time1 - time0) / clock_rate / 60
         if (dt > 10*expected_runtime) then
            write(*,'(/,a30,2f18.6,a,/)') '>>>>>>> EXCESSIVE runtime', &
               dt, expected_runtime, '   <<<<<<<<<  ERROR'
         else
            write(*,'(/,a30,2f18.6,2i10/)') 'runtime (minutes), retries, backups', &
               dt, expected_runtime, s% num_retries, s% num_backups
         end if
      end subroutine extras_after_evolve

      end module run_star_extras