module obl_run_papa_fluxes
    !< @brief obl scm Papa-station 'fluxes' setup
    ! --------------------------------------------------------------------------------

    ! TO DO:
    !   -- ***

    ! modules used
    ! --------------------------------------------------------------------------------

    ! directives list
    ! --------------------------------------------------------------------------------
    implicit none
    private

    ! public interface
    ! --------------------------------------------------------------------------------
    public :: set_phys
    public :: set_grid
    public :: set_time
    public :: set_forcing
    public :: set_initial_conditions
    ! --------------------------------------------------------------------------------

    ! --------------------------------------------------------------------------------
    character(len = 256), parameter :: path = 'papa-2017-june/'
    ! --------------------------------------------------------------------------------
    

    contains

    ! --------------------------------------------------------------------------------
    subroutine set_phys
        !> @brief phys parameters setup
        ! ----------------------------------------------------------------------------
        use obl_scm
        ! ----------------------------------------------------------------------------

        !< coriolis frequency
        f = 1.116 * 1e-4

        !< SW extinction parameters
        a_band_ratio = 0.67
        a_extinction_coeff = 1.0
        b_extinction_coeff = 1.0 / 17.0

        sw_albedo = 0.3

    end subroutine set_phys

    ! --------------------------------------------------------------------------------
    subroutine set_grid(grid)
        !> @brief grid parameters setup
        ! ----------------------------------------------------------------------------
        use obl_grid

        type (gridDataType), intent(inout) :: grid
        ! ----------------------------------------------------------------------------

        !< in: [zpos, height, cz]
        call set_uniform_grid(grid, -128.0, 128.0, 32)

    end subroutine set_grid

    ! --------------------------------------------------------------------------------
    subroutine set_time(time_begin, time_end, dt)
        !> @brief time parameters setup
        ! ----------------------------------------------------------------------------
        real, intent(out) :: time_begin, time_end, dt
        ! ----------------------------------------------------------------------------

        time_begin = 0.0
        time_end = 431.0 * 3600.0
        dt = 1.0

    end subroutine set_time

    ! --------------------------------------------------------------------------------
    subroutine set_forcing
        !> @brief forcing setup
        ! ----------------------------------------------------------------------------
        use obl_fluxes
        use obl_tforcing
        ! ----------------------------------------------------------------------------

        !< setting atmospheric forcing
        ! ---------------------------------------------------------------------------- 
        !< using 'flux' mode
        is_meteo_setup = 0

        call set_external_tforcing(sensible_hflux_surf, 'meteo-forcing/'//trim(path)//'sensible_hflux.dat')
        call set_external_tforcing(latent_hflux_surf, 'meteo-forcing/'//trim(path)//'latent_hflux.dat')

        call set_const_tforcing(salin_flux_surf, 0.0)

        call set_external_tforcing(tau_x_surf, 'meteo-forcing/'//trim(path)//'tau-x.dat')
        call set_external_tforcing(tau_y_surf, 'meteo-forcing/'//trim(path)//'tau-y.dat')

        call set_external_tforcing(sw_flux_surf, 'meteo-forcing/'//trim(path)//'SW-down.dat')

        call set_external_tforcing(lw_in_surf, 'meteo-forcing/'//trim(path)//'LW-down.dat')

        !< normalize time in external forcing: hrs -> sec
        call normalize_time_tforcing(sensible_hflux_surf, 3600.0)
        call normalize_time_tforcing(latent_hflux_surf, 3600.0)

        call normalize_time_tforcing(tau_x_surf, 3600.0)
        call normalize_time_tforcing(tau_y_surf, 3600.0)

        call normalize_time_tforcing(sw_flux_surf, 3600.0)

        call normalize_time_tforcing(lw_in_surf, 3600.0)
        ! ---------------------------------------------------------------------------- 

        !< setting bottom forcing
        ! ----------------------------------------------------------------------------
        call set_const_tforcing(hflux_bot, 0.0)

        call set_const_tforcing(salin_flux_bot, 0.0)

        call set_const_tforcing(tau_x_bot, 0.0)
        call set_const_tforcing(tau_y_bot, 0.0)
        ! ----------------------------------------------------------------------------

    end subroutine set_forcing

    ! --------------------------------------------------------------------------------
    subroutine set_initial_conditions(grid)
        !> @brief initial_conditions setup
        ! ----------------------------------------------------------------------------
        use obl_state
        use obl_init
        use obl_grid

        type (gridDataType), intent(in) :: grid
        ! ----------------------------------------------------------------------------

        call set_external_profile(Theta, 'meteo-init/'//trim(path)//'Theta.dat', grid)
        call set_external_profile(Salin, 'meteo-init/'//trim(path)//'Salin.dat', grid)

        call set_const_profile(U, 0.0, grid)
        call set_const_profile(V, 0.0, grid)

    end subroutine set_initial_conditions

end module