11#include "scaleFElib.h"
72 character(len=H_SHORT) :: mesh_type
82 procedure,
public :: setup_vars => ocean_setup_vars
83 procedure,
public :: set_coupler => ocean_set_coupler
84 procedure,
public :: calc_tendency => ocean_calc_tendency
85 procedure,
public :: update => ocean_update
86 procedure,
public :: set_surface => ocean_set_surface
87 procedure,
public :: get_surface => ocean_get_surface
88 procedure,
public :: finalize => ocean_finalize
109 use scale_const,
only: &
110 undef8 => const_undef8
121 logical :: ACTIVATE_FLAG = .false.
123 real(DP) :: TIME_DT = undef8
124 character(len=H_SHORT) :: TIME_DT_UNIT =
'SEC'
125 real(DP) :: TIME_DT_RESTART = undef8
126 character(len=H_SHORT) :: TIME_DT_RESTART_UNIT =
'SEC'
128 logical :: OCEAN_DYN_DO = .true.
129 character(len=H_SHORT) :: OCEAN_MESH_TYPE =
'REGIONAL'
132 namelist / param_ocean / &
137 time_dt_restart_unit, &
144 log_info(
'OceanComponent_setup',*)
'Oceanic model components '
148 read(io_fid_conf,nml=param_ocean,iostat=ierr)
150 log_info(
"Ocean_setup",*)
'Not found namelist. Default used.'
151 elseif( ierr > 0 )
then
152 log_error(
"Ocean_setup",*)
'Not appropriate names in namelist PARAM_OCEAN. Check!'
158 call this%ModelComponent_Init(
'OCEAN', activate_flag )
160 if ( .not. activate_flag )
return
162 call prof_rapstart(
'Ocean_setup', 1)
166 call this%time_manager%Init( this%GetComponentName(), &
167 time_dt, time_dt_unit, &
168 time_dt_restart, time_dt_restart_unit )
174 this%mesh_type = ocean_mesh_type
175 select case( this%mesh_type )
177 call this%mesh_rm%Init()
179 dim_name_postfix_=
'_O', &
180 registered_comp_id=this%vars%hist_comp_id )
181 this%mesh => this%mesh_rm
183 call this%mesh_gm%Init()
185 dim_name_postfix_=
'_O', &
186 registered_comp_id=this%vars%hist_comp_id )
187 this%mesh => this%mesh_gm
189 log_error(
"Ocean_setup",*)
'Unsupported type of mesh is specified. Check!', this%mesh_type
198 call this%dyn_proc%ModelComponentProc_Init(
'OceanDyn', ocean_dyn_do )
199 call this%dyn_proc%setup( this%mesh, this%time_manager )
204 log_info(
'OceanComponent_setup',*)
'Finish setup of each oceanic component.'
206 call prof_rapend(
'Ocean_setup', 1)
213 subroutine ocean_setup_vars( this )
218 call prof_rapstart(
'Ocean_setup_vars', 1)
219 call this%vars%Init( this%mesh )
220 call prof_rapend(
'Ocean_setup_vars', 1)
222 end subroutine ocean_setup_vars
226 subroutine ocean_set_coupler( this, coupler )
231 this%coupler_ptr => coupler
233 end subroutine ocean_set_coupler
237 subroutine ocean_calc_tendency( this, force )
251 logical,
intent(in) :: force
258 real(RP),
allocatable :: SFLX_GH(:,:)
262 call this%get_surface()
264 call prof_rapstart(
'OCN_tendency', 1)
266 mesh3d => this%mesh%ptr_mesh
268 do idom=1, mesh3d%LOCAL_MESH_NUM
269 lmesh3d => mesh3d%lcmesh_list(idom)
270 lmesh2d => lmesh3d%lcmesh2D
272 allocate( sflx_gh(lmesh2d%refElem2D%Np,lmesh2d%Ne) )
276 call calculate_surface_flux( this, &
277 this%vars%OCN_SFLX(sflx_mw_id)%local(idom)%val, &
278 this%vars%OCN_SFLX(sflx_mu_id)%local(idom)%val, &
279 this%vars%OCN_SFLX(sflx_mv_id)%local(idom)%val, &
280 this%vars%OCN_SFLX(sflx_sh_id)%local(idom)%val, &
281 this%vars%OCN_SFLX(sflx_lh_id)%local(idom)%val, &
282 this%vars%OCN_SFLX(sflx_qv_id)%local(idom)%val, &
284 this%vars%AUX_VARS2D(sfc_temp_id)%local(idom)%val, &
285 this%vars%ATM_VARS2D(atm_sfc_dens_id)%local(idom)%val, &
286 this%vars%ATM_VARS2D(atm_sfc_pres_id)%local(idom)%val, &
287 this%vars%ATM_VARS2D(atm_temp_id)%local(idom)%val, &
288 this%vars%ATM_VARS2D(atm_dens_id)%local(idom)%val, &
289 this%vars%ATM_VARS2D(atm_pres_id)%local(idom)%val, &
290 this%vars%ATM_VARS2D(atm_w_id)%local(idom)%val, &
291 this%vars%ATM_VARS2D(atm_u_id)%local(idom)%val, &
292 this%vars%ATM_VARS2D(atm_v_id)%local(idom)%val, &
293 this%vars%ATM_VARS2D(atm_qv_id)%local(idom)%val, &
294 this%vars%ATM_VARS2D(dz_a_id)%local(idom)%val, &
295 lmesh2d, lmesh2d%refElem2D )
299 call calculate_sfc_heat_flux( sflx_gh, &
300 this%vars%AUX_VARS2D(sfc_temp_id)%local(idom)%val, &
301 this%vars%ATM_VARS2D(sflx_rd_sw_dir_id)%local(idom)%val, &
302 this%vars%ATM_VARS2D(sflx_rd_lw_dif_id)%local(idom)%val, &
303 this%vars%AUX_VARS2D(alb_vis_dir_id)%local(idom)%val, &
304 this%vars%OCN_SFLX(sflx_sh_id)%local(idom)%val, &
305 this%vars%OCN_SFLX(sflx_lh_id)%local(idom)%val, &
306 lmesh2d, lmesh2d%refElem2D )
310 call calculate_phys_tendency( this%vars%PHY_TEND(rhoh_id)%local(idom)%val, &
311 sflx_gh, lmesh3d%zlev, &
312 lmesh3d, lmesh3d%refElem3D, lmesh2d, lmesh2d%refElem2D )
331 deallocate( sflx_gh )
334 call prof_rapend(
'OCN_tendency', 1)
337 call this%set_surface( countup=.true. )
340 end subroutine ocean_calc_tendency
344 subroutine ocean_update( this )
348 integer :: tm_process_id
356 call prof_rapstart(
'OCN_update', 1)
358 if ( this%dyn_proc%IsActivated() )
then
359 call prof_rapstart(
'OCN_Dynamics', 1)
360 tm_process_id = this%dyn_proc%tm_process_id
361 is_update = this%time_manager%Do_process( tm_process_id )
363 log_progress(*)
'ocean / dynamics'
364 do inner_itr=1, this%time_manager%Get_process_inner_itr_num( tm_process_id )
365 call this%dyn_proc%update( &
366 this%mesh, this%vars%PROGVARS_manager, this%vars%QTRCVARS_manager, &
367 this%vars%AUXVARS_manager, this%vars%PHYTENDS_manager, is_update )
369 call prof_rapend(
'OCN_Dynamics', 1)
373 do idom=1, this%mesh%ptr_mesh%LOCAL_MESH_NUM
374 lmesh => this%mesh%ptr_mesh%lcmesh_list(idom)
375 lmesh2d => lmesh%lcmesh2D
376 call set_sfctemp_lc( this%vars%AUX_VARS2D(sfc_temp_id)%local(idom)%val, &
377 this%vars%PROG_VARS(prgvar_therm_id)%local(idom)%val, &
378 lmesh, lmesh%refElem3D, lmesh2d, lmesh2d%refElem2D )
382 call prof_rapend(
'OCN_update', 1)
384 end subroutine ocean_update
386 subroutine set_sfctemp_lc( SFC_TEMP, &
387 THERM, lmesh, elem, lmesh2D, elem2D )
393 real(RP),
intent(out) :: SFC_TEMP(elem2D%Np,lmesh2D%NeA)
394 real(RP),
intent(in) :: THERM(elem%Np,lmesh%NeA)
397 integer :: hSlice(elem2D%Np)
400 hslice(:) = elem%Hslice(:,elem%Nnode_v)
402 do ke2d=lmesh2d%NeS, lmesh2d%NeE
403 ke = ke2d + (lmesh%NeZ-1)*lmesh%Ne2D
404 sfc_temp(:,ke2d) = therm(hslice(:),ke)
407 end subroutine set_sfctemp_lc
411 subroutine ocean_set_surface( this, countup )
414 logical,
intent(in) :: countup
417 call prof_rapstart(
'OCN_sfc_exch', 1)
419 call this%coupler_ptr%vars%PutOCN( this%vars, countup )
421 call prof_rapend(
'OCN_sfc_exch', 1)
423 end subroutine ocean_set_surface
427 subroutine ocean_get_surface( this )
432 call prof_rapstart(
'OCN_sfc_exch', 1)
434 call this%coupler_ptr%vars%Get_ATM_OCN( &
435 this%vars%ATM_VARS2D(atm_sfc_dens_id), &
436 this%vars%ATM_VARS2D(atm_sfc_pres_id), &
437 this%vars%ATM_VARS2D(atm_temp_id), &
438 this%vars%ATM_VARS2D(atm_pres_id), &
439 this%vars%ATM_VARS2D(atm_w_id), &
440 this%vars%ATM_VARS2D(atm_u_id), &
441 this%vars%ATM_VARS2D(atm_v_id), &
442 this%vars%ATM_VARS2D(atm_qv_id), &
443 this%vars%ATM_VARS2D(sflx_rd_sw_dir_id), &
444 this%vars%ATM_VARS2D(sflx_rd_lw_dif_id), &
445 this%vars%ATM_VARS2D(dz_a_id) )
447 call prof_rapend(
'OCN_sfc_exch', 1)
449 end subroutine ocean_get_surface
453 subroutine ocean_finalize( this )
458 log_info(
'OceanComponent_finalize',*)
460 if ( .not. this%IsActivated() )
return
463 call this%vars%Final()
465 select case( this%mesh_type )
467 call this%mesh_rm%Final()
469 call this%mesh_gm%Final()
473 call this%time_manager%Final()
476 end subroutine ocean_finalize
482 subroutine calculate_surface_flux( this, &
483 SFLX_MW, SFLX_MU, SFLX_MV, SFLX_SH, SFLX_LH, SFLX_QV, &
484 SFC_TEMP, SFC_DENS, SFC_PRES, &
485 ATM_TEMP, ATM_DENS, ATM_PRES, ATM_W, ATM_U, ATM_V, ATM_QV, zlev_a, &
487 use scale_const,
only: &
488 rplanet => const_radius
495 real(RP),
intent(out) :: SFLX_MW(elem%Np,lmesh%NeA)
496 real(RP),
intent(out) :: SFLX_MU(elem%Np,lmesh%NeA)
497 real(RP),
intent(out) :: SFLX_MV(elem%Np,lmesh%NeA)
498 real(RP),
intent(out) :: SFLX_SH(elem%Np,lmesh%NeA)
499 real(RP),
intent(out) :: SFLX_LH(elem%Np,lmesh%NeA)
500 real(RP),
intent(out) :: SFLX_QV(elem%Np,lmesh%NeA)
501 real(RP),
intent(in) :: SFC_TEMP(elem%Np,lmesh%NeA)
502 real(RP),
intent(in) :: SFC_DENS(elem%Np,lmesh%NeA)
503 real(RP),
intent(in) :: SFC_PRES(elem%Np,lmesh%NeA)
504 real(RP),
intent(in) :: ATM_TEMP(elem%Np,lmesh%NeA)
505 real(RP),
intent(in) :: ATM_DENS(elem%Np,lmesh%NeA)
506 real(RP),
intent(in) :: ATM_PRES(elem%Np,lmesh%NeA)
507 real(RP),
intent(in) :: ATM_W(elem%Np,lmesh%NeA)
508 real(RP),
intent(in) :: ATM_U(elem%Np,lmesh%NeA)
509 real(RP),
intent(in) :: ATM_V(elem%Np,lmesh%NeA)
510 real(RP),
intent(in) :: ATM_QV(elem%Np,lmesh%NeA)
511 real(RP),
intent(in) :: zlev_a(elem%Np,lmesh%NeA)
514 real(RP) :: U10(elem%Np,lmesh%NeA)
515 real(RP) :: V10(elem%Np,lmesh%NeA)
520 real(RP) :: DZ1 (elem%Np,lmesh%NeA)
521 real(RP) :: Z1 (elem%Np,lmesh%Ne)
522 real(RP) :: ATM_W_lc(elem%Np,lmesh%NeA)
523 real(RP) :: ATM_U_lc(elem%Np,lmesh%NeA)
524 real(RP) :: ATM_V_lc(elem%Np,lmesh%NeA)
528 do ke2d=lmesh%NeS, lmesh%NeE
531 atm_w_lc(ij,ke2d) = atm_w(ij,ke2d)
532 atm_u_lc(ij,ke2d) = atm_u(ij,ke2d)
533 atm_v_lc(ij,ke2d) = atm_v(ij,ke2d)
535 z1(ij,ke2d) = zlev_a(ij,ke2d)
536 dz1(ij,ke2d) = z1(ij,ke2d) - zlev_a(ij,ke2d)
537 z1(ij,ke2d) = z1(ij,ke2d) + rplanet
541 call convert_uv2localorthvec( &
542 this%mesh%ptr_mesh, lmesh%pos_en(:,:,1), lmesh%pos_en(:,:,2), z1(:,:), elem%Np*lmesh%Ne, &
543 atm_u_lc(:,lmesh%NeS:lmesh%NeE), atm_v_lc(:,lmesh%NeS:lmesh%NeE) )
546 elem%Np, 1, elem%Np, lmesh%NeA, 1, lmesh%Ne, &
547 atm_w_lc(:,:), atm_u_lc(:,:), atm_v_lc(:,:), atm_temp(:,:), atm_pres(:,:), &
549 sfc_dens(:,:), sfc_temp(:,:), sfc_pres(:,:), &
551 sflx_mw(:,:), sflx_mu(:,:), sflx_mv(:,:), &
552 sflx_sh(:,:), sflx_lh(:,:), sflx_qv(:,:), &
555 call convert_localorth2uvvec( &
556 this%mesh%ptr_mesh, lmesh%pos_en(:,:,1), lmesh%pos_en(:,:,2), z1(:,:), elem%Np*lmesh%Ne, &
557 sflx_mu(:,lmesh%NeS:lmesh%NeE), sflx_mv(:,lmesh%NeS:lmesh%NeE) )
560 end subroutine calculate_surface_flux
565 subroutine calculate_sfc_heat_flux( sflx_GH, &
567 SFLX_RD_SW_dn_dir, SFLX_RD_LW_dn_dif, &
571 use scale_const,
only: &
576 real(RP),
intent(out) :: sflx_GH(elem%Np,lmesh%Ne)
577 real(RP),
intent(in) :: SFC_TEMP(elem%Np,lmesh%NeA)
578 real(RP),
intent(in) :: SFLX_RD_SW_dn_dir(elem%Np,lmesh%NeA)
579 real(RP),
intent(in) :: SFLX_RD_LW_dn_dif(elem%Np,lmesh%NeA)
580 real(RP),
intent(in) :: SFC_ALB_dir_vis(elem%Np,lmesh%NeA)
581 real(RP),
intent(in) :: SFLX_SH(elem%Np,lmesh%NeA)
582 real(RP),
intent(in) :: SFLX_LH(elem%Np,lmesh%NeA)
585 real(RP) :: emis(elem%Np)
586 real(RP) :: SWU(elem%Np), SWD(elem%Np), LWU(elem%Np), LWD(elem%Np)
590 do ke=lmesh%NeS, lmesh%NeE
591 emis(:) = stb * sfc_temp(:,ke)**4
593 lwd(:) = sflx_rd_lw_dn_dif(:,ke)
595 swd(:) = sflx_rd_sw_dn_dir(:,ke)
596 swu(:) = sfc_alb_dir_vis(:,ke) * swd(:)
598 sflx_gh(:,ke) = swd(:) - swu(:) + lwd(:) - lwu(:) - sflx_sh(:,ke) - sflx_lh(:,ke)
601 end subroutine calculate_sfc_heat_flux
604 subroutine calculate_phys_tendency( RHOH, &
605 sflx_GH, zlev, lmesh, elem, lmesh2D, elem2D )
611 real(RP),
intent(out) :: RHOH(elem%Np,lmesh%NeA)
612 real(RP),
intent(in) :: sflx_GH(elem2D%Np,lmesh2D%Ne)
613 real(RP),
intent(in) :: zlev(elem%Np,lmesh%Ne2D,lmesh%NeZ)
615 integer :: ke, ke_z, ke2D
617 real(RP) :: r_ocn_depth(elem2D%Np,lmesh2D%Ne)
618 integer :: hSlice_t(elem2D%Np), hSlice_b(elem2D%Np)
621 hslice_t(:) = elem%Hslice(:,elem%Nnode_v)
622 hslice_b(:) = elem%Hslice(:,1)
626 do ke2d=1, lmesh%Ne2D
627 r_ocn_depth(:,ke2d) = 1.0_rp / ( zlev(hslice_t(:),ke2d,lmesh%NeZ) - zlev(hslice_b(:),ke2d,1) )
631 do ke2d=1, lmesh%Ne2D
632 ke = ke2d + (ke_z-1)*lmesh%Ne2D
633 do pz=1, elem%Nnode_v
634 do ph=1, elem%Nnode_h1D**2
635 p = ph + (pz-1)*elem%Nnode_h1D**2
636 rhoh(p,ke) = sflx_gh(ph,ke2d) * r_ocn_depth(ph,ke2d)
643 end subroutine calculate_phys_tendency
646 subroutine convert_uv2localorthvec( mesh, x1, x2, r, N, & ! (in)
653 integer,
intent(in) :: N
655 real(RP),
intent(in) :: x1(N)
656 real(RP),
intent(in) :: x2(N)
657 real(RP),
intent(in) :: r(N)
658 real(RP),
intent(inout) :: U(N)
659 real(RP),
intent(inout) :: V(N)
668 end subroutine convert_uv2localorthvec
671 subroutine convert_localorth2uvvec( mesh, x1, x2, r, N, & ! (in)
678 integer,
intent(in) :: N
680 real(RP),
intent(in) :: x1(N)
681 real(RP),
intent(in) :: x2(N)
682 real(RP),
intent(in) :: r(N)
683 real(RP),
intent(inout) :: U(N)
684 real(RP),
intent(inout) :: V(N)
693 end subroutine convert_localorth2uvvec
subroutine ocean_setup(this)
Setup an object to mange oceanic component.
integer, parameter, public ocn_sflx_lh_id
latent heat flux at the ocean surface [W/m2]
integer, parameter, public atmvar2d_atm_qv_id
integer, parameter, public atmvar2d_atm_w_id
integer, parameter, public ocn_sflx_qv_id
water vapor flux at the ocean surface [kg/m2/s]
integer, parameter, public auxvar2d_sfc_alb_vis_dir_id
integer, parameter, public atmvar2d_atm_pres_id
integer, parameter, public atmvar2d_atm_u_id
integer, parameter, public auxvar2d_sfc_temp_id
integer, parameter, public ocn_sflx_mw_id
w-momentum flux at the ocean surface [kg/m/s2]
integer, parameter, public atmvar2d_sflx_rd_lw_dif_id
integer, parameter, public ocn_sflx_mv_id
v-momentum flux at the ocean surface [kg/m/s2]
integer, parameter, public ocn_sflx_sh_id
sensible heat flux at the ocean surface [W/m2]
integer, parameter, public atmvar2d_sfc_dens_id
integer, parameter, public atmvar2d_atm_dens_id
integer, parameter, public prgvar_therm_id
integer, parameter, public atmvar2d_atm_temp_id
integer, parameter, public atmvar2d_atm_v_id
integer, parameter, public phytend_rhoh_id
integer, parameter, public atmvar2d_sfc_pres_id
integer, parameter, public ocn_sflx_mu_id
u-momentum flux at the ocean surface [kg/m/s2]
integer, parameter, public atmvar2d_sflx_rd_sw_dir_id
integer, parameter, public atmvar2d_lowest_layer_dz_id
module atmosphere / physics / surface / simple
subroutine, public atmos_phy_sf_simple_flux(ia, is, ie, ja, js, je, atm_w, atm_u, atm_v, atm_temp, atm_pres, atm_qv, sfc_dens, sfc_temp, sfc_pres, atm_z1, sflx_mw, sflx_mu, sflx_mv, sflx_sh, sflx_lh, sflx_qv, u10, v10)
Calculate surface fluxes with constant bulk coefficients.
Module common / Coordinate conversion with cubed-sphere projection.
module FElib / Element / Base
module FElib / File / History
subroutine, public file_history_meshfield_setup(mesh1d_, mesh2d_, mesh3d_, meshcubedsphere2d_, meshcubedsphere3d_, dim_name_postfix_, registered_comp_id)
Setup a module for file history.
module FElib / Mesh / Local 2D
module FElib / Mesh / Local 3D
module FElib / Data / base
module FElib / Mesh / Base 2D
module FElib / Mesh / Base 3D
module FElib / Mesh / Base
module FElib / Mesh / Cubed-sphere 3D domain
FElib / model framework / model component.
FElib / model framework / mesh manager.
subroutine, public time_manager_regist_component(tmanager_comp)
Derived type to manage coupler component.
Derived type to manage oceanic component.
Derived type to manage a component of oceanic dynamics.
Derived type to manage a computational mesh (base class)
Derived type to manage a computational mesh of global ocean model.
Derived type to manage a computational mesh of regional ocean model.
Derived type to manage variables with ocean component.
Derived type representing a 2D reference element.
Derived type representing a 3D reference element.
Derived type representing a local mesh for 2D domain.
Derived type to manage a local 3D computational domain.
Derived type representing a field with local mesh (base type)
Derived type to manage a computational mesh (base type for 2D domain)
Derived type to manage a computational mesh (base type for 3D domain)
Base type to manage a computational mesh.
Derived type to manage a cubed-sphere 3D computational domain.