Skip to content
Snippets Groups Projects
Commit fecffcf8 authored by Виктория Суязова's avatar Виктория Суязова Committed by Anna Shestakova
Browse files

added sheba coare, new diag

parent 76f5612f
No related branches found
No related tags found
No related merge requests found
...@@ -95,6 +95,8 @@ set(SOURCES_F ...@@ -95,6 +95,8 @@ set(SOURCES_F
srcF/sfx_sheba_param.f90 srcF/sfx_sheba_param.f90
srcF/sfx_sheba_noniterative.f90 srcF/sfx_sheba_noniterative.f90
srcF/sfx_sheba_noit_param.f90 srcF/sfx_sheba_noit_param.f90
srcF/sfx_sheba_coare.f90
srcF/sfx_sheba_coare_param.f90
srcF/sfx_fc_wrapper.F90 srcF/sfx_fc_wrapper.F90
srcF/sfx_api_inmcm.f90 srcF/sfx_api_inmcm.f90
srcF/sfx_api_term.f90 srcF/sfx_api_term.f90
......
...@@ -5,7 +5,7 @@ implicit none ...@@ -5,7 +5,7 @@ implicit none
private private
public :: pbldia_new_sheba,pbldia_new_sheba_noit,& public :: pbldia_new_sheba,pbldia_new_sheba_noit,&
pbldia_new_most,pbldia_new_esm pbldia_new_most,pbldia_new_esm,pbldia_new_log,pbldia_new_sheba_coare
real,parameter,private::kappa=0.4,R=287.,appa=0.287 real,parameter,private::kappa=0.4,R=287.,appa=0.287
...@@ -38,21 +38,51 @@ contains ...@@ -38,21 +38,51 @@ contains
!C* UFTEMP - UNIVERSAL FUNCTION FOR SCALARS !C* UFTEMP - UNIVERSAL FUNCTION FOR SCALARS
subroutine pbldia_new_sheba(AR2,ARDIN,ARDOUT) subroutine pbldia_new_log(AR2,ARDIN,ARDOUT,lat)
use sfx_sheba, only: & real,intent(in):: AR2(11),ARDIN(6),lat
get_psi_sheba => get_psi real,intent(out)::ARDOUT(3)
real hwind,htemp,ustar,tstar,qstar
real dteta,dq,wind,HIN,zeta
HWIND = ARDIN(5)
HTEMP = ARDIN(6)
HIN = ardin(4)
zeta = AR2(1)
USTAR = AR2(8) * ARDIN(1)
TSTAR = AR2(9) * ARDIN(2)
QSTAR = AR2(9) * ARDIN(3)
WIND = (USTAR/kappa)*ALOG(hwind/HIN)
DTETA = (TSTAR/kappa)*ALOG(htemp/HIN)
DQ = (QSTAR/kappa)*ALOG(htemp/HIN)
ARDOUT(1) = ARDIN(1)+WIND
ARDOUT(2) = DTETA+ardin(2)
ARDOUT(3) = DQ+ardin(3)
return
end subroutine pbldia_new_log
subroutine pbldia_new_sheba(AR2,ARDIN,ARDOUT,lat)
use sfx_sheba, only: get_psi_sheba => get_psi
real,intent(in):: AR2(11),ARDIN(6) real,intent(in):: AR2(11),ARDIN(6),lat
real,intent(out)::ARDOUT(3) real,intent(out)::ARDOUT(3)
real,parameter::zetalim = 2. !maximum value of z/L for stable SL real,parameter::zetalim = 1. !maximum value of z/L for
! stable SL for wind
real psi_m,psi_h,psi_m_hs,psi_h_hs real psi_m,psi_h,psi_m_hs,psi_h_hs
real hwind,htemp,ustar,tstar,qstar,& real hwind,htemp,ustar,tstar,qstar,&
& ufwind,uftemp,dteta,dq,wind,L,HIN,zeta & ufwind,uftemp,dteta,dq,wind,L,HIN,zeta
real Rib,ksi,wg,f,L_lim
HWIND = ARDIN(5) HWIND = ARDIN(5)
HTEMP = ARDIN(6) HTEMP = ARDIN(6)
HIN = ardin(4) HIN = ardin(4)
zeta = AR2(1) zeta = AR2(1)
Rib = AR2(2)
USTAR = AR2(8) * ARDIN(1) USTAR = AR2(8) * ARDIN(1)
TSTAR = AR2(9) * ARDIN(2) TSTAR = AR2(9) * ARDIN(2)
...@@ -60,12 +90,15 @@ use sfx_sheba, only: & ...@@ -60,12 +90,15 @@ use sfx_sheba, only: &
if(zeta.ne.0)then if(zeta.ne.0)then
if(zeta.gt.zetalim) zeta=zetalim
if(zeta.gt.zetalim) L_lim = HIN/zetalim
L = HIN/zeta L = HIN/zeta
call get_psi_sheba(psi_m_hs,psi_h_hs,HIN/L) call get_psi_sheba(psi_m_hs,psi_h_hs,HIN/L_lim)
call get_psi_sheba(psi_m,psi_h,HWIND/L) call get_psi_sheba(psi_m,psi_h,HWIND/L_lim)
UFWIND = ALOG(hwind/HIN) - (psi_m - psi_m_hs) UFWIND = ALOG(hwind/HIN) - (psi_m - psi_m_hs)
call get_psi_sheba(psi_m_hs,psi_h_hs,HIN/L)
call get_psi_sheba(psi_m,psi_h,HTEMP/L) call get_psi_sheba(psi_m,psi_h,HTEMP/L)
UFTEMP = ALOG(HTEMP/HIN) - (psi_h - psi_h_hs) UFTEMP = ALOG(HTEMP/HIN) - (psi_h - psi_h_hs)
...@@ -89,21 +122,86 @@ use sfx_sheba, only: & ...@@ -89,21 +122,86 @@ use sfx_sheba, only: &
return return
end subroutine pbldia_new_sheba end subroutine pbldia_new_sheba
subroutine pbldia_new_sheba_noit(AR2,ARDIN,ARDOUT) subroutine pbldia_new_sheba_coare(AR2,ARDIN,ARDOUT,lat)
use sfx_sheba_coare, only: &
get_psi_coare => get_psi_a, &
get_psi_stable_sheba => get_psi_stable
real,intent(in):: AR2(11),ARDIN(6),lat
real,intent(out)::ARDOUT(3)
real,parameter::zetalim = 1. !maximum value of z/L for stable SL
real psi_m,psi_h,psi_m_hs,psi_h_hs
real hwind,htemp,ustar,tstar,qstar,&
& ufwind,uftemp,dteta,dq,wind,L,HIN,zeta,L_lim
HWIND = ARDIN(5)
HTEMP = ARDIN(6)
HIN = ardin(4)
zeta = AR2(1)
USTAR = AR2(8) * ARDIN(1)
TSTAR = AR2(9) * ARDIN(2)
QSTAR = AR2(9) * ARDIN(3)
if(zeta.ne.0)then
if(zeta.gt.zetalim) L_lim = HIN/zetalim
L = HIN/zeta
if(zeta.gt.0)then ! stable stratification
call get_psi_stable_sheba(psi_m_hs,psi_h_hs,HIN/L_lim,HIN/L)
call get_psi_stable_sheba(psi_m,psi_h,HWIND/L_lim,HTEMP/L)
else
call get_psi_coare(psi_m_hs,psi_h_hs,HIN/L,HIN/L)
call get_psi_coare(psi_m,psi_h,HWIND/L,HTEMP/L)
endif
UFWIND = ALOG(hwind/HIN) - (psi_m - psi_m_hs)
UFTEMP = ALOG(HTEMP/HIN) - (psi_h - psi_h_hs)
else
UFWIND = ALOG(HWIND/HIN)
UFTEMP = ALOG(HTEMP/HIN)
endif
WIND = (USTAR/kappa) * UFWIND
DTETA = (TSTAR/kappa) * UFTEMP
DQ = (QSTAR/kappa) * UFTEMP
ARDOUT(1) = ARDIN(1)+WIND
ARDOUT(2) = DTETA+ardin(2)
ARDOUT(3) = DQ+ardin(3)
return
end subroutine pbldia_new_sheba_coare
subroutine pbldia_new_sheba_noit(AR2,ARDIN,ARDOUT,lat)
use sfx_sheba_noniterative, only: & use sfx_sheba_noniterative, only: &
get_psi_stable_sheba => get_psi_stable get_psi_stable_sheba => get_psi_stable
real,intent(in):: AR2(11),ARDIN(6) real,intent(in):: AR2(11),ARDIN(6),lat
real,intent(out)::ARDOUT(3) real,intent(out)::ARDOUT(3)
real,parameter::zetalim = 2. !maximum value of z/L for stable SL real,parameter::zetalim = 1. !maximum value of z/L for stable SL
real psi_m,psi_h,psi_m_hs,psi_h_hs real psi_m,psi_h,psi_m_hs,psi_h_hs
real hwind,htemp,ustar,tstar,qstar,& real hwind,htemp,ustar,tstar,qstar,&
& ufwind,uftemp,dteta,dq,wind,L,HIN,zeta & ufwind,uftemp,dteta,dq,wind,L,HIN,zeta
real Rib,wg,ksi,f, L_lim
HWIND = ARDIN(5) HWIND = ARDIN(5)
HTEMP = ARDIN(6) HTEMP = ARDIN(6)
HIN = ardin(4) HIN = ardin(4)
zeta = AR2(1) zeta = AR2(1)
Rib = AR2(2)
USTAR = AR2(8) * ARDIN(1) USTAR = AR2(8) * ARDIN(1)
TSTAR = AR2(9) * ARDIN(2) TSTAR = AR2(9) * ARDIN(2)
...@@ -111,18 +209,18 @@ use sfx_sheba_noniterative, only: & ...@@ -111,18 +209,18 @@ use sfx_sheba_noniterative, only: &
if(zeta.ne.0)then if(zeta.ne.0)then
if(zeta.gt.zetalim) zeta=zetalim if(zeta.gt.zetalim) L_lim=HIN/zetalim
L = HIN/zeta L = HIN/zeta
if(zeta.gt.0)then ! stable stratification if(zeta.gt.0)then ! stable stratification
call get_psi_stable_sheba(psi_m_hs,psi_h_hs,HIN/L,HIN/L) call get_psi_stable_sheba(psi_m_hs,psi_h_hs,HIN/L_lim,HIN/L)
call get_psi_stable_sheba(psi_m,psi_h,HWIND/L,HWIND/L) call get_psi_stable_sheba(psi_m,psi_h,HWIND/L_lim,HTEMP/L)
UFWIND = ALOG(hwind/HIN) - (psi_m - psi_m_hs) UFWIND = ALOG(hwind/HIN) - (psi_m - psi_m_hs)
call get_psi_stable_sheba(psi_m,psi_h,HTEMP/L,HTEMP/L)
UFTEMP = ALOG(HTEMP/HIN) - (psi_h - psi_h_hs) UFTEMP = ALOG(HTEMP/HIN) - (psi_h - psi_h_hs)
else ! unstable stratification (functions from ESM) else ! unstable stratification (functions from ESM)
call get_psi_esm1(psi_m,psi_h,HIN,HWIND,L) call get_psi_esm1(psi_m,psi_h,HIN,HWIND,L)
...@@ -154,21 +252,23 @@ use sfx_sheba_noniterative, only: & ...@@ -154,21 +252,23 @@ use sfx_sheba_noniterative, only: &
return return
end subroutine pbldia_new_sheba_noit end subroutine pbldia_new_sheba_noit
subroutine pbldia_new_most(AR2,ARDIN,ARDOUT) subroutine pbldia_new_most(AR2,ARDIN,ARDOUT,lat)
use sfx_most, only: & use sfx_most, only: &
get_psi_most => get_psi get_psi_most => get_psi
real,intent(in):: AR2(11),ARDIN(6) real,intent(in):: AR2(11),ARDIN(6),lat
real,intent(out)::ARDOUT(3) real,intent(out)::ARDOUT(3)
real,parameter::zetalim = 2. !maximum value of z/L for stable SL real,parameter::zetalim = 1. !maximum value of z/L for stable SL
real psi_m,psi_h,psi_m_hs,psi_h_hs real psi_m,psi_h,psi_m_hs,psi_h_hs
real hwind,htemp,ustar,tstar,qstar,& real hwind,htemp,ustar,tstar,qstar,&
& ufwind,uftemp,dteta,dq,wind,L,HIN,zeta & ufwind,uftemp,dteta,dq,wind,L,HIN,zeta
real Rib,ksi,wg,f,L_lim
HWIND = ARDIN(5) HWIND = ARDIN(5)
HTEMP = ARDIN(6) HTEMP = ARDIN(6)
HIN = ardin(4) HIN = ardin(4)
zeta = AR2(1) zeta = AR2(1)
Rib = AR2(2)
USTAR = AR2(8) * ARDIN(1) USTAR = AR2(8) * ARDIN(1)
TSTAR = AR2(9) * ARDIN(2) TSTAR = AR2(9) * ARDIN(2)
...@@ -176,12 +276,13 @@ use sfx_most, only: & ...@@ -176,12 +276,13 @@ use sfx_most, only: &
if(zeta.ne.0)then if(zeta.ne.0)then
if(zeta.gt.zetalim) zeta=zetalim if(zeta.gt.zetalim) L_lim=HIN/zetalim
L = HIN/zeta L = HIN/zeta
call get_psi_most(psi_m_hs,psi_h_hs,HIN/L) call get_psi_most(psi_m_hs,psi_h_hs,HIN/L_lim)
call get_psi_most(psi_m,psi_h,HWIND/L) call get_psi_most(psi_m,psi_h,HWIND/L_lim)
UFWIND = ALOG(hwind/HIN) - (psi_m - psi_m_hs) UFWIND = ALOG(hwind/HIN) - (psi_m - psi_m_hs)
call get_psi_most(psi_m_hs,psi_h_hs,HIN/L)
call get_psi_most(psi_m,psi_h,HTEMP/L) call get_psi_most(psi_m,psi_h,HTEMP/L)
UFTEMP = ALOG(HTEMP/HIN) - (psi_h - psi_h_hs) UFTEMP = ALOG(HTEMP/HIN) - (psi_h - psi_h_hs)
...@@ -204,13 +305,13 @@ use sfx_most, only: & ...@@ -204,13 +305,13 @@ use sfx_most, only: &
return return
end subroutine pbldia_new_most end subroutine pbldia_new_most
subroutine pbldia_new_esm(AR2,ARDIN,ARDOUT) subroutine pbldia_new_esm(AR2,ARDIN,ARDOUT,lat)
real,intent(in):: AR2(11),ARDIN(6) real,intent(in):: AR2(11),ARDIN(6),lat
real,intent(out)::ARDOUT(3) real,intent(out)::ARDOUT(3)
real,parameter::zetalim = 2. !maximum value of z/L for stable SL real,parameter::zetalim = 1. !maximum value of z/L for stable SL
real psi_m,psi_h,psi_m_hs,psi_h_hs real psi_m,psi_h,psi_m_hs,psi_h_hs
real hwind,htemp,ustar,tstar,qstar,& real hwind,htemp,ustar,tstar,qstar,&
& ufwind,uftemp,dteta,dq,wind,L,HIN,zeta & ufwind,uftemp,dteta,dq,wind,L_lim,L,HIN,zeta
HWIND = ARDIN(5) HWIND = ARDIN(5)
HTEMP = ARDIN(6) HTEMP = ARDIN(6)
...@@ -223,10 +324,10 @@ subroutine pbldia_new_esm(AR2,ARDIN,ARDOUT) ...@@ -223,10 +324,10 @@ subroutine pbldia_new_esm(AR2,ARDIN,ARDOUT)
if(zeta.ne.0)then if(zeta.ne.0)then
if(zeta.gt.zetalim) zeta=zetalim if(zeta.gt.zetalim) L_lim=HIN/zetalim
L = HIN/zeta L = HIN/zeta
call get_psi_esm1(psi_m,psi_h,HIN,HWIND,L) call get_psi_esm1(psi_m,psi_h,HIN,HWIND,L_lim)
UFWIND = psi_m UFWIND = psi_m
call get_psi_esm1(psi_m,psi_h,HIN,HTEMP,L) call get_psi_esm1(psi_m,psi_h,HIN,HTEMP,L)
UFTEMP = psi_h UFTEMP = psi_h
......
...@@ -288,31 +288,10 @@ contains ...@@ -288,31 +288,10 @@ contains
call get_convection_lim(zeta_conv_lim, Rib_conv_lim, f_m_conv_lim, f_h_conv_lim, & call get_convection_lim(zeta_conv_lim, Rib_conv_lim, f_m_conv_lim, f_h_conv_lim, &
h0_m, h0_t, B) h0_m, h0_t, B)
! --- define snow consentration
!call get_sigma(sigma_r, sigma_w, rho_air, rho_s)
!call get_w_snow(w_snow, sigma_w, g, d_s, nu_air)
!call get_h_salt(h_salt, u_dyn0)
!call get_S_salt(S_salt, u_dyn0, u_thsnow, g, h_salt)
!call get_S_mean(S_mean, S_salt, h_salt, h, w_snow, u_dyn0)
!deltaS=S_salt-S_mean
!Ri_sn = (g * sigma_r * deltaS * h) / U**2
!Ri_sn=0.0
! --- get the fluxes ! --- get the fluxes
! ---------------------------------------------------------------------------- ! ----------------------------------------------------------------------------
if (Rib > 0.0) then if (Rib > 0.0) then
! --- stable stratification block
! --- restrict bulk Ri value
! *: note that this value is written to output
! Rib = min(Rib, Rib_max)
!do i = 1, numerics%maxiters_convection
!if (surface_type == surface_snow) then
!write(*,*) 'RIsnow', Rib, Ri_sn
! Rib=Rib+Ri_sn
!endif
call get_zeta(zeta, Rib, h, z0_m, z0_t) call get_zeta(zeta, Rib, h, z0_m, z0_t)
!write(*,*) 'get_zeta', zeta, h !write(*,*) 'get_zeta', zeta, h
...@@ -407,15 +386,15 @@ contains ...@@ -407,15 +386,15 @@ contains
Pr_t_inv = phi_m / phi_h Pr_t_inv = phi_m / phi_h
! --- setting output ! --- setting output
!sfx = sfxDataType(zeta = zeta, Rib = Rib, &
! Re = Re, B = B, z0_m = z0_m, z0_t = z0_t, &
! Rib_conv_lim = Rib_conv_lim, &
! Cm = Cm, Ct = Ct, Km = Km, Pr_t_inv = Pr_t_inv)
!write(*,*) 'Smean_0ut', S_mean
sfx = sfxDataType(zeta = zeta, Rib = Rib, & sfx = sfxDataType(zeta = zeta, Rib = Rib, &
Re = Linv, B = B, z0_m = z0_m, z0_t = z0_t, & Re = Re, B = B, z0_m = z0_m, z0_t = z0_t, &
Rib_conv_lim = S_mean, & Rib_conv_lim = Rib_conv_lim, &
Cm = Cm, Ct = Ct, Km = S_salt, Pr_t_inv = Udyn) Cm = Cm, Ct = Ct, Km = Km, Pr_t_inv = Pr_t_inv)
!write(*,*) 'Smean_0ut', S_mean
!sfx = sfxDataType(zeta = zeta, Rib = Rib, &
! Re = Linv, B = B, z0_m = z0_m, z0_t = z0_t, &
! Rib_conv_lim = S_mean, &
! Cm = Cm, Ct = Ct, Km = S_salt, Pr_t_inv = Udyn)
end subroutine get_surface_fluxes end subroutine get_surface_fluxes
! -------------------------------------------------------------------------------- ! --------------------------------------------------------------------------------
......
...@@ -84,7 +84,7 @@ module sfx_z0m_all_surface ...@@ -84,7 +84,7 @@ module sfx_z0m_all_surface
! --- define dynamic velocity in neutral conditions ! --- define dynamic velocity in neutral conditions
u_dyn0 = Uc / c u_dyn0 = Uc / c
write(*,*) 'ch', z0_m, u_dyn0 !!write(*,*) 'ch', z0_m, u_dyn0
end subroutine end subroutine
! -------------------------------------------------------------------------------- ! --------------------------------------------------------------------------------
...@@ -204,7 +204,7 @@ subroutine get_dynamic_roughness_map(z0_m, u_dyn0, U, h, z0m_map) ...@@ -204,7 +204,7 @@ subroutine get_dynamic_roughness_map(z0_m, u_dyn0, U, h, z0m_map)
z0_m=z0m_map z0_m=z0m_map
h0_m = h / z0_m h0_m = h / z0_m
u_dyn0 = U * kappa / log(h0_m) u_dyn0 = U * kappa / log(h0_m)
write(*,*) 'map', z0_m, u_dyn0 !write(*,*) 'map', z0_m, u_dyn0
end subroutine end subroutine
! -------------------------------------------------------------------------------- ! --------------------------------------------------------------------------------
......
...@@ -49,7 +49,7 @@ module sfx_z0t_all_surface ...@@ -49,7 +49,7 @@ module sfx_z0t_all_surface
B = min(B, B_max_land) B = min(B, B_max_land)
z0_t = z0_m / exp(B) z0_t = z0_m / exp(B)
write(*,*) 'kl_land', z0_t, B !write(*,*) 'kl_land', z0_t, B
end subroutine end subroutine
! -------------------------------------------------------------------------------- ! --------------------------------------------------------------------------------
...@@ -75,7 +75,7 @@ module sfx_z0t_all_surface ...@@ -75,7 +75,7 @@ module sfx_z0t_all_surface
B = min(B, B_max_ocean) B = min(B, B_max_ocean)
z0_t = z0_m / exp(B) z0_t = z0_m / exp(B)
write(*,*) 'kl_water', z0_t, B !(*,*) 'kl_water', z0_t, B
end subroutine end subroutine
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment