Newer
Older
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/'
! --------------------------------------------------------------------------------
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
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')
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
!< 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