Skip to content
Snippets Groups Projects
obl_run_papa_long_fluxes.f90 5.49 KiB
Newer Older
  • Learn to ignore specific revisions
  • Daria Gladskikh's avatar
    Daria Gladskikh committed
    module obl_run_papa_long_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-2014-long/'
        ! --------------------------------------------------------------------------------
        
    
        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]
    
    Daria Gladskikh's avatar
    Daria Gladskikh committed
            call set_uniform_grid(grid, -400.0, 400.0, 32)
    
    Daria Gladskikh's avatar
    Daria Gladskikh committed
    
        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 * 3600.0
    
    Daria Gladskikh's avatar
    Daria Gladskikh committed
            time_end = 17520.0 * 3600.0 !17520.0 * 3600.0
            dt = 10.0
    
    Daria Gladskikh's avatar
    Daria Gladskikh committed
    
        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