Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • nemo/nemo
  • sparonuz/nemo
  • hatfield/nemo
  • extdevs/nemo
4 results
Show changes
Hide whitespace changes
Inline Side-by-side
Showing
with 1299 additions and 1362 deletions
src/OCE/SBC/sbc_ice.F90
View file @ 3efbcb17
...@@ -50,8 +50,8 @@ MODULE sbc_ice ...@@ -50,8 +50,8 @@ MODULE sbc_ice
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qcn_ice !: heat conduction flux in the layer below surface [W/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qcn_ice !: heat conduction flux in the layer below surface [W/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qtr_ice_top !: solar flux transmitted below the ice surface [W/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qtr_ice_top !: solar flux transmitted below the ice surface [W/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_ice !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts [N/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_ice !: atmos-ice u-stress. T-pts [N/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtau_ice !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts [N/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtau_ice !: atmos-ice v-stress. T-pts [N/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation - precip over sea ice [kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation - precip over sea ice [kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt !: category topmelt REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt !: category topmelt
...@@ -103,6 +103,8 @@ MODULE sbc_ice ...@@ -103,6 +103,8 @@ MODULE sbc_ice
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_mass_b !: mass of snow and ice at previous ice time step [Kg/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_mass_b !: mass of snow and ice at previous ice time step [Kg/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_fmass !: time evolution of mass of snow+ice [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_fmass !: time evolution of mass of snow+ice [Kg/m2/s]
!! * Substitutions
# include "do_loop_substitute.h90"
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018) !! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: sbc_ice.F90 14072 2020-12-04 07:48:38Z laurent $ !! $Id: sbc_ice.F90 14072 2020-12-04 07:48:38Z laurent $
...@@ -114,36 +116,49 @@ CONTAINS ...@@ -114,36 +116,49 @@ CONTAINS
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! *** FUNCTION sbc_ice_alloc *** !! *** FUNCTION sbc_ice_alloc ***
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
INTEGER :: ierr(4) INTEGER :: ierr(5), ii
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
ierr(:) = 0 ierr(:) = 0
ii = 0
ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(1) ) ii = ii + 1
ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(ii) )
#if defined key_si3 #if defined key_si3
ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) , & ! ----------------- !
& qla_ice (jpi,jpj,jpl) , dqla_ice (jpi,jpj,jpl) , & ! == FULL ARRAYS == !
& dqns_ice(jpi,jpj,jpl) , tn_ice (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) , & ! ----------------- !
& qml_ice (jpi,jpj,jpl) , qcn_ice (jpi,jpj,jpl) , qtr_ice_top(jpi,jpj,jpl) , & ii = ii + 1
& utau_ice(jpi,jpj) , vtau_ice (jpi,jpj) , wndm_ice (jpi,jpj) , & ALLOCATE( utau_ice(jpi,jpj) , vtau_ice(jpi,jpj) , &
& evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice (jpi,jpj) , & & rCdU_ice(A2D(1)) , STAT= ierr(ii) )
& qemp_ice(jpi,jpj) , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) , & ! -------------------- !
& qns_oce (jpi,jpj) , qsr_oce (jpi,jpj) , emp_oce (jpi,jpj) , & ! == REDUCED ARRAYS == !
& emp_ice (jpi,jpj) , sstfrz (jpi,jpj) , rCdU_ice (jpi,jpj) , STAT= ierr(2) ) ! -------------------- !
ii = ii + 1
ALLOCATE( wndm_ice(A2D(0)) , &
& qns_ice (A2D(0),jpl) , qsr_ice (A2D(0),jpl) , &
& qla_ice (A2D(0),jpl) , dqla_ice (A2D(0),jpl) , &
& dqns_ice(A2D(0),jpl) , tn_ice (A2D(0),jpl) , alb_ice (A2D(0),jpl) , &
& qml_ice (A2D(0),jpl) , qcn_ice (A2D(0),jpl) , qtr_ice_top(A2D(0),jpl) , &
& evap_ice(A2D(0),jpl) , devap_ice(A2D(0),jpl) , qprec_ice (A2D(0)) , &
& qemp_ice(A2D(0)) , qevap_ice(A2D(0),jpl) , qemp_oce (A2D(0)) , &
& qns_oce (A2D(0)) , qsr_oce (A2D(0)) , emp_oce (A2D(0)) , &
& emp_ice (A2D(0)) , sstfrz (A2D(0)) , STAT= ierr(ii) )
#endif #endif
#if defined key_cice #if defined key_cice
ii = ii + 1
ALLOCATE( qla_ice(jpi,jpj,1) , qlw_ice(jpi,jpj,1) , qsr_ice(jpi,jpj,1) , & ALLOCATE( qla_ice(jpi,jpj,1) , qlw_ice(jpi,jpj,1) , qsr_ice(jpi,jpj,1) , &
wndi_ice(jpi,jpj) , tatm_ice(jpi,jpj) , qatm_ice(jpi,jpj) , & wndi_ice(jpi,jpj) , tatm_ice(jpi,jpj) , qatm_ice(jpi,jpj) , &
wndj_ice(jpi,jpj) , nfrzmlt(jpi,jpj) , ss_iou(jpi,jpj) , & wndj_ice(jpi,jpj) , nfrzmlt(jpi,jpj) , ss_iou(jpi,jpj) , &
ss_iov(jpi,jpj) , fr_iu(jpi,jpj) , fr_iv(jpi,jpj) , & ss_iov(jpi,jpj) , fr_iu(jpi,jpj) , fr_iv(jpi,jpj) , &
a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , &
STAT= ierr(2) ) STAT= ierr(ii) )
ii = ii + 1
IF( ln_cpl ) ALLOCATE( u_ice(jpi,jpj) , tn_ice (jpi,jpj,1) , & IF( ln_cpl ) ALLOCATE( u_ice(jpi,jpj) , tn_ice (jpi,jpj,1) , &
& v_ice(jpi,jpj) , alb_ice(jpi,jpj,1) , & & v_ice(jpi,jpj) , alb_ice(jpi,jpj,1) , &
& emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , & & emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , &
& STAT= ierr(3) ) & h_i(jpi,jpj,jpl) , h_s(jpi,jpj,jpl) ,STAT= ierr(ii) )
IF( ln_cpl ) ALLOCATE( h_i(jpi,jpj,jpl) , h_s(jpi,jpj,jpl) , STAT=ierr(4) )
#endif #endif
sbc_ice_alloc = MAXVAL( ierr ) sbc_ice_alloc = MAXVAL( ierr )
......
src/OCE/SBC/sbc_oce.F90
View file @ 3efbcb17
...@@ -103,34 +103,36 @@ MODULE sbc_oce ...@@ -103,34 +103,36 @@ MODULE sbc_oce
INTEGER , PUBLIC :: ncpl_qsr_freq = 0 !: qsr coupling frequency per days from atmosphere (used by top) INTEGER , PUBLIC :: ncpl_qsr_freq = 0 !: qsr coupling frequency per days from atmosphere (used by top)
! !
!! !! now ! before !! !! !! now ! before !!
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau , utau_b !: sea surface i-stress (ocean referential) [N/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau !: sea surface i-stress (ocean referential) T-pt [N/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtau , vtau_b !: sea surface j-stress (ocean referential) [N/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtau !: sea surface j-stress (ocean referential) T-pt [N/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_icb, vtau_icb !: sea surface (i,j)-stress used by icebergs [N/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utauU , utau_b !: sea surface i-stress (ocean referential) U-pt [N/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: taum !: module of sea surface stress (at T-point) [N/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtauV , vtau_b !: sea surface j-stress (ocean referential) V-pt [N/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_icb, vtau_icb !: sea surface (i,j)-stress used by icebergs [N/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: taum !: module of sea surface stress (at T-point) [N/m2]
!! wndm is used compute surface gases exchanges in ice-free ocean or leads !! wndm is used compute surface gases exchanges in ice-free ocean or leads
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm !: wind speed module at T-point (=|U10m-Uoce|) [m/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm !: wind speed module at T-point (=|U10m-Uoce|) [m/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rhoa !: air density at "rn_zu" m above the sea [kg/m3] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rhoa !: air density at "rn_zu" m above the sea [kg/m3]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr !: sea heat flux: solar [W/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr !: sea heat flux: solar [W/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qns , qns_b !: sea heat flux: non solar [W/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qns , qns_b !: sea heat flux: non solar [W/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_tot !: total solar heat flux (over sea and ice) [W/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_tot !: total solar heat flux (over sea and ice) [W/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qns_tot !: total non solar heat flux (over sea and ice) [W/m2] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qns_tot !: total non solar heat flux (over sea and ice) [W/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp , emp_b !: freshwater budget: volume flux [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp , emp_b !: freshwater budget: volume flux [Kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx , sfx_b !: salt flux [PSS.kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx , sfx_b !: salt flux [PSS.kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_tot !: total E-P over ocean and ice [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_tot !: total E-P over ocean and ice [Kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fmmflx !: freshwater budget: freezing/melting [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fmmflx !: freshwater budget: freezing/melting [Kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf , rnf_b !: river runoff [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf , rnf_b !: river runoff [Kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwficb , fwficb_b !: iceberg melting [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwficb !: iceberg melting [Kg/m2/s]
!! !!
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sbc_tsc, sbc_tsc_b !: sbc content trend [K.m/s] jpi,jpj,jpts REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sbc_tsc, sbc_tsc_b !: sbc content trend [K.m/s] jpi,jpj,jpts
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_hc , qsr_hc_b !: heat content trend due to qsr flux [K.m/s] jpi,jpj,jpk REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_hc , qsr_hc_b !: heat content trend due to qsr flux [K.m/s] jpi,jpj,jpk
!! !!
!! !!
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tprecip !: total precipitation [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tprecip !: total precipitation [Kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sprecip !: solid precipitation [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sprecip !: solid precipitation [Kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_i !: ice fraction = 1 - lead fraction (between 0 to 1) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_i !: ice fraction = 1 - lead fraction (between 0 to 1)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: atm_co2 !: atmospheric pCO2 [ppm] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: atm_co2 !: atmospheric pCO2 [ppm]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask !: coupling mask for ln_mixcpl (warning: allocated in sbccpl)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: cloud_fra !: cloud cover (fraction of cloud in a gridcell) [-] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: cloud_fra !: cloud cover (fraction of cloud in a gridcell) [-]
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
!! ABL Vertical Domain size !! ABL Vertical Domain size
...@@ -173,30 +175,41 @@ CONTAINS ...@@ -173,30 +175,41 @@ CONTAINS
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
!! *** FUNCTION sbc_oce_alloc *** !! *** FUNCTION sbc_oce_alloc ***
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
INTEGER :: ierr(6) INTEGER :: ierr(8)
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
ierr(:) = 0 ierr(:) = 0
! !
ALLOCATE( utau(jpi,jpj) , utau_b(jpi,jpj) , taum(jpi,jpj) , & ! ----------------- !
& vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , rhoa(jpi,jpj) , STAT=ierr(1) ) ! == FULL ARRAYS == !
! ----------------- !
ALLOCATE( utau(jpi,jpj) , utau_b(jpi,jpj) , utauU(jpi,jpj) , &
& vtau(jpi,jpj) , vtau_b(jpi,jpj) , vtauV(jpi,jpj) , STAT=ierr(1) )
! !
ALLOCATE( qns_tot(jpi,jpj) , qns (jpi,jpj) , qns_b(jpi,jpj), & ALLOCATE( emp(jpi,jpj) , emp_b(jpi,jpj) , &
& qsr_tot(jpi,jpj) , qsr (jpi,jpj) , & & STAT=ierr(2) )
& emp (jpi,jpj) , emp_b(jpi,jpj) , &
& sfx (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj), fmmflx(jpi,jpj), STAT=ierr(2) )
! !
ALLOCATE( rnf (jpi,jpj) , sbc_tsc (jpi,jpj,jpts) , qsr_hc (jpi,jpj,jpk) , & ALLOCATE( rnf (jpi,jpj) , rnf_b (jpi,jpj) , &
& rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , & & fwficb (jpi,jpj) , STAT=ierr(3) )
& fwficb (jpi,jpj), fwficb_b(jpi,jpj), STAT=ierr(3) )
! !
ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) , & ALLOCATE( fr_i(jpi,jpj) , &
& atm_co2(jpi,jpj) , tsk_m(jpi,jpj) , cloud_fra(jpi,jpj), &
& ssu_m (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) , & & ssu_m (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) , &
& ssv_m (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) & ssv_m (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , e3t_m(jpi,jpj) , STAT=ierr(4) )
! !
ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) ) ! -------------------- !
! == REDUCED ARRAYS == !
! -------------------- !
ALLOCATE( qns (A2D(0)) , qns_b (A2D(0)) , qsr (A2D(0)) , &
& qns_tot(A2D(0)) , qsr_tot(A2D(0)) , qsr_hc(A2D(0),jpk) , qsr_hc_b(A2D(0),jpk) , STAT=ierr(5) )
!
ALLOCATE( sbc_tsc(A2D(0),jpts) , sbc_tsc_b(A2D(0),jpts) , &
& sfx (A2D(0)) , sfx_b(A2D(0)) , emp_tot(A2D(0)), fmmflx(A2D(0)) ,&
& wndm(A2D(0)) , taum (A2D(0)) , STAT=ierr(6) )
!
ALLOCATE( tprecip(A2D(0)) , sprecip(A2D(0)) , &
& atm_co2(A2D(0)) , tsk_m (A2D(0)) , cloud_fra(A2D(0)), STAT=ierr(7) )
ALLOCATE( rhoa(A2D(0)) , q_air_zt(A2D(0)) , theta_air_zt(A2D(0)) , STAT=ierr(8) )
! !
ALLOCATE( q_air_zt(jpi,jpj) , theta_air_zt(jpi,jpj) , STAT=ierr(6) ) !#LB
! !
sbc_oce_alloc = MAXVAL( ierr ) sbc_oce_alloc = MAXVAL( ierr )
CALL mpp_sum ( 'sbc_oce', sbc_oce_alloc ) CALL mpp_sum ( 'sbc_oce', sbc_oce_alloc )
...@@ -205,9 +218,10 @@ CONTAINS ...@@ -205,9 +218,10 @@ CONTAINS
END FUNCTION sbc_oce_alloc END FUNCTION sbc_oce_alloc
!!clem => this subroutine is never used in nemo
SUBROUTINE sbc_tau2wnd SUBROUTINE sbc_tau2wnd
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
!! *** ROUTINE sbc_tau2wnd *** !! *** ROUTINE ***
!! !!
!! ** Purpose : Estimation of wind speed as a function of wind stress !! ** Purpose : Estimation of wind speed as a function of wind stress
!! !!
...@@ -217,17 +231,14 @@ CONTAINS ...@@ -217,17 +231,14 @@ CONTAINS
USE lbclnk ! ocean lateral boundary conditions (or mpp link) USE lbclnk ! ocean lateral boundary conditions (or mpp link)
REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3
REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient
REAL(wp) :: ztx, zty, ztau, zcoef ! temporary variables REAL(wp) :: ztau, zcoef ! temporary variables
INTEGER :: ji, jj ! dummy indices INTEGER :: ji, jj ! dummy indices
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
zcoef = 0.5 / ( zrhoa * zcdrag ) zcoef = 0.5 / ( zrhoa * zcdrag )
DO_2D( 0, 0, 0, 0 ) DO_2D( 0, 0, 0, 0 )
ztx = utau(ji-1,jj ) + utau(ji,jj) ztau = SQRT( utau(ji,jj)*utau(ji,jj) + vtau(ji,jj)*vtau(ji,jj) )
zty = vtau(ji ,jj-1) + vtau(ji,jj) wndm(ji,jj) = SQRT ( ztau * zcoef ) * smask0(ji,jj)
ztau = SQRT( ztx * ztx + zty * zty )
wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1)
END_2D END_2D
CALL lbc_lnk( 'sbc_oce', wndm(:,:) , 'T', 1.0_wp )
! !
END SUBROUTINE sbc_tau2wnd END SUBROUTINE sbc_tau2wnd
......
src/OCE/SBC/sbc_phy.F90
View file @ 3efbcb17
...@@ -223,9 +223,9 @@ CONTAINS ...@@ -223,9 +223,9 @@ CONTAINS
FUNCTION virt_temp_vctr( pta, pqa ) FUNCTION virt_temp_vctr( pta, pqa )
REAL(wp), DIMENSION(jpi,jpj) :: virt_temp_vctr !: virtual temperature [K] REAL(wp), DIMENSION(A2D(0)) :: virt_temp_vctr !: virtual temperature [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pta !: absolute or potential air temperature [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pta !: absolute or potential air temperature [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa !: specific humidity of air [kg/kg] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqa !: specific humidity of air [kg/kg]
virt_temp_vctr(:,:) = pta(:,:) * (1._wp + rctv0*pqa(:,:)) virt_temp_vctr(:,:) = pta(:,:) * (1._wp + rctv0*pqa(:,:))
...@@ -290,25 +290,25 @@ CONTAINS ...@@ -290,25 +290,25 @@ CONTAINS
!! ** Author: G. Samson, Feb 2021 !! ** Author: G. Samson, Feb 2021
!!------------------------------------------------------------------------------- !!-------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: pres_temp_vctr ! air pressure [Pa] REAL(wp), DIMENSION(A2D(0)) :: pres_temp_vctr ! air pressure [Pa]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pqspe ! air specific humidity [kg/kg] REAL(wp), DIMENSION(A2D(0)), INTENT(in ) :: pqspe ! air specific humidity [kg/kg]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pslp ! sea-level pressure [Pa] REAL(wp), DIMENSION(A2D(0)), INTENT(in ) :: pslp ! sea-level pressure [Pa]
REAL(wp), INTENT(in ) :: pz ! height above surface [m] REAL(wp), INTENT(in ) :: pz ! height above surface [m]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) , OPTIONAL :: ptpot ! air potential temperature [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in ) , OPTIONAL :: ptpot ! air potential temperature [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(inout), OPTIONAL :: pta ! air absolute temperature [K] REAL(wp), DIMENSION(A2D(0)), INTENT(inout), OPTIONAL :: pta ! air absolute temperature [K]
INTEGER :: ji, jj ! loop indices INTEGER :: ji, jj ! loop indices
LOGICAL , INTENT(in) , OPTIONAL :: l_ice ! sea-ice presence LOGICAL , INTENT(in) , OPTIONAL :: l_ice ! sea-ice presence
LOGICAL :: lice ! sea-ice presence LOGICAL :: lice ! sea-ice presence
lice = .FALSE. lice = .FALSE.
IF( PRESENT(l_ice) ) lice = l_ice IF( PRESENT(l_ice) ) lice = l_ice
IF( PRESENT(ptpot) ) THEN IF( PRESENT(ptpot) ) THEN
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
pres_temp_vctr(ji,jj) = pres_temp_sclr( pqspe(ji,jj), pslp(ji,jj), pz, ptpot=ptpot(ji,jj), pta=pta(ji,jj), l_ice=lice ) pres_temp_vctr(ji,jj) = pres_temp_sclr( pqspe(ji,jj), pslp(ji,jj), pz, ptpot=ptpot(ji,jj), pta=pta(ji,jj), l_ice=lice )
END_2D END_2D
ELSE ELSE
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
pres_temp_vctr(ji,jj) = pres_temp_sclr( pqspe(ji,jj), pslp(ji,jj), pz, pta=pta(ji,jj), l_ice=lice ) pres_temp_vctr(ji,jj) = pres_temp_sclr( pqspe(ji,jj), pslp(ji,jj), pz, pta=pta(ji,jj), l_ice=lice )
END_2D END_2D
ENDIF ENDIF
...@@ -344,12 +344,12 @@ CONTAINS ...@@ -344,12 +344,12 @@ CONTAINS
!! ** Author: G. Samson, Feb 2021 !! ** Author: G. Samson, Feb 2021
!!------------------------------------------------------------------------------- !!-------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: theta_exner_vctr ! air/surface potential temperature [K] REAL(wp), DIMENSION(A2D(0)) :: theta_exner_vctr ! air/surface potential temperature [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pta ! air/surface absolute temperature [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pta ! air/surface absolute temperature [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppa ! air/surface pressure [Pa] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppa ! air/surface pressure [Pa]
INTEGER :: ji, jj ! loop indices INTEGER :: ji, jj ! loop indices
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
theta_exner_vctr(ji,jj) = theta_exner_sclr( pta(ji,jj), ppa(ji,jj) ) theta_exner_vctr(ji,jj) = theta_exner_sclr( pta(ji,jj), ppa(ji,jj) )
END_2D END_2D
...@@ -364,10 +364,10 @@ CONTAINS ...@@ -364,10 +364,10 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!------------------------------------------------------------------------------- !!-------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak ! air temperature [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptak ! air temperature [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa ! air specific humidity [kg/kg] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqa ! air specific humidity [kg/kg]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppa ! pressure in [Pa] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppa ! pressure in [Pa]
REAL(wp), DIMENSION(jpi,jpj) :: rho_air_vctr ! density of moist air [kg/m^3] REAL(wp), DIMENSION(A2D(0)) :: rho_air_vctr ! density of moist air [kg/m^3]
!!------------------------------------------------------------------------------- !!-------------------------------------------------------------------------------
rho_air_vctr = MAX( ppa / (R_dry*ptak * ( 1._wp + rctv0*pqa )) , 0.8_wp ) rho_air_vctr = MAX( ppa / (R_dry*ptak * ( 1._wp + rctv0*pqa )) , 0.8_wp )
...@@ -412,11 +412,11 @@ CONTAINS ...@@ -412,11 +412,11 @@ CONTAINS
FUNCTION visc_air_vctr(ptak) FUNCTION visc_air_vctr(ptak)
REAL(wp), DIMENSION(jpi,jpj) :: visc_air_vctr ! kinetic viscosity (m^2/s) REAL(wp), DIMENSION(A2D(0)) :: visc_air_vctr ! kinetic viscosity (m^2/s)
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak ! air temperature in (K) REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptak ! air temperature in (K)
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
visc_air_vctr(ji,jj) = visc_air_sclr( ptak(ji,jj) ) visc_air_vctr(ji,jj) = visc_air_sclr( ptak(ji,jj) )
END_2D END_2D
...@@ -431,8 +431,8 @@ CONTAINS ...@@ -431,8 +431,8 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: L_vap_vctr ! latent heat of vaporization [J/kg] REAL(wp), DIMENSION(A2D(0)) :: L_vap_vctr ! latent heat of vaporization [J/kg]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psst ! water temperature [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: psst ! water temperature [K]
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
! !
L_vap_vctr = ( 2.501_wp - 0.00237_wp * ( psst(:,:) - rt0) ) * 1.e6_wp L_vap_vctr = ( 2.501_wp - 0.00237_wp * ( psst(:,:) - rt0) ) * 1.e6_wp
...@@ -464,8 +464,8 @@ CONTAINS ...@@ -464,8 +464,8 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!------------------------------------------------------------------------------- !!-------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa ! air specific humidity [kg/kg] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqa ! air specific humidity [kg/kg]
REAL(wp), DIMENSION(jpi,jpj) :: cp_air_vctr ! specific heat of moist air [J/K/kg] REAL(wp), DIMENSION(A2D(0)) :: cp_air_vctr ! specific heat of moist air [J/K/kg]
!!------------------------------------------------------------------------------- !!-------------------------------------------------------------------------------
cp_air_vctr = rCp_dry + rCp_vap * pqa cp_air_vctr = rCp_dry + rCp_vap * pqa
...@@ -516,12 +516,12 @@ CONTAINS ...@@ -516,12 +516,12 @@ CONTAINS
FUNCTION gamma_moist_vctr( ptak, pqa ) FUNCTION gamma_moist_vctr( ptak, pqa )
REAL(wp), DIMENSION(jpi,jpj) :: gamma_moist_vctr REAL(wp), DIMENSION(A2D(0)) :: gamma_moist_vctr
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptak
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqa
INTEGER :: ji, jj INTEGER :: ji, jj
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
gamma_moist_vctr(ji,jj) = gamma_moist_sclr( ptak(ji,jj), pqa(ji,jj) ) gamma_moist_vctr(ji,jj) = gamma_moist_sclr( ptak(ji,jj), pqa(ji,jj) )
END_2D END_2D
...@@ -537,17 +537,17 @@ CONTAINS ...@@ -537,17 +537,17 @@ CONTAINS
!! Author: L. Brodeau, June 2019 / AeroBulk !! Author: L. Brodeau, June 2019 / AeroBulk
!! (https://github.com/brodeau/aerobulk/) !! (https://github.com/brodeau/aerobulk/)
!!------------------------------------------------------------------------ !!------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: One_on_L !: 1./(Obukhov length) [m^-1] REAL(wp), DIMENSION(A2D(0)) :: One_on_L !: 1./(Obukhov length) [m^-1]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptha !: reference potential temperature of air [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptha !: reference potential temperature of air [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa !: reference specific humidity of air [kg/kg] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqa !: reference specific humidity of air [kg/kg]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus !: u*: friction velocity [m/s] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pus !: u*: friction velocity [m/s]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pts, pqs !: \theta* and q* friction aka turb. scales for temp. and spec. hum. REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pts, pqs !: \theta* and q* friction aka turb. scales for temp. and spec. hum.
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zqa ! local scalar REAL(wp) :: zqa ! local scalar
!!------------------------------------------------------------------- !!-------------------------------------------------------------------
! !
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zqa = (1._wp + rctv0*pqa(ji,jj)) zqa = (1._wp + rctv0*pqa(ji,jj))
! !
! The main concern is to know whether, the vertical turbulent flux of virtual temperature, < u' theta_v' > is estimated with: ! The main concern is to know whether, the vertical turbulent flux of virtual temperature, < u' theta_v' > is estimated with:
...@@ -598,27 +598,27 @@ CONTAINS ...@@ -598,27 +598,27 @@ CONTAINS
FUNCTION Ri_bulk_vctr( pz, psst, ptha, pssq, pqa, pub, pta_layer, pqa_layer ) FUNCTION Ri_bulk_vctr( pz, psst, ptha, pssq, pqa, pub, pta_layer, pqa_layer )
REAL(wp), DIMENSION(jpi,jpj) :: Ri_bulk_vctr REAL(wp), DIMENSION(A2D(0)) :: Ri_bulk_vctr
REAL(wp) , INTENT(in) :: pz ! height above the sea (aka "delta z") [m] REAL(wp) , INTENT(in) :: pz ! height above the sea (aka "delta z") [m]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psst ! SST [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: psst ! SST [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptha ! pot. air temp. at height "pz" [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptha ! pot. air temp. at height "pz" [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pssq ! 0.98*q_sat(SST) [kg/kg] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pssq ! 0.98*q_sat(SST) [kg/kg]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa ! air spec. hum. at height "pz" [kg/kg] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqa ! air spec. hum. at height "pz" [kg/kg]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pub ! bulk wind speed [m/s] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pub ! bulk wind speed [m/s]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pta_layer ! when possible, a better guess of absolute temperature WITHIN the layer [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: pta_layer ! when possible, a better guess of absolute temperature WITHIN the layer [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pqa_layer ! when possible, a better guess of specific humidity WITHIN the layer [kg/kg] REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: pqa_layer ! when possible, a better guess of specific humidity WITHIN the layer [kg/kg]
!! !!
LOGICAL :: l_ptqa_l_prvd = .FALSE. LOGICAL :: l_ptqa_l_prvd = .FALSE.
INTEGER :: ji, jj INTEGER :: ji, jj
IF( PRESENT(pta_layer) .AND. PRESENT(pqa_layer) ) l_ptqa_l_prvd = .TRUE. IF( PRESENT(pta_layer) .AND. PRESENT(pqa_layer) ) l_ptqa_l_prvd = .TRUE.
IF( l_ptqa_l_prvd ) THEN IF( l_ptqa_l_prvd ) THEN
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
Ri_bulk_vctr(ji,jj) = Ri_bulk_sclr( pz, psst(ji,jj), ptha(ji,jj), pssq(ji,jj), pqa(ji,jj), pub(ji,jj), & Ri_bulk_vctr(ji,jj) = Ri_bulk_sclr( pz, psst(ji,jj), ptha(ji,jj), pssq(ji,jj), pqa(ji,jj), pub(ji,jj), &
& pta_layer=pta_layer(ji,jj ), pqa_layer=pqa_layer(ji,jj ) ) & pta_layer=pta_layer(ji,jj ), pqa_layer=pqa_layer(ji,jj ) )
END_2D END_2D
ELSE ELSE
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
Ri_bulk_vctr(ji,jj) = Ri_bulk_sclr( pz, psst(ji,jj), ptha(ji,jj), pssq(ji,jj), pqa(ji,jj), pub(ji,jj) ) Ri_bulk_vctr(ji,jj) = Ri_bulk_sclr( pz, psst(ji,jj), ptha(ji,jj), pssq(ji,jj), pqa(ji,jj), pub(ji,jj) )
END_2D END_2D
END IF END IF
...@@ -652,10 +652,10 @@ CONTAINS ...@@ -652,10 +652,10 @@ CONTAINS
END FUNCTION e_sat_sclr END FUNCTION e_sat_sclr
FUNCTION e_sat_vctr(ptak) FUNCTION e_sat_vctr(ptak)
REAL(wp), DIMENSION(jpi,jpj) :: e_sat_vctr !: vapour pressure at saturation [Pa] REAL(wp), DIMENSION(A2D(0)) :: e_sat_vctr !: vapour pressure at saturation [Pa]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak !: temperature (K) REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptak !: temperature (K)
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
e_sat_vctr(ji,jj) = e_sat_sclr(ptak(ji,jj)) e_sat_vctr(ji,jj) = e_sat_sclr(ptak(ji,jj))
END_2D END_2D
END FUNCTION e_sat_vctr END FUNCTION e_sat_vctr
...@@ -681,11 +681,11 @@ CONTAINS ...@@ -681,11 +681,11 @@ CONTAINS
FUNCTION e_sat_ice_vctr(ptak) FUNCTION e_sat_ice_vctr(ptak)
!! Same as "e_sat" but over ice rather than water! !! Same as "e_sat" but over ice rather than water!
REAL(wp), DIMENSION(jpi,jpj) :: e_sat_ice_vctr !: vapour pressure at saturation in presence of ice [Pa] REAL(wp), DIMENSION(A2D(0)) :: e_sat_ice_vctr !: vapour pressure at saturation in presence of ice [Pa]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptak
INTEGER :: ji, jj INTEGER :: ji, jj
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
e_sat_ice_vctr(ji,jj) = e_sat_ice_sclr( ptak(ji,jj) ) e_sat_ice_vctr(ji,jj) = e_sat_ice_sclr( ptak(ji,jj) )
END_2D END_2D
...@@ -712,11 +712,11 @@ CONTAINS ...@@ -712,11 +712,11 @@ CONTAINS
FUNCTION de_sat_dt_ice_vctr(ptak) FUNCTION de_sat_dt_ice_vctr(ptak)
!! Same as "e_sat" but over ice rather than water! !! Same as "e_sat" but over ice rather than water!
REAL(wp), DIMENSION(jpi,jpj) :: de_sat_dt_ice_vctr !: vapour pressure at saturation in presence of ice [Pa] REAL(wp), DIMENSION(A2D(0)) :: de_sat_dt_ice_vctr !: vapour pressure at saturation in presence of ice [Pa]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptak
INTEGER :: ji, jj INTEGER :: ji, jj
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
de_sat_dt_ice_vctr(ji,jj) = de_sat_dt_ice_sclr( ptak(ji,jj) ) de_sat_dt_ice_vctr(ji,jj) = de_sat_dt_ice_sclr( ptak(ji,jj) )
END_2D END_2D
...@@ -751,16 +751,16 @@ CONTAINS ...@@ -751,16 +751,16 @@ CONTAINS
FUNCTION q_sat_vctr( pta, ppa, l_ice ) FUNCTION q_sat_vctr( pta, ppa, l_ice )
REAL(wp), DIMENSION(jpi,jpj) :: q_sat_vctr REAL(wp), DIMENSION(A2D(0)) :: q_sat_vctr
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pta !: absolute temperature of air [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pta !: absolute temperature of air [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppa !: atmospheric pressure [Pa] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppa !: atmospheric pressure [Pa]
LOGICAL, INTENT(in), OPTIONAL :: l_ice !: we are above ice LOGICAL, INTENT(in), OPTIONAL :: l_ice !: we are above ice
LOGICAL :: lice LOGICAL :: lice
INTEGER :: ji, jj INTEGER :: ji, jj
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
lice = .FALSE. lice = .FALSE.
IF( PRESENT(l_ice) ) lice = l_ice IF( PRESENT(l_ice) ) lice = l_ice
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
q_sat_vctr(ji,jj) = q_sat_sclr( pta(ji,jj) , ppa(ji,jj), l_ice=lice ) q_sat_vctr(ji,jj) = q_sat_sclr( pta(ji,jj) , ppa(ji,jj), l_ice=lice )
END_2D END_2D
...@@ -790,12 +790,12 @@ CONTAINS ...@@ -790,12 +790,12 @@ CONTAINS
FUNCTION dq_sat_dt_ice_vctr( pta, ppa ) FUNCTION dq_sat_dt_ice_vctr( pta, ppa )
REAL(wp), DIMENSION(jpi,jpj) :: dq_sat_dt_ice_vctr REAL(wp), DIMENSION(A2D(0)) :: dq_sat_dt_ice_vctr
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pta !: absolute temperature of air [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pta !: absolute temperature of air [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppa !: atmospheric pressure [Pa] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppa !: atmospheric pressure [Pa]
INTEGER :: ji, jj INTEGER :: ji, jj
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
dq_sat_dt_ice_vctr(ji,jj) = dq_sat_dt_ice_sclr( pta(ji,jj) , ppa(ji,jj) ) dq_sat_dt_ice_vctr(ji,jj) = dq_sat_dt_ice_sclr( pta(ji,jj) , ppa(ji,jj) )
END_2D END_2D
...@@ -808,16 +808,16 @@ CONTAINS ...@@ -808,16 +808,16 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: q_air_rh REAL(wp), DIMENSION(A2D(0)) :: q_air_rh
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: prha !: relative humidity [fraction, not %!!!] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: prha !: relative humidity [fraction, not %!!!]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak !: air temperature [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptak !: air temperature [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppa !: atmospheric pressure [Pa] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppa !: atmospheric pressure [Pa]
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: ze ! local scalar REAL(wp) :: ze ! local scalar
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
! !
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
ze = prha(ji,jj)*e_sat_sclr(ptak(ji,jj)) ze = prha(ji,jj)*e_sat_sclr(ptak(ji,jj))
q_air_rh(ji,jj) = ze*reps0/(ppa(ji,jj) - (1. - reps0)*ze) q_air_rh(ji,jj) = ze*reps0/(ppa(ji,jj) - (1. - reps0)*ze)
END_2D END_2D
...@@ -833,29 +833,29 @@ CONTAINS ...@@ -833,29 +833,29 @@ CONTAINS
!! and the module of the wind stress => pTau = Tau !! and the module of the wind stress => pTau = Tau
!! ** Author: L. Brodeau, Sept. 2019 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, Sept. 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), INTENT(in) :: pzu ! height above the sea-level where all this takes place (normally 10m) REAL(wp), INTENT(in) :: pzu ! height above the sea-level where all this takes place (normally 10m)
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pTs ! water temperature at the air-sea interface [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pTs ! water temperature at the air-sea interface [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqs ! satur. spec. hum. at T=pTs [kg/kg] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqs ! satur. spec. hum. at T=pTs [kg/kg]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pTa ! potential air temperature at z=pzu [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pTa ! potential air temperature at z=pzu [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa ! specific humidity at z=pzu [kg/kg] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqa ! specific humidity at z=pzu [kg/kg]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pust ! u* REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pust ! u*
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptst ! t* REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptst ! t*
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqst ! q* REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqst ! q*
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwnd ! wind speed module at z=pzu [m/s] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pwnd ! wind speed module at z=pzu [m/s]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pUb ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pUb ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppa ! sea-level atmospheric pressure [Pa] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppa ! sea-level atmospheric pressure [Pa]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: prlw ! downwelling longwave radiative flux [W/m^2] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: prlw ! downwelling longwave radiative flux [W/m^2]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: prhoa ! air density [kg/m3] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: prhoa ! air density [kg/m3]
! !
REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pQns ! non-solar heat flux to the ocean aka "Qlat + Qsen + Qlw" [W/m^2]] REAL(wp), DIMENSION(A2D(0)), INTENT(out) :: pQns ! non-solar heat flux to the ocean aka "Qlat + Qsen + Qlw" [W/m^2]]
REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pTau ! module of the wind stress [N/m^2] REAL(wp), DIMENSION(A2D(0)), INTENT(out) :: pTau ! module of the wind stress [N/m^2]
! !
REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(out) :: Qlat REAL(wp), DIMENSION(A2D(0)), OPTIONAL, INTENT(out) :: Qlat
! !
REAL(wp) :: zdt, zdq, zCd, zCh, zCe, zz0, zQlat, zQsen, zQlw REAL(wp) :: zdt, zdq, zCd, zCh, zCe, zz0, zQlat, zQsen, zQlw
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zdt = pTa(ji,jj) - pTs(ji,jj) ; zdt = SIGN( MAX(ABS(zdt),1.E-6_wp), zdt ) zdt = pTa(ji,jj) - pTs(ji,jj) ; zdt = SIGN( MAX(ABS(zdt),1.E-6_wp), zdt )
zdq = pqa(ji,jj) - pqs(ji,jj) ; zdq = SIGN( MAX(ABS(zdq),1.E-9_wp), zdq ) zdq = pqa(ji,jj) - pqs(ji,jj) ; zdq = SIGN( MAX(ABS(zdq),1.E-9_wp), zdq )
...@@ -929,25 +929,25 @@ CONTAINS ...@@ -929,25 +929,25 @@ CONTAINS
& pTau, pQsen, pQlat, & & pTau, pQsen, pQlat, &
& pEvap, pfact_evap ) & pEvap, pfact_evap )
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), INTENT(in) :: pzu ! height above the sea-level where all this takes place (normally 10m) REAL(wp), INTENT(in) :: pzu ! height above the sea-level where all this takes place (normally 10m)
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pTs ! water temperature at the air-sea interface [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pTs ! water temperature at the air-sea interface [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqs ! satur. spec. hum. at T=pTs [kg/kg] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqs ! satur. spec. hum. at T=pTs [kg/kg]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pTa ! potential air temperature at z=pzu [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pTa ! potential air temperature at z=pzu [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa ! specific humidity at z=pzu [kg/kg] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqa ! specific humidity at z=pzu [kg/kg]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pCd REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pCd
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pCh REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pCh
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pCe REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pCe
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwnd ! wind speed module at z=pzu [m/s] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pwnd ! wind speed module at z=pzu [m/s]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pUb ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pUb ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppa ! sea-level atmospheric pressure [Pa] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppa ! sea-level atmospheric pressure [Pa]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: prhoa ! Air density at z=pzu [kg/m^3] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: prhoa ! Air density at z=pzu [kg/m^3]
!! !!
REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pTau ! module of the wind stress [N/m^2] REAL(wp), DIMENSION(A2D(0)), INTENT(out) :: pTau ! module of the wind stress [N/m^2]
REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pQsen ! [W/m^2] REAL(wp), DIMENSION(A2D(0)), INTENT(out) :: pQsen ! [W/m^2]
REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pQlat ! [W/m^2] REAL(wp), DIMENSION(A2D(0)), INTENT(out) :: pQlat ! [W/m^2]
!! !!
REAL(wp), DIMENSION(jpi,jpj), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s] REAL(wp), DIMENSION(A2D(0)), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s]
REAL(wp), INTENT(in) , OPTIONAL :: pfact_evap ! ABOMINATION: corrective factor for evaporation (doing this against my will! /laurent) REAL(wp), INTENT(in) , OPTIONAL :: pfact_evap ! ABOMINATION: corrective factor for evaporation (doing this against my will! /laurent)
!! !!
REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap, zfact_evap REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap, zfact_evap
INTEGER :: ji, jj INTEGER :: ji, jj
...@@ -955,7 +955,7 @@ CONTAINS ...@@ -955,7 +955,7 @@ CONTAINS
zfact_evap = 1._wp zfact_evap = 1._wp
IF( PRESENT(pfact_evap) ) zfact_evap = pfact_evap IF( PRESENT(pfact_evap) ) zfact_evap = pfact_evap
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), &
& pCd(ji,jj), pCh(ji,jj), pCe(ji,jj), & & pCd(ji,jj), pCh(ji,jj), pCe(ji,jj), &
...@@ -977,8 +977,8 @@ CONTAINS ...@@ -977,8 +977,8 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: alpha_sw_vctr ! thermal expansion coefficient of sea-water [1/K] REAL(wp), DIMENSION(A2D(0)) :: alpha_sw_vctr ! thermal expansion coefficient of sea-water [1/K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psst ! water temperature [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: psst ! water temperature [K]
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
alpha_sw_vctr = 2.1e-5_wp * MAX(psst(:,:)-rt0 + 3.2_wp, 0._wp)**0.79 alpha_sw_vctr = 2.1e-5_wp * MAX(psst(:,:)-rt0 + 3.2_wp, 0._wp)**0.79
...@@ -1027,16 +1027,16 @@ CONTAINS ...@@ -1027,16 +1027,16 @@ CONTAINS
FUNCTION qlw_net_vctr( pdwlw, pts, l_ice ) FUNCTION qlw_net_vctr( pdwlw, pts, l_ice )
REAL(wp), DIMENSION(jpi,jpj) :: qlw_net_vctr REAL(wp), DIMENSION(A2D(0)) :: qlw_net_vctr
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pdwlw !: downwelling longwave (aka infrared, aka thermal) radiation [W/m^2] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pdwlw !: downwelling longwave (aka infrared, aka thermal) radiation [W/m^2]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pts !: surface temperature [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pts !: surface temperature [K]
LOGICAL, INTENT(in), OPTIONAL :: l_ice !: we are above ice LOGICAL, INTENT(in), OPTIONAL :: l_ice !: we are above ice
LOGICAL :: lice LOGICAL :: lice
INTEGER :: ji, jj INTEGER :: ji, jj
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
lice = .FALSE. lice = .FALSE.
IF( PRESENT(l_ice) ) lice = l_ice IF( PRESENT(l_ice) ) lice = l_ice
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
qlw_net_vctr(ji,jj) = qlw_net_sclr( pdwlw(ji,jj) , pts(ji,jj), l_ice=lice ) qlw_net_vctr(ji,jj) = qlw_net_sclr( pdwlw(ji,jj) , pts(ji,jj), l_ice=lice )
END_2D END_2D
...@@ -1045,10 +1045,10 @@ CONTAINS ...@@ -1045,10 +1045,10 @@ CONTAINS
FUNCTION z0_from_Cd( pzu, pCd, ppsi ) FUNCTION z0_from_Cd( pzu, pCd, ppsi )
REAL(wp), DIMENSION(jpi,jpj) :: z0_from_Cd !: roughness length [m] REAL(wp), DIMENSION(A2D(0)) :: z0_from_Cd !: roughness length [m]
REAL(wp) , INTENT(in) :: pzu !: reference height zu [m] REAL(wp) , INTENT(in) :: pzu !: reference height zu [m]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pCd !: (neutral or non-neutral) drag coefficient [] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pCd !: (neutral or non-neutral) drag coefficient []
REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum [] REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum []
!! !!
!! If pCd is the NEUTRAL-STABILITY drag coefficient then ppsi must be 0 or not given !! If pCd is the NEUTRAL-STABILITY drag coefficient then ppsi must be 0 or not given
!! If pCd is the drag coefficient (in stable or unstable conditions) then pssi must be provided !! If pCd is the drag coefficient (in stable or unstable conditions) then pssi must be provided
...@@ -1066,10 +1066,10 @@ CONTAINS ...@@ -1066,10 +1066,10 @@ CONTAINS
FUNCTION Cd_from_z0( pzu, pz0, ppsi ) FUNCTION Cd_from_z0( pzu, pz0, ppsi )
REAL(wp), DIMENSION(jpi,jpj) :: Cd_from_z0 !: (neutral or non-neutral) drag coefficient [] REAL(wp), DIMENSION(A2D(0)) :: Cd_from_z0 !: (neutral or non-neutral) drag coefficient []
REAL(wp) , INTENT(in) :: pzu !: reference height zu [m] REAL(wp) , INTENT(in) :: pzu !: reference height zu [m]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0 !: roughness length [m] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pz0 !: roughness length [m]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum [] REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum []
!! !!
!! If we want to return the NEUTRAL-STABILITY drag coefficient then ppsi must be 0 or not given !! If we want to return the NEUTRAL-STABILITY drag coefficient then ppsi must be 0 or not given
!! If we want to return the stability-corrected Cd (i.e. in stable or unstable conditions) then pssi must be provided !! If we want to return the stability-corrected Cd (i.e. in stable or unstable conditions) then pssi must be provided
...@@ -1111,14 +1111,14 @@ CONTAINS ...@@ -1111,14 +1111,14 @@ CONTAINS
FUNCTION f_m_louis_vctr( pzu, pRib, pCdn, pz0 ) FUNCTION f_m_louis_vctr( pzu, pRib, pCdn, pz0 )
REAL(wp), DIMENSION(jpi,jpj) :: f_m_louis_vctr REAL(wp), DIMENSION(A2D(0)) :: f_m_louis_vctr
REAL(wp), INTENT(in) :: pzu REAL(wp), INTENT(in) :: pzu
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pRib REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pRib
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pCdn REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pCdn
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0 REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pz0
INTEGER :: ji, jj INTEGER :: ji, jj
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
f_m_louis_vctr(ji,jj) = f_m_louis_sclr( pzu, pRib(ji,jj), pCdn(ji,jj), pz0(ji,jj) ) f_m_louis_vctr(ji,jj) = f_m_louis_sclr( pzu, pRib(ji,jj), pCdn(ji,jj), pz0(ji,jj) )
END_2D END_2D
...@@ -1150,14 +1150,14 @@ CONTAINS ...@@ -1150,14 +1150,14 @@ CONTAINS
FUNCTION f_h_louis_vctr( pzu, pRib, pChn, pz0 ) FUNCTION f_h_louis_vctr( pzu, pRib, pChn, pz0 )
REAL(wp), DIMENSION(jpi,jpj) :: f_h_louis_vctr REAL(wp), DIMENSION(A2D(0)) :: f_h_louis_vctr
REAL(wp), INTENT(in) :: pzu REAL(wp), INTENT(in) :: pzu
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pRib REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pRib
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pChn REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pChn
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0 REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pz0
INTEGER :: ji, jj INTEGER :: ji, jj
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
f_h_louis_vctr(ji,jj) = f_h_louis_sclr( pzu, pRib(ji,jj), pChn(ji,jj), pz0(ji,jj) ) f_h_louis_vctr(ji,jj) = f_h_louis_sclr( pzu, pRib(ji,jj), pChn(ji,jj), pz0(ji,jj) )
END_2D END_2D
...@@ -1168,11 +1168,11 @@ CONTAINS ...@@ -1168,11 +1168,11 @@ CONTAINS
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
!! Provides the neutral-stability wind speed at 10 m !! Provides the neutral-stability wind speed at 10 m
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: UN10_from_ustar !: neutral stability wind speed at 10m [m/s] REAL(wp), DIMENSION(A2D(0)) :: UN10_from_ustar !: neutral stability wind speed at 10m [m/s]
REAL(wp), INTENT(in) :: pzu !: measurement heigh of wind speed [m] REAL(wp), INTENT(in) :: pzu !: measurement heigh of wind speed [m]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pUzu !: bulk wind speed at height pzu m [m/s] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pUzu !: bulk wind speed at height pzu m [m/s]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus !: friction velocity [m/s] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pus !: friction velocity [m/s]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum [] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum []
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
UN10_from_ustar(:,:) = pUzu(:,:) - pus(:,:)/vkarmn * ( LOG(pzu/10._wp) - ppsi(:,:) ) UN10_from_ustar(:,:) = pUzu(:,:) - pus(:,:)/vkarmn * ( LOG(pzu/10._wp) - ppsi(:,:) )
!! !!
...@@ -1183,11 +1183,11 @@ CONTAINS ...@@ -1183,11 +1183,11 @@ CONTAINS
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
!! Provides the neutral-stability wind speed at 10 m !! Provides the neutral-stability wind speed at 10 m
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: UN10_from_CD !: [m/s] REAL(wp), DIMENSION(A2D(0)) :: UN10_from_CD !: [m/s]
REAL(wp), INTENT(in) :: pzu !: measurement heigh of bulk wind speed REAL(wp), INTENT(in) :: pzu !: measurement heigh of bulk wind speed
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pUb !: bulk wind speed at height pzu m [m/s] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pUb !: bulk wind speed at height pzu m [m/s]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pCd !: drag coefficient REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pCd !: drag coefficient
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum [] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum []
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
!! Reminder: UN10 = u*/vkarmn * log(10/z0) !! Reminder: UN10 = u*/vkarmn * log(10/z0)
!! and: u* = sqrt(Cd) * Ub !! and: u* = sqrt(Cd) * Ub
...@@ -1214,10 +1214,10 @@ CONTAINS ...@@ -1214,10 +1214,10 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, April 2020 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, April 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: z0tq_LKB REAL(wp), DIMENSION(A2D(0)) :: z0tq_LKB
INTEGER, INTENT(in) :: iflag !: 1 => dealing with temperature; 2 => dealing with humidity INTEGER, INTENT(in) :: iflag !: 1 => dealing with temperature; 2 => dealing with humidity
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pRer !: roughness Reynolds number [z_0 u*]/Nu_{air} REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pRer !: roughness Reynolds number [z_0 u*]/Nu_{air}
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0 !: roughness length (for momentum) [m] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pz0 !: roughness length (for momentum) [m]
!------------------------------------------------------------------- !-------------------------------------------------------------------
! Scalar Re_r relation from Liu et al. ! Scalar Re_r relation from Liu et al.
REAL(wp), DIMENSION(8,2), PARAMETER :: & REAL(wp), DIMENSION(8,2), PARAMETER :: &
...@@ -1250,7 +1250,7 @@ CONTAINS ...@@ -1250,7 +1250,7 @@ CONTAINS
z0tq_LKB(:,:) = -999._wp z0tq_LKB(:,:) = -999._wp
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zrr = pRer(ji,jj) zrr = pRer(ji,jj)
lfound = .FALSE. lfound = .FALSE.
......
src/OCE/SBC/sbcblk.F90
View file @ 3efbcb17
...@@ -124,7 +124,7 @@ MODULE sbcblk ...@@ -124,7 +124,7 @@ MODULE sbcblk
! !
INTEGER :: nn_iter_algo ! Number of iterations in bulk param. algo ("stable ABL + weak wind" requires more) INTEGER :: nn_iter_algo ! Number of iterations in bulk param. algo ("stable ABL + weak wind" requires more)
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: theta_zu, q_zu ! air temp. and spec. hum. at wind speed height (L15 bulk scheme) REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: theta_zu, q_zu ! air temp. and spec. hum. at wind speed height (L15 bulk scheme)
#if defined key_si3 #if defined key_si3
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: Cd_ice , Ch_ice , Ce_ice !#LB transfert coefficients over ice REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: Cd_ice , Ch_ice , Ce_ice !#LB transfert coefficients over ice
...@@ -180,7 +180,7 @@ CONTAINS ...@@ -180,7 +180,7 @@ CONTAINS
!!------------------------------------------------------------------- !!-------------------------------------------------------------------
!! *** ROUTINE sbc_blk_alloc *** !! *** ROUTINE sbc_blk_alloc ***
!!------------------------------------------------------------------- !!-------------------------------------------------------------------
ALLOCATE( theta_zu(jpi,jpj), q_zu(jpi,jpj), STAT=sbc_blk_alloc ) ALLOCATE( theta_zu(A2D(0)), q_zu(A2D(0)), STAT=sbc_blk_alloc )
CALL mpp_sum ( 'sbcblk', sbc_blk_alloc ) CALL mpp_sum ( 'sbcblk', sbc_blk_alloc )
IF( sbc_blk_alloc /= 0 ) CALL ctl_stop( 'STOP', 'sbc_blk_alloc: failed to allocate arrays' ) IF( sbc_blk_alloc /= 0 ) CALL ctl_stop( 'STOP', 'sbc_blk_alloc: failed to allocate arrays' )
END FUNCTION sbc_blk_alloc END FUNCTION sbc_blk_alloc
...@@ -190,8 +190,7 @@ CONTAINS ...@@ -190,8 +190,7 @@ CONTAINS
!!------------------------------------------------------------------- !!-------------------------------------------------------------------
!! *** ROUTINE sbc_blk_ice_alloc *** !! *** ROUTINE sbc_blk_ice_alloc ***
!!------------------------------------------------------------------- !!-------------------------------------------------------------------
ALLOCATE( Cd_ice (jpi,jpj), Ch_ice (jpi,jpj), Ce_ice (jpi,jpj), & ALLOCATE( Cd_ice(A2D(0)), Ch_ice(A2D(0)), Ce_ice(A2D(0)), theta_zu_i(A2D(0)), q_zu_i(A2D(0)), STAT=sbc_blk_ice_alloc )
& theta_zu_i(jpi,jpj), q_zu_i(jpi,jpj), STAT=sbc_blk_ice_alloc )
CALL mpp_sum ( 'sbcblk', sbc_blk_ice_alloc ) CALL mpp_sum ( 'sbcblk', sbc_blk_ice_alloc )
IF( sbc_blk_ice_alloc /= 0 ) CALL ctl_stop( 'STOP', 'sbc_blk_ice_alloc: failed to allocate arrays' ) IF( sbc_blk_ice_alloc /= 0 ) CALL ctl_stop( 'STOP', 'sbc_blk_ice_alloc: failed to allocate arrays' )
END FUNCTION sbc_blk_ice_alloc END FUNCTION sbc_blk_ice_alloc
...@@ -362,7 +361,7 @@ CONTAINS ...@@ -362,7 +361,7 @@ CONTAINS
ipka = 1 ipka = 1
ENDIF ENDIF
! !
ALLOCATE( sf(jfpr)%fnow(jpi,jpj,ipka) ) ALLOCATE( sf(jfpr)%fnow(A2D(0),ipka) )
! !
IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN !-- not used field --! (only now allocated and set to default) IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN !-- not used field --! (only now allocated and set to default)
IF( jfpr == jp_slp ) THEN IF( jfpr == jp_slp ) THEN
...@@ -384,7 +383,7 @@ CONTAINS ...@@ -384,7 +383,7 @@ CONTAINS
CALL ctl_stop( ctmp1 ) CALL ctl_stop( ctmp1 )
ENDIF ENDIF
ELSE !-- used field --! ELSE !-- used field --!
IF( sf(jfpr)%ln_tint ) ALLOCATE( sf(jfpr)%fdta(jpi,jpj,ipka,2) ) ! allocate array for temporal interpolation IF( sf(jfpr)%ln_tint ) ALLOCATE( sf(jfpr)%fdta(A2D(0),ipka,2) ) ! allocate array for temporal interpolation
! !
IF( sf(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * sf(jfpr)%freqh), nn_fsbc * NINT(rn_Dt) ) /= 0 ) & IF( sf(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * sf(jfpr)%freqh), nn_fsbc * NINT(rn_Dt) ) /= 0 ) &
& CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rn_Dt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.', & & CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rn_Dt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.', &
...@@ -493,7 +492,7 @@ CONTAINS ...@@ -493,7 +492,7 @@ CONTAINS
!! the stress is assumed to be in the (i,j) mesh referential !! the stress is assumed to be in the (i,j) mesh referential
!! !!
!! ** Action : defined at each time-step at the air-sea interface !! ** Action : defined at each time-step at the air-sea interface
!! - utau, vtau i- and j-component of the wind stress !! - utau, vtau i- and j-component of the wind stress at T-point
!! - taum wind stress module at T-point !! - taum wind stress module at T-point
!! - wndm wind speed module at T-point over free ocean or leads in presence of sea-ice !! - wndm wind speed module at T-point over free ocean or leads in presence of sea-ice
!! - qns, qsr non-solar and solar heat fluxes !! - qns, qsr non-solar and solar heat fluxes
...@@ -505,9 +504,10 @@ CONTAINS ...@@ -505,9 +504,10 @@ CONTAINS
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
INTEGER, INTENT(in) :: kt ! ocean time step INTEGER, INTENT(in) :: kt ! ocean time step
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: zssq, zcd_du, zsen, zlat, zevp, zpre, ztheta REAL(wp), DIMENSION(A2D(0)) :: zssq, zcd_du, zsen, zlat, zevp, zpre, ztheta
REAL(wp) :: ztst REAL(wp) :: ztst
LOGICAL :: llerr LOGICAL :: llerr
INTEGER :: ji, jj
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step
...@@ -515,7 +515,8 @@ CONTAINS ...@@ -515,7 +515,8 @@ CONTAINS
! Sanity/consistence test on humidity at first time step to detect potential screw-up: ! Sanity/consistence test on humidity at first time step to detect potential screw-up:
IF( kt == nit000 ) THEN IF( kt == nit000 ) THEN
! mean humidity over ocean on proc ! mean humidity over ocean on proc
ztst = glob_sum( 'sbcblk', sf(jp_humi)%fnow(:,:,1) * e1e2t(:,:) * tmask(:,:,1) ) / glob_sum( 'sbcblk', e1e2t(:,:) * tmask(:,:,1) ) ztst = glob_sum( 'sbcblk', sf(jp_humi)%fnow(:,:,1) * e1e2t(A2D(0)) * smask0(:,:) ) &
& / glob_sum( 'sbcblk', e1e2t(A2D(0)) * smask0(:,:) )
llerr = .FALSE. llerr = .FALSE.
SELECT CASE( nhumi ) SELECT CASE( nhumi )
CASE( np_humi_sph ) ! specific humidity => expect: 0. <= something < 0.065 [kg/kg] (0.061 is saturation at 45degC !!!) CASE( np_humi_sph ) ! specific humidity => expect: 0. <= something < 0.065 [kg/kg] (0.061 is saturation at 45degC !!!)
...@@ -568,7 +569,7 @@ CONTAINS ...@@ -568,7 +569,7 @@ CONTAINS
! !
CALL blk_oce_1( kt, sf(jp_wndi )%fnow(:,:,1), sf(jp_wndj )%fnow(:,:,1), & ! <<= in CALL blk_oce_1( kt, sf(jp_wndi )%fnow(:,:,1), sf(jp_wndj )%fnow(:,:,1), & ! <<= in
& theta_air_zt(:,:), q_air_zt(:,:), & ! <<= in & theta_air_zt(:,:), q_air_zt(:,:), & ! <<= in
& sf(jp_slp )%fnow(:,:,1), sst_m, ssu_m, ssv_m, & ! <<= in & sf(jp_slp )%fnow(:,:,1), sst_m(A2D(0)), ssu_m(A2D(0)), ssv_m(A2D(0)), & ! <<= in
& sf(jp_uoatm)%fnow(:,:,1), sf(jp_voatm)%fnow(:,:,1), & ! <<= in & sf(jp_uoatm)%fnow(:,:,1), sf(jp_voatm)%fnow(:,:,1), & ! <<= in
& sf(jp_qsr )%fnow(:,:,1), sf(jp_qlw )%fnow(:,:,1), & ! <<= in (wl/cs) & sf(jp_qsr )%fnow(:,:,1), sf(jp_qlw )%fnow(:,:,1), & ! <<= in (wl/cs)
& tsk_m, zssq, zcd_du, zsen, zlat, zevp ) ! =>> out & tsk_m, zssq, zcd_du, zsen, zlat, zevp ) ! =>> out
...@@ -600,7 +601,9 @@ CONTAINS ...@@ -600,7 +601,9 @@ CONTAINS
IF( ln_trcdc2dm ) THEN ! diurnal cycle in TOP IF( ln_trcdc2dm ) THEN ! diurnal cycle in TOP
IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
IF( ln_dm2dc ) THEN IF( ln_dm2dc ) THEN
qsr_mean(:,:) = ( 1. - albo ) * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1) DO_2D( 0, 0, 0, 0 )
qsr_mean(ji,jj) = ( 1. - albo ) * sf(jp_qsr)%fnow(ji,jj,1) * smask0(ji,jj)
END_2D
ELSE ELSE
ncpl_qsr_freq = sf(jp_qsr)%freqh * 3600 ! qsr_mean will be computed in TOP ncpl_qsr_freq = sf(jp_qsr)%freqh * 3600 ! qsr_mean will be computed in TOP
ENDIF ENDIF
...@@ -611,10 +614,10 @@ CONTAINS ...@@ -611,10 +614,10 @@ CONTAINS
END SUBROUTINE sbc_blk END SUBROUTINE sbc_blk
SUBROUTINE blk_oce_1( kt, pwndi, pwndj, ptair, pqair, & ! inp SUBROUTINE blk_oce_1( kt, pwndi, pwndj, ptair, pqair, & ! <<= in
& pslp , pst , pu , pv, & ! inp & pslp , pst , pu , pv, & ! <<= in
& puatm, pvatm, pdqsr , pdqlw , & ! inp & puatm, pvatm, pdqsr , pdqlw , & ! <<= in
& ptsk , pssq , pcd_du, psen, plat, pevp ) ! out & ptsk , pssq , pcd_du, psen, plat, pevp ) ! =>> out
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
!! *** ROUTINE blk_oce_1 *** !! *** ROUTINE blk_oce_1 ***
!! !!
...@@ -631,40 +634,39 @@ CONTAINS ...@@ -631,40 +634,39 @@ CONTAINS
!! - plat : latent heat flux (W/m^2) !! - plat : latent heat flux (W/m^2)
!! - pevp : evaporation (mm/s) #lolo !! - pevp : evaporation (mm/s) #lolo
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! time step index INTEGER , INTENT(in ) :: kt ! time step index
REAL(wp), INTENT(in ), DIMENSION(:,:) :: pwndi ! atmospheric wind at T-point [m/s] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pwndi ! atmospheric wind at T-point [m/s]
REAL(wp), INTENT(in ), DIMENSION(:,:) :: pwndj ! atmospheric wind at T-point [m/s] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pwndj ! atmospheric wind at T-point [m/s]
REAL(wp), INTENT(in ), DIMENSION(:,:) :: pqair ! specific humidity at T-points [kg/kg] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pqair ! specific humidity at T-points [kg/kg]
REAL(wp), INTENT(in ), DIMENSION(:,:) :: ptair ! potential temperature at T-points [Kelvin] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: ptair ! potential temperature at T-points [Kelvin]
REAL(wp), INTENT(in ), DIMENSION(:,:) :: pslp ! sea-level pressure [Pa] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pslp ! sea-level pressure [Pa]
REAL(wp), INTENT(in ), DIMENSION(:,:) :: pst ! surface temperature [Celsius] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pst ! surface temperature [Celsius]
REAL(wp), INTENT(in ), DIMENSION(:,:) :: pu ! surface current at U-point (i-component) [m/s] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pu ! surface current at U-point (i-component) [m/s]
REAL(wp), INTENT(in ), DIMENSION(:,:) :: pv ! surface current at V-point (j-component) [m/s] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pv ! surface current at V-point (j-component) [m/s]
REAL(wp), INTENT(in ), DIMENSION(:,:) :: puatm ! surface current seen by the atm at T-point (i-component) [m/s] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: puatm ! surface current seen by the atm at T-point (i-component) [m/s]
REAL(wp), INTENT(in ), DIMENSION(:,:) :: pvatm ! surface current seen by the atm at T-point (j-component) [m/s] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pvatm ! surface current seen by the atm at T-point (j-component) [m/s]
REAL(wp), INTENT(in ), DIMENSION(:,:) :: pdqsr ! downwelling solar (shortwave) radiation at surface [W/m^2] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pdqsr ! downwelling solar (shortwave) radiation at surface [W/m^2]
REAL(wp), INTENT(in ), DIMENSION(:,:) :: pdqlw ! downwelling longwave radiation at surface [W/m^2] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pdqlw ! downwelling longwave radiation at surface [W/m^2]
REAL(wp), INTENT( out), DIMENSION(:,:) :: ptsk ! skin temp. (or SST if CS & WL not used) [Celsius] REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: ptsk ! skin temp. (or SST if CS & WL not used) [Celsius]
REAL(wp), INTENT( out), DIMENSION(:,:) :: pssq ! specific humidity at pst [kg/kg] REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: pssq ! specific humidity at pst [kg/kg]
REAL(wp), INTENT( out), DIMENSION(:,:) :: pcd_du REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: pcd_du
REAL(wp), INTENT( out), DIMENSION(:,:) :: psen REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: psen
REAL(wp), INTENT( out), DIMENSION(:,:) :: plat REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: plat
REAL(wp), INTENT( out), DIMENSION(:,:) :: pevp REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: pevp
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zztmp ! local variable REAL(wp) :: zztmp ! local variable
REAL(wp) :: zstmax, zstau REAL(wp) :: zstmax, zstau
#if defined key_cyclone #if defined key_cyclone
REAL(wp), DIMENSION(jpi,jpj) :: zwnd_i, zwnd_j ! wind speed components at T-point REAL(wp), DIMENSION(A2D(0)) :: zwnd_i, zwnd_j ! wind speed components at T-point
#endif #endif
REAL(wp), DIMENSION(jpi,jpj) :: ztau_i, ztau_j ! wind stress components at T-point REAL(wp), DIMENSION(A2D(0)) :: zU_zu ! bulk wind speed at height zu [m/s]
REAL(wp), DIMENSION(jpi,jpj) :: zU_zu ! bulk wind speed at height zu [m/s] REAL(wp), DIMENSION(A2D(0)) :: zcd_oce ! momentum transfert coefficient over ocean
REAL(wp), DIMENSION(jpi,jpj) :: zcd_oce ! momentum transfert coefficient over ocean REAL(wp), DIMENSION(A2D(0)) :: zch_oce ! sensible heat transfert coefficient over ocean
REAL(wp), DIMENSION(jpi,jpj) :: zch_oce ! sensible heat transfert coefficient over ocean REAL(wp), DIMENSION(A2D(0)) :: zce_oce ! latent heat transfert coefficient over ocean
REAL(wp), DIMENSION(jpi,jpj) :: zce_oce ! latent heat transfert coefficient over ocean REAL(wp), DIMENSION(A2D(0)) :: zsspt ! potential sea-surface temperature [K]
REAL(wp), DIMENSION(jpi,jpj) :: zsspt ! potential sea-surface temperature [K] REAL(wp), DIMENSION(A2D(0)) :: zpre, ztabs ! air pressure [Pa] & absolute temperature [K]
REAL(wp), DIMENSION(jpi,jpj) :: zpre, ztabs ! air pressure [Pa] & absolute temperature [K] REAL(wp), DIMENSION(A2D(0)) :: zztmp1, zztmp2
REAL(wp), DIMENSION(jpi,jpj) :: zztmp1, zztmp2
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
! !
! local scalars ( place there for vector optimisation purposes) ! local scalars ( place there for vector optimisation purposes)
...@@ -686,7 +688,7 @@ CONTAINS ...@@ -686,7 +688,7 @@ CONTAINS
zwnd_i(:,:) = 0._wp zwnd_i(:,:) = 0._wp
zwnd_j(:,:) = 0._wp zwnd_j(:,:) = 0._wp
CALL wnd_cyc( kt, zwnd_i, zwnd_j ) ! add analytical tropical cyclone (Vincent et al. JGR 2012) CALL wnd_cyc( kt, zwnd_i, zwnd_j ) ! add analytical tropical cyclone (Vincent et al. JGR 2012)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zwnd_i(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj) zwnd_i(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj)
zwnd_j(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj) zwnd_j(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj)
! ... scalar wind at T-point (not masked) ! ... scalar wind at T-point (not masked)
...@@ -694,23 +696,21 @@ CONTAINS ...@@ -694,23 +696,21 @@ CONTAINS
END_2D END_2D
#else #else
! ... scalar wind module at T-point (not masked) ! ... scalar wind module at T-point (not masked)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
wndm(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) wndm(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) )
END_2D END_2D
#endif #endif
! ----------------------------------------------------------------------------- ! ! ----------------------------------------------------------------------------- !
! I Solar FLUX ! ! I Solar FLUX !
! ----------------------------------------------------------------------------- ! ! ----------------------------------------------------------------------------- !
! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle ! Short Wave ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle
zztmp = 1. - albo
IF( ln_dm2dc ) THEN IF( ln_dm2dc ) THEN
qsr(:,:) = zztmp * sbc_dcy( pdqsr(:,:) ) * tmask(:,:,1) qsr(:,:) = ( 1._wp - albo ) * sbc_dcy( pdqsr(:,:) ) * smask0(:,:)
ELSE ELSE
qsr(:,:) = zztmp * pdqsr(:,:) * tmask(:,:,1) qsr(:,:) = ( 1._wp - albo ) * pdqsr(:,:) * smask0(:,:)
ENDIF ENDIF
! ----------------------------------------------------------------------------- ! ! ----------------------------------------------------------------------------- !
! II Turbulent FLUXES ! ! II Turbulent FLUXES !
! ----------------------------------------------------------------------------- ! ! ----------------------------------------------------------------------------- !
...@@ -718,69 +718,62 @@ CONTAINS ...@@ -718,69 +718,62 @@ CONTAINS
! specific humidity at SST ! specific humidity at SST
pssq(:,:) = rdct_qsat_salt * q_sat( ptsk(:,:), pslp(:,:) ) pssq(:,:) = rdct_qsat_salt * q_sat( ptsk(:,:), pslp(:,:) )
! Backup "bulk SST" and associated spec. hum.
IF( ln_skin_cs .OR. ln_skin_wl ) THEN IF( ln_skin_cs .OR. ln_skin_wl ) THEN
!! Backup "bulk SST" and associated spec. hum.
zztmp1(:,:) = zsspt(:,:) zztmp1(:,:) = zsspt(:,:)
zztmp2(:,:) = pssq(:,:) zztmp2(:,:) = pssq (:,:)
ENDIF ENDIF
!! Time to call the user-selected bulk parameterization for ! transfer coefficients (Cd, Ch, Ce at T-point, and more)
!! == transfer coefficients ==! Cd, Ch, Ce at T-point, and more... SELECT CASE( nblk ) ! user-selected bulk parameterization
SELECT CASE( nblk ) !
CASE( np_NCAR ) CASE( np_NCAR )
CALL turb_ncar ( rn_zqt, rn_zu, zsspt, ptair, pssq, pqair, wndm, & CALL turb_ncar ( rn_zqt, rn_zu, zsspt, ptair, pssq, pqair, wndm, &
& zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu , & & zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu , &
& nb_iter=nn_iter_algo ) & nb_iter=nn_iter_algo )
!
CASE( np_COARE_3p0 ) CASE( np_COARE_3p0 )
CALL turb_coare3p0( kt, rn_zqt, rn_zu, zsspt, ptair, pssq, pqair, wndm, & CALL turb_coare3p0( kt, rn_zqt, rn_zu, zsspt, ptair, pssq, pqair, wndm, &
& ln_skin_cs, ln_skin_wl, & & ln_skin_cs, ln_skin_wl, &
& zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu, & & zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu, &
& nb_iter=nn_iter_algo, & & nb_iter=nn_iter_algo, &
& Qsw=qsr(:,:), rad_lw=pdqlw(:,:), slp=pslp(:,:) ) & Qsw=qsr(:,:), rad_lw=pdqlw(:,:), slp=pslp(:,:) )
!
CASE( np_COARE_3p6 ) CASE( np_COARE_3p6 )
CALL turb_coare3p6( kt, rn_zqt, rn_zu, zsspt, ptair, pssq, pqair, wndm, & CALL turb_coare3p6( kt, rn_zqt, rn_zu, zsspt, ptair, pssq, pqair, wndm, &
& ln_skin_cs, ln_skin_wl, & & ln_skin_cs, ln_skin_wl, &
& zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu, & & zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu, &
& nb_iter=nn_iter_algo, & & nb_iter=nn_iter_algo, &
& Qsw=qsr(:,:), rad_lw=pdqlw(:,:), slp=pslp(:,:) ) & Qsw=qsr(:,:), rad_lw=pdqlw(:,:), slp=pslp(:,:) )
!
CASE( np_ECMWF ) CASE( np_ECMWF )
CALL turb_ecmwf ( kt, rn_zqt, rn_zu, zsspt, ptair, pssq, pqair, wndm, & CALL turb_ecmwf ( kt, rn_zqt, rn_zu, zsspt, ptair, pssq, pqair, wndm, &
& ln_skin_cs, ln_skin_wl, & & ln_skin_cs, ln_skin_wl, &
& zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu, & & zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu, &
& nb_iter=nn_iter_algo, & & nb_iter=nn_iter_algo, &
& Qsw=qsr(:,:), rad_lw=pdqlw(:,:), slp=pslp(:,:) ) & Qsw=qsr(:,:), rad_lw=pdqlw(:,:), slp=pslp(:,:) )
!
CASE( np_ANDREAS ) CASE( np_ANDREAS )
CALL turb_andreas ( rn_zqt, rn_zu, zsspt, ptair, pssq, pqair, wndm, & CALL turb_andreas ( rn_zqt, rn_zu, zsspt, ptair, pssq, pqair, wndm, &
& zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu , & & zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu, &
& nb_iter=nn_iter_algo ) & nb_iter=nn_iter_algo )
!
CASE DEFAULT CASE DEFAULT
CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk parameterizaton selected' ) CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk parameterizaton selected' )
!
END SELECT END SELECT
IF( iom_use('Cd_oce') ) CALL iom_put("Cd_oce", zcd_oce * tmask(:,:,1)) ! outputs
IF( iom_use('Ce_oce') ) CALL iom_put("Ce_oce", zce_oce * tmask(:,:,1)) IF( iom_use('Cd_oce') ) CALL iom_put( "Cd_oce", zcd_oce * smask0(:,:) )
IF( iom_use('Ch_oce') ) CALL iom_put("Ch_oce", zch_oce * tmask(:,:,1)) IF( iom_use('Ce_oce') ) CALL iom_put( "Ce_oce", zce_oce * smask0(:,:) )
IF( iom_use('Ch_oce') ) CALL iom_put( "Ch_oce", zch_oce * smask0(:,:) )
!! LB: mainly here for debugging purpose: !! LB: mainly here for debugging purpose:
IF( iom_use('theta_zt') ) CALL iom_put("theta_zt", (ptair-rt0) * tmask(:,:,1)) ! potential temperature at z=zt IF( iom_use('theta_zt') ) CALL iom_put( "theta_zt", (ptair-rt0) * smask0(:,:) ) ! potential temperature at z=zt
IF( iom_use('q_zt') ) CALL iom_put("q_zt", pqair * tmask(:,:,1)) ! specific humidity " IF( iom_use('q_zt') ) CALL iom_put( "q_zt", pqair * smask0(:,:) ) ! specific humidity "
IF( iom_use('theta_zu') ) CALL iom_put("theta_zu", (theta_zu -rt0) * tmask(:,:,1)) ! potential temperature at z=zu IF( iom_use('theta_zu') ) CALL iom_put( "theta_zu", (theta_zu -rt0) * smask0(:,:) ) ! potential temperature at z=zu
IF( iom_use('q_zu') ) CALL iom_put("q_zu", q_zu * tmask(:,:,1)) ! specific humidity " IF( iom_use('q_zu') ) CALL iom_put( "q_zu", q_zu * smask0(:,:) ) ! specific humidity "
IF( iom_use('ssq') ) CALL iom_put("ssq", pssq * tmask(:,:,1)) ! saturation specific humidity at z=0 IF( iom_use('ssq') ) CALL iom_put( "ssq", pssq * smask0(:,:) ) ! saturation specific humidity at z=0
IF( iom_use('wspd_blk') ) CALL iom_put("wspd_blk", zU_zu * tmask(:,:,1)) ! bulk wind speed at z=zu IF( iom_use('wspd_blk') ) CALL iom_put( "wspd_blk", zU_zu * smask0(:,:) ) ! bulk wind speed at z=zu
! In the presence of sea-ice we do not use the cool-skin/warm-layer update of zsspt, pssq & ptsk from turb_*()
IF( ln_skin_cs .OR. ln_skin_wl ) THEN IF( ln_skin_cs .OR. ln_skin_wl ) THEN
!! In the presence of sea-ice we forget about the cool-skin/warm-layer update of zsspt, pssq & ptsk: WHERE ( fr_i(A2D(0)) > 0.001_wp )
WHERE ( fr_i(:,:) > 0.001_wp )
! sea-ice present, we forget about the update, using what we backed up before call to turb_*()
zsspt(:,:) = zztmp1(:,:) zsspt(:,:) = zztmp1(:,:)
pssq(:,:) = zztmp2(:,:) pssq (:,:) = zztmp2(:,:)
END WHERE END WHERE
! apply potential temperature increment to abolute SST ! apply potential temperature increment to abolute SST
ptsk(:,:) = ptsk(:,:) + ( zsspt(:,:) - zztmp1(:,:) ) ptsk(:,:) = ptsk(:,:) + ( zsspt(:,:) - zztmp1(:,:) )
...@@ -791,7 +784,7 @@ CONTAINS ...@@ -791,7 +784,7 @@ CONTAINS
IF( ln_abl ) THEN !== ABL formulation ==! multiplication by rho_air and turbulent fluxes computation done in ablstp IF( ln_abl ) THEN !== ABL formulation ==! multiplication by rho_air and turbulent fluxes computation done in ablstp
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zztmp = zU_zu(ji,jj) zztmp = zU_zu(ji,jj)
wndm(ji,jj) = zztmp ! Store zU_zu in wndm to compute ustar2 in ablmod wndm(ji,jj) = zztmp ! Store zU_zu in wndm to compute ustar2 in ablmod
pcd_du(ji,jj) = zztmp * zcd_oce(ji,jj) pcd_du(ji,jj) = zztmp * zcd_oce(ji,jj)
...@@ -803,81 +796,66 @@ CONTAINS ...@@ -803,81 +796,66 @@ CONTAINS
ELSE !== BLK formulation ==! turbulent fluxes computation ELSE !== BLK formulation ==! turbulent fluxes computation
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zpre(ji,jj) = pres_temp( q_zu(ji,jj), pslp(ji,jj), rn_zu, ptpot=theta_zu(ji,jj), pta=ztabs(ji,jj) ) zpre(ji,jj) = pres_temp( q_zu(ji,jj), pslp(ji,jj), rn_zu, ptpot=theta_zu(ji,jj), pta=ztabs(ji,jj) )
rhoa(ji,jj) = rho_air( ztabs(ji,jj), q_zu(ji,jj), zpre(ji,jj) ) rhoa(ji,jj) = rho_air( ztabs(ji,jj), q_zu(ji,jj), zpre(ji,jj) )
END_2D END_2D
CALL BULK_FORMULA( rn_zu, zsspt(:,:), pssq(:,:), theta_zu(:,:), q_zu(:,:), & CALL BULK_FORMULA( rn_zu, zsspt(:,:), pssq(:,:), theta_zu(:,:), q_zu(:,:), &
& zcd_oce(:,:), zch_oce(:,:), zce_oce(:,:), & & zcd_oce(:,:), zch_oce(:,:), zce_oce(:,:), &
& wndm(:,:), zU_zu(:,:), pslp(:,:), rhoa(:,:), & & wndm(:,:), zU_zu(:,:), pslp(:,:), rhoa(:,:), &
& taum(:,:), psen(:,:), plat(:,:), & & taum(:,:), psen(:,:), plat(:,:), &
& pEvap=pevp(:,:), pfact_evap=rn_efac ) & pEvap=pevp(:,:), pfact_evap=rn_efac )
psen(:,:) = psen(:,:) * tmask(:,:,1) psen(:,:) = psen(:,:) * smask0(:,:)
plat(:,:) = plat(:,:) * tmask(:,:,1) plat(:,:) = plat(:,:) * smask0(:,:)
taum(:,:) = taum(:,:) * tmask(:,:,1) taum(:,:) = taum(:,:) * smask0(:,:)
pevp(:,:) = pevp(:,:) * tmask(:,:,1) pevp(:,:) = pevp(:,:) * smask0(:,:)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
IF( wndm(ji,jj) > 0._wp ) THEN IF( wndm(ji,jj) > 0._wp ) THEN
zztmp = taum(ji,jj) / wndm(ji,jj) zztmp = taum(ji,jj) / wndm(ji,jj)
#if defined key_cyclone #if defined key_cyclone
ztau_i(ji,jj) = zztmp * zwnd_i(ji,jj) utau(ji,jj) = zztmp * zwnd_i(ji,jj)
ztau_j(ji,jj) = zztmp * zwnd_j(ji,jj) vtau(ji,jj) = zztmp * zwnd_j(ji,jj)
#else #else
ztau_i(ji,jj) = zztmp * pwndi(ji,jj) utau(ji,jj) = zztmp * pwndi(ji,jj)
ztau_j(ji,jj) = zztmp * pwndj(ji,jj) vtau(ji,jj) = zztmp * pwndj(ji,jj)
#endif #endif
ELSE ELSE
ztau_i(ji,jj) = 0._wp utau(ji,jj) = 0._wp
ztau_j(ji,jj) = 0._wp vtau(ji,jj) = 0._wp
ENDIF ENDIF
END_2D END_2D
IF( ln_crt_fbk ) THEN ! aply eq. 10 and 11 of Renault et al. 2020 (doi: 10.1029/2019MS001715) IF( ln_crt_fbk ) THEN ! aply eq. 10 and 11 of Renault et al. 2020 (doi: 10.1029/2019MS001715)
zstmax = MIN( rn_stau_a * 3._wp + rn_stau_b, 0._wp ) ! set the max value of Stau corresponding to a wind of 3 m/s (<0) zstmax = MIN( rn_stau_a * 3._wp + rn_stau_b, 0._wp ) ! set the max value of Stau corresponding to a wind of 3 m/s (<0)
DO_2D( 0, 1, 0, 1 ) ! end at jpj and jpi, as ztau_j(ji,jj+1) ztau_i(ji+1,jj) used in the next loop DO_2D( 0, 0, 0, 0 )
zstau = MIN( rn_stau_a * wndm(ji,jj) + rn_stau_b, zstmax ) ! stau (<0) must be smaller than zstmax zstau = MIN( rn_stau_a * wndm(ji,jj) + rn_stau_b, zstmax ) * smask0(ji,jj) ! stau (<0) must be smaller than zstmax
ztau_i(ji,jj) = ztau_i(ji,jj) + zstau * ( 0.5_wp * ( pu(ji-1,jj ) + pu(ji,jj) ) - puatm(ji,jj) ) utau(ji,jj) = utau(ji,jj) + zstau * ( 0.5_wp * ( pu(ji-1,jj ) + pu(ji,jj) ) - puatm(ji,jj) )
ztau_j(ji,jj) = ztau_j(ji,jj) + zstau * ( 0.5_wp * ( pv(ji ,jj-1) + pv(ji,jj) ) - pvatm(ji,jj) ) vtau(ji,jj) = vtau(ji,jj) + zstau * ( 0.5_wp * ( pv(ji ,jj-1) + pv(ji,jj) ) - pvatm(ji,jj) )
taum(ji,jj) = SQRT( ztau_i(ji,jj) * ztau_i(ji,jj) + ztau_j(ji,jj) * ztau_j(ji,jj) ) taum(ji,jj) = SQRT( utau(ji,jj) * utau(ji,jj) + vtau(ji,jj) * vtau(ji,jj) )
END_2D END_2D
CALL lbc_lnk( 'sbcblk', utau, 'T', -1._wp, vtau, 'T', -1._wp )
ENDIF ENDIF
! ... utau, vtau at U- and V_points, resp. ! Saving open-ocean wind-stress (module and components)
! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines CALL iom_put( "taum_oce", taum(:,:) ) ! wind stress module
! Note that coastal wind stress is not used in the code... so this extra care has no effect ! ! LB: These 2 lines below mostly here for 'STATION_ASF' test-case
DO_2D( 0, 0, 0, 0 ) ! start loop at 2, in case ln_crt_fbk = T CALL iom_put( "utau_oce", utau(A2D(0)) ) ! utau
utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( ztau_i(ji,jj) + ztau_i(ji+1,jj ) ) & CALL iom_put( "vtau_oce", vtau(A2D(0)) ) ! vtau
& * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1))
vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( ztau_j(ji,jj) + ztau_j(ji ,jj+1) ) &
& * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1))
END_2D
IF( ln_crt_fbk ) THEN
CALL lbc_lnk( 'sbcblk', utau, 'U', -1._wp, vtau, 'V', -1._wp, taum, 'T', 1._wp )
ELSE
CALL lbc_lnk( 'sbcblk', utau, 'U', -1._wp, vtau, 'V', -1._wp )
ENDIF
! Saving open-ocean wind-stress (module and components) on T-points:
CALL iom_put( "taum_oce", taum(:,:)*tmask(:,:,1) ) ! output wind stress module
!#LB: These 2 lines below mostly here for 'STATION_ASF' test-case, otherwize "utau" (U-grid) and vtau" (V-grid) does the job in: [DYN/dynatf.F90])
CALL iom_put( "utau_oce", ztau_i(:,:)*tmask(:,:,1) ) ! utau at T-points!
CALL iom_put( "vtau_oce", ztau_j(:,:)*tmask(:,:,1) ) ! vtau at T-points!
IF(sn_cfctl%l_prtctl) THEN IF(sn_cfctl%l_prtctl) THEN
CALL prt_ctl( tab2d_1=pssq , clinfo1=' blk_oce_1: pssq : ', mask1=tmask ) CALL prt_ctl( tab2d_1=pssq , clinfo1=' blk_oce_1: pssq : ', mask1=tmask )
CALL prt_ctl( tab2d_1=wndm , clinfo1=' blk_oce_1: wndm : ', mask1=tmask ) CALL prt_ctl( tab2d_1=wndm , clinfo1=' blk_oce_1: wndm : ', mask1=tmask )
CALL prt_ctl( tab2d_1=utau , clinfo1=' blk_oce_1: utau : ', mask1=umask, & CALL prt_ctl( tab2d_1=utau , clinfo1=' blk_oce_1: utau : ', mask1=tmask, &
& tab2d_2=vtau , clinfo2=' vtau : ', mask2=vmask ) & tab2d_2=vtau , clinfo2=' vtau : ', mask2=tmask )
CALL prt_ctl( tab2d_1=zcd_oce, clinfo1=' blk_oce_1: Cd : ', mask1=tmask ) CALL prt_ctl( tab2d_1=zcd_oce, clinfo1=' blk_oce_1: Cd : ', mask1=tmask )
ENDIF ENDIF
! !
ENDIF ! ln_blk / ln_abl ENDIF ! ln_blk / ln_abl
ptsk(:,:) = ( ptsk(:,:) - rt0 ) * tmask(:,:,1) ! Back to Celsius ptsk(:,:) = ( ptsk(:,:) - rt0 ) * smask0(:,:) ! Back to Celsius
IF( ln_skin_cs .OR. ln_skin_wl ) THEN IF( ln_skin_cs .OR. ln_skin_wl ) THEN
CALL iom_put( "t_skin" , ptsk ) ! T_skin in Celsius CALL iom_put( "t_skin" , ptsk ) ! T_skin in Celsius
...@@ -896,68 +874,74 @@ CONTAINS ...@@ -896,68 +874,74 @@ CONTAINS
!! at the ocean surface at each time step knowing Cd, Ch, Ce and !! at the ocean surface at each time step knowing Cd, Ch, Ce and
!! atmospheric variables (from ABL or external data) !! atmospheric variables (from ABL or external data)
!! !!
!! ** Outputs : - utau : i-component of the stress at U-point (N/m2) !! ** Outputs : - utau : i-component of the stress at T-point (N/m2)
!! - vtau : j-component of the stress at V-point (N/m2) !! - vtau : j-component of the stress at T-point (N/m2)
!! - taum : Wind stress module at T-point (N/m2) !! - taum : Wind stress module at T-point (N/m2)
!! - wndm : Wind speed module at T-point (m/s) !! - wndm : Wind speed module at T-point (m/s)
!! - qsr : Solar heat flux over the ocean (W/m2) !! - qsr : Solar heat flux over the ocean (W/m2)
!! - qns : Non Solar heat flux over the ocean (W/m2) !! - qns : Non Solar heat flux over the ocean (W/m2)
!! - emp : evaporation minus precipitation (kg/m2/s) !! - emp : evaporation minus precipitation (kg/m2/s)
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
REAL(wp), INTENT(in), DIMENSION(:,:) :: ptair ! potential temperature of air #LB: confirm! REAL(wp), INTENT(in), DIMENSION(A2D(0)) :: ptair ! potential temperature of air #LB: confirm!
REAL(wp), INTENT(in), DIMENSION(:,:) :: pdqlw ! downwelling longwave radiation at surface [W/m^2] REAL(wp), INTENT(in), DIMENSION(A2D(0)) :: pdqlw ! downwelling longwave radiation at surface [W/m^2]
REAL(wp), INTENT(in), DIMENSION(:,:) :: pprec REAL(wp), INTENT(in), DIMENSION(A2D(0)) :: pprec
REAL(wp), INTENT(in), DIMENSION(:,:) :: psnow REAL(wp), INTENT(in), DIMENSION(A2D(0)) :: psnow
REAL(wp), INTENT(in), DIMENSION(:,:) :: ptsk ! SKIN surface temperature [Celsius] REAL(wp), INTENT(in), DIMENSION(A2D(0)) :: ptsk ! SKIN surface temperature [Celsius]
REAL(wp), INTENT(in), DIMENSION(:,:) :: psen REAL(wp), INTENT(in), DIMENSION(A2D(0)) :: psen
REAL(wp), INTENT(in), DIMENSION(:,:) :: plat REAL(wp), INTENT(in), DIMENSION(A2D(0)) :: plat
REAL(wp), INTENT(in), DIMENSION(:,:) :: pevp REAL(wp), INTENT(in), DIMENSION(A2D(0)) :: pevp
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zztmp,zz1,zz2,zz3 ! local variable REAL(wp) :: zztmp,zz1,zz2,zz3 ! local variable
REAL(wp), DIMENSION(jpi,jpj) :: zqlw ! net long wave radiative heat flux REAL(wp), DIMENSION(A2D(0)) :: zqlw ! net long wave radiative heat flux
REAL(wp), DIMENSION(jpi,jpj) :: zcptrain, zcptsnw, zcptn ! Heat content per unit mass (J/kg) REAL(wp), DIMENSION(A2D(0)) :: zcptrain, zcptsnw, zcptn ! Heat content per unit mass (J/kg)
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
! !
! Heat content per unit mass (J/kg) DO_2D( 0, 0, 0, 0 )
zcptrain(:,:) = ( ptair - rt0 ) * rcp * tmask(:,:,1) ! Heat content per unit mass (J/kg)
zcptsnw (:,:) = ( MIN( ptair, rt0 ) - rt0 ) * rcpi * tmask(:,:,1) zcptrain(ji,jj) = ( ptair(ji,jj) - rt0 ) * rcp * smask0(ji,jj)
zcptn (:,:) = ptsk * rcp * tmask(:,:,1) zcptsnw (ji,jj) = ( MIN( ptair(ji,jj), rt0 ) - rt0 ) * rcpi * smask0(ji,jj)
! zcptn (ji,jj) = ptsk (ji,jj) * rcp * smask0(ji,jj)
!
END_2D
! ----------------------------------------------------------------------------- ! ! ----------------------------------------------------------------------------- !
! III Net longwave radiative FLUX ! ! III Net longwave radiative FLUX !
! ----------------------------------------------------------------------------- ! ! ----------------------------------------------------------------------------- !
!! #LB: now moved after Turbulent fluxes because must use the skin temperature rather than bulk SST !! #LB: now moved after Turbulent fluxes because must use the skin temperature rather than bulk SST
!! (ptsk is skin temperature if ln_skin_cs==.TRUE. .OR. ln_skin_wl==.TRUE.) !! (ptsk is skin temperature if ln_skin_cs==.TRUE. .OR. ln_skin_wl==.TRUE.)
zqlw(:,:) = qlw_net( pdqlw(:,:), ptsk(:,:)+rt0 ) zqlw(:,:) = qlw_net( pdqlw(:,:), ptsk(:,:)+rt0 )
! ----------------------------------------------------------------------------- ! ! ----------------------------------------------------------------------------- !
! IV Total FLUXES ! ! IV Total FLUXES !
! ----------------------------------------------------------------------------- ! ! ----------------------------------------------------------------------------- !
! !
emp (:,:) = ( pevp(:,:) - pprec(:,:) * rn_pfac ) * tmask(:,:,1) ! mass flux (evap. - precip.) DO_2D( 0, 0, 0, 0 )
! emp (ji,jj) = ( pevp(ji,jj) - pprec(ji,jj) * rn_pfac ) * smask0(ji,jj) ! mass flux (evap. - precip.)
qns(:,:) = zqlw(:,:) + psen(:,:) + plat(:,:) & ! Downward Non Solar !
& - psnow(:,:) * rn_pfac * rLfus & ! remove latent melting heat for solid precip qns(ji,jj) = zqlw(ji,jj) + psen(ji,jj) + plat(ji,jj) & ! Downward Non Solar
& - pevp(:,:) * zcptn(:,:) & ! remove evap heat content at SST & - psnow(ji,jj) * rn_pfac * rLfus & ! remove latent melting heat for solid precip
& + ( pprec(:,:) - psnow(:,:) ) * rn_pfac * zcptrain(:,:) & ! add liquid precip heat content at Tair & - pevp(ji,jj) * zcptn(ji,jj) & ! remove evap heat content at SST
& + psnow(:,:) * rn_pfac * zcptsnw(:,:) ! add solid precip heat content at min(Tair,Tsnow) & + ( pprec(ji,jj) - psnow(ji,jj) ) * rn_pfac * zcptrain(ji,jj) & ! add liquid precip heat content at Tair
qns(:,:) = qns(:,:) * tmask(:,:,1) & + psnow(ji,jj) * rn_pfac * zcptsnw(ji,jj) ! add solid precip heat content at min(Tair,Tsnow)
qns(ji,jj) = qns(ji,jj) * smask0(ji,jj)
END_2D
! !
#if defined key_si3 #if defined key_si3
IF ( nn_ice == 2 ) THEN IF ( nn_ice == 2 ) THEN
qns_oce(:,:) = zqlw(:,:) + psen(:,:) + plat(:,:) ! non solar without emp (only needed by SI3) DO_2D( 0, 0, 0, 0 )
qsr_oce(:,:) = qsr(:,:) qns_oce(ji,jj) = zqlw(ji,jj) + psen(ji,jj) + plat(ji,jj) ! non solar without emp (only needed by SI3)
qsr_oce(ji,jj) = qsr(ji,jj)
END_2D
ENDIF ENDIF
#endif #endif
! !
CALL iom_put( "rho_air" , rhoa*tmask(:,:,1) ) ! output air density [kg/m^3] CALL iom_put( "rho_air" , rhoa*smask0(:,:) ) ! output air density [kg/m^3]
CALL iom_put( "evap_oce" , pevp ) ! evaporation CALL iom_put( "evap_oce" , pevp ) ! evaporation
CALL iom_put( "qlw_oce" , zqlw ) ! output downward longwave heat over the ocean CALL iom_put( "qlw_oce" , zqlw ) ! output downward longwave heat over the ocean
CALL iom_put( "qsb_oce" , psen ) ! output downward sensible heat over the ocean CALL iom_put( "qsb_oce" , psen ) ! output downward sensible heat over the ocean
CALL iom_put( "qla_oce" , plat ) ! output downward latent heat over the ocean CALL iom_put( "qla_oce" , plat ) ! output downward latent heat over the ocean
tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1) ! output total precipitation [kg/m2/s] tprecip(:,:) = pprec(:,:) * rn_pfac * smask0(:,:) ! output total precipitation [kg/m2/s]
sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1) ! output solid precipitation [kg/m2/s] sprecip(:,:) = psnow(:,:) * rn_pfac * smask0(:,:) ! output solid precipitation [kg/m2/s]
CALL iom_put( 'snowpre', sprecip ) ! Snow CALL iom_put( 'snowpre', sprecip ) ! Snow
CALL iom_put( 'precip' , tprecip ) ! Total precipitation CALL iom_put( 'precip' , tprecip ) ! Total precipitation
! !
...@@ -999,32 +983,37 @@ CONTAINS ...@@ -999,32 +983,37 @@ CONTAINS
!! formulea, ice variables and read atmospheric fields. !! formulea, ice variables and read atmospheric fields.
!! NB: ice drag coefficient is assumed to be a constant !! NB: ice drag coefficient is assumed to be a constant
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pslp ! sea-level pressure [Pa] REAL(wp) , INTENT(in ), DIMENSION(A2D(0) ) :: pslp ! sea-level pressure [Pa]
REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pwndi ! atmospheric wind at T-point [m/s] REAL(wp) , INTENT(in ), DIMENSION(A2D(0) ) :: pwndi ! atmospheric wind at T-point [m/s]
REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pwndj ! atmospheric wind at T-point [m/s] REAL(wp) , INTENT(in ), DIMENSION(A2D(0) ) :: pwndj ! atmospheric wind at T-point [m/s]
REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: ptair ! atmospheric potential temperature at T-point [K] REAL(wp) , INTENT(in ), DIMENSION(A2D(0) ) :: ptair ! atmospheric potential temperature at T-point [K]
REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pqair ! atmospheric specific humidity at T-point [kg/kg] REAL(wp) , INTENT(in ), DIMENSION(A2D(0) ) :: pqair ! atmospheric specific humidity at T-point [kg/kg]
REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: puice ! sea-ice velocity on I or C grid [m/s] REAL(wp) , INTENT(in ), DIMENSION(A2D(0) ) :: puice ! sea-ice velocity on I or C grid [m/s]
REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pvice ! " REAL(wp) , INTENT(in ), DIMENSION(A2D(0) ) :: pvice ! "
REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: ptsui ! sea-ice surface temperature [K] REAL(wp) , INTENT(in ), DIMENSION(A2D(0) ) :: ptsui ! sea-ice surface temperature [K]
REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: putaui ! if ln_blk REAL(wp) , INTENT( out), DIMENSION(A2D(0) ), OPTIONAL :: putaui ! if ln_blk
REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: pvtaui ! if ln_blk REAL(wp) , INTENT( out), DIMENSION(A2D(0) ), OPTIONAL :: pvtaui ! if ln_blk
REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: pseni ! if ln_abl REAL(wp) , INTENT( out), DIMENSION(A2D(0) ), OPTIONAL :: pseni ! if ln_abl
REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: pevpi ! if ln_abl REAL(wp) , INTENT( out), DIMENSION(A2D(0) ), OPTIONAL :: pevpi ! if ln_abl
REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: pssqi ! if ln_abl REAL(wp) , INTENT( out), DIMENSION(A2D(0) ), OPTIONAL :: pssqi ! if ln_abl
REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: pcd_dui ! if ln_abl REAL(wp) , INTENT( out), DIMENSION(A2D(0) ), OPTIONAL :: pcd_dui ! if ln_abl
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zootm_su ! sea-ice surface mean temperature REAL(wp) :: zztmp ! temporary scalars
REAL(wp) :: zztmp1, zztmp2 ! temporary scalars REAL(wp), DIMENSION(A2D(0)) :: ztmp, zsipt ! temporary array
REAL(wp), DIMENSION(jpi,jpj) :: ztmp, zsipt ! temporary array REAL(wp), DIMENSION(A2D(0)) :: zmsk00 ! O% concentration ice mask
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
! !
! treshold for outputs
DO_2D( 0, 0, 0, 0 )
zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , fr_i(ji,jj) - 1.e-6_wp ) ) ! 1 if ice, 0 if no ice
END_2D
! ------------------------------------------------------------ ! ! ------------------------------------------------------------ !
! Wind module relative to the moving ice ( U10m - U_ice ) ! ! Wind module relative to the moving ice ( U10m - U_ice ) !
! ------------------------------------------------------------ ! ! ------------------------------------------------------------ !
! C-grid ice dynamics : U & V-points (same as ocean) ! C-grid ice dynamics : U & V-points (same as ocean)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
wndm_ice(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) wndm_ice(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) )
END_2D END_2D
! !
...@@ -1032,9 +1021,9 @@ CONTAINS ...@@ -1032,9 +1021,9 @@ CONTAINS
zsipt(:,:) = theta_exner( ptsui(:,:), pslp(:,:) ) zsipt(:,:) = theta_exner( ptsui(:,:), pslp(:,:) )
! sea-ice <-> atmosphere bulk transfer coefficients ! sea-ice <-> atmosphere bulk transfer coefficients
SELECT CASE( nblk_ice ) SELECT CASE( nblk_ice ) ! user-selected bulk parameterization
!
CASE( np_ice_cst ) CASE( np_ice_cst )
! Constant bulk transfer coefficients over sea-ice: ! Constant bulk transfer coefficients over sea-ice:
Cd_ice(:,:) = rn_Cd_i Cd_ice(:,:) = rn_Cd_i
Ch_ice(:,:) = rn_Ch_i Ch_ice(:,:) = rn_Ch_i
...@@ -1042,73 +1031,61 @@ CONTAINS ...@@ -1042,73 +1031,61 @@ CONTAINS
! no height adjustment, keeping zt values: ! no height adjustment, keeping zt values:
theta_zu_i(:,:) = ptair(:,:) theta_zu_i(:,:) = ptair(:,:)
q_zu_i(:,:) = pqair(:,:) q_zu_i(:,:) = pqair(:,:)
!
CASE( np_ice_an05 ) ! calculate new drag from Lupkes(2015) equations CASE( np_ice_an05 ) ! from Andreas(2005) equations
ztmp(:,:) = q_sat( ptsui(:,:), pslp(:,:), l_ice=.TRUE. ) ! temporary array for SSQ ztmp(:,:) = q_sat( ptsui(:,:), pslp(:,:), l_ice=.TRUE. ) ! temporary array for SSQ
CALL turb_ice_an05( rn_zqt, rn_zu, zsipt, ptair, ztmp, pqair, wndm_ice, & CALL turb_ice_an05( rn_zqt, rn_zu, zsipt, ptair, ztmp, pqair, wndm_ice, &
& Cd_ice, Ch_ice, Ce_ice, theta_zu_i, q_zu_i ) & Cd_ice, Ch_ice, Ce_ice, theta_zu_i, q_zu_i )
!! !
CASE( np_ice_lu12 ) CASE( np_ice_lu12 ) ! from Lupkes(2012) equations
ztmp(:,:) = q_sat( ptsui(:,:), pslp(:,:), l_ice=.TRUE. ) ! temporary array for SSQ ztmp(:,:) = q_sat( ptsui(:,:), pslp(:,:), l_ice=.TRUE. ) ! temporary array for SSQ
CALL turb_ice_lu12( rn_zqt, rn_zu, zsipt, ptair, ztmp, pqair, wndm_ice, fr_i, & CALL turb_ice_lu12( rn_zqt, rn_zu, zsipt, ptair, ztmp, pqair, wndm_ice, fr_i(A2D(0)), &
& Cd_ice, Ch_ice, Ce_ice, theta_zu_i, q_zu_i ) & Cd_ice, Ch_ice, Ce_ice, theta_zu_i, q_zu_i )
!! !
CASE( np_ice_lg15 ) ! calculate new drag from Lupkes(2015) equations CASE( np_ice_lg15 ) ! from Lupkes and Gryanik (2015) equations
ztmp(:,:) = q_sat( ptsui(:,:), pslp(:,:), l_ice=.TRUE. ) ! temporary array for SSQ ztmp(:,:) = q_sat( ptsui(:,:), pslp(:,:), l_ice=.TRUE. ) ! temporary array for SSQ
CALL turb_ice_lg15( rn_zqt, rn_zu, zsipt, ptair, ztmp, pqair, wndm_ice, fr_i, & CALL turb_ice_lg15( rn_zqt, rn_zu, zsipt, ptair, ztmp, pqair, wndm_ice, fr_i(A2D(0)), &
& Cd_ice, Ch_ice, Ce_ice, theta_zu_i, q_zu_i ) & Cd_ice, Ch_ice, Ce_ice, theta_zu_i, q_zu_i )
!! !
END SELECT END SELECT
IF( iom_use('Cd_ice').OR.iom_use('Ce_ice').OR.iom_use('Ch_ice').OR.iom_use('taum_ice').OR.iom_use('utau_ice').OR.iom_use('vtau_ice') ) &
& ztmp(:,:) = ( 1._wp - MAX(0._wp, SIGN( 1._wp, 1.E-6_wp - fr_i )) )*tmask(:,:,1) ! mask for presence of ice !
IF( iom_use('Cd_ice') ) CALL iom_put("Cd_ice", Cd_ice*ztmp)
IF( iom_use('Ce_ice') ) CALL iom_put("Ce_ice", Ce_ice*ztmp)
IF( iom_use('Ch_ice') ) CALL iom_put("Ch_ice", Ch_ice*ztmp)
IF( ln_blk ) THEN IF( ln_blk ) THEN
! ---------------------------------------------------- ! ! ---------------------------------------------------- !
! Wind stress relative to nonmoving ice ( U10m ) ! ! Wind stress relative to nonmoving ice ( U10m ) !
! ---------------------------------------------------- ! ! ---------------------------------------------------- !
! supress moving ice in wind stress computation as we don't know how to do it properly... ! supress moving ice in wind stress computation as we don't know how to do it properly...
DO_2D( 0, 1, 0, 1 ) ! at T point DO_2D( 0, 0, 0, 0 )
zztmp1 = rhoa(ji,jj) * Cd_ice(ji,jj) * wndm_ice(ji,jj) zztmp = rhoa(ji,jj) * Cd_ice(ji,jj) * wndm_ice(ji,jj)
putaui(ji,jj) = zztmp1 * pwndi(ji,jj) putaui(ji,jj) = zztmp * pwndi(ji,jj)
pvtaui(ji,jj) = zztmp1 * pwndj(ji,jj) pvtaui(ji,jj) = zztmp * pwndj(ji,jj)
END_2D END_2D
!#LB: saving the module, and x-y components, of the ai wind-stress at T-points: NOT weighted by the ice concentration !!! ! outputs
IF(iom_use('taum_ice')) CALL iom_put('taum_ice', SQRT( putaui*putaui + pvtaui*pvtaui )*ztmp ) ! LB: not weighted by the ice concentration
!#LB: These 2 lines below mostly here for 'STATION_ASF' test-case, otherwize "utau_oi" (U-grid) and vtau_oi" (V-grid) does the job in: [ICE/icedyn_rhg_evp.F90]) IF( iom_use('taum_ice') ) CALL iom_put( 'taum_ice', SQRT( putaui*putaui + pvtaui*pvtaui ) * zmsk00 )
IF(iom_use('utau_ice')) CALL iom_put("utau_ice", putaui*ztmp) ! utau at T-points! ! LB: These 2 lines below mostly here for 'STATION_ASF' test-case
IF(iom_use('vtau_ice')) CALL iom_put("vtau_ice", pvtaui*ztmp) ! vtau at T-points! IF( iom_use('utau_ice') ) CALL iom_put( "utau_ice", putaui * zmsk00 )
IF( iom_use('vtau_ice') ) CALL iom_put( "vtau_ice", pvtaui * zmsk00 )
! !
DO_2D( 0, 0, 0, 0 ) ! U & V-points (same as ocean). IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=putaui , clinfo1=' blk_ice: putaui : ', mask1=tmask &
!#LB: QUESTION?? so SI3 expects wind stress vector to be provided at U & V points? Not at T-points ? & , tab2d_2=pvtaui , clinfo2=' pvtaui : ', mask2=tmask )
! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology
zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj ,1) )
zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji ,jj+1,1) )
putaui(ji,jj) = zztmp1 * ( putaui(ji,jj) + putaui(ji+1,jj ) )
pvtaui(ji,jj) = zztmp2 * ( pvtaui(ji,jj) + pvtaui(ji ,jj+1) )
END_2D
CALL lbc_lnk( 'sbcblk', putaui, 'U', -1._wp, pvtaui, 'V', -1._wp )
!
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=putaui , clinfo1=' blk_ice: putaui : ', mask1=umask &
& , tab2d_2=pvtaui , clinfo2=' pvtaui : ', mask2=vmask )
ELSE ! ln_abl ELSE ! ln_abl
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
pcd_dui(ji,jj) = wndm_ice(ji,jj) * Cd_ice(ji,jj) pcd_dui(ji,jj) = wndm_ice(ji,jj) * Cd_ice(ji,jj)
pseni (ji,jj) = wndm_ice(ji,jj) * Ch_ice(ji,jj) pseni (ji,jj) = wndm_ice(ji,jj) * Ch_ice(ji,jj)
pevpi (ji,jj) = wndm_ice(ji,jj) * Ce_ice(ji,jj) pevpi (ji,jj) = wndm_ice(ji,jj) * Ce_ice(ji,jj)
END_2D END_2D
pssqi(:,:) = q_sat( ptsui(:,:), pslp(:,:), l_ice=.TRUE. ) ; ! more accurate way to obtain ssq ! pssqi(:,:) = q_sat( ptsui(:,:), pslp(:,:), l_ice=.TRUE. ) ! more accurate way to obtain ssq
ENDIF ! ln_blk / ln_abl ENDIF ! ln_blk / ln_abl
! !
! outputs
IF( iom_use('Cd_ice') ) CALL iom_put( "Cd_ice", Cd_ice * zmsk00 )
IF( iom_use('Ce_ice') ) CALL iom_put( "Ce_ice", Ce_ice * zmsk00 )
IF( iom_use('Ch_ice') ) CALL iom_put( "Ch_ice", Ch_ice * zmsk00 )
!
IF(sn_cfctl%l_prtctl) CALL prt_ctl(tab2d_1=wndm_ice , clinfo1=' blk_ice: wndm_ice : ', mask1=tmask ) IF(sn_cfctl%l_prtctl) CALL prt_ctl(tab2d_1=wndm_ice , clinfo1=' blk_ice: wndm_ice : ', mask1=tmask )
! !
END SUBROUTINE blk_ice_1 END SUBROUTINE blk_ice_1
...@@ -1126,30 +1103,30 @@ CONTAINS ...@@ -1126,30 +1103,30 @@ CONTAINS
!! !!
!! caution : the net upward water flux has with mm/day unit !! caution : the net upward water flux has with mm/day unit
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
REAL(wp), DIMENSION(:,:,:), INTENT(in) :: ptsu ! sea ice surface temperature [K] REAL(wp), DIMENSION(A2D(0),jpl), INTENT(in) :: ptsu ! sea ice surface temperature [K]
REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phs ! snow thickness REAL(wp), DIMENSION(A2D(0),jpl), INTENT(in) :: phs ! snow thickness
REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phi ! ice thickness REAL(wp), DIMENSION(A2D(0),jpl), INTENT(in) :: phi ! ice thickness
REAL(wp), DIMENSION(:,:,:), INTENT(in) :: palb ! ice albedo (all skies) REAL(wp), DIMENSION(A2D(0),jpl), INTENT(in) :: palb ! ice albedo (all skies)
REAL(wp), DIMENSION(:,: ), INTENT(in) :: ptair ! potential temperature of air #LB: okay ??? REAL(wp), DIMENSION(A2D(0) ), INTENT(in) :: ptair ! potential temperature of air #LB: okay ???
REAL(wp), DIMENSION(:,: ), INTENT(in) :: pqair ! specific humidity of air REAL(wp), DIMENSION(A2D(0) ), INTENT(in) :: pqair ! specific humidity of air
REAL(wp), DIMENSION(:,: ), INTENT(in) :: pslp REAL(wp), DIMENSION(A2D(0) ), INTENT(in) :: pslp
REAL(wp), DIMENSION(:,: ), INTENT(in) :: pdqlw REAL(wp), DIMENSION(A2D(0) ), INTENT(in) :: pdqlw
REAL(wp), DIMENSION(:,: ), INTENT(in) :: pprec REAL(wp), DIMENSION(A2D(0) ), INTENT(in) :: pprec
REAL(wp), DIMENSION(:,: ), INTENT(in) :: psnow REAL(wp), DIMENSION(A2D(0) ), INTENT(in) :: psnow
!! !!
INTEGER :: ji, jj, jl ! dummy loop indices INTEGER :: ji, jj, jl ! dummy loop indices
REAL(wp) :: zst, zst3, zsq, zsipt ! local variable REAL(wp) :: zst, zst3, zsq, zsipt ! local variable
REAL(wp) :: zcoef_dqlw, zcoef_dqla ! - - REAL(wp) :: zcoef_dqlw, zcoef_dqla ! - -
REAL(wp) :: zztmp, zzblk, zztmp1, z1_rLsub ! - - REAL(wp) :: zztmp, zzblk, zztmp1, z1_rLsub ! - -
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zmsk ! temporary mask for prt_ctl REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zmsk ! temporary mask for prt_ctl
REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_qlw ! long wave heat flux over ice REAL(wp), DIMENSION(A2D(0),jpl) :: z_qlw ! long wave heat flux over ice
REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_qsb ! sensible heat flux over ice REAL(wp), DIMENSION(A2D(0),jpl) :: z_qsb ! sensible heat flux over ice
REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_dqlw ! long wave heat sensitivity over ice REAL(wp), DIMENSION(A2D(0),jpl) :: z_dqlw ! long wave heat sensitivity over ice
REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_dqsb ! sensible heat sensitivity over ice REAL(wp), DIMENSION(A2D(0),jpl) :: z_dqsb ! sensible heat sensitivity over ice
REAL(wp), DIMENSION(jpi,jpj) :: zevap, zsnw ! evaporation and snw distribution after wind blowing (SI3) REAL(wp), DIMENSION(A2D(0)) :: zevap, zsnw ! evaporation and snw distribution after wind blowing (SI3)
REAL(wp), DIMENSION(jpi,jpj) :: ztmp, ztmp2 REAL(wp), DIMENSION(A2D(0)) :: ztmp, ztmp2
REAL(wp), DIMENSION(jpi,jpj) :: ztri REAL(wp), DIMENSION(A2D(0)) :: ztri
REAL(wp), DIMENSION(jpi,jpj) :: zcptrain, zcptsnw, zcptn ! Heat content per unit mass (J/kg) REAL(wp), DIMENSION(A2D(0)) :: zcptrain, zcptsnw, zcptn ! Heat content per unit mass (J/kg)
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
! !
zcoef_dqlw = 4._wp * emiss_i * stefan ! local scalars zcoef_dqlw = 4._wp * emiss_i * stefan ! local scalars
...@@ -1157,14 +1134,14 @@ CONTAINS ...@@ -1157,14 +1134,14 @@ CONTAINS
dqla_ice(:,:,:) = 0._wp dqla_ice(:,:,:) = 0._wp
! Heat content per unit mass (J/kg) ! Heat content per unit mass (J/kg)
zcptrain(:,:) = ( ptair - rt0 ) * rcp * tmask(:,:,1) zcptrain(:,:) = ( ptair(:,:) - rt0 ) * rcp * smask0(:,:)
zcptsnw (:,:) = ( MIN( ptair, rt0 ) - rt0 ) * rcpi * tmask(:,:,1) zcptsnw (:,:) = ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * smask0(:,:)
zcptn (:,:) = sst_m * rcp * tmask(:,:,1) zcptn (:,:) = sst_m(A2D(0)) * rcp * smask0(:,:)
! !
! ! ========================== ! ! ! ========================== !
DO jl = 1, jpl ! Loop over ice categories ! DO jl = 1, jpl ! Loop over ice categories !
! ! ========================== ! ! ! ========================== !
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zst = ptsu(ji,jj,jl) ! surface temperature of sea-ice [K] zst = ptsu(ji,jj,jl) ! surface temperature of sea-ice [K]
zsq = q_sat( zst, pslp(ji,jj), l_ice=.TRUE. ) ! surface saturation specific humidity when ice present zsq = q_sat( zst, pslp(ji,jj), l_ice=.TRUE. ) ! surface saturation specific humidity when ice present
...@@ -1178,7 +1155,7 @@ CONTAINS ...@@ -1178,7 +1155,7 @@ CONTAINS
! Long Wave (lw) ! Long Wave (lw)
zst3 = zst * zst * zst zst3 = zst * zst * zst
z_qlw(ji,jj,jl) = emiss_i * ( pdqlw(ji,jj) - stefan * zst * zst3 ) * tmask(ji,jj,1) z_qlw(ji,jj,jl) = emiss_i * ( pdqlw(ji,jj) - stefan * zst * zst3 ) * smask0(ji,jj)
! lw sensitivity ! lw sensitivity
z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3 z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3
...@@ -1205,7 +1182,6 @@ CONTAINS ...@@ -1205,7 +1182,6 @@ CONTAINS
!qla_ice( ji,jj,jl) = zztmp1 * (zsq - q_zu_i(ji,jj)) !qla_ice( ji,jj,jl) = zztmp1 * (zsq - q_zu_i(ji,jj))
!dqla_ice(ji,jj,jl) = zztmp1 * dq_sat_dt_ice(zst, pslp(ji,jj)) ! ==> Qlat sensitivity (dQlat/dT) !dqla_ice(ji,jj,jl) = zztmp1 * dq_sat_dt_ice(zst, pslp(ji,jj)) ! ==> Qlat sensitivity (dQlat/dT)
! ----------------------------! ! ----------------------------!
! III Total FLUXES ! ! III Total FLUXES !
! ----------------------------! ! ----------------------------!
...@@ -1218,43 +1194,48 @@ CONTAINS ...@@ -1218,43 +1194,48 @@ CONTAINS
! !
END DO END DO
! !
tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1) ! total precipitation [kg/m2/s]
sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1) ! solid precipitation [kg/m2/s]
CALL iom_put( 'snowpre', sprecip ) ! Snow precipitation
CALL iom_put( 'precip' , tprecip ) ! Total precipitation
! --- evaporation --- !
z1_rLsub = 1._wp / rLsub z1_rLsub = 1._wp / rLsub
evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_rLsub ! sublimation DO_2D( 0, 0, 0, 0 )
devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_rLsub ! d(sublimation)/dT ! --- precipitation --- !
zevap (:,:) = emp(:,:) + tprecip(:,:) ! evaporation over ocean !LB: removed rn_efac here, correct??? tprecip(ji,jj) = pprec(ji,jj) * rn_pfac * smask0(ji,jj) ! total precipitation [kg/m2/s]
sprecip(ji,jj) = psnow(ji,jj) * rn_pfac * smask0(ji,jj) ! solid precipitation [kg/m2/s]
! --- evaporation --- !
zevap(ji,jj) = emp(ji,jj) + tprecip(ji,jj) ! evaporation over ocean !LB: removed rn_efac here, correct???
DO jl = 1, jpl
evap_ice (ji,jj,jl) = rn_efac * qla_ice (ji,jj,jl) * z1_rLsub ! sublimation
devap_ice(ji,jj,jl) = rn_efac * dqla_ice(ji,jj,jl) * z1_rLsub ! d(sublimation)/dT
ENDDO
END_2D
! --- evaporation minus precipitation --- !
zsnw(:,:) = 0._wp zsnw(:,:) = 0._wp
CALL ice_var_snwblow( (1.-at_i_b(:,:)), zsnw ) ! snow distribution over ice after wind blowing CALL ice_var_snwblow( (1.-at_i_b(:,:)), zsnw(:,:) ) ! snow distribution over ice after wind blowing
emp_oce(:,:) = ( 1._wp - at_i_b(:,:) ) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) DO_2D( 0, 0, 0, 0 )
emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw ! --- evaporation minus precipitation --- !
emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) emp_oce(ji,jj) = ( 1._wp - at_i_b(ji,jj) ) * zevap(ji,jj) - ( tprecip(ji,jj) - sprecip(ji,jj) ) - sprecip(ji,jj) * (1._wp - zsnw(ji,jj) )
emp_ice(ji,jj) = SUM( a_i_b(ji,jj,:) * evap_ice(ji,jj,:) ) - sprecip(ji,jj) * zsnw(ji,jj)
! --- heat flux associated with emp --- ! emp_tot(ji,jj) = emp_oce(ji,jj) + emp_ice(ji,jj)
qemp_oce(:,:) = - ( 1._wp - at_i_b(:,:) ) * zevap(:,:) * zcptn(:,:) & ! evap at sst
& + ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) & ! liquid precip at Tair ! --- heat flux associated with emp --- !
& + sprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - rLfus ) ! solid precip at min(Tair,Tsnow) qemp_oce(ji,jj) = - ( 1._wp - at_i_b(ji,jj) ) * zevap(ji,jj) * zcptn(ji,jj) & ! evap at sst
qemp_ice(:,:) = sprecip(:,:) * zsnw * ( zcptsnw (:,:) - rLfus ) ! solid precip (only) & + ( tprecip(ji,jj) - sprecip(ji,jj) ) * zcptrain(ji,jj) & ! liquid precip at Tair
& + sprecip(ji,jj) * ( 1._wp - zsnw(ji,jj) ) * ( zcptsnw (ji,jj) - rLfus ) ! solid precip at min(Tair,Tsnow)
! --- total solar and non solar fluxes --- ! qemp_ice(ji,jj) = sprecip(ji,jj) * zsnw(ji,jj) * ( zcptsnw (ji,jj) - rLfus ) ! solid precip (only)
qns_tot(:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) &
& + qemp_ice(:,:) + qemp_oce(:,:) ! --- total solar and non solar fluxes --- !
qsr_tot(:,:) = ( 1._wp - at_i_b(:,:) ) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) qns_tot(ji,jj) = ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) ) &
& + qemp_ice(ji,jj) + qemp_oce(ji,jj)
! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! qsr_tot(ji,jj) = ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) + SUM( a_i_b(ji,jj,:) * qsr_ice(ji,jj,:) )
qprec_ice(:,:) = rhos * ( zcptsnw(:,:) - rLfus )
! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- qprec_ice(ji,jj) = rhos * ( zcptsnw(ji,jj) - rLfus )
DO jl = 1, jpl
qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * rcpi * tmask(:,:,1) ) ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) ---
! ! But we do not have Tice => consider it at 0degC => evap=0 DO jl = 1, jpl
END DO qevap_ice(ji,jj,jl) = 0._wp ! should be -evap_ice(ji,jj,jl)*( ( Tice - rt0 ) * rcpi * smask0(ji,jj) )
! ! But we do not have Tice => consider it at 0degC => evap=0
ENDDO
END_2D
! --- shortwave radiation transmitted thru the surface scattering layer (W/m2) --- ! ! --- shortwave radiation transmitted thru the surface scattering layer (W/m2) --- !
IF( nn_qtrice == 0 ) THEN IF( nn_qtrice == 0 ) THEN
...@@ -1279,9 +1260,11 @@ CONTAINS ...@@ -1279,9 +1260,11 @@ CONTAINS
qtr_ice_top(:,:,:) = 0.3_wp * qsr_ice(:,:,:) qtr_ice_top(:,:,:) = 0.3_wp * qsr_ice(:,:,:)
ENDIF ENDIF
! !
CALL iom_put( 'snowpre', sprecip ) ! Snow precipitation
CALL iom_put( 'precip' , tprecip ) ! Total precipitation
IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) THEN IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) THEN
CALL iom_put( 'evap_ao_cea' , zevap(:,:) * ( 1._wp - at_i_b(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) CALL iom_put( 'evap_ao_cea' , zevap(:,:) * ( 1._wp - at_i_b(:,:) ) * smask0(:,:) ) ! ice-free oce evap (cell average)
CALL iom_put( 'hflx_evap_cea', zevap(:,:) * ( 1._wp - at_i_b(:,:) ) * tmask(:,:,1) * zcptn(:,:) ) ! heat flux from evap (cell average) CALL iom_put( 'hflx_evap_cea', zevap(:,:) * ( 1._wp - at_i_b(:,:) ) * smask0(:,:) * zcptn(:,:) ) ! heat flux from evap (cell average)
ENDIF ENDIF
IF( iom_use('rain') .OR. iom_use('rain_ao_cea') .OR. iom_use('hflx_rain_cea') ) THEN IF( iom_use('rain') .OR. iom_use('rain_ao_cea') .OR. iom_use('hflx_rain_cea') ) THEN
CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation
...@@ -1301,14 +1284,14 @@ CONTAINS ...@@ -1301,14 +1284,14 @@ CONTAINS
& + ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) & + ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )
ENDIF ENDIF
IF( iom_use('subl_ai_cea') .OR. iom_use('hflx_subl_cea') ) THEN IF( iom_use('subl_ai_cea') .OR. iom_use('hflx_subl_cea') ) THEN
CALL iom_put( 'subl_ai_cea' , SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average) CALL iom_put( 'subl_ai_cea' , SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) * smask0(:,:) ) ! Sublimation over sea-ice (cell average)
CALL iom_put( 'hflx_subl_cea', SUM( a_i_b(:,:,:) * qevap_ice(:,:,:), dim=3 ) * tmask(:,:,1) ) ! Heat flux from sublimation (cell average) CALL iom_put( 'hflx_subl_cea', SUM( a_i_b(:,:,:) * qevap_ice(:,:,:), dim=3 ) * smask0(:,:) ) ! Heat flux from sublimation (cell average)
ENDIF ENDIF
! !
IF(sn_cfctl%l_prtctl) THEN IF(sn_cfctl%l_prtctl) THEN
ALLOCATE(zmsk(jpi,jpj,jpl)) ALLOCATE(zmsk(A2D(0),jpl))
DO jl = 1, jpl DO jl = 1, jpl
zmsk(:,:,jl) = tmask(:,:,1) zmsk(:,:,jl) = smask0(:,:)
END DO END DO
CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice: qla_ice : ', mask1=zmsk, & CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice: qla_ice : ', mask1=zmsk, &
& tab3d_2=z_qsb , clinfo2=' z_qsb : ' , mask2=zmsk, kdim=jpl) & tab3d_2=z_qsb , clinfo2=' z_qsb : ' , mask2=zmsk, kdim=jpl)
...@@ -1321,7 +1304,7 @@ CONTAINS ...@@ -1321,7 +1304,7 @@ CONTAINS
CALL prt_ctl(tab3d_1=ptsu , clinfo1=' blk_ice: ptsu : ', mask1=zmsk, & CALL prt_ctl(tab3d_1=ptsu , clinfo1=' blk_ice: ptsu : ', mask1=zmsk, &
& tab3d_2=qns_ice , clinfo2=' qns_ice : ' , mask2=zmsk, kdim=jpl) & tab3d_2=qns_ice , clinfo2=' qns_ice : ' , mask2=zmsk, kdim=jpl)
CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice: tprecip : ', mask1=tmask, & CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice: tprecip : ', mask1=tmask, &
& tab2d_2=sprecip , clinfo2=' sprecip : ' , mask2=tmask ) & tab2d_2=sprecip , clinfo2=' sprecip : ' , mask2=tmask )
DEALLOCATE(zmsk) DEALLOCATE(zmsk)
ENDIF ENDIF
...@@ -1335,7 +1318,9 @@ CONTAINS ...@@ -1335,7 +1318,9 @@ CONTAINS
END SUBROUTINE blk_ice_2 END SUBROUTINE blk_ice_2
SUBROUTINE blk_ice_qcn( ld_virtual_itd, ptsu, ptb, phs, phi ) SUBROUTINE blk_ice_qcn( ld_virtual_itd, ptb, phs, phi, & ! <<== in
& pqcn_ice, pqml_ice, & ! ==>> out
& pqns_ice, ptsu ) ! ==>> inout
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
!! *** ROUTINE blk_ice_qcn *** !! *** ROUTINE blk_ice_qcn ***
!! !!
...@@ -1350,12 +1335,15 @@ CONTAINS ...@@ -1350,12 +1335,15 @@ CONTAINS
!! - qcn_ice : surface inner conduction flux (W/m2) !! - qcn_ice : surface inner conduction flux (W/m2)
!! !!
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
LOGICAL , INTENT(in ) :: ld_virtual_itd ! single-category option LOGICAL , INTENT(in ) :: ld_virtual_itd ! single-category option
REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptsu ! sea ice / snow surface temperature REAL(wp), DIMENSION(A2D(0)) , INTENT(in ) :: ptb ! sea ice base temperature
REAL(wp), DIMENSION(:,:) , INTENT(in ) :: ptb ! sea ice base temperature REAL(wp), DIMENSION(A2D(0),jpl), INTENT(in ) :: phs ! snow thickness
REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: phs ! snow thickness REAL(wp), DIMENSION(A2D(0),jpl), INTENT(in ) :: phi ! sea ice thickness
REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: phi ! sea ice thickness REAL(wp), DIMENSION(A2D(0),jpl), INTENT( out) :: pqcn_ice
! REAL(wp), DIMENSION(A2D(0),jpl), INTENT( out) :: pqml_ice
REAL(wp), DIMENSION(A2D(0),jpl), INTENT(inout) :: pqns_ice
REAL(wp), DIMENSION(A2D(0),jpl), INTENT(inout) :: ptsu ! sea ice / snow surface temperature
!
INTEGER , PARAMETER :: nit = 10 ! number of iterations INTEGER , PARAMETER :: nit = 10 ! number of iterations
REAL(wp), PARAMETER :: zepsilon = 0.1_wp ! characteristic thickness for enhanced conduction REAL(wp), PARAMETER :: zepsilon = 0.1_wp ! characteristic thickness for enhanced conduction
! !
...@@ -1365,7 +1353,7 @@ CONTAINS ...@@ -1365,7 +1353,7 @@ CONTAINS
REAL(wp) :: zkeff_h, ztsu, ztsu0 ! REAL(wp) :: zkeff_h, ztsu, ztsu0 !
REAL(wp) :: zqc, zqnet ! REAL(wp) :: zqc, zqnet !
REAL(wp) :: zhe, zqa0 ! REAL(wp) :: zhe, zqa0 !
REAL(wp), DIMENSION(jpi,jpj,jpl) :: zgfac ! enhanced conduction factor REAL(wp), DIMENSION(A2D(0),jpl) :: zgfac ! enhanced conduction factor
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
! -------------------------------------! ! -------------------------------------!
...@@ -1383,7 +1371,7 @@ CONTAINS ...@@ -1383,7 +1371,7 @@ CONTAINS
zfac3 = 2._wp / zepsilon zfac3 = 2._wp / zepsilon
! !
DO jl = 1, jpl DO jl = 1, jpl
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac ! Effective thickness zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac ! Effective thickness
IF( zhe >= zfac2 ) zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor IF( zhe >= zfac2 ) zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor
END_2D END_2D
...@@ -1398,13 +1386,13 @@ CONTAINS ...@@ -1398,13 +1386,13 @@ CONTAINS
zfac = rcnd_i * rn_cnd_s zfac = rcnd_i * rn_cnd_s
! !
DO jl = 1, jpl DO jl = 1, jpl
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
! !
zkeff_h = zfac * zgfac(ji,jj,jl) / & ! Effective conductivity of the snow-ice system divided by thickness zkeff_h = zfac * zgfac(ji,jj,jl) / & ! Effective conductivity of the snow-ice system divided by thickness
& ( rcnd_i * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) ) & ( rcnd_i * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) )
ztsu = ptsu(ji,jj,jl) ! Store current iteration temperature ztsu = ptsu(ji,jj,jl) ! Store current iteration temperature
ztsu0 = ptsu(ji,jj,jl) ! Store initial surface temperature ztsu0 = ptsu(ji,jj,jl) ! Store initial surface temperature
zqa0 = qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) ! Net initial atmospheric heat flux zqa0 = qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + pqns_ice(ji,jj,jl) ! Net initial atmospheric heat flux
! !
DO iter = 1, nit ! --- Iterative loop DO iter = 1, nit ! --- Iterative loop
zqc = zkeff_h * ( ztsu - ptb(ji,jj) ) ! Conduction heat flux through snow-ice system (>0 downwards) zqc = zkeff_h * ( ztsu - ptb(ji,jj) ) ! Conduction heat flux through snow-ice system (>0 downwards)
...@@ -1412,10 +1400,10 @@ CONTAINS ...@@ -1412,10 +1400,10 @@ CONTAINS
ztsu = ztsu - zqnet / ( dqns_ice(ji,jj,jl) - zkeff_h ) ! Temperature update ztsu = ztsu - zqnet / ( dqns_ice(ji,jj,jl) - zkeff_h ) ! Temperature update
END DO END DO
! !
ptsu (ji,jj,jl) = MIN( rt0, ztsu ) ptsu (ji,jj,jl) = MIN( rt0, ztsu )
qcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) ) pqcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) )
qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) pqns_ice(ji,jj,jl) = pqns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 )
qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) ) & pqml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + pqns_ice(ji,jj,jl) - pqcn_ice(ji,jj,jl) ) &
& * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) ) & * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) )
! --- Diagnose the heat loss due to changing non-solar flux (as in icethd_zdf_bl99) --- ! ! --- Diagnose the heat loss due to changing non-solar flux (as in icethd_zdf_bl99) --- !
......
src/OCE/SBC/sbcblk_algo_andreas.F90
View file @ 3efbcb17
...@@ -85,34 +85,34 @@ CONTAINS ...@@ -85,34 +85,34 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m] REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
REAL(wp), INTENT(in ) :: zu ! height for U_zu [m] REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: sst ! sea surface temperature [Kelvin] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: sst ! sea surface temperature [Kelvin]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: t_zt ! potential air temperature [Kelvin] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: t_zt ! potential air temperature [Kelvin]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: ssq ! sea surface specific humidity [kg/kg] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: ssq ! sea surface specific humidity [kg/kg]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: q_zt ! specific air humidity at zt [kg/kg] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: q_zt ! specific air humidity at zt [kg/kg]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: U_zu ! relative wind module at zu [m/s] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: U_zu ! relative wind module at zu [m/s]
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Cd ! transfer coefficient for momentum (tau) REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Cd ! transfer coefficient for momentum (tau)
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ch ! transfer coefficient for sensible heat (Q_sens) REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ch ! transfer coefficient for sensible heat (Q_sens)
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ce ! transfert coefficient for evaporation (Q_lat) REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ce ! transfert coefficient for evaporation (Q_lat)
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: t_zu ! pot. air temp. adjusted at zu [K] REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: t_zu ! pot. air temp. adjusted at zu [K]
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: q_zu ! spec. humidity adjusted at zu [kg/kg] REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: q_zu ! spec. humidity adjusted at zu [kg/kg]
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ubzu ! bulk wind speed at zu [m/s] REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ubzu ! bulk wind speed at zu [m/s]
! !
INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CdN REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CdN
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: ChN REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: ChN
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CeN REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CeN
! !
INTEGER :: nbit, jit ! iterations... INTEGER :: nbit, jit ! iterations...
LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U
!! !!
REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star REAL(wp), DIMENSION(A2D(0)) :: u_star, t_star, q_star
REAL(wp), DIMENSION(jpi,jpj) :: z0 ! roughness length (momentum) [m] REAL(wp), DIMENSION(A2D(0)) :: z0 ! roughness length (momentum) [m]
REAL(wp), DIMENSION(jpi,jpj) :: UN10 ! Neutral wind speed at zu [m/s] REAL(wp), DIMENSION(A2D(0)) :: UN10 ! Neutral wind speed at zu [m/s]
REAL(wp), DIMENSION(jpi,jpj) :: zeta_u ! stability parameter at height zu REAL(wp), DIMENSION(A2D(0)) :: zeta_u ! stability parameter at height zu
REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 REAL(wp), DIMENSION(A2D(0)) :: ztmp0, ztmp1, ztmp2
REAL(wp), DIMENSION(jpi,jpj) :: RiB ! square root of Cd REAL(wp), DIMENSION(A2D(0)) :: RiB ! square root of Cd
!! !!
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
nbit = nb_iter0 nbit = nb_iter0
...@@ -217,13 +217,13 @@ CONTAINS ...@@ -217,13 +217,13 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, April 2020 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, April 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pun10 !: neutral-stability scalar wind speed at 10m (m/s) REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pun10 !: neutral-stability scalar wind speed at 10m (m/s)
REAL(wp), DIMENSION(jpi,jpj) :: u_star_andreas !: friction velocity [m/s] REAL(wp), DIMENSION(A2D(0)) :: u_star_andreas !: friction velocity [m/s]
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: za, zt, zw ! local scalars REAL(wp) :: za, zt, zw ! local scalars
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zw = pun10(ji,jj) zw = pun10(ji,jj)
za = zw - 8.271_wp za = zw - 8.271_wp
zt = za + SQRT( 0.12_wp*za*za + 0.181_wp ) zt = za + SQRT( 0.12_wp*za*za + 0.181_wp )
...@@ -243,8 +243,8 @@ CONTAINS ...@@ -243,8 +243,8 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, April 2020 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, April 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: psi_m_andreas REAL(wp), DIMENSION(A2D(0)) :: psi_m_andreas
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
! !
REAL(wp), PARAMETER :: zam = 5._wp ! a_m (just below Eq.(9b) REAL(wp), PARAMETER :: zam = 5._wp ! a_m (just below Eq.(9b)
REAL(wp), PARAMETER :: zbm = zam/6.5_wp ! b_m (just below Eq.(9b) REAL(wp), PARAMETER :: zbm = zam/6.5_wp ! b_m (just below Eq.(9b)
...@@ -255,7 +255,7 @@ CONTAINS ...@@ -255,7 +255,7 @@ CONTAINS
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zx2, zx, zpsi_unst, zbbm, zpsi_stab, zstab ! local scalars REAL(wp) :: zta, zx2, zx, zpsi_unst, zbbm, zpsi_stab, zstab ! local scalars
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
! !
zta = MIN( pzeta(ji,jj) , 15._wp ) !! Very stable conditions (L positif and big!) zta = MIN( pzeta(ji,jj) , 15._wp ) !! Very stable conditions (L positif and big!)
! !
...@@ -298,8 +298,8 @@ CONTAINS ...@@ -298,8 +298,8 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: psi_h_andreas REAL(wp), DIMENSION(A2D(0)) :: psi_h_andreas
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
! !
REAL(wp), PARAMETER :: zah = 5._wp ! a_h (just below Eq.(9b) REAL(wp), PARAMETER :: zah = 5._wp ! a_h (just below Eq.(9b)
REAL(wp), PARAMETER :: zbh = 5._wp ! b_h (just below Eq.(9b) REAL(wp), PARAMETER :: zbh = 5._wp ! b_h (just below Eq.(9b)
...@@ -309,7 +309,7 @@ CONTAINS ...@@ -309,7 +309,7 @@ CONTAINS
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zz, zx2, zpsi_unst, zpsi_stab, zstab ! local scalars REAL(wp) :: zta, zz, zx2, zpsi_unst, zpsi_stab, zstab ! local scalars
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
! !
zta = MIN( pzeta(ji,jj) , 15._wp ) !! Very stable conditions (L positif and large!) zta = MIN( pzeta(ji,jj) , 15._wp ) !! Very stable conditions (L positif and large!)
! !
......
src/OCE/SBC/sbcblk_algo_coare3p0.F90
View file @ 3efbcb17
...@@ -71,7 +71,7 @@ CONTAINS ...@@ -71,7 +71,7 @@ CONTAINS
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
IF( l_use_wl ) THEN IF( l_use_wl ) THEN
ierr = 0 ierr = 0
ALLOCATE ( Tau_ac(jpi,jpj) , Qnt_ac(jpi,jpj), dT_wl(jpi,jpj), Hz_wl(jpi,jpj), STAT=ierr ) ALLOCATE ( Tau_ac(A2D(0)) , Qnt_ac(A2D(0)), dT_wl(A2D(0)), Hz_wl(A2D(0)), STAT=ierr )
IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P0_INIT => allocation of Tau_ac, Qnt_ac, dT_wl & Hz_wl failed!' ) IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P0_INIT => allocation of Tau_ac, Qnt_ac, dT_wl & Hz_wl failed!' )
Tau_ac(:,:) = 0._wp Tau_ac(:,:) = 0._wp
Qnt_ac(:,:) = 0._wp Qnt_ac(:,:) = 0._wp
...@@ -80,7 +80,7 @@ CONTAINS ...@@ -80,7 +80,7 @@ CONTAINS
ENDIF ENDIF
IF( l_use_cs ) THEN IF( l_use_cs ) THEN
ierr = 0 ierr = 0
ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr ) ALLOCATE ( dT_cs(A2D(0)), STAT=ierr )
IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P0_INIT => allocation of dT_cs failed!' ) IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P0_INIT => allocation of dT_cs failed!' )
dT_cs(:,:) = -0.25_wp ! First guess of skin correction dT_cs(:,:) = -0.25_wp ! First guess of skin correction
ENDIF ENDIF
...@@ -151,44 +151,44 @@ CONTAINS ...@@ -151,44 +151,44 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
INTEGER, INTENT(in ) :: kt ! current time step INTEGER, INTENT(in ) :: kt ! current time step
REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m] REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
REAL(wp), INTENT(in ) :: zu ! height for U_zu [m] REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: T_s ! sea surface temperature [Kelvin] REAL(wp), INTENT(inout), DIMENSION(A2D(0)) :: T_s ! sea surface temperature [Kelvin]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: t_zt ! potential air temperature [Kelvin] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: t_zt ! potential air temperature [Kelvin]
REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: q_s ! sea surface specific humidity [kg/kg] REAL(wp), INTENT(inout), DIMENSION(A2D(0)) :: q_s ! sea surface specific humidity [kg/kg]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: q_zt ! specific air humidity at zt [kg/kg] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: q_zt ! specific air humidity at zt [kg/kg]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: U_zu ! relative wind module at zu [m/s] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: U_zu ! relative wind module at zu [m/s]
LOGICAL , INTENT(in ) :: l_use_cs ! use the cool-skin parameterization LOGICAL , INTENT(in ) :: l_use_cs ! use the cool-skin parameterization
LOGICAL , INTENT(in ) :: l_use_wl ! use the warm-layer parameterization LOGICAL , INTENT(in ) :: l_use_wl ! use the warm-layer parameterization
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Cd ! transfer coefficient for momentum (tau) REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Cd ! transfer coefficient for momentum (tau)
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ch ! transfer coefficient for sensible heat (Q_sens) REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ch ! transfer coefficient for sensible heat (Q_sens)
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ce ! transfert coefficient for evaporation (Q_lat) REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ce ! transfert coefficient for evaporation (Q_lat)
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: t_zu ! pot. air temp. adjusted at zu [K] REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: t_zu ! pot. air temp. adjusted at zu [K]
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: q_zu ! spec. humidity adjusted at zu [kg/kg] REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: q_zu ! spec. humidity adjusted at zu [kg/kg]
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ubzu ! bulk wind speed at zu [m/s] REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ubzu ! bulk wind speed at zu [m/s]
! !
INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CdN REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CdN
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: ChN REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: ChN
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CeN REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CeN
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: Qsw ! [W/m^2] REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: Qsw ! [W/m^2]
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: rad_lw ! [W/m^2] REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: rad_lw ! [W/m^2]
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: slp ! [Pa] REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: slp ! [Pa]
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pdT_cs REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pdT_cs
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pdT_wl ! [K] REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pdT_wl ! [K]
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pHz_wl ! [m] REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pHz_wl ! [m]
! !
INTEGER :: nbit, jit INTEGER :: nbit, jit
LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U
! !
REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star REAL(wp), DIMENSION(A2D(0)) :: u_star, t_star, q_star
REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu REAL(wp), DIMENSION(A2D(0)) :: dt_zu, dq_zu
REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air REAL(wp), DIMENSION(A2D(0)) :: znu_a !: Nu_air, Viscosity of air
REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t REAL(wp), DIMENSION(A2D(0)) :: z0, z0t
REAL(wp), DIMENSION(jpi,jpj) :: zeta_u ! stability parameter at height zu REAL(wp), DIMENSION(A2D(0)) :: zeta_u ! stability parameter at height zu
REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 REAL(wp), DIMENSION(A2D(0)) :: ztmp0, ztmp1, ztmp2
REAL(wp), DIMENSION(jpi,jpj) :: zpre, zrhoa, zta ! air pressure [Pa], density [kg/m3] & absolute temperature [k] REAL(wp), DIMENSION(A2D(0)) :: zpre, zrhoa, zta ! air pressure [Pa], density [kg/m3] & absolute temperature [k]
! !
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zeta_t ! stability parameter at height zt REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zeta_t ! stability parameter at height zt
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst ! to back up the initial bulk SST REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst ! to back up the initial bulk SST
...@@ -201,7 +201,7 @@ CONTAINS ...@@ -201,7 +201,7 @@ CONTAINS
IF( PRESENT(nb_iter) ) nbit = nb_iter IF( PRESENT(nb_iter) ) nbit = nb_iter
l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision
IF( .NOT. l_zt_equal_zu ) ALLOCATE( zeta_t(jpi,jpj) ) IF( .NOT. l_zt_equal_zu ) ALLOCATE( zeta_t(A2D(0)) )
!! Initializations for cool skin and warm layer: !! Initializations for cool skin and warm layer:
IF( l_use_cs .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) & IF( l_use_cs .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) &
...@@ -211,7 +211,7 @@ CONTAINS ...@@ -211,7 +211,7 @@ CONTAINS
& CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use warm-layer param!' ) & CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use warm-layer param!' )
IF( l_use_cs .OR. l_use_wl ) THEN IF( l_use_cs .OR. l_use_wl ) THEN
ALLOCATE ( zsst(jpi,jpj) ) ALLOCATE ( zsst(A2D(0)) )
zsst = T_s ! backing up the bulk SST zsst = T_s ! backing up the bulk SST
IF( l_use_cs ) T_s = T_s - 0.25_wp ! First guess of correction IF( l_use_cs ) T_s = T_s - 0.25_wp ! First guess of correction
q_s = rdct_qsat_salt*q_sat(MAX(T_s, 200._wp), slp) ! First guess of q_s q_s = rdct_qsat_salt*q_sat(MAX(T_s, 200._wp), slp) ! First guess of q_s
...@@ -334,8 +334,8 @@ CONTAINS ...@@ -334,8 +334,8 @@ CONTAINS
CALL CS_COARE( Qsw, ztmp1, u_star, zsst, ztmp2 ) ! ! Qnsol -> ztmp1 / Qlat -> ztmp2 CALL CS_COARE( Qsw, ztmp1, u_star, zsst, ztmp2 ) ! ! Qnsol -> ztmp1 / Qlat -> ztmp2
T_s(:,:) = zsst(:,:) + dT_cs(:,:)*tmask(:,:,1) T_s(:,:) = zsst(:,:) + dT_cs(:,:)*smask0(:,:)
IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1) IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*smask0(:,:)
q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:)) q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
ENDIF ENDIF
...@@ -347,8 +347,8 @@ CONTAINS ...@@ -347,8 +347,8 @@ CONTAINS
CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nbit,jit) ) CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nbit,jit) )
!! Updating T_s and q_s !!! !! Updating T_s and q_s !!!
T_s(:,:) = zsst(:,:) + dT_wl(:,:)*tmask(:,:,1) T_s(:,:) = zsst(:,:) + dT_wl(:,:)*smask0(:,:)
IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*tmask(:,:,1) IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*smask0(:,:)
q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:)) q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
ENDIF ENDIF
...@@ -392,13 +392,13 @@ CONTAINS ...@@ -392,13 +392,13 @@ CONTAINS
!! !!
!! Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) !! Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!------------------------------------------------------------------- !!-------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: charn_coare3p0 REAL(wp), DIMENSION(A2D(0)) :: charn_coare3p0
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwnd ! wind speed REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pwnd ! wind speed
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zw, zgt10, zgt18 REAL(wp) :: zw, zgt10, zgt18
!!------------------------------------------------------------------- !!-------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
! !
zw = pwnd(ji,jj) ! wind speed zw = pwnd(ji,jj) ! wind speed
! !
...@@ -426,13 +426,13 @@ CONTAINS ...@@ -426,13 +426,13 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: psi_m_coare REAL(wp), DIMENSION(A2D(0)) :: psi_m_coare
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zphi_m, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab REAL(wp) :: zta, zphi_m, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
! !
zta = pzeta(ji,jj) zta = pzeta(ji,jj)
! !
...@@ -474,13 +474,13 @@ CONTAINS ...@@ -474,13 +474,13 @@ CONTAINS
!! Author: L. Brodeau, June 2016 / AeroBulk !! Author: L. Brodeau, June 2016 / AeroBulk
!! (https://github.com/brodeau/aerobulk/) !! (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------- !!----------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: psi_h_coare REAL(wp), DIMENSION(A2D(0)) :: psi_h_coare
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
!!---------------------------------------------------------------- !!----------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
! !
zta = pzeta(ji,jj) zta = pzeta(ji,jj)
! !
......
src/OCE/SBC/sbcblk_algo_coare3p6.F90
View file @ 3efbcb17
...@@ -61,7 +61,7 @@ CONTAINS ...@@ -61,7 +61,7 @@ CONTAINS
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
IF( l_use_wl ) THEN IF( l_use_wl ) THEN
ierr = 0 ierr = 0
ALLOCATE ( Tau_ac(jpi,jpj) , Qnt_ac(jpi,jpj), dT_wl(jpi,jpj), Hz_wl(jpi,jpj), STAT=ierr ) ALLOCATE ( Tau_ac(A2D(0)) , Qnt_ac(A2D(0)), dT_wl(A2D(0)), Hz_wl(A2D(0)), STAT=ierr )
IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P6_INIT => allocation of Tau_ac, Qnt_ac, dT_wl & Hz_wl failed!' ) IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P6_INIT => allocation of Tau_ac, Qnt_ac, dT_wl & Hz_wl failed!' )
Tau_ac(:,:) = 0._wp Tau_ac(:,:) = 0._wp
Qnt_ac(:,:) = 0._wp Qnt_ac(:,:) = 0._wp
...@@ -70,7 +70,7 @@ CONTAINS ...@@ -70,7 +70,7 @@ CONTAINS
ENDIF ENDIF
IF( l_use_cs ) THEN IF( l_use_cs ) THEN
ierr = 0 ierr = 0
ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr ) ALLOCATE ( dT_cs(A2D(0)), STAT=ierr )
IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P6_INIT => allocation of dT_cs failed!' ) IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P6_INIT => allocation of dT_cs failed!' )
dT_cs(:,:) = -0.25_wp ! First guess of skin correction dT_cs(:,:) = -0.25_wp ! First guess of skin correction
ENDIF ENDIF
...@@ -141,44 +141,44 @@ CONTAINS ...@@ -141,44 +141,44 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
INTEGER, INTENT(in ) :: kt ! current time step INTEGER, INTENT(in ) :: kt ! current time step
REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m] REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
REAL(wp), INTENT(in ) :: zu ! height for U_zu [m] REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: T_s ! sea surface temperature [Kelvin] REAL(wp), INTENT(inout), DIMENSION(A2D(0)) :: T_s ! sea surface temperature [Kelvin]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: t_zt ! potential air temperature [Kelvin] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: t_zt ! potential air temperature [Kelvin]
REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: q_s ! sea surface specific humidity [kg/kg] REAL(wp), INTENT(inout), DIMENSION(A2D(0)) :: q_s ! sea surface specific humidity [kg/kg]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: q_zt ! specific air humidity at zt [kg/kg] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: q_zt ! specific air humidity at zt [kg/kg]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: U_zu ! relative wind module at zu [m/s] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: U_zu ! relative wind module at zu [m/s]
LOGICAL , INTENT(in ) :: l_use_cs ! use the cool-skin parameterization LOGICAL , INTENT(in ) :: l_use_cs ! use the cool-skin parameterization
LOGICAL , INTENT(in ) :: l_use_wl ! use the warm-layer parameterization LOGICAL , INTENT(in ) :: l_use_wl ! use the warm-layer parameterization
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Cd ! transfer coefficient for momentum (tau) REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Cd ! transfer coefficient for momentum (tau)
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ch ! transfer coefficient for sensible heat (Q_sens) REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ch ! transfer coefficient for sensible heat (Q_sens)
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ce ! transfert coefficient for evaporation (Q_lat) REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ce ! transfert coefficient for evaporation (Q_lat)
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: t_zu ! pot. air temp. adjusted at zu [K] REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: t_zu ! pot. air temp. adjusted at zu [K]
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: q_zu ! spec. humidity adjusted at zu [kg/kg] REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: q_zu ! spec. humidity adjusted at zu [kg/kg]
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ubzu ! bulk wind speed at zu [m/s] REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ubzu ! bulk wind speed at zu [m/s]
! !
INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CdN REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CdN
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: ChN REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: ChN
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CeN REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CeN
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: Qsw ! [W/m^2] REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: Qsw ! [W/m^2]
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: rad_lw ! [W/m^2] REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: rad_lw ! [W/m^2]
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: slp ! [Pa] REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: slp ! [Pa]
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pdT_cs REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pdT_cs
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pdT_wl ! [K] REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pdT_wl ! [K]
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pHz_wl ! [m] REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pHz_wl ! [m]
! !
INTEGER :: nbit, jit INTEGER :: nbit, jit
LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U
! !
REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star REAL(wp), DIMENSION(A2D(0)) :: u_star, t_star, q_star
REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu REAL(wp), DIMENSION(A2D(0)) :: dt_zu, dq_zu
REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air REAL(wp), DIMENSION(A2D(0)) :: znu_a !: Nu_air, Viscosity of air
REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t REAL(wp), DIMENSION(A2D(0)) :: z0, z0t
REAL(wp), DIMENSION(jpi,jpj) :: zeta_u ! stability parameter at height zu REAL(wp), DIMENSION(A2D(0)) :: zeta_u ! stability parameter at height zu
REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 REAL(wp), DIMENSION(A2D(0)) :: ztmp0, ztmp1, ztmp2
REAL(wp), DIMENSION(jpi,jpj) :: zpre, zrhoa, zta ! air pressure [Pa], density [kg/m3] & absolute temperature [k] REAL(wp), DIMENSION(A2D(0)) :: zpre, zrhoa, zta ! air pressure [Pa], density [kg/m3] & absolute temperature [k]
! !
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zeta_t ! stability parameter at height zt REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zeta_t ! stability parameter at height zt
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst ! to back up the initial bulk SST REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst ! to back up the initial bulk SST
...@@ -191,7 +191,7 @@ CONTAINS ...@@ -191,7 +191,7 @@ CONTAINS
IF( PRESENT(nb_iter) ) nbit = nb_iter IF( PRESENT(nb_iter) ) nbit = nb_iter
l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision
IF( .NOT. l_zt_equal_zu ) ALLOCATE( zeta_t(jpi,jpj) ) IF( .NOT. l_zt_equal_zu ) ALLOCATE( zeta_t(A2D(0)) )
!! Initializations for cool skin and warm layer: !! Initializations for cool skin and warm layer:
IF( l_use_cs .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) & IF( l_use_cs .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) &
...@@ -201,7 +201,7 @@ CONTAINS ...@@ -201,7 +201,7 @@ CONTAINS
& CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use warm-layer param!' ) & CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use warm-layer param!' )
IF( l_use_cs .OR. l_use_wl ) THEN IF( l_use_cs .OR. l_use_wl ) THEN
ALLOCATE ( zsst(jpi,jpj) ) ALLOCATE ( zsst(A2D(0)) )
zsst = T_s ! backing up the bulk SST zsst = T_s ! backing up the bulk SST
IF( l_use_cs ) T_s = T_s - 0.25_wp ! First guess of correction IF( l_use_cs ) T_s = T_s - 0.25_wp ! First guess of correction
q_s = rdct_qsat_salt*q_sat(MAX(T_s, 200._wp), slp) ! First guess of q_s q_s = rdct_qsat_salt*q_sat(MAX(T_s, 200._wp), slp) ! First guess of q_s
...@@ -324,8 +324,8 @@ CONTAINS ...@@ -324,8 +324,8 @@ CONTAINS
CALL CS_COARE( Qsw, ztmp1, u_star, zsst, ztmp2 ) ! ! Qnsol -> ztmp1 / Qlat -> ztmp2 CALL CS_COARE( Qsw, ztmp1, u_star, zsst, ztmp2 ) ! ! Qnsol -> ztmp1 / Qlat -> ztmp2
T_s(:,:) = zsst(:,:) + dT_cs(:,:)*tmask(:,:,1) T_s(:,:) = zsst(:,:) + dT_cs(:,:)*smask0(:,:)
IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1) IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*smask0(:,:)
q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:)) q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
ENDIF ENDIF
...@@ -337,8 +337,8 @@ CONTAINS ...@@ -337,8 +337,8 @@ CONTAINS
CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nbit,jit) ) CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nbit,jit) )
!! Updating T_s and q_s !!! !! Updating T_s and q_s !!!
T_s(:,:) = zsst(:,:) + dT_wl(:,:)*tmask(:,:,1) T_s(:,:) = zsst(:,:) + dT_wl(:,:)*smask0(:,:)
IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*tmask(:,:,1) IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*smask0(:,:)
q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:)) q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
ENDIF ENDIF
...@@ -378,8 +378,8 @@ CONTAINS ...@@ -378,8 +378,8 @@ CONTAINS
!! !!
!! Author: L. Brodeau, July 2019 / AeroBulk (https://github.com/brodeau/aerobulk/) !! Author: L. Brodeau, July 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!------------------------------------------------------------------- !!-------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: charn_coare3p6 REAL(wp), DIMENSION(A2D(0)) :: charn_coare3p6
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwnd ! neutral wind speed at 10m REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pwnd ! neutral wind speed at 10m
! !
REAL(wp), PARAMETER :: charn0_max = 0.028 !: value above which the Charnock parameter levels off for winds > 18 m/s REAL(wp), PARAMETER :: charn0_max = 0.028 !: value above which the Charnock parameter levels off for winds > 18 m/s
!!------------------------------------------------------------------- !!-------------------------------------------------------------------
...@@ -395,10 +395,10 @@ CONTAINS ...@@ -395,10 +395,10 @@ CONTAINS
!! !!
!! Author: L. Brodeau, October 2019 / AeroBulk (https://github.com/brodeau/aerobulk/) !! Author: L. Brodeau, October 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!------------------------------------------------------------------- !!-------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: charn_coare3p6_wave REAL(wp), DIMENSION(A2D(0)) :: charn_coare3p6_wave
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus ! friction velocity [m/s] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pus ! friction velocity [m/s]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwsh ! significant wave height [m] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pwsh ! significant wave height [m]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwps ! phase speed of dominant waves [m/s] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pwps ! phase speed of dominant waves [m/s]
!!------------------------------------------------------------------- !!-------------------------------------------------------------------
charn_coare3p6_wave = ( pwsh*0.2_wp*(pus/pwps)**2.2_wp ) * grav/(pus*pus) charn_coare3p6_wave = ( pwsh*0.2_wp*(pus/pwps)**2.2_wp ) * grav/(pus*pus)
!! !!
...@@ -418,13 +418,13 @@ CONTAINS ...@@ -418,13 +418,13 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: psi_m_coare REAL(wp), DIMENSION(A2D(0)) :: psi_m_coare
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zphi_m, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab REAL(wp) :: zta, zphi_m, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
! !
zta = pzeta(ji,jj) zta = pzeta(ji,jj)
! !
...@@ -466,13 +466,13 @@ CONTAINS ...@@ -466,13 +466,13 @@ CONTAINS
!! Author: L. Brodeau, June 2016 / AeroBulk !! Author: L. Brodeau, June 2016 / AeroBulk
!! (https://github.com/brodeau/aerobulk/) !! (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------- !!----------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: psi_h_coare REAL(wp), DIMENSION(A2D(0)) :: psi_h_coare
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
!!---------------------------------------------------------------- !!----------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
! !
zta = pzeta(ji,jj) zta = pzeta(ji,jj)
! !
......
src/OCE/SBC/sbcblk_algo_ecmwf.F90
View file @ 3efbcb17
...@@ -69,14 +69,14 @@ CONTAINS ...@@ -69,14 +69,14 @@ CONTAINS
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
IF( l_use_wl ) THEN IF( l_use_wl ) THEN
ierr = 0 ierr = 0
ALLOCATE ( dT_wl(jpi,jpj), Hz_wl(jpi,jpj), STAT=ierr ) ALLOCATE ( dT_wl(A2D(0)), Hz_wl(A2D(0)), STAT=ierr )
IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_wl & Hz_wl failed!' ) IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_wl & Hz_wl failed!' )
dT_wl(:,:) = 0._wp dT_wl(:,:) = 0._wp
Hz_wl(:,:) = rd0 ! (rd0, constant, = 3m is default for Zeng & Beljaars) Hz_wl(:,:) = rd0 ! (rd0, constant, = 3m is default for Zeng & Beljaars)
ENDIF ENDIF
IF( l_use_cs ) THEN IF( l_use_cs ) THEN
ierr = 0 ierr = 0
ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr ) ALLOCATE ( dT_cs(A2D(0)), STAT=ierr )
IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_cs failed!' ) IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_cs failed!' )
dT_cs(:,:) = -0.25_wp ! First guess of skin correction dT_cs(:,:) = -0.25_wp ! First guess of skin correction
ENDIF ENDIF
...@@ -147,48 +147,48 @@ CONTAINS ...@@ -147,48 +147,48 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
INTEGER, INTENT(in ) :: kt ! current time step INTEGER, INTENT(in ) :: kt ! current time step
REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m] REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
REAL(wp), INTENT(in ) :: zu ! height for U_zu [m] REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: T_s ! sea surface temperature [Kelvin] REAL(wp), INTENT(inout), DIMENSION(A2D(0)) :: T_s ! sea surface temperature [Kelvin]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: t_zt ! potential air temperature [Kelvin] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: t_zt ! potential air temperature [Kelvin]
REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: q_s ! sea surface specific humidity [kg/kg] REAL(wp), INTENT(inout), DIMENSION(A2D(0)) :: q_s ! sea surface specific humidity [kg/kg]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: q_zt ! specific air humidity at zt [kg/kg] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: q_zt ! specific air humidity at zt [kg/kg]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: U_zu ! relative wind module at zu [m/s] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: U_zu ! relative wind module at zu [m/s]
LOGICAL , INTENT(in ) :: l_use_cs ! use the cool-skin parameterization LOGICAL , INTENT(in ) :: l_use_cs ! use the cool-skin parameterization
LOGICAL , INTENT(in ) :: l_use_wl ! use the warm-layer parameterization LOGICAL , INTENT(in ) :: l_use_wl ! use the warm-layer parameterization
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Cd ! transfer coefficient for momentum (tau) REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Cd ! transfer coefficient for momentum (tau)
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ch ! transfer coefficient for sensible heat (Q_sens) REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ch ! transfer coefficient for sensible heat (Q_sens)
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ce ! transfert coefficient for evaporation (Q_lat) REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ce ! transfert coefficient for evaporation (Q_lat)
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: t_zu ! pot. air temp. adjusted at zu [K] REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: t_zu ! pot. air temp. adjusted at zu [K]
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: q_zu ! spec. humidity adjusted at zu [kg/kg] REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: q_zu ! spec. humidity adjusted at zu [kg/kg]
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ubzu ! bulk wind speed at zu [m/s] REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ubzu ! bulk wind speed at zu [m/s]
! !
INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CdN REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CdN
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: ChN REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: ChN
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CeN REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CeN
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: Qsw ! [W/m^2] REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: Qsw ! [W/m^2]
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: rad_lw ! [W/m^2] REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: rad_lw ! [W/m^2]
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: slp ! [Pa] REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: slp ! [Pa]
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pdT_cs REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pdT_cs
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pdT_wl ! [K] REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pdT_wl ! [K]
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pHz_wl ! [m] REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pHz_wl ! [m]
! !
INTEGER :: nbit, jit INTEGER :: nbit, jit
LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U
! !
REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star REAL(wp), DIMENSION(A2D(0)) :: u_star, t_star, q_star
REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu REAL(wp), DIMENSION(A2D(0)) :: dt_zu, dq_zu
REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air REAL(wp), DIMENSION(A2D(0)) :: znu_a !: Nu_air, Viscosity of air
REAL(wp), DIMENSION(jpi,jpj) :: Linv !: 1/L (inverse of Monin Obukhov length... REAL(wp), DIMENSION(A2D(0)) :: Linv !: 1/L (inverse of Monin Obukhov length...
REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t, z0q REAL(wp), DIMENSION(A2D(0)) :: z0, z0t, z0q
REAL(wp), DIMENSION(jpi,jpj) :: zrhoa, zpre, zta ! air pressure [Pa], density [kg/m3] & absolute temperature [k] REAL(wp), DIMENSION(A2D(0)) :: zrhoa, zpre, zta ! air pressure [Pa], density [kg/m3] & absolute temperature [k]
! !
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst ! to back up the initial bulk SST REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst ! to back up the initial bulk SST
! !
REAL(wp), DIMENSION(jpi,jpj) :: func_m, func_h REAL(wp), DIMENSION(A2D(0)) :: func_m, func_h
REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 REAL(wp), DIMENSION(A2D(0)) :: ztmp0, ztmp1, ztmp2
CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ecmwf@sbcblk_algo_ecmwf.F90' CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ecmwf@sbcblk_algo_ecmwf.F90'
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
IF( kt == nit000 ) CALL SBCBLK_ALGO_ECMWF_INIT(l_use_cs, l_use_wl) IF( kt == nit000 ) CALL SBCBLK_ALGO_ECMWF_INIT(l_use_cs, l_use_wl)
...@@ -206,7 +206,7 @@ CONTAINS ...@@ -206,7 +206,7 @@ CONTAINS
& CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use warm-layer param!' ) & CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use warm-layer param!' )
IF( l_use_cs .OR. l_use_wl ) THEN IF( l_use_cs .OR. l_use_wl ) THEN
ALLOCATE ( zsst(jpi,jpj) ) ALLOCATE ( zsst(A2D(0)) )
zsst = T_s ! backing up the bulk SST zsst = T_s ! backing up the bulk SST
IF( l_use_cs ) T_s = T_s - 0.25_wp ! First guess of correction IF( l_use_cs ) T_s = T_s - 0.25_wp ! First guess of correction
q_s = rdct_qsat_salt*q_sat(MAX(T_s, 200._wp), slp) ! First guess of q_s q_s = rdct_qsat_salt*q_sat(MAX(T_s, 200._wp), slp) ! First guess of q_s
...@@ -360,8 +360,8 @@ CONTAINS ...@@ -360,8 +360,8 @@ CONTAINS
CALL CS_ECMWF( Qsw, ztmp1, u_star, zsst ) ! Qnsol -> ztmp1 CALL CS_ECMWF( Qsw, ztmp1, u_star, zsst ) ! Qnsol -> ztmp1
T_s(:,:) = zsst(:,:) + dT_cs(:,:)*tmask(:,:,1) T_s(:,:) = zsst(:,:) + dT_cs(:,:)*smask0(:,:)
IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1) IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*smask0(:,:)
q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:)) q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
ENDIF ENDIF
...@@ -372,8 +372,8 @@ CONTAINS ...@@ -372,8 +372,8 @@ CONTAINS
& ztmp1, ztmp2) ! Qnsol -> ztmp1 / Tau -> ztmp2 & ztmp1, ztmp2) ! Qnsol -> ztmp1 / Tau -> ztmp2
CALL WL_ECMWF( Qsw, ztmp1, u_star, zsst ) CALL WL_ECMWF( Qsw, ztmp1, u_star, zsst )
!! Updating T_s and q_s !!! !! Updating T_s and q_s !!!
T_s(:,:) = zsst(:,:) + dT_wl(:,:)*tmask(:,:,1) ! T_s(:,:) = zsst(:,:) + dT_wl(:,:)*smask0(:,:) !
IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*tmask(:,:,1) IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*smask0(:,:)
q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:)) q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
ENDIF ENDIF
...@@ -413,14 +413,14 @@ CONTAINS ...@@ -413,14 +413,14 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: psi_m_ecmwf REAL(wp), DIMENSION(A2D(0)) :: psi_m_ecmwf
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zx2, zx, ztmp, zpsi_unst, zpsi_stab, zstab, zc REAL(wp) :: zta, zx2, zx, ztmp, zpsi_unst, zpsi_stab, zstab, zc
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
zc = 5._wp/0.35_wp zc = 5._wp/0.35_wp
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
! !
zta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!): zta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!):
...@@ -454,15 +454,15 @@ CONTAINS ...@@ -454,15 +454,15 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: psi_h_ecmwf REAL(wp), DIMENSION(A2D(0)) :: psi_h_ecmwf
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zx2, zpsi_unst, zpsi_stab, zstab, zc REAL(wp) :: zta, zx2, zpsi_unst, zpsi_stab, zstab, zc
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
zc = 5._wp/0.35_wp zc = 5._wp/0.35_wp
! !
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
! !
zta = MIN(pzeta(ji,jj) , 5._wp) ! Very stable conditions (L positif and big!): zta = MIN(pzeta(ji,jj) , 5._wp) ! Very stable conditions (L positif and big!):
! !
......
src/OCE/SBC/sbcblk_algo_ice_an05.F90
View file @ 3efbcb17
...@@ -79,26 +79,26 @@ CONTAINS ...@@ -79,26 +79,26 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, January 2020 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, January 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m] REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
REAL(wp), INTENT(in ) :: zu ! height for U_zu [m] REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: Ts_i ! ice surface temperature [Kelvin] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: Ts_i ! ice surface temperature [Kelvin]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: t_zt ! potential air temperature [Kelvin] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: t_zt ! potential air temperature [Kelvin]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: qs_i ! sat. spec. hum. at ice/air interface [kg/kg] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: qs_i ! sat. spec. hum. at ice/air interface [kg/kg]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: q_zt ! spec. air humidity at zt [kg/kg] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: q_zt ! spec. air humidity at zt [kg/kg]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: U_zu ! relative wind module at zu [m/s] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: U_zu ! relative wind module at zu [m/s]
REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Cd_i ! drag coefficient over sea-ice REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Cd_i ! drag coefficient over sea-ice
REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Ch_i ! transfert coefficient for heat over ice REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Ch_i ! transfert coefficient for heat over ice
REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Ce_i ! transfert coefficient for sublimation over ice REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Ce_i ! transfert coefficient for sublimation over ice
REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: t_zu_i ! pot. air temp. adjusted at zu [K] REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: t_zu_i ! pot. air temp. adjusted at zu [K]
REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: q_zu_i ! spec. humidity adjusted at zu [kg/kg] REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: q_zu_i ! spec. humidity adjusted at zu [kg/kg]
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: CdN REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: CdN
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: ChN REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: ChN
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: CeN REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: CeN
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xz0 ! Aerodynamic roughness length [m] REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xz0 ! Aerodynamic roughness length [m]
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xu_star ! u*, friction velocity REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xu_star ! u*, friction velocity
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xL ! zeta (zu/L) REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xL ! zeta (zu/L)
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xUN10 ! Neutral wind at zu REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xUN10 ! Neutral wind at zu
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: Ubzu REAL(wp), DIMENSION(:,:), ALLOCATABLE :: Ubzu
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztmp0, ztmp1, ztmp2 ! temporary stuff REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztmp0, ztmp1, ztmp2 ! temporary stuff
...@@ -116,10 +116,10 @@ CONTAINS ...@@ -116,10 +116,10 @@ CONTAINS
!! !!
CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ice_an05@sbcblk_algo_ice_an05.f90' CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ice_an05@sbcblk_algo_ice_an05.f90'
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
ALLOCATE ( Ubzu(jpi,jpj), u_star(jpi,jpj), t_star(jpi,jpj), q_star(jpi,jpj), & ALLOCATE ( Ubzu(A2D(0)), u_star(A2D(0)), t_star(A2D(0)), q_star(A2D(0)), &
& zeta_u(jpi,jpj), dt_zu(jpi,jpj), dq_zu(jpi,jpj), & & zeta_u(A2D(0)), dt_zu(A2D(0)), dq_zu(A2D(0)), &
& znu_a(jpi,jpj), ztmp1(jpi,jpj), ztmp2(jpi,jpj), & & znu_a(A2D(0)), ztmp1(A2D(0)), ztmp2(A2D(0)), &
& z0(jpi,jpj), z0tq(jpi,jpj,2), ztmp0(jpi,jpj) ) & z0(A2D(0)), z0tq(A2D(0),2), ztmp0(A2D(0)) )
lreturn_cdn = PRESENT(CdN) lreturn_cdn = PRESENT(CdN)
lreturn_chn = PRESENT(ChN) lreturn_chn = PRESENT(ChN)
...@@ -130,7 +130,7 @@ CONTAINS ...@@ -130,7 +130,7 @@ CONTAINS
lreturn_UN10 = PRESENT(xUN10) lreturn_UN10 = PRESENT(xUN10)
l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp )
IF( .NOT. l_zt_equal_zu ) ALLOCATE( zeta_t(jpi,jpj) ) IF( .NOT. l_zt_equal_zu ) ALLOCATE( zeta_t(A2D(0)) )
!! Scalar wind speed cannot be below 0.2 m/s !! Scalar wind speed cannot be below 0.2 m/s
Ubzu = MAX( U_zu, wspd_thrshld_ice ) Ubzu = MAX( U_zu, wspd_thrshld_ice )
...@@ -227,14 +227,14 @@ CONTAINS ...@@ -227,14 +227,14 @@ CONTAINS
!! !!
!! Author: L. Brodeau, January 2020 / AeroBulk (https://github.com/brodeau/aerobulk/) !! Author: L. Brodeau, January 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: rough_leng_m ! roughness length over sea-ice [m] REAL(wp), DIMENSION(A2D(0)) :: rough_leng_m ! roughness length over sea-ice [m]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus ! u* = friction velocity [m/s] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pus ! u* = friction velocity [m/s]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pnua ! kinematic viscosity of air [m^2/s] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pnua ! kinematic viscosity of air [m^2/s]
!! !!
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zus, zz REAL(wp) :: zus, zz
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zus = MAX( pus(ji,jj) , 1.E-9_wp ) zus = MAX( pus(ji,jj) , 1.E-9_wp )
zz = (zus - 0.18_wp) / 0.1_wp zz = (zus - 0.18_wp) / 0.1_wp
...@@ -251,16 +251,16 @@ CONTAINS ...@@ -251,16 +251,16 @@ CONTAINS
!! !!
!! Author: L. Brodeau, January 2020 / AeroBulk (https://github.com/brodeau/aerobulk/) !! Author: L. Brodeau, January 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj,2) :: rough_leng_tq ! temp.,hum. roughness lengthes over sea-ice [m] REAL(wp), DIMENSION(A2D(0),2) :: rough_leng_tq ! temp.,hum. roughness lengthes over sea-ice [m]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0 ! roughness length [m] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pz0 ! roughness length [m]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus ! u* = friction velocity [m/s] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pus ! u* = friction velocity [m/s]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pnua ! kinematic viscosity of air [m^2/s] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pnua ! kinematic viscosity of air [m^2/s]
!! !!
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zz0, zus, zre, zsmoot, ztrans, zrough REAL(wp) :: zz0, zus, zre, zsmoot, ztrans, zrough
REAL(wp) :: zb0, zb1, zb2, zlog, zlog2, zlog_z0s_on_z0 REAL(wp) :: zb0, zb1, zb2, zlog, zlog2, zlog_z0s_on_z0
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zz0 = pz0(ji,jj) zz0 = pz0(ji,jj)
zus = MAX( pus(ji,jj) , 1.E-9_wp ) zus = MAX( pus(ji,jj) , 1.E-9_wp )
zre = MAX( zus*zz0/pnua(ji,jj) , 0._wp ) ! Roughness Reynolds number zre = MAX( zus*zz0/pnua(ji,jj) , 0._wp ) ! Roughness Reynolds number
...@@ -315,13 +315,13 @@ CONTAINS ...@@ -315,13 +315,13 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, 2020 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: psi_m_ice REAL(wp), DIMENSION(A2D(0)) :: psi_m_ice
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zx, zpsi_u, zpsi_s, zstab REAL(wp) :: zta, zx, zpsi_u, zpsi_s, zstab
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! DO_2D( 0, 0, 0, 0 ) !
zta = pzeta(ji,jj) zta = pzeta(ji,jj)
! !
! Unstable stratification: ! Unstable stratification:
...@@ -360,13 +360,13 @@ CONTAINS ...@@ -360,13 +360,13 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, 2020 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: psi_h_ice REAL(wp), DIMENSION(A2D(0)) :: psi_h_ice
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zx, zpsi_u, zpsi_s, zstab REAL(wp) :: zta, zx, zpsi_u, zpsi_s, zstab
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! DO_2D( 0, 0, 0, 0 ) !
zta = pzeta(ji,jj) zta = pzeta(ji,jj)
! !
! Unstable stratification: ! Unstable stratification:
......
src/OCE/SBC/sbcblk_algo_ice_cdn.F90
View file @ 3efbcb17
...@@ -59,12 +59,12 @@ CONTAINS ...@@ -59,12 +59,12 @@ CONTAINS
!! ** References : Lupkes et al. JGR 2012 (theory) !! ** References : Lupkes et al. JGR 2012 (theory)
!! !!
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: CdN10_f_LU12 ! neutral FORM drag coefficient contribution over sea-ice REAL(wp), DIMENSION(A2D(0)) :: CdN10_f_LU12 ! neutral FORM drag coefficient contribution over sea-ice
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc2, phf and pDi all provided... REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc2, phf and pDi all provided...
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0w ! roughness length over water [m] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pz0w ! roughness length over water [m]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pSc2 ! squared shletering function [0-1] (Sc->1 for large distance between floes, ->0 for small distances) REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: pSc2 ! squared shletering function [0-1] (Sc->1 for large distance between floes, ->0 for small distances)
REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: phf ! mean freeboard of floes [m] REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: phf ! mean freeboard of floes [m]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pDi ! cross wind dimension of the floe (aka effective edge length for form drag) [m] REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: pDi ! cross wind dimension of the floe (aka effective edge length for form drag) [m]
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
LOGICAL :: l_known_Sc2=.FALSE., l_known_hf=.FALSE., l_known_Di=.FALSE. LOGICAL :: l_known_Sc2=.FALSE., l_known_hf=.FALSE., l_known_Di=.FALSE.
REAL(wp) :: ztmp, zrlog, zfri, zfrw, zSc2, zhf, zDi REAL(wp) :: ztmp, zrlog, zfri, zfrw, zSc2, zhf, zDi
...@@ -74,7 +74,7 @@ CONTAINS ...@@ -74,7 +74,7 @@ CONTAINS
l_known_hf = PRESENT(phf) l_known_hf = PRESENT(phf)
l_known_Di = PRESENT(pDi) l_known_Di = PRESENT(pDi)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zfri = pfrice(ji,jj) zfri = pfrice(ji,jj)
zfrw = (1._wp - zfri) zfrw = (1._wp - zfri)
...@@ -113,9 +113,9 @@ CONTAINS ...@@ -113,9 +113,9 @@ CONTAINS
FUNCTION CdN_f_LU12_eq36( pzu, pfrice ) FUNCTION CdN_f_LU12_eq36( pzu, pfrice )
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: CdN_f_LU12_eq36 ! neutral FORM drag coefficient contribution over sea-ice REAL(wp), DIMENSION(A2D(0)) :: CdN_f_LU12_eq36 ! neutral FORM drag coefficient contribution over sea-ice
REAL(wp), INTENT(in) :: pzu ! reference height [m] REAL(wp), INTENT(in) :: pzu ! reference height [m]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc2, phf and pDi all provided... REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc2, phf and pDi all provided...
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
REAL(wp) :: ztmp, zrlog, zfri, zhf, zDi REAL(wp) :: ztmp, zrlog, zfri, zhf, zDi
INTEGER :: ji, jj INTEGER :: ji, jj
...@@ -127,7 +127,7 @@ CONTAINS ...@@ -127,7 +127,7 @@ CONTAINS
ztmp = 1._wp/rz0_w_0 ztmp = 1._wp/rz0_w_0
zrlog = LOG(zhf*ztmp) / LOG(pzu*ztmp) zrlog = LOG(zhf*ztmp) / LOG(pzu*ztmp)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zfri = pfrice(ji,jj) zfri = pfrice(ji,jj)
CdN_f_LU12_eq36(ji,jj) = 0.5_wp* 0.3_wp * zrlog*zrlog * zhf/zDi * (1._wp - zfri)**rBeta_0 ! Eq.(35) & (36) CdN_f_LU12_eq36(ji,jj) = 0.5_wp* 0.3_wp * zrlog*zrlog * zhf/zDi * (1._wp - zfri)**rBeta_0 ! Eq.(35) & (36)
!! 1/2 Ce !! 1/2 Ce
...@@ -167,8 +167,8 @@ CONTAINS ...@@ -167,8 +167,8 @@ CONTAINS
!! Lupkes et al. GRL 2013 (application to GCM) !! Lupkes et al. GRL 2013 (application to GCM)
!! !!
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: CdN10_f_LU13 ! neutral FORM drag coefficient contribution over sea-ice REAL(wp), DIMENSION(A2D(0)) :: CdN10_f_LU13 ! neutral FORM drag coefficient contribution over sea-ice
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
INTEGER :: ji, jj INTEGER :: ji, jj
REAL(wp) :: zcoef REAL(wp) :: zcoef
...@@ -178,7 +178,7 @@ CONTAINS ...@@ -178,7 +178,7 @@ CONTAINS
!! We are not an AGCM, we are an OGCM!!! => we drop term "(1 - A)*Cd_w" !! We are not an AGCM, we are an OGCM!!! => we drop term "(1 - A)*Cd_w"
!! => so we keep only the last rhs terms of Eq.(1) of Lupkes et al, 2013 that we divide by "A": !! => so we keep only the last rhs terms of Eq.(1) of Lupkes et al, 2013 that we divide by "A":
!! (we multiply Cd_i_s and Cd_i_f by A later, when applying ocean-ice partitioning... !! (we multiply Cd_i_s and Cd_i_f by A later, when applying ocean-ice partitioning...
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
CdN10_f_LU13(ji,jj) = rCe_0 * pfrice(ji,jj)**(rMu_0 - 1._wp) * (1._wp - pfrice(ji,jj))**zcoef CdN10_f_LU13(ji,jj) = rCe_0 * pfrice(ji,jj)**(rMu_0 - 1._wp) * (1._wp - pfrice(ji,jj))**zcoef
END_2D END_2D
!! => seems okay for winter 100% sea-ice as second rhs term vanishes as pfrice == 1.... !! => seems okay for winter 100% sea-ice as second rhs term vanishes as pfrice == 1....
...@@ -203,13 +203,13 @@ CONTAINS ...@@ -203,13 +203,13 @@ CONTAINS
!! ** References : Lupkes & Gryanik (2015) !! ** References : Lupkes & Gryanik (2015)
!! !!
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: CdN_f_LG15 ! neutral FORM drag coefficient contribution over sea-ice REAL(wp), DIMENSION(A2D(0)) :: CdN_f_LG15 ! neutral FORM drag coefficient contribution over sea-ice
REAL(wp), INTENT(in ) :: pzu ! reference height [m] REAL(wp), INTENT(in ) :: pzu ! reference height [m]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc2, phf and pDi all provided... REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc2, phf and pDi all provided...
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0i ! roughness length over ICE [m] (in LU12, it's over water ???) REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pz0i ! roughness length over ICE [m] (in LU12, it's over water ???)
REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pSc2 ! squared shletering function [0-1] (Sc->1 for large distance between floes, ->0 for small distances) REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: pSc2 ! squared shletering function [0-1] (Sc->1 for large distance between floes, ->0 for small distances)
REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: phf ! mean freeboard of floes [m] REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: phf ! mean freeboard of floes [m]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pDi ! cross wind dimension of the floe (aka effective edge length for form drag) [m] REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: pDi ! cross wind dimension of the floe (aka effective edge length for form drag) [m]
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
LOGICAL :: l_known_Sc2=.FALSE., l_known_hf=.FALSE., l_known_Di=.FALSE. LOGICAL :: l_known_Sc2=.FALSE., l_known_hf=.FALSE., l_known_Di=.FALSE.
REAL(wp) :: ztmp, zrlog, zfri, zfrw, zSc2, zhf, zDi REAL(wp) :: ztmp, zrlog, zfri, zfrw, zSc2, zhf, zDi
...@@ -219,7 +219,7 @@ CONTAINS ...@@ -219,7 +219,7 @@ CONTAINS
l_known_hf = PRESENT(phf) l_known_hf = PRESENT(phf)
l_known_Di = PRESENT(pDi) l_known_Di = PRESENT(pDi)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zfri = pfrice(ji,jj) zfri = pfrice(ji,jj)
zfrw = (1._wp - zfri) zfrw = (1._wp - zfri)
...@@ -270,15 +270,15 @@ CONTAINS ...@@ -270,15 +270,15 @@ CONTAINS
!! ** References : Lupkes & Gryanik (2015) !! ** References : Lupkes & Gryanik (2015)
!! !!
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: CdN_f_LG15_light ! neutral FORM drag coefficient contribution over sea-ice REAL(wp), DIMENSION(A2D(0)) :: CdN_f_LG15_light ! neutral FORM drag coefficient contribution over sea-ice
REAL(wp), INTENT(in) :: pzu ! reference height [m] REAL(wp), INTENT(in) :: pzu ! reference height [m]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0w ! roughness length over water [m] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pz0w ! roughness length over water [m]
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
REAL(wp) :: ztmp, zrlog, zfri REAL(wp) :: ztmp, zrlog, zfri
INTEGER :: ji, jj INTEGER :: ji, jj
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zfri = pfrice(ji,jj) zfri = pfrice(ji,jj)
......
src/OCE/SBC/sbcblk_algo_ice_lg15.F90
View file @ 3efbcb17
...@@ -42,6 +42,8 @@ MODULE sbcblk_algo_ice_lg15 ...@@ -42,6 +42,8 @@ MODULE sbcblk_algo_ice_lg15
INTEGER , PARAMETER :: nbit = 8 ! number of itterations INTEGER , PARAMETER :: nbit = 8 ! number of itterations
!! * Substitutions
# include "do_loop_substitute.h90"
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
CONTAINS CONTAINS
...@@ -92,27 +94,27 @@ CONTAINS ...@@ -92,27 +94,27 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, January 2020 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, January 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m] REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
REAL(wp), INTENT(in ) :: zu ! height for U_zu [m] REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: Ts_i ! ice surface temperature [Kelvin] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: Ts_i ! ice surface temperature [Kelvin]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: t_zt ! potential air temperature [Kelvin] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: t_zt ! potential air temperature [Kelvin]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: qs_i ! sat. spec. hum. at ice/air interface [kg/kg] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: qs_i ! sat. spec. hum. at ice/air interface [kg/kg]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: q_zt ! spec. air humidity at zt [kg/kg] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: q_zt ! spec. air humidity at zt [kg/kg]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: U_zu ! relative wind module at zu [m/s] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: U_zu ! relative wind module at zu [m/s]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: frice ! sea-ice concentration (fraction) REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: frice ! sea-ice concentration (fraction)
REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Cd_i ! drag coefficient over sea-ice REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Cd_i ! drag coefficient over sea-ice
REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Ch_i ! transfert coefficient for heat over ice REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Ch_i ! transfert coefficient for heat over ice
REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Ce_i ! transfert coefficient for sublimation over ice REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Ce_i ! transfert coefficient for sublimation over ice
REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: t_zu_i ! pot. air temp. adjusted at zu [K] REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: t_zu_i ! pot. air temp. adjusted at zu [K]
REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: q_zu_i ! spec. humidity adjusted at zu [kg/kg] REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: q_zu_i ! spec. humidity adjusted at zu [kg/kg]
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: CdN REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: CdN
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: ChN REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: ChN
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: CeN REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: CeN
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xz0 ! Aerodynamic roughness length [m] REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xz0 ! Aerodynamic roughness length [m]
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xu_star ! u*, friction velocity REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xu_star ! u*, friction velocity
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xL ! zeta (zu/L) REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xL ! zeta (zu/L)
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xUN10 ! Neutral wind at zu REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xUN10 ! Neutral wind at zu
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: Ubzu REAL(wp), DIMENSION(:,:), ALLOCATABLE :: Ubzu
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztmp1, ztmp2 ! temporary stuff REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztmp1, ztmp2 ! temporary stuff
...@@ -128,11 +130,11 @@ CONTAINS ...@@ -128,11 +130,11 @@ CONTAINS
!! !!
CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ice_lg15@sbcblk_algo_ice_lg15.f90' CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ice_lg15@sbcblk_algo_ice_lg15.f90'
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
ALLOCATE ( Ubzu(jpi,jpj) ) ALLOCATE ( Ubzu(A2D(0)) )
ALLOCATE ( ztmp1(jpi,jpj), ztmp2(jpi,jpj) ) ALLOCATE ( ztmp1(A2D(0)), ztmp2(A2D(0)) )
ALLOCATE ( dt_zu(jpi,jpj), dq_zu(jpi,jpj) ) ALLOCATE ( dt_zu(A2D(0)), dq_zu(A2D(0)) )
ALLOCATE ( zz0_s(jpi,jpj), zz0_f(jpi,jpj), RiB(jpi,jpj), & ALLOCATE ( zz0_s(A2D(0)), zz0_f(A2D(0)), RiB(A2D(0)), &
& zCdN_s(jpi,jpj), zChN_s(jpi,jpj), zCdN_f(jpi,jpj), zChN_f(jpi,jpj) ) & zCdN_s(A2D(0)), zChN_s(A2D(0)), zCdN_f(A2D(0)), zChN_f(A2D(0)) )
lreturn_cdn = PRESENT(CdN) lreturn_cdn = PRESENT(CdN)
lreturn_chn = PRESENT(ChN) lreturn_chn = PRESENT(ChN)
......
src/OCE/SBC/sbcblk_algo_ice_lu12.F90
View file @ 3efbcb17
...@@ -32,6 +32,8 @@ MODULE sbcblk_algo_ice_lu12 ...@@ -32,6 +32,8 @@ MODULE sbcblk_algo_ice_lu12
REAL(wp), PARAMETER :: rz0_i_s_0 = 0.69e-3_wp ! Eq.(43) of Lupkes & Gryanik (2015) [m] => to estimate CdN10 for skin drag! REAL(wp), PARAMETER :: rz0_i_s_0 = 0.69e-3_wp ! Eq.(43) of Lupkes & Gryanik (2015) [m] => to estimate CdN10 for skin drag!
REAL(wp), PARAMETER :: rz0_i_f_0 = 4.54e-4_wp ! bottom p.562 MIZ [m] (LG15) REAL(wp), PARAMETER :: rz0_i_f_0 = 4.54e-4_wp ! bottom p.562 MIZ [m] (LG15)
!! * Substitutions
# include "do_loop_substitute.h90"
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
CONTAINS CONTAINS
...@@ -79,27 +81,27 @@ CONTAINS ...@@ -79,27 +81,27 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, January 2020 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, January 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m] REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
REAL(wp), INTENT(in ) :: zu ! height for U_zu [m] REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: Ts_i ! ice surface temperature [Kelvin] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: Ts_i ! ice surface temperature [Kelvin]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: t_zt ! potential air temperature [Kelvin] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: t_zt ! potential air temperature [Kelvin]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: qs_i ! sat. spec. hum. at ice/air interface [kg/kg] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: qs_i ! sat. spec. hum. at ice/air interface [kg/kg]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: q_zt ! spec. air humidity at zt [kg/kg] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: q_zt ! spec. air humidity at zt [kg/kg]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: U_zu ! relative wind module at zu [m/s] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: U_zu ! relative wind module at zu [m/s]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: frice ! sea-ice concentration (fraction) REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: frice ! sea-ice concentration (fraction)
REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Cd_i ! drag coefficient over sea-ice REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Cd_i ! drag coefficient over sea-ice
REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Ch_i ! transfert coefficient for heat over ice REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Ch_i ! transfert coefficient for heat over ice
REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Ce_i ! transfert coefficient for sublimation over ice REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Ce_i ! transfert coefficient for sublimation over ice
REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: t_zu_i ! pot. air temp. adjusted at zu [K] REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: t_zu_i ! pot. air temp. adjusted at zu [K]
REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: q_zu_i ! spec. humidity adjusted at zu [kg/kg] REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: q_zu_i ! spec. humidity adjusted at zu [kg/kg]
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: CdN REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: CdN
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: ChN REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: ChN
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: CeN REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: CeN
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xz0 ! Aerodynamic roughness length [m] REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xz0 ! Aerodynamic roughness length [m]
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xu_star ! u*, friction velocity REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xu_star ! u*, friction velocity
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xL ! zeta (zu/L) REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xL ! zeta (zu/L)
REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xUN10 ! Neutral wind at zu REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xUN10 ! Neutral wind at zu
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dt_zu, dq_zu, z0 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dt_zu, dq_zu, z0
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: Ubzu REAL(wp), DIMENSION(:,:), ALLOCATABLE :: Ubzu
...@@ -109,8 +111,8 @@ CONTAINS ...@@ -109,8 +111,8 @@ CONTAINS
!! !!
CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ice_lu12@sbcblk_algo_ice_lu12.f90' CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ice_lu12@sbcblk_algo_ice_lu12.f90'
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
ALLOCATE ( Ubzu(jpi,jpj) ) ALLOCATE ( Ubzu(A2D(0)) )
ALLOCATE ( dt_zu(jpi,jpj), dq_zu(jpi,jpj), z0(jpi,jpj) ) ALLOCATE ( dt_zu(A2D(0)), dq_zu(A2D(0)), z0(A2D(0)) )
lreturn_cdn = PRESENT(CdN) lreturn_cdn = PRESENT(CdN)
lreturn_chn = PRESENT(ChN) lreturn_chn = PRESENT(ChN)
......
src/OCE/SBC/sbcblk_algo_ncar.F90
View file @ 3efbcb17
...@@ -79,32 +79,32 @@ CONTAINS ...@@ -79,32 +79,32 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m] REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
REAL(wp), INTENT(in ) :: zu ! height for U_zu [m] REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: sst ! sea surface temperature [Kelvin] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: sst ! sea surface temperature [Kelvin]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: t_zt ! potential air temperature [Kelvin] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: t_zt ! potential air temperature [Kelvin]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: ssq ! sea surface specific humidity [kg/kg] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: ssq ! sea surface specific humidity [kg/kg]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: q_zt ! specific air humidity at zt [kg/kg] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: q_zt ! specific air humidity at zt [kg/kg]
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: U_zu ! relative wind module at zu [m/s] REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: U_zu ! relative wind module at zu [m/s]
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Cd ! transfer coefficient for momentum (tau) REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Cd ! transfer coefficient for momentum (tau)
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ch ! transfer coefficient for sensible heat (Q_sens) REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ch ! transfer coefficient for sensible heat (Q_sens)
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ce ! transfert coefficient for evaporation (Q_lat) REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ce ! transfert coefficient for evaporation (Q_lat)
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: t_zu ! pot. air temp. adjusted at zu [K] REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: t_zu ! pot. air temp. adjusted at zu [K]
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: q_zu ! spec. humidity adjusted at zu [kg/kg] REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: q_zu ! spec. humidity adjusted at zu [kg/kg]
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ubzu ! bulk wind speed at zu [m/s] REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ubzu ! bulk wind speed at zu [m/s]
! !
INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CdN REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CdN
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: ChN REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: ChN
REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CeN REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CeN
! !
INTEGER :: nbit, jit ! iterations... INTEGER :: nbit, jit ! iterations...
LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U
! !
REAL(wp), DIMENSION(jpi,jpj) :: zCdN, zCeN, zChN ! 10m neutral latent/sensible coefficient REAL(wp), DIMENSION(A2D(0)) :: zCdN, zCeN, zChN ! 10m neutral latent/sensible coefficient
REAL(wp), DIMENSION(jpi,jpj) :: zsqrt_Cd, zsqrt_CdN ! root square of Cd and Cd_neutral REAL(wp), DIMENSION(A2D(0)) :: zsqrt_Cd, zsqrt_CdN ! root square of Cd and Cd_neutral
REAL(wp), DIMENSION(jpi,jpj) :: zeta_u ! stability parameter at height zu REAL(wp), DIMENSION(A2D(0)) :: zeta_u ! stability parameter at height zu
REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 REAL(wp), DIMENSION(A2D(0)) :: ztmp0, ztmp1, ztmp2
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
nbit = nb_iter0 nbit = nb_iter0
IF( PRESENT(nb_iter) ) nbit = nb_iter IF( PRESENT(nb_iter) ) nbit = nb_iter
...@@ -119,7 +119,7 @@ CONTAINS ...@@ -119,7 +119,7 @@ CONTAINS
!! Neutral coefficients at 10m: !! Neutral coefficients at 10m:
IF( ln_cdgw ) THEN ! wave drag case IF( ln_cdgw ) THEN ! wave drag case
cdn_wave(:,:) = cdn_wave(:,:) + rsmall * ( 1._wp - tmask(:,:,1) ) cdn_wave(:,:) = cdn_wave(:,:) + rsmall * ( 1._wp - smask0(:,:) )
zCdN (:,:) = cdn_wave(:,:) zCdN (:,:) = cdn_wave(:,:)
ELSE ELSE
zCdN = cd_n10_ncar( Ubzu ) zCdN = cd_n10_ncar( Ubzu )
...@@ -231,14 +231,14 @@ CONTAINS ...@@ -231,14 +231,14 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pw10 ! scalar wind speed at 10m (m/s) REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pw10 ! scalar wind speed at 10m (m/s)
REAL(wp), DIMENSION(jpi,jpj) :: cd_n10_ncar REAL(wp), DIMENSION(A2D(0)) :: cd_n10_ncar
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zgt33, zw, zw6 ! local scalars REAL(wp) :: zgt33, zw, zw6 ! local scalars
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
! !
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
! !
zw = pw10(ji,jj) zw = pw10(ji,jj)
zw6 = zw*zw*zw zw6 = zw*zw*zw
...@@ -264,9 +264,9 @@ CONTAINS ...@@ -264,9 +264,9 @@ CONTAINS
!! Origin: Large & Yeager 2008, Eq. (9) and (12) !! Origin: Large & Yeager 2008, Eq. (9) and (12)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: ch_n10_ncar REAL(wp), DIMENSION(A2D(0)) :: ch_n10_ncar
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psqrtcdn10 ! sqrt( CdN10 ) REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: psqrtcdn10 ! sqrt( CdN10 )
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pstab ! stable ABL => 1 / unstable ABL => 0 REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pstab ! stable ABL => 1 / unstable ABL => 0
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
IF( ANY(pstab < -0.00001) .OR. ANY(pstab > 1.00001) ) THEN IF( ANY(pstab < -0.00001) .OR. ANY(pstab > 1.00001) ) THEN
PRINT *, 'ERROR: ch_n10_ncar@mod_blk_ncar.f90: pstab =' PRINT *, 'ERROR: ch_n10_ncar@mod_blk_ncar.f90: pstab ='
...@@ -283,8 +283,8 @@ CONTAINS ...@@ -283,8 +283,8 @@ CONTAINS
!! Estimate of the neutral heat transfer coefficient at 10m !! !! Estimate of the neutral heat transfer coefficient at 10m !!
!! Origin: Large & Yeager 2008, Eq. (9) and (13) !! Origin: Large & Yeager 2008, Eq. (9) and (13)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: ce_n10_ncar REAL(wp), DIMENSION(A2D(0)) :: ce_n10_ncar
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psqrtcdn10 ! sqrt( CdN10 ) REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: psqrtcdn10 ! sqrt( CdN10 )
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
ce_n10_ncar = MAX( 1.e-3_wp * ( 34.6_wp * psqrtcdn10 ) , Cx_min ) ce_n10_ncar = MAX( 1.e-3_wp * ( 34.6_wp * psqrtcdn10 ) , Cx_min )
! !
...@@ -301,13 +301,13 @@ CONTAINS ...@@ -301,13 +301,13 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: psi_m_ncar REAL(wp), DIMENSION(A2D(0)) :: psi_m_ncar
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zx2, zx, zpsi_unst, zpsi_stab, zstab ! local scalars REAL(wp) :: zta, zx2, zx, zpsi_unst, zpsi_stab, zstab ! local scalars
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zta = pzeta(ji,jj) zta = pzeta(ji,jj)
! !
zx2 = SQRT( ABS(1._wp - 16._wp*zta) ) ! (1 - 16z)^0.5 zx2 = SQRT( ABS(1._wp - 16._wp*zta) ) ! (1 - 16z)^0.5
...@@ -339,14 +339,14 @@ CONTAINS ...@@ -339,14 +339,14 @@ CONTAINS
!! !!
!! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: psi_h_ncar REAL(wp), DIMENSION(A2D(0)) :: psi_h_ncar
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zx2, zpsi_unst, zpsi_stab, zstab ! local scalars REAL(wp) :: zta, zx2, zpsi_unst, zpsi_stab, zstab ! local scalars
!!---------------------------------------------------------------------------------- !!----------------------------------------------------------------------------------
! !
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
! !
zta = pzeta(ji,jj) zta = pzeta(ji,jj)
! !
......
src/OCE/SBC/sbcblk_skin_coare.F90
View file @ 3efbcb17
...@@ -79,16 +79,16 @@ CONTAINS ...@@ -79,16 +79,16 @@ CONTAINS
!! *pSST* bulk SST (taken at depth gdept_1d(1)) [K] !! *pSST* bulk SST (taken at depth gdept_1d(1)) [K]
!! *pQlat* surface latent heat flux [K] !! *pQlat* surface latent heat flux [K]
!!------------------------------------------------------------------ !!------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQsw ! net solar a.k.a shortwave radiation into the ocean (after albedo) [W/m^2] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQsw ! net solar a.k.a shortwave radiation into the ocean (after albedo) [W/m^2]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQnsol ! non-solar heat flux to the ocean [W/m^2] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQnsol ! non-solar heat flux to the ocean [W/m^2]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pustar ! friction velocity, temperature and humidity (u*,t*,q*) REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pustar ! friction velocity, temperature and humidity (u*,t*,q*)
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pSST ! bulk SST [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pSST ! bulk SST [K]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQlat ! latent heat flux [W/m^2] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQlat ! latent heat flux [W/m^2]
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
INTEGER :: ji, jj, jc INTEGER :: ji, jj, jc
REAL(wp) :: zQabs, zdlt, zfr, zalfa, zqlat, zus REAL(wp) :: zQabs, zdlt, zfr, zalfa, zqlat, zus
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zQabs = pQnsol(ji,jj) ! first guess of heat flux absorbed within the viscous sublayer of thicknes delta, zQabs = pQnsol(ji,jj) ! first guess of heat flux absorbed within the viscous sublayer of thicknes delta,
! ! => we DO not miss a lot assuming 0 solar flux absorbed in the tiny layer of thicknes zdlt... ! ! => we DO not miss a lot assuming 0 solar flux absorbed in the tiny layer of thicknes zdlt...
...@@ -129,11 +129,11 @@ CONTAINS ...@@ -129,11 +129,11 @@ CONTAINS
!! *pSST* bulk SST (taken at depth gdept_1d(1)) [K] !! *pSST* bulk SST (taken at depth gdept_1d(1)) [K]
!! *iwait* if /= 0 then wait before updating accumulated fluxes, we are within a converging itteration loop... !! *iwait* if /= 0 then wait before updating accumulated fluxes, we are within a converging itteration loop...
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQsw ! surface net solar radiation into the ocean [W/m^2] => >= 0 ! REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQsw ! surface net solar radiation into the ocean [W/m^2] => >= 0 !
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQnsol ! surface net non-solar heat flux into the ocean [W/m^2] => normally < 0 ! REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQnsol ! surface net non-solar heat flux into the ocean [W/m^2] => normally < 0 !
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pTau ! wind stress [N/m^2] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pTau ! wind stress [N/m^2]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pSST ! bulk SST at depth gdept_1d(1) [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pSST ! bulk SST at depth gdept_1d(1) [K]
INTEGER , INTENT(in) :: iwait ! if /= 0 then wait before updating accumulated fluxes INTEGER , INTENT(in) :: iwait ! if /= 0 then wait before updating accumulated fluxes
!! !!
INTEGER :: ji,jj INTEGER :: ji,jj
! !
...@@ -155,7 +155,7 @@ CONTAINS ...@@ -155,7 +155,7 @@ CONTAINS
ztime = REAL(nsec_day,wp)/(24._wp*3600._wp) ! time of current time step since 00:00 for current day (UTC) -> ztime = 0 -> 00:00 / ztime = 0.5 -> 12:00 ... ztime = REAL(nsec_day,wp)/(24._wp*3600._wp) ! time of current time step since 00:00 for current day (UTC) -> ztime = 0 -> 00:00 / ztime = 0.5 -> 12:00 ...
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
l_exit = .FALSE. l_exit = .FALSE.
l_destroy_wl = .FALSE. l_destroy_wl = .FALSE.
......
src/OCE/SBC/sbcblk_skin_ecmwf.F90
View file @ 3efbcb17
...@@ -87,15 +87,15 @@ CONTAINS ...@@ -87,15 +87,15 @@ CONTAINS
!! *pustar* friction velocity u* [m/s] !! *pustar* friction velocity u* [m/s]
!! *pSST* bulk SST (taken at depth gdept_1d(1)) [K] !! *pSST* bulk SST (taken at depth gdept_1d(1)) [K]
!!------------------------------------------------------------------ !!------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQsw ! net solar a.k.a shortwave radiation into the ocean (after albedo) [W/m^2] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQsw ! net solar a.k.a shortwave radiation into the ocean (after albedo) [W/m^2]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQnsol ! non-solar heat flux to the ocean [W/m^2] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQnsol ! non-solar heat flux to the ocean [W/m^2]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pustar ! friction velocity, temperature and humidity (u*,t*,q*) REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pustar ! friction velocity, temperature and humidity (u*,t*,q*)
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pSST ! bulk SST [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pSST ! bulk SST [K]
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
INTEGER :: ji, jj, jc INTEGER :: ji, jj, jc
REAL(wp) :: zQabs, zdlt, zfr, zalfa, zus REAL(wp) :: zQabs, zdlt, zfr, zalfa, zus
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zQabs = pQnsol(ji,jj) ! first guess of heat flux absorbed within the viscous sublayer of thicknes delta, zQabs = pQnsol(ji,jj) ! first guess of heat flux absorbed within the viscous sublayer of thicknes delta,
! ! => we DO not miss a lot assuming 0 solar flux absorbed in the tiny layer of thicknes zdlt... ! ! => we DO not miss a lot assuming 0 solar flux absorbed in the tiny layer of thicknes zdlt...
...@@ -147,12 +147,12 @@ CONTAINS ...@@ -147,12 +147,12 @@ CONTAINS
!! *pustar* friction velocity u* [m/s] !! *pustar* friction velocity u* [m/s]
!! *pSST* bulk SST (taken at depth gdept_1d(1)) [K] !! *pSST* bulk SST (taken at depth gdept_1d(1)) [K]
!!------------------------------------------------------------------ !!------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQsw ! surface net solar radiation into the ocean [W/m^2] => >= 0 ! REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQsw ! surface net solar radiation into the ocean [W/m^2] => >= 0 !
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQnsol ! surface net non-solar heat flux into the ocean [W/m^2] => normally < 0 ! REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQnsol ! surface net non-solar heat flux into the ocean [W/m^2] => normally < 0 !
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pustar ! friction velocity [m/s] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pustar ! friction velocity [m/s]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pSST ! bulk SST at depth gdept_1d(1) [K] REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pSST ! bulk SST at depth gdept_1d(1) [K]
!! !!
REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pustk ! surface Stokes velocity [m/s] REAL(wp), DIMENSION(A2D(0)), OPTIONAL, INTENT(in) :: pustk ! surface Stokes velocity [m/s]
! !
INTEGER :: ji, jj, jc INTEGER :: ji, jj, jc
! !
...@@ -173,7 +173,7 @@ CONTAINS ...@@ -173,7 +173,7 @@ CONTAINS
l_pustk_known = .FALSE. l_pustk_known = .FALSE.
IF( PRESENT(pustk) ) l_pustk_known = .TRUE. IF( PRESENT(pustk) ) l_pustk_known = .TRUE.
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zHwl = Hz_wl(ji,jj) ! first guess for warm-layer depth (and unique..., less advanced than COARE3p6 !) zHwl = Hz_wl(ji,jj) ! first guess for warm-layer depth (and unique..., less advanced than COARE3p6 !)
! it is = rd0 (3m) in default Zeng & Beljaars case... ! it is = rd0 (3m) in default Zeng & Beljaars case...
......
src/OCE/SBC/sbcclo.F90
View file @ 3efbcb17
...@@ -44,6 +44,8 @@ MODULE sbcclo ...@@ -44,6 +44,8 @@ MODULE sbcclo
! !
INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: mcsgrpg, mcsgrpr, mcsgrpe !: closed sea group for glo, rnf and emp INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: mcsgrpg, mcsgrpr, mcsgrpe !: closed sea group for glo, rnf and emp
! !
!! * Substitutions
# include "do_loop_substitute.h90"
CONTAINS CONTAINS
! !
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
...@@ -120,8 +122,8 @@ MODULE sbcclo ...@@ -120,8 +122,8 @@ MODULE sbcclo
CALL iom_put('qclosea',zqcs) CALL iom_put('qclosea',zqcs)
! !
! 3. update emp and qns ! 3. update emp and qns
emp(:,:) = emp(:,:) + zwcs(:,:) emp(A2D(0)) = emp(A2D(0)) + zwcs(A2D(0))
qns(:,:) = qns(:,:) + zqcs(:,:) qns(:,:) = qns(:,:) + zqcs(A2D(0))
! !
END SUBROUTINE sbc_clo END SUBROUTINE sbc_clo
! !
...@@ -289,7 +291,7 @@ MODULE sbcclo ...@@ -289,7 +291,7 @@ MODULE sbcclo
!! 1. Work out net freshwater over the closed sea from EMP - RNF. !! 1. Work out net freshwater over the closed sea from EMP - RNF.
!! Work out net heat associated with the correction (needed for conservation) !! Work out net heat associated with the correction (needed for conservation)
!! (PM: should we consider used delayed glob sum ?) !! (PM: should we consider used delayed glob sum ?)
zcsfw = glob_sum( 'closea', e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * imsk_src(:,:) ) zcsfw = glob_sum( 'closea', e1e2t(A2D(0)) * ( emp(A2D(0))-rnf(A2D(0)) ) * imsk_src(A2D(0)) )
! !
!! 2. Deal with runoff special case (net evaporation spread globally) !! 2. Deal with runoff special case (net evaporation spread globally)
!! and compute trg mask !! and compute trg mask
......
src/OCE/SBC/sbccpl.F90
View file @ 3efbcb17
...@@ -65,18 +65,19 @@ MODULE sbccpl ...@@ -65,18 +65,19 @@ MODULE sbccpl
PUBLIC sbc_cpl_ice_flx ! routine called by icestp.F90 PUBLIC sbc_cpl_ice_flx ! routine called by icestp.F90
PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90 PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90
!! received fields are only in the interior (without halos)
INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 1 INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 1
INTEGER, PARAMETER :: jpr_oty1 = 2 ! INTEGER, PARAMETER :: jpr_oty1 = 2 !
INTEGER, PARAMETER :: jpr_otz1 = 3 ! INTEGER, PARAMETER :: jpr_otz1 = 3 !
INTEGER, PARAMETER :: jpr_otx2 = 4 ! 3 atmosphere-ocean stress components on grid 2 !!$ INTEGER, PARAMETER :: jpr_otx2 = 4 ! 3 atmosphere-ocean stress components on grid 2
INTEGER, PARAMETER :: jpr_oty2 = 5 ! !!$ INTEGER, PARAMETER :: jpr_oty2 = 5 !
INTEGER, PARAMETER :: jpr_otz2 = 6 ! !!$ INTEGER, PARAMETER :: jpr_otz2 = 6 !
INTEGER, PARAMETER :: jpr_itx1 = 7 ! 3 atmosphere-ice stress components on grid 1 INTEGER, PARAMETER :: jpr_itx1 = 7 ! 3 atmosphere-ice stress components on grid 1
INTEGER, PARAMETER :: jpr_ity1 = 8 ! INTEGER, PARAMETER :: jpr_ity1 = 8 !
INTEGER, PARAMETER :: jpr_itz1 = 9 ! INTEGER, PARAMETER :: jpr_itz1 = 9 !
INTEGER, PARAMETER :: jpr_itx2 = 10 ! 3 atmosphere-ice stress components on grid 2 !!$ INTEGER, PARAMETER :: jpr_itx2 = 10 ! 3 atmosphere-ice stress components on grid 2
INTEGER, PARAMETER :: jpr_ity2 = 11 ! !!$ INTEGER, PARAMETER :: jpr_ity2 = 11 !
INTEGER, PARAMETER :: jpr_itz2 = 12 ! !!$ INTEGER, PARAMETER :: jpr_itz2 = 12 !
INTEGER, PARAMETER :: jpr_qsroce = 13 ! Qsr above the ocean INTEGER, PARAMETER :: jpr_qsroce = 13 ! Qsr above the ocean
INTEGER, PARAMETER :: jpr_qsrice = 14 ! Qsr above the ice INTEGER, PARAMETER :: jpr_qsrice = 14 ! Qsr above the ice
INTEGER, PARAMETER :: jpr_qsrmix = 15 INTEGER, PARAMETER :: jpr_qsrmix = 15
...@@ -128,10 +129,11 @@ MODULE sbccpl ...@@ -128,10 +129,11 @@ MODULE sbccpl
INTEGER, PARAMETER :: jpr_isf = 60 INTEGER, PARAMETER :: jpr_isf = 60
INTEGER, PARAMETER :: jpr_icb = 61 INTEGER, PARAMETER :: jpr_icb = 61
INTEGER, PARAMETER :: jpr_ts_ice = 62 ! Sea ice surface temp INTEGER, PARAMETER :: jpr_ts_ice = 62 ! Sea ice surface temp
!!INTEGER, PARAMETER :: jpr_qtrice = 63 ! Transmitted solar thru sea-ice INTEGER, PARAMETER :: jpr_qtrice = 63 ! Transmitted solar thru sea-ice
INTEGER, PARAMETER :: jprcv = 62 ! total number of fields received
INTEGER, PARAMETER :: jprcv = 63 ! total number of fields received
!! sent fields are only in the interior (without halos)
INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere
INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature
INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature
...@@ -194,7 +196,7 @@ MODULE sbccpl ...@@ -194,7 +196,7 @@ MODULE sbccpl
& sn_snd_thick1, sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_ttilyr & sn_snd_thick1, sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_ttilyr
! ! Received from the atmosphere ! ! Received from the atmosphere
TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, & TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, &
& sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf, sn_rcv_ts_ice & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf, sn_rcv_ts_ice, sn_rcv_qtrice
TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf
! ! Send to waves ! ! Send to waves
TYPE(FLD_C) :: sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev TYPE(FLD_C) :: sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev
...@@ -202,7 +204,6 @@ MODULE sbccpl ...@@ -202,7 +204,6 @@ MODULE sbccpl
TYPE(FLD_C) :: sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, & TYPE(FLD_C) :: sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, &
& sn_rcv_wstrf, sn_rcv_wdrag, sn_rcv_charn, sn_rcv_taw, sn_rcv_bhd, sn_rcv_tusd, sn_rcv_tvsd & sn_rcv_wstrf, sn_rcv_wdrag, sn_rcv_charn, sn_rcv_taw, sn_rcv_bhd, sn_rcv_tusd, sn_rcv_tvsd
! ! Other namelist parameters ! ! Other namelist parameters
!! TYPE(FLD_C) :: sn_rcv_qtrice
INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models
! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
...@@ -239,12 +240,12 @@ CONTAINS ...@@ -239,12 +240,12 @@ CONTAINS
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
ierr(:) = 0 ierr(:) = 0
! !
ALLOCATE( alb_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) ) ALLOCATE( alb_oce_mix(A2D(0)), nrcvinfo(jprcv), STAT=ierr(1) )
#if ! defined key_si3 && ! defined key_cice #if ! defined key_si3 && ! defined key_cice
ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init)
#endif #endif
ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) ALLOCATE( xcplmask(A2D(0),0:nn_cplmodel) , STAT=ierr(3) )
! !
IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) ) IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) )
...@@ -271,7 +272,7 @@ CONTAINS ...@@ -271,7 +272,7 @@ CONTAINS
! !
INTEGER :: jn ! dummy loop index INTEGER :: jn ! dummy loop index
INTEGER :: ios, inum ! Local integer INTEGER :: ios, inum ! Local integer
REAL(wp), DIMENSION(jpi,jpj) :: zacs, zaos REAL(wp), DIMENSION(A2D(0)) :: zacs, zaos
!! !!
NAMELIST/namsbc_cpl/ nn_cplmodel , ln_usecplmask, nn_cats_cpl , ln_scale_ice_flux, & NAMELIST/namsbc_cpl/ nn_cplmodel , ln_usecplmask, nn_cats_cpl , ln_scale_ice_flux, &
& sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2 , & & sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2 , &
...@@ -281,7 +282,7 @@ CONTAINS ...@@ -281,7 +282,7 @@ CONTAINS
& sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum , sn_rcv_wstrf , & & sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum , sn_rcv_wstrf , &
& sn_rcv_charn , sn_rcv_taw , sn_rcv_bhd , sn_rcv_tusd , sn_rcv_tvsd, & & sn_rcv_charn , sn_rcv_taw , sn_rcv_bhd , sn_rcv_tusd , sn_rcv_tvsd, &
& sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , & & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , &
& sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_icb , sn_rcv_isf , sn_rcv_ts_ice, & !!, sn_rcv_qtrice & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_icb , sn_rcv_isf , sn_rcv_ts_ice, sn_rcv_qtrice, &
& sn_rcv_mslp & sn_rcv_mslp
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
...@@ -313,7 +314,6 @@ CONTAINS ...@@ -313,7 +314,6 @@ CONTAINS
WRITE(numout,*)' surface stress = ', TRIM(sn_rcv_tau%cldes ), ' (', TRIM(sn_rcv_tau%clcat ), ')' WRITE(numout,*)' surface stress = ', TRIM(sn_rcv_tau%cldes ), ' (', TRIM(sn_rcv_tau%clcat ), ')'
WRITE(numout,*)' - referential = ', sn_rcv_tau%clvref WRITE(numout,*)' - referential = ', sn_rcv_tau%clvref
WRITE(numout,*)' - orientation = ', sn_rcv_tau%clvor WRITE(numout,*)' - orientation = ', sn_rcv_tau%clvor
WRITE(numout,*)' - mesh = ', sn_rcv_tau%clvgrd
WRITE(numout,*)' non-solar heat flux sensitivity = ', TRIM(sn_rcv_dqnsdt%cldes), ' (', TRIM(sn_rcv_dqnsdt%clcat), ')' WRITE(numout,*)' non-solar heat flux sensitivity = ', TRIM(sn_rcv_dqnsdt%cldes), ' (', TRIM(sn_rcv_dqnsdt%clcat), ')'
WRITE(numout,*)' solar heat flux = ', TRIM(sn_rcv_qsr%cldes ), ' (', TRIM(sn_rcv_qsr%clcat ), ')' WRITE(numout,*)' solar heat flux = ', TRIM(sn_rcv_qsr%cldes ), ' (', TRIM(sn_rcv_qsr%clcat ), ')'
WRITE(numout,*)' non-solar heat flux = ', TRIM(sn_rcv_qns%cldes ), ' (', TRIM(sn_rcv_qns%clcat ), ')' WRITE(numout,*)' non-solar heat flux = ', TRIM(sn_rcv_qns%cldes ), ' (', TRIM(sn_rcv_qns%clcat ), ')'
...@@ -323,7 +323,7 @@ CONTAINS ...@@ -323,7 +323,7 @@ CONTAINS
WRITE(numout,*)' iceberg = ', TRIM(sn_rcv_icb%cldes ), ' (', TRIM(sn_rcv_icb%clcat ), ')' WRITE(numout,*)' iceberg = ', TRIM(sn_rcv_icb%cldes ), ' (', TRIM(sn_rcv_icb%clcat ), ')'
WRITE(numout,*)' ice shelf = ', TRIM(sn_rcv_isf%cldes ), ' (', TRIM(sn_rcv_isf%clcat ), ')' WRITE(numout,*)' ice shelf = ', TRIM(sn_rcv_isf%cldes ), ' (', TRIM(sn_rcv_isf%clcat ), ')'
WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')'
!! WRITE(numout,*)' transmitted solar thru sea-ice = ', TRIM(sn_rcv_qtrice%cldes), ' (', TRIM(sn_rcv_qtrice%clcat), ')' WRITE(numout,*)' transmitted solar thru sea-ice = ', TRIM(sn_rcv_qtrice%cldes), ' (', TRIM(sn_rcv_qtrice%clcat), ')'
WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')'
WRITE(numout,*)' Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')' WRITE(numout,*)' Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')'
WRITE(numout,*)' surface waves:' WRITE(numout,*)' surface waves:'
...@@ -358,7 +358,7 @@ CONTAINS ...@@ -358,7 +358,7 @@ CONTAINS
WRITE(numout,*)' - mesh = ', sn_snd_crtw%clvgrd WRITE(numout,*)' - mesh = ', sn_snd_crtw%clvgrd
ENDIF ENDIF
IF( lwp .AND. ln_wave) THEN ! control print IF( lwp .AND. ln_wave) THEN ! control print
WRITE(numout,*)' surface waves:' WRITE(numout,*)' surface waves:'
WRITE(numout,*)' Significant wave heigth = ', TRIM(sn_rcv_hsig%cldes ), ' (', TRIM(sn_rcv_hsig%clcat ), ')' WRITE(numout,*)' Significant wave heigth = ', TRIM(sn_rcv_hsig%cldes ), ' (', TRIM(sn_rcv_hsig%clcat ), ')'
WRITE(numout,*)' Wave to oce energy flux = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')' WRITE(numout,*)' Wave to oce energy flux = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')'
WRITE(numout,*)' Surface Stokes drift grid u = ', TRIM(sn_rcv_sdrfx%cldes ), ' (', TRIM(sn_rcv_sdrfx%clcat ), ')' WRITE(numout,*)' Surface Stokes drift grid u = ', TRIM(sn_rcv_sdrfx%cldes ), ' (', TRIM(sn_rcv_sdrfx%clcat ), ')'
...@@ -368,8 +368,8 @@ CONTAINS ...@@ -368,8 +368,8 @@ CONTAINS
WRITE(numout,*)' Stress frac adsorbed by waves = ', TRIM(sn_rcv_wstrf%cldes ), ' (', TRIM(sn_rcv_wstrf%clcat ), ')' WRITE(numout,*)' Stress frac adsorbed by waves = ', TRIM(sn_rcv_wstrf%cldes ), ' (', TRIM(sn_rcv_wstrf%clcat ), ')'
WRITE(numout,*)' Neutral surf drag coefficient = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')' WRITE(numout,*)' Neutral surf drag coefficient = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')'
WRITE(numout,*)' Charnock coefficient = ', TRIM(sn_rcv_charn%cldes ), ' (', TRIM(sn_rcv_charn%clcat ), ')' WRITE(numout,*)' Charnock coefficient = ', TRIM(sn_rcv_charn%cldes ), ' (', TRIM(sn_rcv_charn%clcat ), ')'
WRITE(numout,*)' Transport associated to Stokes drift grid u = ', TRIM(sn_rcv_tusd%cldes ), ' (', TRIM(sn_rcv_tusd%clcat ), ')' WRITE(numout,*)' Transport associated to Stokes drift u = ', TRIM(sn_rcv_tusd%cldes ), ' (', TRIM(sn_rcv_tusd%clcat ), ')'
WRITE(numout,*)' Transport associated to Stokes drift grid v = ', TRIM(sn_rcv_tvsd%cldes ), ' (', TRIM(sn_rcv_tvsd%clcat ), ')' WRITE(numout,*)' Transport associated to Stokes drift v = ', TRIM(sn_rcv_tvsd%cldes ), ' (', TRIM(sn_rcv_tvsd%clcat ), ')'
WRITE(numout,*)' Bernouilli pressure head = ', TRIM(sn_rcv_bhd%cldes ), ' (', TRIM(sn_rcv_bhd%clcat ), ')' WRITE(numout,*)' Bernouilli pressure head = ', TRIM(sn_rcv_bhd%cldes ), ' (', TRIM(sn_rcv_bhd%clcat ), ')'
WRITE(numout,*)'Wave to ocean momentum flux and Net wave-supported stress = ', TRIM(sn_rcv_taw%cldes ), ' (', TRIM(sn_rcv_taw%clcat ), ')' WRITE(numout,*)'Wave to ocean momentum flux and Net wave-supported stress = ', TRIM(sn_rcv_taw%cldes ), ' (', TRIM(sn_rcv_taw%clcat ), ')'
WRITE(numout,*)' Surface current to waves = ', TRIM(sn_snd_crtw%cldes ), ' (', TRIM(sn_snd_crtw%clcat ), ')' WRITE(numout,*)' Surface current to waves = ', TRIM(sn_snd_crtw%cldes ), ' (', TRIM(sn_snd_crtw%clcat ), ')'
...@@ -390,6 +390,7 @@ CONTAINS ...@@ -390,6 +390,7 @@ CONTAINS
! define the north fold type of lbc (srcv(:)%nsgn) ! define the north fold type of lbc (srcv(:)%nsgn)
! default definitions of srcv ! default definitions of srcv
ALLOCATE( srcv(jprcv) )
srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1 srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1
! ! ------------------------- ! ! ! ------------------------- !
...@@ -399,87 +400,26 @@ CONTAINS ...@@ -399,87 +400,26 @@ CONTAINS
srcv(jpr_otx1)%clname = 'O_OTaux1' ! 1st ocean component on grid ONE (T or U) srcv(jpr_otx1)%clname = 'O_OTaux1' ! 1st ocean component on grid ONE (T or U)
srcv(jpr_oty1)%clname = 'O_OTauy1' ! 2nd - - - - srcv(jpr_oty1)%clname = 'O_OTauy1' ! 2nd - - - -
srcv(jpr_otz1)%clname = 'O_OTauz1' ! 3rd - - - - srcv(jpr_otz1)%clname = 'O_OTauz1' ! 3rd - - - -
srcv(jpr_otx2)%clname = 'O_OTaux2' ! 1st ocean component on grid TWO (V)
srcv(jpr_oty2)%clname = 'O_OTauy2' ! 2nd - - - -
srcv(jpr_otz2)%clname = 'O_OTauz2' ! 3rd - - - -
! !
srcv(jpr_itx1)%clname = 'O_ITaux1' ! 1st ice component on grid ONE (T, F, I or U) srcv(jpr_itx1)%clname = 'O_ITaux1' ! 1st ice component on grid ONE (T, F, I or U)
srcv(jpr_ity1)%clname = 'O_ITauy1' ! 2nd - - - - srcv(jpr_ity1)%clname = 'O_ITauy1' ! 2nd - - - -
srcv(jpr_itz1)%clname = 'O_ITauz1' ! 3rd - - - - srcv(jpr_itz1)%clname = 'O_ITauz1' ! 3rd - - - -
srcv(jpr_itx2)%clname = 'O_ITaux2' ! 1st ice component on grid TWO (V)
srcv(jpr_ity2)%clname = 'O_ITauy2' ! 2nd - - - -
srcv(jpr_itz2)%clname = 'O_ITauz2' ! 3rd - - - -
! !
! Vectors: change of sign at north fold ONLY if on the local grid ! Vectors: change of sign at north fold ONLY if on the local grid
IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM( sn_rcv_tau%cldes ) == 'oce and ice' & IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM( sn_rcv_tau%cldes ) == 'oce and ice' &
.OR. TRIM( sn_rcv_tau%cldes ) == 'mixed oce-ice' ) THEN ! avoid working with the atmospheric fields if they are not coupled .OR. TRIM( sn_rcv_tau%cldes ) == 'mixed oce-ice' ) THEN ! avoid working with the atmospheric fields if they are not coupled
! !
IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1. IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz1)%nsgn = -1.
! ! Set grid and action ! ! Set grid and action
SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) ) ! 'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V' srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
CASE( 'T' ) srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
CASE( 'U,V' )
srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
srcv(jpr_itx1:jpr_itz1)%clgrid = 'U' ! ice components given at U-point
srcv(jpr_itx2:jpr_itz2)%clgrid = 'V' ! and V-point
srcv(jpr_otx1:jpr_itz2)%laction = .TRUE. ! receive oce and ice components on both grid 1 & 2
CASE( 'U,V,T' )
srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
srcv(jpr_itx1:jpr_itz1)%clgrid = 'T' ! ice components given at T-point
srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
CASE( 'U,V,I' )
srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
srcv(jpr_itx1:jpr_itz1)%clgrid = 'I' ! ice components given at I-point
srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
CASE( 'U,V,F' )
srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point
srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
CASE( 'T,I' )
srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
srcv(jpr_itx1:jpr_itz1)%clgrid = 'I' ! ice components given at I-point
srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
CASE( 'T,F' )
srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point
srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
CASE( 'T,U,V' )
srcv(jpr_otx1:jpr_otz1)%clgrid = 'T' ! oce components given at T-point
srcv(jpr_itx1:jpr_itz1)%clgrid = 'U' ! ice components given at U-point
srcv(jpr_itx2:jpr_itz2)%clgrid = 'V' ! and V-point
srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1 only
srcv(jpr_itx1:jpr_itz2)%laction = .TRUE. ! receive ice components on grid 1 & 2
CASE default
CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' )
END SELECT
! !
IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' ) & ! spherical: 3rd component not received IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' ) & ! spherical: 3rd component not received
& srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE. & srcv( (/jpr_otz1, jpr_itz1/) )%laction = .FALSE.
!
IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) THEN ! already on local grid -> no need of the second grid
srcv(jpr_otx2:jpr_otz2)%laction = .FALSE.
srcv(jpr_itx2:jpr_itz2)%laction = .FALSE.
srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid ! not needed but cleaner...
srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid ! not needed but cleaner...
ENDIF
! !
IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used
srcv(jpr_itx1:jpr_itz2)%laction = .FALSE. ! ice components not received srcv(jpr_itx1:jpr_itz1)%laction = .FALSE. ! ice components not received
srcv(jpr_itx1)%clgrid = 'U' ! ocean stress used after its transformation
srcv(jpr_ity1)%clgrid = 'V' ! i.e. it is always at U- & V-points for i- & j-comp. resp.
ENDIF ENDIF
ENDIF ENDIF
...@@ -612,18 +552,18 @@ CONTAINS ...@@ -612,18 +552,18 @@ CONTAINS
ENDIF ENDIF
srcv(jpr_topm:jpr_botm)%laction = .TRUE. srcv(jpr_topm:jpr_botm)%laction = .TRUE.
ENDIF ENDIF
!! ! ! --------------------------- ! ! ! --------------------------- !
!! ! ! transmitted solar thru ice ! ! ! transmitted solar thru ice !
!! ! ! --------------------------- ! ! ! --------------------------- !
!! srcv(jpr_qtrice)%clname = 'OQtr' srcv(jpr_qtrice)%clname = 'OQtr'
!! IF( TRIM(sn_rcv_qtrice%cldes) == 'coupled' ) THEN IF( TRIM(sn_rcv_qtrice%cldes) == 'coupled' ) THEN
!! IF ( TRIM( sn_rcv_qtrice%clcat ) == 'yes' ) THEN IF ( TRIM( sn_rcv_qtrice%clcat ) == 'yes' ) THEN
!! srcv(jpr_qtrice)%nct = nn_cats_cpl srcv(jpr_qtrice)%nct = nn_cats_cpl
!! ELSE ELSE
!! CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qtrice%clcat should always be set to yes currently' ) CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qtrice%clcat should always be set to yes currently' )
!! ENDIF ENDIF
!! srcv(jpr_qtrice)%laction = .TRUE. srcv(jpr_qtrice)%laction = .TRUE.
!! ENDIF ENDIF
! ! ------------------------- ! ! ! ------------------------- !
! ! ice skin temperature ! ! ! ice skin temperature !
! ! ------------------------- ! ! ! ------------------------- !
...@@ -725,11 +665,10 @@ CONTAINS ...@@ -725,11 +665,10 @@ CONTAINS
srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling
srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling
srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE. srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE.
srcv(jpr_otx1)%clgrid = 'U' ! oce components given at U-point srcv(jpr_otx1)%clgrid = 'T' ! oce components given at T-point
srcv(jpr_oty1)%clgrid = 'V' ! and V-point srcv(jpr_oty1)%clgrid = 'T'
! Vectors: change of sign at north fold ONLY if on the local grid ! Vectors: change of sign at north fold ONLY if on the local grid
srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1. srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1.
sn_rcv_tau%clvgrd = 'U,V'
sn_rcv_tau%clvor = 'local grid' sn_rcv_tau%clvor = 'local grid'
sn_rcv_tau%clvref = 'spherical' sn_rcv_tau%clvref = 'spherical'
sn_rcv_emp%cldes = 'oce only' sn_rcv_emp%cldes = 'oce only'
...@@ -802,19 +741,19 @@ CONTAINS ...@@ -802,19 +741,19 @@ CONTAINS
! Allocate all parts of frcv used for received fields ! ! Allocate all parts of frcv used for received fields !
! =================================================== ! ! =================================================== !
DO jn = 1, jprcv DO jn = 1, jprcv
IF( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) IF( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(A2D(0),srcv(jn)%nct) )
END DO END DO
! Allocate taum part of frcv which is used even when not received as coupling field ! Allocate taum part of frcv which is used even when not received as coupling field
IF( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) IF( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(A2D(0),srcv(jpr_taum)%nct) )
! Allocate w10m part of frcv which is used even when not received as coupling field ! Allocate w10m part of frcv which is used even when not received as coupling field
IF( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) IF( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(A2D(0),srcv(jpr_w10m)%nct) )
! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field
IF( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) IF( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(A2D(0),srcv(jpr_otx1)%nct) )
IF( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) IF( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(A2D(0),srcv(jpr_oty1)%nct) )
! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.
IF( k_ice /= 0 ) THEN IF( k_ice /= 0 ) THEN
IF( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) IF( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(A2D(0),srcv(jpr_itx1)%nct) )
IF( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) IF( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(A2D(0),srcv(jpr_ity1)%nct) )
ENDIF ENDIF
! ================================ ! ! ================================ !
...@@ -823,8 +762,9 @@ CONTAINS ...@@ -823,8 +762,9 @@ CONTAINS
! for each field: define the OASIS name (ssnd(:)%clname) ! for each field: define the OASIS name (ssnd(:)%clname)
! define send or not from the namelist parameters (ssnd(:)%laction) ! define send or not from the namelist parameters (ssnd(:)%laction)
! define the north fold type of lbc (ssnd(:)%nsgn) ! define the north fold type of lbc (ssnd(:)%nsgn)
! default definitions of nsnd ! default definitions of nsnd
ALLOCATE( ssnd(jpsnd) )
ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1 ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1
! ! ------------------------- ! ! ! ------------------------- !
...@@ -1113,15 +1053,14 @@ CONTAINS ...@@ -1113,15 +1053,14 @@ CONTAINS
IF(ln_usecplmask) THEN IF(ln_usecplmask) THEN
xcplmask(:,:,:) = 0. xcplmask(:,:,:) = 0.
CALL iom_open( 'cplmask', inum ) CALL iom_open( 'cplmask', inum )
CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:jpi,1:jpj,1:nn_cplmodel), & CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(:,:,1:nn_cplmodel), &
& kstart = (/ mig(1),mjg(1),1 /), kcount = (/ jpi,jpj,nn_cplmodel /) ) & kstart = (/ mig(Nis0,0),mjg(Njs0,0),1 /), kcount = (/ Ni_0,Nj_0,nn_cplmodel /) )
CALL iom_close( inum ) CALL iom_close( inum )
ELSE ELSE
xcplmask(:,:,:) = 1. xcplmask(:,:,:) = 1.
ENDIF ENDIF
xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 )
! !
!
END SUBROUTINE sbc_cpl_init END SUBROUTINE sbc_cpl_init
...@@ -1162,7 +1101,7 @@ CONTAINS ...@@ -1162,7 +1101,7 @@ CONTAINS
!! ** Method : receive all fields from the atmosphere and transform !! ** Method : receive all fields from the atmosphere and transform
!! them into ocean surface boundary condition fields !! them into ocean surface boundary condition fields
!! !!
!! ** Action : update utau, vtau ocean stress at U,V grid !! ** Action : update utau, vtau ocean stress at T-point
!! taum wind stress module at T-point !! taum wind stress module at T-point
!! wndm wind speed module at T-point over free ocean or leads in presence of sea-ice !! wndm wind speed module at T-point over free ocean or leads in presence of sea-ice
!! qns non solar heat fluxes including emp heat content (ocean only case) !! qns non solar heat fluxes including emp heat content (ocean only case)
...@@ -1186,7 +1125,8 @@ CONTAINS ...@@ -1186,7 +1125,8 @@ CONTAINS
REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient
REAL(wp) :: zzx, zzy ! temporary variables REAL(wp) :: zzx, zzy ! temporary variables
REAL(wp) :: r1_grau ! = 1.e0 / (grav * rho0) REAL(wp) :: r1_grau ! = 1.e0 / (grav * rho0)
REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr, zcloud_fra REAL(wp), DIMENSION(A2D(0)) :: ztx, zty, zmsk, zemp
REAL(wp), DIMENSION(A2D(0)) :: zqns, zqsr, zcloud_fra
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
IF( kt == nit000 ) THEN IF( kt == nit000 ) THEN
...@@ -1201,7 +1141,7 @@ CONTAINS ...@@ -1201,7 +1141,7 @@ CONTAINS
ENDIF ENDIF
ENDIF ENDIF
! !
IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) IF( ln_mixcpl ) zmsk (:,:) = 1. - xcplmask (:,:,0)
! !
! ! ======================================================= ! ! ! ======================================================= !
! ! Receive all the atmos. fields (including ice information) ! ! Receive all the atmos. fields (including ice information)
...@@ -1221,39 +1161,20 @@ CONTAINS ...@@ -1221,39 +1161,20 @@ CONTAINS
IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere
! ! (cartesian to spherical -> 3 to 2 components) ! ! (cartesian to spherical -> 3 to 2 components)
! !
CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1), & CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1), 'T', ztx, zty )
& srcv(jpr_otx1)%clgrid, ztx, zty )
frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid
frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid
! !
IF( srcv(jpr_otx2)%laction ) THEN
CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1), &
& srcv(jpr_otx2)%clgrid, ztx, zty )
frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid
frcv(jpr_oty2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid
ENDIF
!
ENDIF ENDIF
! !
IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid
! ! (geographical to local grid -> rotate the components) ! ! (geographical to local grid -> rotate the components)
CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), 'T', 'en->i', ztx )
IF( srcv(jpr_otx2)%laction ) THEN CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), 'T', 'en->j', zty )
CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )
ELSE
CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )
ENDIF
frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid
frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid
ENDIF ENDIF
! !
IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN
DO_2D( 0, 0, 0, 0 ) ! T ==> (U,V)
frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) )
frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) )
END_2D
CALL lbc_lnk( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1.0_wp, frcv(jpr_oty1)%z3(:,:,1), 'V', -1.0_wp )
ENDIF
llnewtx = .TRUE. llnewtx = .TRUE.
ELSE ELSE
llnewtx = .FALSE. llnewtx = .FALSE.
...@@ -1273,11 +1194,10 @@ CONTAINS ...@@ -1273,11 +1194,10 @@ CONTAINS
! => need to be done only when otx1 was changed ! => need to be done only when otx1 was changed
IF( llnewtx ) THEN IF( llnewtx ) THEN
DO_2D( 0, 0, 0, 0 ) DO_2D( 0, 0, 0, 0 )
zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) zzx = frcv(jpr_otx1)%z3(ji,jj,1)
zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) zzy = frcv(jpr_oty1)%z3(ji,jj,1)
frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
END_2D END_2D
CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1.0_wp )
llnewtau = .TRUE. llnewtau = .TRUE.
ELSE ELSE
llnewtau = .FALSE. llnewtau = .FALSE.
...@@ -1286,7 +1206,7 @@ CONTAINS ...@@ -1286,7 +1206,7 @@ CONTAINS
llnewtau = nrcvinfo(jpr_taum) == OASIS_Rcv llnewtau = nrcvinfo(jpr_taum) == OASIS_Rcv
! Stress module can be negative when received (interpolation problem) ! Stress module can be negative when received (interpolation problem)
IF( llnewtau ) THEN IF( llnewtau ) THEN
frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) ) frcv(jpr_taum)%z3(A2D(0),1) = MAX( 0._wp, frcv(jpr_taum)%z3(A2D(0),1) )
ENDIF ENDIF
ENDIF ENDIF
! !
...@@ -1297,7 +1217,7 @@ CONTAINS ...@@ -1297,7 +1217,7 @@ CONTAINS
! => need to be done only when taumod was changed ! => need to be done only when taumod was changed
IF( llnewtau ) THEN IF( llnewtau ) THEN
zcoef = 1. / ( zrhoa * zcdrag ) zcoef = 1. / ( zrhoa * zcdrag )
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
END_2D END_2D
ENDIF ENDIF
...@@ -1305,7 +1225,7 @@ CONTAINS ...@@ -1305,7 +1225,7 @@ CONTAINS
!!$ ! ! ========================= ! !!$ ! ! ========================= !
!!$ SELECT CASE( TRIM( sn_rcv_clouds%cldes ) ) ! cloud fraction ! !!$ SELECT CASE( TRIM( sn_rcv_clouds%cldes ) ) ! cloud fraction !
!!$ ! ! ========================= ! !!$ ! ! ========================= !
!!$ cloud_fra(:,:) = frcv(jpr_clfra)*z3(:,:,1) !!$ cloud_fra(:,:) = frcv(jpr_clfra)*z3(A2D(0),1)
!!$ END SELECT !!$ END SELECT
!!$ !!$
zcloud_fra(:,:) = pp_cldf ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm. zcloud_fra(:,:) = pp_cldf ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm.
...@@ -1343,13 +1263,14 @@ CONTAINS ...@@ -1343,13 +1263,14 @@ CONTAINS
! ! Mean Sea Level Pressure ! (taum) ! ! Mean Sea Level Pressure ! (taum)
! ! ========================= ! ! ! ========================= !
IF( srcv(jpr_mslp)%laction ) THEN ! UKMO SHELF effect of atmospheric pressure on SSH IF( srcv(jpr_mslp)%laction ) THEN ! UKMO SHELF effect of atmospheric pressure on SSH
IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields IF( kt /= nit000 ) ssh_ibb(A2D(0)) = ssh_ib(A2D(0)) !* Swap of ssh_ib fields
r1_grau = 1.e0 / (grav * rho0) !* constant for optimization r1_grau = 1.e0 / (grav * rho0) !* constant for optimization
ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau ! equivalent ssh (inverse barometer) ssh_ib(A2D(0)) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau ! equivalent ssh (inverse barometer)
apr (:,:) = frcv(jpr_mslp)%z3(:,:,1) !atmospheric pressure apr (A2D(0)) = frcv(jpr_mslp)%z3(:,:,1) !atmospheric pressure
IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) ! correct this later (read from restart if possible) IF( kt == nit000 ) ssh_ibb(A2D(0)) = ssh_ib(A2D(0)) ! correct this later (read from restart if possible)
CALL lbc_lnk( 'sbccpl', ssh_ib, 'T', 1.0_wp, ssh_ibb, 'T', 1.0_wp )
ENDIF ENDIF
! !
IF( ln_sdw ) THEN ! Stokes Drift correction activated IF( ln_sdw ) THEN ! Stokes Drift correction activated
...@@ -1445,30 +1366,33 @@ CONTAINS ...@@ -1445,30 +1366,33 @@ CONTAINS
! ! SST ! ! ! SST !
! ! ================== ! ! ! ================== !
IF( srcv(jpr_toce)%laction ) THEN ! received by sas in case of opa <-> sas coupling IF( srcv(jpr_toce)%laction ) THEN ! received by sas in case of opa <-> sas coupling
sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1) sst_m(A2D(0)) = frcv(jpr_toce)%z3(:,:,1)
IF( srcv(jpr_soce)%laction .AND. l_useCT ) THEN ! make sure that sst_m is the potential temperature IF( srcv(jpr_soce)%laction .AND. l_useCT ) THEN ! make sure that sst_m is the potential temperature
sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) ) sst_m(A2D(0)) = eos_pt_from_ct( sst_m(A2D(0)), sss_m(A2D(0)) )
ENDIF ENDIF
CALL iom_put( 'sst_m', sst_m )
ENDIF ENDIF
! ! ================== ! ! ! ================== !
! ! SSH ! ! ! SSH !
! ! ================== ! ! ! ================== !
IF( srcv(jpr_ssh )%laction ) THEN ! received by sas in case of opa <-> sas coupling IF( srcv(jpr_ssh )%laction ) THEN ! received by sas in case of opa <-> sas coupling
ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1) ssh_m(A2D(0)) = frcv(jpr_ssh )%z3(:,:,1)
CALL iom_put( 'ssh_m', ssh_m ) CALL iom_put( 'ssh_m', ssh_m )
ENDIF ENDIF
! ! ================== ! ! ! ================== !
! ! surface currents ! ! ! surface currents !
! ! ================== ! ! ! ================== !
IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling
ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) ssu_m(A2D(0)) = frcv(jpr_ocx1)%z3(:,:,1)
uu(:,:,1,Kbb) = ssu_m(:,:) ! will be used in icestp in the call of ice_forcing_tau CALL lbc_lnk( 'sbccpl', ssu_m, 'U', -1.0_wp )
uu(:,:,1,Kbb) = ssu_m(:,:) ! will be used in icestp in the call of ice_update_tau
uu(:,:,1,Kmm) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling uu(:,:,1,Kmm) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling
CALL iom_put( 'ssu_m', ssu_m ) CALL iom_put( 'ssu_m', ssu_m )
ENDIF ENDIF
IF( srcv(jpr_ocy1)%laction ) THEN IF( srcv(jpr_ocy1)%laction ) THEN
ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) ssv_m(A2D(0)) = frcv(jpr_ocy1)%z3(:,:,1)
vv(:,:,1,Kbb) = ssv_m(:,:) ! will be used in icestp in the call of ice_forcing_tau CALL lbc_lnk( 'sbccpl', ssv_m, 'V', -1.0_wp )
vv(:,:,1,Kbb) = ssv_m(:,:) ! will be used in icestp in the call of ice_update_tau
vv(:,:,1,Kmm) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling vv(:,:,1,Kmm) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling
CALL iom_put( 'ssv_m', ssv_m ) CALL iom_put( 'ssv_m', ssv_m )
ENDIF ENDIF
...@@ -1476,14 +1400,14 @@ CONTAINS ...@@ -1476,14 +1400,14 @@ CONTAINS
! ! first T level thickness ! ! ! first T level thickness !
! ! ======================== ! ! ! ======================== !
IF( srcv(jpr_e3t1st )%laction ) THEN ! received by sas in case of opa <-> sas coupling IF( srcv(jpr_e3t1st )%laction ) THEN ! received by sas in case of opa <-> sas coupling
e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1) e3t_m(A2D(0)) = frcv(jpr_e3t1st )%z3(:,:,1)
CALL iom_put( 'e3t_m', e3t_m(:,:) ) CALL iom_put( 'e3t_m', e3t_m )
ENDIF ENDIF
! ! ================================ ! ! ! ================================ !
! ! fraction of solar net radiation ! ! ! fraction of solar net radiation !
! ! ================================ ! ! ! ================================ !
IF( srcv(jpr_fraqsr)%laction ) THEN ! received by sas in case of opa <-> sas coupling IF( srcv(jpr_fraqsr)%laction ) THEN ! received by sas in case of opa <-> sas coupling
frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1) frq_m(A2D(0)) = frcv(jpr_fraqsr)%z3(:,:,1)
CALL iom_put( 'frq_m', frq_m ) CALL iom_put( 'frq_m', frq_m )
ENDIF ENDIF
...@@ -1506,21 +1430,21 @@ CONTAINS ...@@ -1506,21 +1430,21 @@ CONTAINS
ENDIF ENDIF
! !
! ! runoffs and calving (added in emp) ! ! runoffs and calving (added in emp)
IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) IF( srcv(jpr_rnf)%laction ) rnf(A2D(0)) = frcv(jpr_rnf)%z3(:,:,1)
IF( srcv(jpr_cal)%laction ) zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) IF( srcv(jpr_cal)%laction ) zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1)
IF( srcv(jpr_icb)%laction ) THEN IF( srcv(jpr_icb)%laction ) THEN
fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) fwficb(A2D(0)) = frcv(jpr_icb)%z3(:,:,1)
rnf(:,:) = rnf(:,:) + fwficb(:,:) ! iceberg added to runfofs rnf (A2D(0)) = rnf(A2D(0)) + fwficb(A2D(0)) ! iceberg added to runfofs
ENDIF ENDIF
! !
! ice shelf fwf ! ice shelf fwf
IF( srcv(jpr_isf)%laction ) THEN IF( srcv(jpr_isf)%laction ) THEN
fwfisf_oasis(:,:) = frcv(jpr_isf)%z3(:,:,1) ! fresh water flux from the isf to the ocean ( > 0 = melting ) fwfisf_oasis(A2D(0)) = frcv(jpr_isf)%z3(:,:,1) ! fresh water flux from the isf to the ocean ( > 0 = melting )
END IF END IF
IF( ln_mixcpl ) THEN ; emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) IF( ln_mixcpl ) THEN ; emp(A2D(0)) = emp(A2D(0)) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
ELSE ; emp(:,:) = zemp(:,:) ELSE ; emp(A2D(0)) = zemp(:,:)
ENDIF ENDIF
! !
! ! non solar heat flux over the ocean (qns) ! ! non solar heat flux over the ocean (qns)
...@@ -1530,7 +1454,7 @@ CONTAINS ...@@ -1530,7 +1454,7 @@ CONTAINS
ENDIF ENDIF
! update qns over the free ocean with: ! update qns over the free ocean with:
IF( nn_components /= jp_iam_oce ) THEN IF( nn_components /= jp_iam_oce ) THEN
zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(A2D(0)) * rcp ! remove heat content due to mass flux (assumed to be at SST)
IF( srcv(jpr_snow )%laction ) THEN IF( srcv(jpr_snow )%laction ) THEN
zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * rLfus ! energy for melting solid precipitation over the free ocean zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * rLfus ! energy for melting solid precipitation over the free ocean
ENDIF ENDIF
...@@ -1593,13 +1517,13 @@ CONTAINS ...@@ -1593,13 +1517,13 @@ CONTAINS
!! !!
!! ** Action : return ptau_i, ptau_j, the stress over the ice !! ** Action : return ptau_i, ptau_j, the stress over the ice
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
REAL(wp), INTENT(inout), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2] REAL(wp), INTENT(inout), DIMENSION(A2D(0)) :: p_taui ! i- & j-components of atmos-ice stress [N/m2]
REAL(wp), INTENT(inout), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) REAL(wp), INTENT(inout), DIMENSION(A2D(0)) :: p_tauj ! at T-point
!! !!
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
INTEGER :: itx ! index of taux over ice INTEGER :: itx ! index of taux over ice
REAL(wp) :: zztmp1, zztmp2 REAL(wp) :: zztmp1, zztmp2
REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty REAL(wp), DIMENSION(A2D(0)) :: ztx, zty
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
#if defined key_si3 || defined key_cice #if defined key_si3 || defined key_cice
...@@ -1616,28 +1540,16 @@ CONTAINS ...@@ -1616,28 +1540,16 @@ CONTAINS
! !
IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere
! ! (cartesian to spherical -> 3 to 2 components) ! ! (cartesian to spherical -> 3 to 2 components)
CALL geo2oce( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1), & CALL geo2oce( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1), 'T', ztx, zty )
& srcv(jpr_itx1)%clgrid, ztx, zty )
frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid
frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid
! !
IF( srcv(jpr_itx2)%laction ) THEN
CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1), &
& srcv(jpr_itx2)%clgrid, ztx, zty )
frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid
frcv(jpr_ity2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid
ENDIF
!
ENDIF ENDIF
! !
IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid
! ! (geographical to local grid -> rotate the components) ! ! (geographical to local grid -> rotate the components)
CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx ) CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), 'T', 'en->i', ztx )
IF( srcv(jpr_itx2)%laction ) THEN CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), 'T', 'en->j', zty )
CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )
ELSE
CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty )
ENDIF
frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid
frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid
ENDIF ENDIF
...@@ -1651,29 +1563,8 @@ CONTAINS ...@@ -1651,29 +1563,8 @@ CONTAINS
! ! ======================= ! ! ! ======================= !
! ! put on ice grid ! ! ! put on ice grid !
! ! ======================= ! ! ! ======================= !
! p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)
! j+1 j -----V---F p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
! ice stress on ice velocity point ! |
! (C-grid ==>(U,V)) j | T U
! | |
! j j-1 -I-------|
! (for I) | |
! i-1 i i
! i i+1 (for I)
SELECT CASE ( srcv(jpr_itx1)%clgrid )
CASE( 'U' )
p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! (U,V) ==> (U,V)
p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
CASE( 'T' )
DO_2D( 0, 0, 0, 0 ) ! T ==> (U,V)
! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology
zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj ,1) )
zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji ,jj+1,1) )
p_taui(ji,jj) = zztmp1 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
END_2D
CALL lbc_lnk( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. )
END SELECT
ENDIF ENDIF
! !
...@@ -1739,22 +1630,23 @@ CONTAINS ...@@ -1739,22 +1630,23 @@ CONTAINS
!! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice !! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice
!! sprecip solid precipitation over the ocean !! sprecip solid precipitation over the ocean
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
INTEGER, INTENT(in) :: kt ! ocean model time step index (only for a_i_last_couple) INTEGER, INTENT(in) :: kt ! ocean model time step index (only for a_i_last_couple)
REAL(wp), INTENT(in) , DIMENSION(:,:) :: picefr ! ice fraction [0 to 1] REAL(wp), INTENT(in) , DIMENSION(A2D(0)) :: picefr ! ice fraction [0 to 1]
! !! ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling ! !! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling
REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo REAL(wp), INTENT(in) , DIMENSION(A2D(0),jpl), OPTIONAL :: palbi ! all skies ice albedo
REAL(wp), INTENT(in) , DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] REAL(wp), INTENT(in) , DIMENSION(A2D(0) ), OPTIONAL :: psst ! sea surface temperature [Celsius]
REAL(wp), INTENT(inout), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] => inout for Met-Office REAL(wp), INTENT(inout), DIMENSION(A2D(0),jpl), OPTIONAL :: pist ! ice surface temperature [Kelvin] => inout for Met-Office
REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: phs ! snow depth [m] REAL(wp), INTENT(in) , DIMENSION(A2D(0),jpl), OPTIONAL :: phs ! snow depth [m]
REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: phi ! ice thickness [m] REAL(wp), INTENT(in) , DIMENSION(A2D(0),jpl), OPTIONAL :: phi ! ice thickness [m]
! !
INTEGER :: ji, jj, jl ! dummy loop index INTEGER :: ji, jj, jl ! dummy loop index
REAL(wp), DIMENSION(jpi,jpj) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw REAL(wp), DIMENSION(A2D(0)) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw
REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice REAL(wp), DIMENSION(A2D(0)) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice
REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice REAL(wp), DIMENSION(A2D(0)) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice
REAL(wp), DIMENSION(jpi,jpj) :: zevap_ice_total REAL(wp), DIMENSION(A2D(0)) :: zevap_ice_total
REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu REAL(wp), DIMENSION(A2D(0)) :: ztri
REAL(wp), DIMENSION(jpi,jpj) :: ztri REAL(wp), DIMENSION(A2D(0),jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top
REAL(wp), DIMENSION(A2D(0),jpl) :: ztsu
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
#if defined key_si3 || defined key_cice #if defined key_si3 || defined key_cice
...@@ -1768,7 +1660,7 @@ CONTAINS ...@@ -1768,7 +1660,7 @@ CONTAINS
! !
IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0)
ziceld(:,:) = 1._wp - picefr(:,:) ziceld(:,:) = 1._wp - picefr(:,:)
zcptn (:,:) = rcp * sst_m(:,:) zcptn (:,:) = rcp * sst_m(A2D(0))
! !
! ! ========================= ! ! ! ========================= !
! ! freshwater budget ! (emp_tot) ! ! freshwater budget ! (emp_tot)
...@@ -1780,9 +1672,9 @@ CONTAINS ...@@ -1780,9 +1672,9 @@ CONTAINS
! ! sublimation - solid precipitation (cell average) (emp_ice) ! ! sublimation - solid precipitation (cell average) (emp_ice)
SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here
ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here
zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)
CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:) zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:)
...@@ -1794,17 +1686,19 @@ CONTAINS ...@@ -1794,17 +1686,19 @@ CONTAINS
END SELECT END SELECT
! --- evaporation over ice (kg/m2/s) --- ! ! --- evaporation over ice (kg/m2/s) --- !
IF (ln_scale_ice_flux) THEN ! typically met-office requirements IF( ln_scale_ice_flux ) THEN ! typically met-office requirements
IF (sn_rcv_emp%clcat == 'yes') THEN IF( sn_rcv_emp%clcat == 'yes' ) THEN
WHERE( a_i(:,:,:) > 1.e-10 ) ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) WHERE( a_i(A2D(0),:) > 1.e-10 ) ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * &
ELSEWHERE ; zevap_ice(:,:,:) = 0._wp & a_i_last_couple(A2D(0),:) / a_i(A2D(0),:)
ELSEWHERE ; zevap_ice(:,:,:) = 0._wp
END WHERE END WHERE
WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(A2D(0),:), dim=3 ) / picefr(:,:)
ELSEWHERE ; zevap_ice_total(:,:) = 0._wp ELSEWHERE ; zevap_ice_total(:,:) = 0._wp
END WHERE END WHERE
ELSE ELSE
WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:) WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * &
ELSEWHERE ; zevap_ice(:,:,1) = 0._wp & SUM( a_i_last_couple(A2D(0),:), dim=3 ) / picefr(:,:)
ELSEWHERE ; zevap_ice(:,:,1) = 0._wp
END WHERE END WHERE
zevap_ice_total(:,:) = zevap_ice(:,:,1) zevap_ice_total(:,:) = zevap_ice(:,:,1)
DO jl = 2, jpl DO jl = 2, jpl
...@@ -1812,9 +1706,9 @@ CONTAINS ...@@ -1812,9 +1706,9 @@ CONTAINS
ENDDO ENDDO
ENDIF ENDIF
ELSE ELSE
IF (sn_rcv_emp%clcat == 'yes') THEN IF( sn_rcv_emp%clcat == 'yes' ) THEN
zevap_ice(:,:,1:jpl) = frcv(jpr_ievp)%z3(:,:,1:jpl) zevap_ice(:,:,1:jpl) = frcv(jpr_ievp)%z3(:,:,1:jpl)
WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(A2D(0),:), dim=3 ) / picefr(:,:)
ELSEWHERE ; zevap_ice_total(:,:) = 0._wp ELSEWHERE ; zevap_ice_total(:,:) = 0._wp
END WHERE END WHERE
ELSE ELSE
...@@ -1826,7 +1720,7 @@ CONTAINS ...@@ -1826,7 +1720,7 @@ CONTAINS
ENDIF ENDIF
ENDIF ENDIF
IF ( TRIM( sn_rcv_emp%cldes ) == 'conservative' ) THEN IF( TRIM( sn_rcv_emp%cldes ) == 'conservative' ) THEN
! For conservative case zemp_ice has not been defined yet. Do it now. ! For conservative case zemp_ice has not been defined yet. Do it now.
zemp_ice(:,:) = zevap_ice_total(:,:) * picefr(:,:) - frcv(jpr_snow)%z3(:,:,1) * picefr(:,:) zemp_ice(:,:) = zevap_ice_total(:,:) * picefr(:,:) - frcv(jpr_snow)%z3(:,:,1) * picefr(:,:)
ENDIF ENDIF
...@@ -1847,18 +1741,18 @@ CONTAINS ...@@ -1847,18 +1741,18 @@ CONTAINS
! --- Continental fluxes --- ! ! --- Continental fluxes --- !
IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on) IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on)
rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) rnf(A2D(0)) = frcv(jpr_rnf)%z3(:,:,1)
ENDIF ENDIF
IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot and emp_oce) IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot and emp_oce)
zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1) zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1)
ENDIF ENDIF
IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs
fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) fwficb(A2D(0)) = frcv(jpr_icb)%z3(:,:,1)
rnf(:,:) = rnf(:,:) + fwficb(:,:) rnf (A2D(0)) = rnf(A2D(0)) + fwficb(A2D(0))
ENDIF ENDIF
IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf > 0 mean melting) IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf > 0 mean melting)
fwfisf_oasis(:,:) = frcv(jpr_isf)%z3(:,:,1) fwfisf_oasis(A2D(0)) = frcv(jpr_isf)%z3(:,:,1)
ENDIF ENDIF
IF( ln_mixcpl ) THEN IF( ln_mixcpl ) THEN
...@@ -1913,29 +1807,29 @@ CONTAINS ...@@ -1913,29 +1807,29 @@ CONTAINS
!!$ ENDIF !!$ ENDIF
! !
! outputs ! outputs
IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(A2D(0),1) ) ! calving
IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(A2D(0),1) ) ! icebergs
IF( iom_use('snowpre') ) CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow IF( iom_use('snowpre') ) CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow
IF( iom_use('precip') ) CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation IF( iom_use('precip') ) CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation
IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation
IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average)
IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average)
IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * ziceld(:,:) ) ! liquid precipitation over ocean (cell average) IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * ziceld(:,:) ) ! liquid precipitation over ocean (cell average)
IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , zevap_ice_total(:,:) * picefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average) IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , zevap_ice_total(:,:) * picefr(:,:) * smask0(:,:) ) ! Sublimation over sea-ice (cell average)
IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) &
& - zevap_ice_total(:,:) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) & - zevap_ice_total(:,:) * picefr(:,:) ) * smask0(:,:) ) ! ice-free oce evap (cell average)
! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf
!! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff !! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff
!! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', frcv(jpr_isf)%z3(:,:,1) * smask0(:,:) ) ! iceshelf
! !
! ! ========================= ! ! ! ========================= !
SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt ! SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt !
! ! ========================= ! ! ! ========================= !
CASE ('coupled') CASE( 'coupled' )
IF (ln_scale_ice_flux) THEN IF( ln_scale_ice_flux ) THEN
WHERE( a_i(:,:,:) > 1.e-10_wp ) WHERE( a_i(A2D(0),:) > 1.e-10_wp )
qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(A2D(0),:) / a_i(A2D(0),:)
qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(A2D(0),:) / a_i(A2D(0),:)
ELSEWHERE ELSEWHERE
qml_ice(:,:,:) = 0.0_wp qml_ice(:,:,:) = 0.0_wp
qcn_ice(:,:,:) = 0.0_wp qcn_ice(:,:,:) = 0.0_wp
...@@ -1958,7 +1852,7 @@ CONTAINS ...@@ -1958,7 +1852,7 @@ CONTAINS
ENDIF ENDIF
! Calculate the total non solar heat flux. The ocean only non solar heat flux (zqns_oce) will be recalculated after this CASE ! Calculate the total non solar heat flux. The ocean only non solar heat flux (zqns_oce) will be recalculated after this CASE
! statement to be consistent with other coupling methods even though .zqns_oce = frcv(jpr_qnsoce)%z3(:,:,1) ! statement to be consistent with other coupling methods even though .zqns_oce = frcv(jpr_qnsoce)%z3(:,:,1)
zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) + SUM( zqns_ice(:,:,:) * a_i(:,:,:), dim=3 ) zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) + SUM( zqns_ice(:,:,:) * a_i(A2D(0),:), dim=3 )
CASE( 'conservative' ) ! the required fields are directly provided CASE( 'conservative' ) ! the required fields are directly provided
zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
...@@ -1972,7 +1866,7 @@ CONTAINS ...@@ -1972,7 +1866,7 @@ CONTAINS
zqns_tot(:,:) = ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) zqns_tot(:,:) = ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
DO jl=1,jpl DO jl=1,jpl
zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) zqns_tot(:,: ) = zqns_tot(:,:) + a_i(A2D(0),jl) * frcv(jpr_qnsice)%z3(:,:,jl)
zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
ENDDO ENDDO
ELSE ELSE
...@@ -2001,21 +1895,22 @@ CONTAINS ...@@ -2001,21 +1895,22 @@ CONTAINS
! !
! --- calving (removed from qns_tot) --- ! ! --- calving (removed from qns_tot) --- !
IF( srcv(jpr_cal)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * rLfus ! remove latent heat of calving IF( srcv(jpr_cal)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * rLfus ! remove latent heat of calving
! we suppose it melts at 0deg, though it should be temp. of surrounding ocean ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean
! --- iceberg (removed from qns_tot) --- ! ! --- iceberg (removed from qns_tot) --- !
IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove latent heat of iceberg melting IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove latent heat of iceberg melting
! --- non solar flux over ocean --- ! ! --- non solar flux over ocean --- !
! note: ziceld cannot be = 0 since we limit the ice concentration to amax ! note: ziceld cannot be = 0 since we limit the ice concentration to amax
zqns_oce = 0._wp zqns_oce = 0._wp
WHERE( ziceld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / ziceld(:,:) WHERE( ziceld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i(A2D(0),:) * zqns_ice(:,:,:), dim=3 ) ) / ziceld(:,:)
! Heat content per unit mass of snow (J/kg) ! Heat content per unit mass of snow (J/kg)
WHERE( SUM( a_i, dim=3 ) > 1.e-10 ) ; zcptsnw(:,:) = rcpi * SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 ) WHERE( SUM( a_i(A2D(0),:), dim=3 ) > 1.e-10 ) ; zcptsnw(:,:) = rcpi * SUM( (tn_ice(:,:,:) - rt0) * a_i(A2D(0),:), dim=3 ) &
ELSEWHERE ; zcptsnw(:,:) = zcptn(:,:) & / SUM( a_i(A2D(0),:), dim=3 )
ELSEWHERE ; zcptsnw(:,:) = zcptn(:,:)
ENDWHERE ENDWHERE
! Heat content per unit mass of rain (J/kg) ! Heat content per unit mass of rain (J/kg)
zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) ) zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(A2D(0),:), dim=3 ) + sst_m(A2D(0)) * ziceld(:,:) )
! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- !
zqprec_ice(:,:) = rhos * ( zcptsnw(:,:) - rLfus ) zqprec_ice(:,:) = rhos * ( zcptsnw(:,:) - rLfus )
...@@ -2086,7 +1981,7 @@ CONTAINS ...@@ -2086,7 +1981,7 @@ CONTAINS
& CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) & CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )
IF ( iom_use('hflx_evap_cea') ) & ! heat flux from evap (cell average) IF ( iom_use('hflx_evap_cea') ) & ! heat flux from evap (cell average)
& CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) * picefr(:,:) ) & & CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) * picefr(:,:) ) &
& * zcptn(:,:) * tmask(:,:,1) ) & * zcptn(:,:) * smask0(:,:) )
IF ( iom_use('hflx_prec_cea') ) & ! heat flux from all precip (cell avg) IF ( iom_use('hflx_prec_cea') ) & ! heat flux from all precip (cell avg)
& CALL iom_put('hflx_prec_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & & CALL iom_put('hflx_prec_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &
& + ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) & + ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )
...@@ -2097,7 +1992,7 @@ CONTAINS ...@@ -2097,7 +1992,7 @@ CONTAINS
IF ( iom_use('hflx_snow_ai_cea') ) & ! heat flux from snow (over ice) IF ( iom_use('hflx_snow_ai_cea') ) & ! heat flux from snow (over ice)
& CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) * zsnw(:,:) ) & CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) * zsnw(:,:) )
IF( iom_use('hflx_subl_cea') ) & ! heat flux from sublimation IF( iom_use('hflx_subl_cea') ) & ! heat flux from sublimation
& CALL iom_put('hflx_subl_cea' , SUM( qevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) * tmask(:,:,1) ) & CALL iom_put('hflx_subl_cea' , SUM( qevap_ice(:,:,:) * a_i(A2D(0),:), dim=3 ) * smask0(:,:) )
! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp.
! !
! ! ========================= ! ! ! ========================= !
...@@ -2145,7 +2040,7 @@ CONTAINS ...@@ -2145,7 +2040,7 @@ CONTAINS
zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
DO jl = 1, jpl DO jl = 1, jpl
zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(A2D(0),jl) * frcv(jpr_qsrice)%z3(:,:,jl)
zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
END DO END DO
ELSE ELSE
...@@ -2162,14 +2057,14 @@ CONTAINS ...@@ -2162,14 +2057,14 @@ CONTAINS
IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
DO jl = 1, jpl DO jl = 1, jpl
zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:,jl) * ( 1.- palbi(:,:,jl) ) & zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:,jl) * ( 1.- palbi(:,:,jl) ) &
& / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) &
& + palbi (:,:,jl) * picefr(:,:) ) ) & + palbi (:,:,jl) * picefr(:,:) ) )
END DO END DO
ELSE ELSE
DO jl = 1, jpl DO jl = 1, jpl
zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:, 1) * ( 1.- palbi(:,:,jl) ) & zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:, 1) * ( 1.- palbi(:,:,jl) ) &
& / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) &
& + palbi (:,:,jl) * picefr(:,:) ) ) & + palbi (:,:,jl) * picefr(:,:) ) )
END DO END DO
ENDIF ENDIF
CASE( 'none' ) ! Not available as for now: needs additional coding CASE( 'none' ) ! Not available as for now: needs additional coding
...@@ -2177,7 +2072,7 @@ CONTAINS ...@@ -2177,7 +2072,7 @@ CONTAINS
CALL ctl_stop('STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_qsr value in namelist namsbc_cpl') CALL ctl_stop('STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_qsr value in namelist namsbc_cpl')
END SELECT END SELECT
IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle
zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) ) zqsr_tot(:,:) = sbc_dcy( zqsr_tot(:,:) )
DO jl = 1, jpl DO jl = 1, jpl
zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) ) zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) )
END DO END DO
...@@ -2213,33 +2108,34 @@ CONTAINS ...@@ -2213,33 +2108,34 @@ CONTAINS
! !
ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==! ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==!
! !
!! SELECT CASE( TRIM( sn_rcv_qtrice%cldes ) ) !
!! ! SELECT CASE( TRIM( sn_rcv_qtrice%cldes ) )
!! ! ! ===> here we receive the qtr_ice_top array from the coupler !
!! CASE ('coupled') ! ! ===> here we receive the qtr_ice_top array from the coupler
!! IF (ln_scale_ice_flux) THEN CASE ('coupled')
!! WHERE( a_i(:,:,:) > 1.e-10_wp ) IF (ln_scale_ice_flux) THEN
!! zqtr_ice_top(:,:,:) = frcv(jpr_qtrice)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) WHERE( a_i(A2D(0),:) > 1.e-10_wp )
!! ELSEWHERE zqtr_ice_top(:,:,:) = frcv(jpr_qtrice)%z3(:,:,:) * a_i_last_couple(A2D(0),:) / a_i(A2D(0),:)
!! zqtr_ice_top(:,:,:) = 0.0_wp ELSEWHERE
!! ENDWHERE zqtr_ice_top(:,:,:) = 0.0_wp
!! ELSE ENDWHERE
!! zqtr_ice_top(:,:,:) = frcv(jpr_qtrice)%z3(:,:,:) ELSE
!! ENDIF zqtr_ice_top(:,:,:) = frcv(jpr_qtrice)%z3(:,:,:)
!! ENDIF
!! ! Add retrieved transmitted solar radiation onto the ice and total solar radiation
!! zqsr_ice(:,:,:) = zqsr_ice(:,:,:) + zqtr_ice_top(:,:,:) ! Add retrieved transmitted solar radiation onto the ice and total solar radiation
!! zqsr_tot(:,:) = zqsr_tot(:,:) + SUM( zqtr_ice_top(:,:,:) * a_i(:,:,:), dim=3 ) zqsr_ice(:,:,:) = zqsr_ice(:,:,:) + zqtr_ice_top(:,:,:)
!! zqsr_tot(:,:) = zqsr_tot(:,:) + SUM( zqtr_ice_top(:,:,:) * a_i(A2D(0),:), dim=3 )
!! ! if we are not getting this data from the coupler then assume zero (fully opaque ice)
!! CASE ('none') ! if we are not getting this data from the coupler then assume zero (fully opaque ice)
zqtr_ice_top(:,:,:) = 0._wp CASE ('none')
!! END SELECT zqtr_ice_top(:,:,:) = 0._wp
END SELECT
! !
ENDIF ENDIF
IF( ln_mixcpl ) THEN IF( ln_mixcpl ) THEN
qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(A2D(0),:), dim=3 ) ! total flux from blk
qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:) * zmsk(:,:) qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:) * zmsk(:,:)
DO jl = 1, jpl DO jl = 1, jpl
qsr_ice (:,:,jl) = qsr_ice (:,:,jl) * xcplmask(:,:,0) + zqsr_ice (:,:,jl) * zmsk(:,:) qsr_ice (:,:,jl) = qsr_ice (:,:,jl) * xcplmask(:,:,0) + zqsr_ice (:,:,jl) * zmsk(:,:)
...@@ -2254,7 +2150,7 @@ CONTAINS ...@@ -2254,7 +2150,7 @@ CONTAINS
! --- solar flux over ocean --- ! ! --- solar flux over ocean --- !
! note: ziceld cannot be = 0 since we limit the ice concentration to amax ! note: ziceld cannot be = 0 since we limit the ice concentration to amax
zqsr_oce = 0._wp zqsr_oce = 0._wp
WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:) WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i(A2D(0),:) * zqsr_ice(:,:,:), dim=3 ) ) / ziceld(:,:)
IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:)
ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF
...@@ -2299,25 +2195,26 @@ CONTAINS ...@@ -2299,25 +2195,26 @@ CONTAINS
INTEGER :: ji, jj, jl ! dummy loop indices INTEGER :: ji, jj, jl ! dummy loop indices
INTEGER :: isec, info ! local integer INTEGER :: isec, info ! local integer
REAL(wp) :: zumax, zvmax REAL(wp) :: zumax, zvmax
REAL(wp), DIMENSION(jpi,jpj) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 REAL(wp), DIMENSION(A2D(0)) :: zat_i, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
REAL(wp), DIMENSION(jpi,jpj,jpl) :: ztmp3, ztmp4 REAL(wp), DIMENSION(A2D(0),jpl) :: ztmp3, ztmp4
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
isec = ( kt - nit000 ) * NINT( rn_Dt ) ! date of exchanges isec = ( kt - nit000 ) * NINT( rn_Dt ) ! date of exchanges
info = OASIS_idle info = OASIS_idle
zfr_l(:,:) = 1.- fr_i(:,:) zfr_l(:,:) = 1.- fr_i(A2D(0))
zat_i(:,:) = SUM( a_i(A2D(0),:), dim=3 )
! ! ------------------------- ! ! ! ------------------------- !
! ! Surface temperature ! in Kelvin ! ! Surface temperature ! in Kelvin
! ! ------------------------- ! ! ! ------------------------- !
IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
IF( nn_components == jp_iam_oce ) THEN IF( nn_components == jp_iam_oce ) THEN
ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part ztmp1(:,:) = ts(A2D(0),1,jp_tem,Kmm) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part
ELSE ELSE
! we must send the surface potential temperature ! we must send the surface potential temperature
IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) ) IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( ts(A2D(0),1,jp_tem,Kmm), ts(A2D(0),1,jp_sal,Kmm) )
ELSE ; ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) ELSE ; ztmp1(:,:) = ts(A2D(0),1,jp_tem,Kmm)
ENDIF ENDIF
! !
SELECT CASE( sn_snd_temp%cldes) SELECT CASE( sn_snd_temp%cldes)
...@@ -2327,8 +2224,8 @@ CONTAINS ...@@ -2327,8 +2224,8 @@ CONTAINS
CASE( 'yes' ) CASE( 'yes' )
ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl)
CASE( 'no' ) CASE( 'no' )
WHERE( SUM( a_i, dim=3 ) /= 0. ) WHERE( zat_i(:,:) /= 0. )
ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 ) ztmp3(:,:,1) = SUM( tn_ice(:,:,:) * a_i(A2D(0),:), dim=3 ) / zat_i(:,:)
ELSEWHERE ELSEWHERE
ztmp3(:,:,1) = rt0 ztmp3(:,:,1) = rt0
END WHERE END WHERE
...@@ -2337,36 +2234,36 @@ CONTAINS ...@@ -2337,36 +2234,36 @@ CONTAINS
CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)
SELECT CASE( sn_snd_temp%clcat ) SELECT CASE( sn_snd_temp%clcat )
CASE( 'yes' ) CASE( 'yes' )
ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(A2D(0),1:jpl)
CASE( 'no' ) CASE( 'no' )
ztmp3(:,:,:) = 0.0 ztmp3(:,:,:) = 0.0
DO jl=1,jpl DO jl=1,jpl
ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(A2D(0),jl)
ENDDO ENDDO
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
END SELECT END SELECT
CASE( 'oce and weighted ice') ; ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) + rt0 CASE( 'oce and weighted ice') ; ztmp1(:,:) = ts(A2D(0),1,jp_tem,Kmm) + rt0
SELECT CASE( sn_snd_temp%clcat ) SELECT CASE( sn_snd_temp%clcat )
CASE( 'yes' ) CASE( 'yes' )
ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(A2D(0),1:jpl)
CASE( 'no' ) CASE( 'no' )
ztmp3(:,:,:) = 0.0 ztmp3(:,:,:) = 0.0
DO jl=1,jpl DO jl=1,jpl
ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(A2D(0),jl)
ENDDO ENDDO
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
END SELECT END SELECT
CASE( 'mixed oce-ice' ) CASE( 'mixed oce-ice' )
ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)
DO jl=1,jpl DO jl=1,jpl
ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(A2D(0),jl)
ENDDO ENDDO
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
END SELECT END SELECT
ENDIF ENDIF
IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/Ni_0,Nj_0,1/) ), info )
IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info ) IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info )
IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/Ni_0,Nj_0,1/) ), info )
ENDIF ENDIF
! !
! ! ------------------------- ! ! ! ------------------------- !
...@@ -2377,7 +2274,7 @@ CONTAINS ...@@ -2377,7 +2274,7 @@ CONTAINS
IF( ssnd(jps_ttilyr)%laction) THEN IF( ssnd(jps_ttilyr)%laction) THEN
SELECT CASE( sn_snd_ttilyr%cldes) SELECT CASE( sn_snd_ttilyr%cldes)
CASE ('weighted ice') CASE ('weighted ice')
ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(:,:,1:jpl) ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(A2D(0),1:jpl)
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ttilyr%cldes' ) CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ttilyr%cldes' )
END SELECT END SELECT
IF( ssnd(jps_ttilyr)%laction ) CALL cpl_snd( jps_ttilyr, isec, ztmp3, info ) IF( ssnd(jps_ttilyr)%laction ) CALL cpl_snd( jps_ttilyr, isec, ztmp3, info )
...@@ -2393,8 +2290,8 @@ CONTAINS ...@@ -2393,8 +2290,8 @@ CONTAINS
CASE( 'yes' ) CASE( 'yes' )
ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
CASE( 'no' ) CASE( 'no' )
WHERE( SUM( a_i, dim=3 ) /= 0. ) WHERE( zat_i(:,:) /= 0. )
ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 ) ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(A2D(0),1:jpl), dim=3 ) / zat_i(:,:)
ELSEWHERE ELSEWHERE
ztmp1(:,:) = alb_oce_mix(:,:) ztmp1(:,:) = alb_oce_mix(:,:)
END WHERE END WHERE
...@@ -2403,10 +2300,10 @@ CONTAINS ...@@ -2403,10 +2300,10 @@ CONTAINS
CASE( 'weighted ice' ) ; CASE( 'weighted ice' ) ;
SELECT CASE( sn_snd_alb%clcat ) SELECT CASE( sn_snd_alb%clcat )
CASE( 'yes' ) CASE( 'yes' )
ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(A2D(0),1:jpl)
CASE( 'no' ) CASE( 'no' )
WHERE( fr_i (:,:) > 0. ) WHERE( fr_i (A2D(0)) > 0. )
ztmp1(:,:) = SUM ( alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) ztmp1(:,:) = SUM ( alb_ice(:,:,1:jpl) * a_i(A2D(0),1:jpl), dim=3 )
ELSEWHERE ELSEWHERE
ztmp1(:,:) = 0. ztmp1(:,:) = 0.
END WHERE END WHERE
...@@ -2419,16 +2316,16 @@ CONTAINS ...@@ -2419,16 +2316,16 @@ CONTAINS
CASE( 'yes' ) CASE( 'yes' )
CALL cpl_snd( jps_albice, isec, ztmp3, info ) !-> MV this has never been checked in coupled mode CALL cpl_snd( jps_albice, isec, ztmp3, info ) !-> MV this has never been checked in coupled mode
CASE( 'no' ) CASE( 'no' )
CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/Ni_0,Nj_0,1/) ), info )
END SELECT END SELECT
ENDIF ENDIF
IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean
ztmp1(:,:) = alb_oce_mix(:,:) * zfr_l(:,:) ztmp1(:,:) = alb_oce_mix(:,:) * zfr_l(:,:)
DO jl = 1, jpl DO jl = 1, jpl
ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(A2D(0),jl)
END DO END DO
CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/Ni_0,Nj_0,1/) ), info )
ENDIF ENDIF
! ! ------------------------- ! ! ! ------------------------- !
! ! Ice fraction & Thickness ! ! ! Ice fraction & Thickness !
...@@ -2436,8 +2333,8 @@ CONTAINS ...@@ -2436,8 +2333,8 @@ CONTAINS
! Send ice fraction field to atmosphere ! Send ice fraction field to atmosphere
IF( ssnd(jps_fice)%laction ) THEN IF( ssnd(jps_fice)%laction ) THEN
SELECT CASE( sn_snd_thick%clcat ) SELECT CASE( sn_snd_thick%clcat )
CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl) CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(A2D(0),1:jpl)
CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(:,: ) CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(A2D(0) )
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
END SELECT END SELECT
CALL cpl_snd( jps_fice, isec, ztmp3, info ) CALL cpl_snd( jps_fice, isec, ztmp3, info )
...@@ -2457,8 +2354,8 @@ CONTAINS ...@@ -2457,8 +2354,8 @@ CONTAINS
IF( ssnd(jps_fice1)%laction ) THEN IF( ssnd(jps_fice1)%laction ) THEN
SELECT CASE( sn_snd_thick1%clcat ) SELECT CASE( sn_snd_thick1%clcat )
CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl) CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(A2D(0),1:jpl)
CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(:,: ) CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(A2D(0) )
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' ) CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' )
END SELECT END SELECT
CALL cpl_snd( jps_fice1, isec, ztmp3, info ) CALL cpl_snd( jps_fice1, isec, ztmp3, info )
...@@ -2466,7 +2363,7 @@ CONTAINS ...@@ -2466,7 +2363,7 @@ CONTAINS
! Send ice fraction field to OCE (sent by SAS in SAS-OCE coupling) ! Send ice fraction field to OCE (sent by SAS in SAS-OCE coupling)
IF( ssnd(jps_fice2)%laction ) THEN IF( ssnd(jps_fice2)%laction ) THEN
ztmp3(:,:,1) = fr_i(:,:) ztmp3(:,:,1) = fr_i(A2D(0))
IF( ssnd(jps_fice2)%laction ) CALL cpl_snd( jps_fice2, isec, ztmp3, info ) IF( ssnd(jps_fice2)%laction ) CALL cpl_snd( jps_fice2, isec, ztmp3, info )
ENDIF ENDIF
...@@ -2477,25 +2374,25 @@ CONTAINS ...@@ -2477,25 +2374,25 @@ CONTAINS
CASE( 'weighted ice and snow' ) CASE( 'weighted ice and snow' )
SELECT CASE( sn_snd_thick%clcat ) SELECT CASE( sn_snd_thick%clcat )
CASE( 'yes' ) CASE( 'yes' )
ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl) * a_i(:,:,1:jpl) ztmp3(:,:,1:jpl) = h_i(A2D(0),1:jpl) * a_i(A2D(0),1:jpl)
ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl) * a_i(:,:,1:jpl) ztmp4(:,:,1:jpl) = h_s(A2D(0),1:jpl) * a_i(A2D(0),1:jpl)
CASE( 'no' ) CASE( 'no' )
ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0 ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0
DO jl=1,jpl DO jl=1,jpl
ztmp3(:,:,1) = ztmp3(:,:,1) + h_i(:,:,jl) * a_i(:,:,jl) ztmp3(:,:,1) = ztmp3(:,:,1) + h_i(A2D(0),jl) * a_i(A2D(0),jl)
ztmp4(:,:,1) = ztmp4(:,:,1) + h_s(:,:,jl) * a_i(:,:,jl) ztmp4(:,:,1) = ztmp4(:,:,1) + h_s(A2D(0),jl) * a_i(A2D(0),jl)
ENDDO ENDDO
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
END SELECT END SELECT
CASE( 'ice and snow' ) CASE( 'ice and snow' )
SELECT CASE( sn_snd_thick%clcat ) SELECT CASE( sn_snd_thick%clcat )
CASE( 'yes' ) CASE( 'yes' )
ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl) ztmp3(:,:,1:jpl) = h_i(A2D(0),1:jpl)
ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl) ztmp4(:,:,1:jpl) = h_s(A2D(0),1:jpl)
CASE( 'no' ) CASE( 'no' )
WHERE( SUM( a_i, dim=3 ) /= 0. ) WHERE( SUM( a_i, dim=3 ) /= 0. )
ztmp3(:,:,1) = SUM( h_i * a_i, dim=3 ) / SUM( a_i, dim=3 ) ztmp3(:,:,1) = SUM( h_i(A2D(0),:) * a_i(A2D(0),:), dim=3 ) / zat_i(:,:)
ztmp4(:,:,1) = SUM( h_s * a_i, dim=3 ) / SUM( a_i, dim=3 ) ztmp4(:,:,1) = SUM( h_s(A2D(0),:) * a_i(A2D(0),:), dim=3 ) / zat_i(:,:)
ELSEWHERE ELSEWHERE
ztmp3(:,:,1) = 0. ztmp3(:,:,1) = 0.
ztmp4(:,:,1) = 0. ztmp4(:,:,1) = 0.
...@@ -2519,13 +2416,13 @@ CONTAINS ...@@ -2519,13 +2416,13 @@ CONTAINS
SELECT CASE( sn_snd_mpnd%clcat ) SELECT CASE( sn_snd_mpnd%clcat )
CASE( 'yes' ) CASE( 'yes' )
ztmp3(:,:,1:jpl) = a_ip_eff(:,:,1:jpl) ztmp3(:,:,1:jpl) = a_ip_eff(:,:,1:jpl)
ztmp4(:,:,1:jpl) = h_ip(:,:,1:jpl) ztmp4(:,:,1:jpl) = h_ip(A2D(0),1:jpl)
CASE( 'no' ) CASE( 'no' )
ztmp3(:,:,:) = 0.0 ztmp3(:,:,:) = 0.0
ztmp4(:,:,:) = 0.0 ztmp4(:,:,:) = 0.0
DO jl=1,jpl DO jl=1,jpl
ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl)
ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(A2D(0),jpl)
ENDDO ENDDO
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' ) CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' )
END SELECT END SELECT
...@@ -2544,11 +2441,11 @@ CONTAINS ...@@ -2544,11 +2441,11 @@ CONTAINS
CASE( 'weighted ice' ) CASE( 'weighted ice' )
SELECT CASE( sn_snd_cond%clcat ) SELECT CASE( sn_snd_cond%clcat )
CASE( 'yes' ) CASE( 'yes' )
ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) * a_i(:,:,1:jpl) ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) * a_i(A2D(0),1:jpl)
CASE( 'no' ) CASE( 'no' )
ztmp3(:,:,:) = 0.0 ztmp3(:,:,:) = 0.0
DO jl=1,jpl DO jl=1,jpl
ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(:,:,jl) ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(A2D(0),jl)
ENDDO ENDDO
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' ) CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' )
END SELECT END SELECT
...@@ -2564,25 +2461,26 @@ CONTAINS ...@@ -2564,25 +2461,26 @@ CONTAINS
! ! CO2 flux from PISCES ! ! ! CO2 flux from PISCES !
! ! ------------------------- ! ! ! ------------------------- !
IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) THEN IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) THEN
ztmp1(:,:) = oce_co2(:,:) * 1000. ! conversion in molC/m2/s ztmp1(:,:) = oce_co2(A2D(0)) * 1000. ! conversion in molC/m2/s
CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ) , info ) CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/Ni_0,Nj_0,1/) ) , info )
ENDIF ENDIF
! !
! ! ------------------------- ! ! ! ------------------------- !
IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current ! IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current !
! ! ------------------------- ! ! ! ------------------------- !
! !
! j+1 j -----V---F ! j -----V---F
! surface velocity always sent from T point ! | ! surface velocity always sent from T point ! |
! j | T U ! j | T U
! | | ! | |
! j j-1 -I-------| ! j-1 -I-------|
! (for I) | | ! | |
! i-1 i i ! i-1 i i
! i i+1 (for I) !!clem: make a new variable at T-point to replace uu and vv => uuT and vvT for instance
IF( nn_components == jp_iam_oce ) THEN IF( nn_components == jp_iam_oce ) THEN
zotx1(:,:) = uu(:,:,1,Kmm) zotx1(:,:) = uu(A2D(0),1,Kmm)
zoty1(:,:) = vv(:,:,1,Kmm) zoty1(:,:) = vv(A2D(0),1,Kmm)
!!clem : should be demi sum, no? Or uuT and vvT
ELSE ELSE
SELECT CASE( TRIM( sn_snd_crt%cldes ) ) SELECT CASE( TRIM( sn_snd_crt%cldes ) )
CASE( 'oce only' ) ! C-grid ==> T CASE( 'oce only' ) ! C-grid ==> T
...@@ -2597,7 +2495,7 @@ CONTAINS ...@@ -2597,7 +2495,7 @@ CONTAINS
zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
END_2D END_2D
CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) !!$ CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp )
CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T
DO_2D( 0, 0, 0, 0 ) DO_2D( 0, 0, 0, 0 )
zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) &
...@@ -2606,7 +2504,7 @@ CONTAINS ...@@ -2606,7 +2504,7 @@ CONTAINS
& + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
END_2D END_2D
END SELECT END SELECT
CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp ) !!$ CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp )
! !
ENDIF ENDIF
! !
...@@ -2638,13 +2536,13 @@ CONTAINS ...@@ -2638,13 +2536,13 @@ CONTAINS
ENDIF ENDIF
ENDIF ENDIF
! !
IF( ssnd(jps_ocx1)%laction ) CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid IF( ssnd(jps_ocx1)%laction ) CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/Ni_0,Nj_0,1/) ), info ) ! ocean x current 1st grid
IF( ssnd(jps_ocy1)%laction ) CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid IF( ssnd(jps_ocy1)%laction ) CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/Ni_0,Nj_0,1/) ), info ) ! ocean y current 1st grid
IF( ssnd(jps_ocz1)%laction ) CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid IF( ssnd(jps_ocz1)%laction ) CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/Ni_0,Nj_0,1/) ), info ) ! ocean z current 1st grid
! !
IF( ssnd(jps_ivx1)%laction ) CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid IF( ssnd(jps_ivx1)%laction ) CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/Ni_0,Nj_0,1/) ), info ) ! ice x current 1st grid
IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/Ni_0,Nj_0,1/) ), info ) ! ice y current 1st grid
IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/Ni_0,Nj_0,1/) ), info ) ! ice z current 1st grid
! !
ENDIF ENDIF
! !
...@@ -2652,42 +2550,42 @@ CONTAINS ...@@ -2652,42 +2550,42 @@ CONTAINS
! ! Surface current to waves ! ! ! Surface current to waves !
! ! ------------------------- ! ! ! ------------------------- !
IF( ssnd(jps_ocxw)%laction .OR. ssnd(jps_ocyw)%laction ) THEN IF( ssnd(jps_ocxw)%laction .OR. ssnd(jps_ocyw)%laction ) THEN
! !
! j+1 j -----V---F ! j -----V---F
! surface velocity always sent from T point ! | ! surface velocity always sent from T point ! |
! j | T U ! j | T U
! | | ! | |
! j j-1 -I-------| ! j-1 -I-------|
! (for I) | | ! | |
! i-1 i i ! i-1 i i
! i i+1 (for I) !!clem: make a new variable at T-point to replace uu and vv => uuT and vvT for instance
SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) SELECT CASE( TRIM( sn_snd_crtw%cldes ) )
CASE( 'oce only' ) ! C-grid ==> T CASE( 'oce only' ) ! C-grid ==> T
DO_2D( 0, 0, 0, 0 ) DO_2D( 0, 0, 0, 0 )
zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) )
zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) ) zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) )
END_2D END_2D
CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T
DO_2D( 0, 0, 0, 0 ) DO_2D( 0, 0, 0, 0 )
zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj)
zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj)
zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
END_2D END_2D
CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) !!$ CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp )
CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T
DO_2D( 0, 0, 0, 0 ) DO_2D( 0, 0, 0, 0 )
zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) &
& + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) & zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) &
& + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
END_2D END_2D
END SELECT END SELECT
CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp ) !!$ CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp )
! !
! !
IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components
! ! Ocean component ! ! Ocean component
CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->e', ztmp1 ) ! 1st component CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->e', ztmp1 ) ! 1st component
CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->n', ztmp2 ) ! 2nd component CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
zotx1(:,:) = ztmp1(:,:) ! overwrite the components zotx1(:,:) = ztmp1(:,:) ! overwrite the components
...@@ -2700,26 +2598,26 @@ CONTAINS ...@@ -2700,26 +2598,26 @@ CONTAINS
ENDIF ENDIF
ENDIF ENDIF
! !
! ! spherical coordinates to cartesian -> 2 components to 3 components ! ! spherical coordinates to cartesian -> 2 components to 3 components
! IF( TRIM( sn_snd_crtw%clvref ) == 'cartesian' ) THEN ! IF( TRIM( sn_snd_crtw%clvref ) == 'cartesian' ) THEN
! ztmp1(:,:) = zotx1(:,:) ! ocean currents ! ztmp1(:,:) = zotx1(:,:) ! ocean currents
! ztmp2(:,:) = zoty1(:,:) ! ztmp2(:,:) = zoty1(:,:)
! CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 ) ! CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
! ! ! !
! IF( ssnd(jps_ivx1)%laction ) THEN ! ice velocities ! IF( ssnd(jps_ivx1)%laction ) THEN ! ice velocities
! ztmp1(:,:) = zitx1(:,:) ! ztmp1(:,:) = zitx1(:,:)
! ztmp1(:,:) = zity1(:,:) ! ztmp1(:,:) = zity1(:,:)
! CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 ) ! CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
! ENDIF ! ENDIF
! ENDIF ! ENDIF
! !
IF( ssnd(jps_ocxw)%laction ) CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid IF( ssnd(jps_ocxw)%laction ) CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/Ni_0,Nj_0,1/) ), info ) ! ocean x current 1st grid
IF( ssnd(jps_ocyw)%laction ) CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid IF( ssnd(jps_ocyw)%laction ) CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/Ni_0,Nj_0,1/) ), info ) ! ocean y current 1st grid
! !
ENDIF ENDIF
! !
IF( ssnd(jps_ficet)%laction ) THEN IF( ssnd(jps_ficet)%laction ) THEN
CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info ) CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i(A2D(0)), (/Ni_0,Nj_0,1/) ), info )
ENDIF ENDIF
! ! ------------------------- ! ! ! ------------------------- !
! ! Water levels to waves ! ! ! Water levels to waves !
...@@ -2727,14 +2625,14 @@ CONTAINS ...@@ -2727,14 +2625,14 @@ CONTAINS
IF( ssnd(jps_wlev)%laction ) THEN IF( ssnd(jps_wlev)%laction ) THEN
IF( ln_apr_dyn ) THEN IF( ln_apr_dyn ) THEN
IF( kt /= nit000 ) THEN IF( kt /= nit000 ) THEN
ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ztmp1(:,:) = ssh(A2D(0),Kbb) - 0.5 * ( ssh_ib(A2D(0)) + ssh_ibb(A2D(0)) )
ELSE ELSE
ztmp1(:,:) = ssh(:,:,Kbb) ztmp1(:,:) = ssh(A2D(0),Kbb)
ENDIF ENDIF
ELSE ELSE
ztmp1(:,:) = ssh(:,:,Kmm) ztmp1(:,:) = ssh(A2D(0),Kmm)
ENDIF ENDIF
CALL cpl_snd( jps_wlev , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) CALL cpl_snd( jps_wlev , isec, RESHAPE ( ztmp1, (/Ni_0,Nj_0,1/) ), info )
ENDIF ENDIF
! !
! Fields sent by OCE to SAS when doing OCE<->SAS coupling ! Fields sent by OCE to SAS when doing OCE<->SAS coupling
...@@ -2742,44 +2640,44 @@ CONTAINS ...@@ -2742,44 +2640,44 @@ CONTAINS
IF( ssnd(jps_ssh )%laction ) THEN IF( ssnd(jps_ssh )%laction ) THEN
! ! removed inverse barometer ssh when Patm ! ! removed inverse barometer ssh when Patm
! forcing is used (for sea-ice dynamics) ! forcing is used (for sea-ice dynamics)
IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = ssh(A2D(0),Kbb) - 0.5 * ( ssh_ib(A2D(0)) + ssh_ibb(A2D(0)) )
ELSE ; ztmp1(:,:) = ssh(:,:,Kmm) ELSE ; ztmp1(:,:) = ssh(A2D(0),Kmm)
ENDIF ENDIF
CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info ) CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/Ni_0,Nj_0,1/) ), info )
ENDIF ENDIF
! ! SSS ! ! SSS
IF( ssnd(jps_soce )%laction ) THEN IF( ssnd(jps_soce )%laction ) THEN
CALL cpl_snd( jps_soce , isec, RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) ), info ) CALL cpl_snd( jps_soce , isec, RESHAPE ( ts(A2D(0),1,jp_sal,Kmm), (/Ni_0,Nj_0,1/) ), info )
ENDIF ENDIF
! ! first T level thickness ! ! first T level thickness
IF( ssnd(jps_e3t1st )%laction ) THEN IF( ssnd(jps_e3t1st )%laction ) THEN
CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(:,:,1,Kmm) , (/jpi,jpj,1/) ), info ) CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(Nis0:Nie0,Njs0:Nje0,1,Kmm) , (/Ni_0,Nj_0,1/) ), info )
ENDIF ENDIF
! ! Qsr fraction ! ! Qsr fraction
IF( ssnd(jps_fraqsr)%laction ) THEN IF( ssnd(jps_fraqsr)%laction ) THEN
CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info ) CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(A2D(0)) , (/Ni_0,Nj_0,1/) ), info )
ENDIF ENDIF
! !
! Fields sent by SAS to OCE when OASIS coupling ! Fields sent by SAS to OCE when OASIS coupling
! ! Solar heat flux ! ! Solar heat flux
IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info ) IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr (:,:) , (/Ni_0,Nj_0,1/) ), info )
IF( ssnd(jps_qnsoce)%laction ) CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info ) IF( ssnd(jps_qnsoce)%laction ) CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns (:,:) , (/Ni_0,Nj_0,1/) ), info )
IF( ssnd(jps_oemp )%laction ) CALL cpl_snd( jps_oemp , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info ) IF( ssnd(jps_oemp )%laction ) CALL cpl_snd( jps_oemp , isec, RESHAPE ( emp (A2D(0)), (/Ni_0,Nj_0,1/) ), info )
IF( ssnd(jps_sflx )%laction ) CALL cpl_snd( jps_sflx , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info ) IF( ssnd(jps_sflx )%laction ) CALL cpl_snd( jps_sflx , isec, RESHAPE ( sfx (:,:) , (/Ni_0,Nj_0,1/) ), info )
IF( ssnd(jps_otx1 )%laction ) CALL cpl_snd( jps_otx1 , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info ) IF( ssnd(jps_otx1 )%laction ) CALL cpl_snd( jps_otx1 , isec, RESHAPE ( utau(A2D(0)), (/Ni_0,Nj_0,1/) ), info )
IF( ssnd(jps_oty1 )%laction ) CALL cpl_snd( jps_oty1 , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info ) IF( ssnd(jps_oty1 )%laction ) CALL cpl_snd( jps_oty1 , isec, RESHAPE ( vtau(A2D(0)), (/Ni_0,Nj_0,1/) ), info )
IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf (A2D(0)), (/Ni_0,Nj_0,1/) ), info )
IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum(:,:) , (/Ni_0,Nj_0,1/) ), info )
#if defined key_si3 #if defined key_si3
! ! ------------------------- ! ! ! ------------------------- !
! ! Sea surface freezing temp ! ! ! Sea surface freezing temp !
! ! ------------------------- ! ! ! ------------------------- !
! needed by Met Office ! needed by Met Office
CALL eos_fzp(ts(:,:,1,jp_sal,Kmm), sstfrz) CALL eos_fzp(ts(A2D(0),1,jp_sal,Kmm), sstfrz)
ztmp1(:,:) = sstfrz(:,:) + rt0 ztmp1(:,:) = sstfrz(:,:) + rt0
IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info) IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/Ni_0,Nj_0,1/) ), info)
#endif #endif
! !
END SUBROUTINE sbc_cpl_snd END SUBROUTINE sbc_cpl_snd
......
src/OCE/SBC/sbcdcy.F90
View file @ 3efbcb17
...@@ -49,8 +49,8 @@ CONTAINS ...@@ -49,8 +49,8 @@ CONTAINS
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! *** FUNCTION sbc_dcy_alloc *** !! *** FUNCTION sbc_dcy_alloc ***
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
ALLOCATE( raa (jpi,jpj) , rbb (jpi,jpj) , rcc (jpi,jpj) , rab (jpi,jpj) , & ALLOCATE( raa (A2D(0)) , rbb (A2D(0)) , rcc (A2D(0)) , rab (A2D(0)) , &
& rtmd(jpi,jpj) , rdawn_dcy(jpi,jpj) , rdusk_dcy(jpi,jpj) , rscal(jpi,jpj) , STAT=sbc_dcy_alloc ) & rtmd(A2D(0)) , rdawn_dcy(A2D(0)) , rdusk_dcy(A2D(0)) , rscal(A2D(0)) , STAT=sbc_dcy_alloc )
! !
CALL mpp_sum ( 'sbcdcy', sbc_dcy_alloc ) CALL mpp_sum ( 'sbcdcy', sbc_dcy_alloc )
IF( sbc_dcy_alloc /= 0 ) CALL ctl_stop( 'STOP', 'sbc_dcy_alloc: failed to allocate arrays' ) IF( sbc_dcy_alloc /= 0 ) CALL ctl_stop( 'STOP', 'sbc_dcy_alloc: failed to allocate arrays' )
...@@ -71,12 +71,12 @@ CONTAINS ...@@ -71,12 +71,12 @@ CONTAINS
!! Impact of resolving the diurnal cycle in an ocean--atmosphere GCM. !! Impact of resolving the diurnal cycle in an ocean--atmosphere GCM.
!! Part 1: a diurnally forced OGCM. Climate Dynamics 29:6, 575-590. !! Part 1: a diurnally forced OGCM. Climate Dynamics 29:6, 575-590.
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
LOGICAL , OPTIONAL , INTENT(in) :: l_mask ! use the routine for night mask computation LOGICAL , OPTIONAL , INTENT(in) :: l_mask ! use the routine for night mask computation
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqsrin ! input daily QSR flux REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqsrin ! input daily QSR flux
REAL(wp), DIMENSION(jpi,jpj) :: zqsrout ! output QSR flux with diurnal cycle REAL(wp), DIMENSION(A2D(0)) :: zqsrout ! output QSR flux with diurnal cycle
!! !!
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask INTEGER, DIMENSION(A2D(0)) :: imask_night ! night mask
REAL(wp) :: zlo, zup, zlousd, zupusd REAL(wp) :: zlo, zup, zlousd, zupusd
REAL(wp) :: ztmp, ztmp1, ztmp2 REAL(wp) :: ztmp, ztmp1, ztmp2
REAL(wp) :: ztmpm, ztmpm1, ztmpm2 REAL(wp) :: ztmpm, ztmpm1, ztmpm2
...@@ -100,16 +100,16 @@ CONTAINS ...@@ -100,16 +100,16 @@ CONTAINS
! Setting parameters for each new day: ! Setting parameters for each new day:
CALL sbc_dcy_param() CALL sbc_dcy_param()
!CALL iom_put( "rdusk_dcy", rdusk_dcy(:,:)*tmask(:,:,1) ) !LB !CALL iom_put( "rdusk_dcy", rdusk_dcy(:,:)*smask0(:,:) ) !LB
!CALL iom_put( "rdawn_dcy", rdawn_dcy(:,:)*tmask(:,:,1) ) !LB !CALL iom_put( "rdawn_dcy", rdawn_dcy(:,:)*smask0(:,:) ) !LB
!CALL iom_put( "rscal_dcy", rscal(:,:)*tmask(:,:,1) ) !LB !CALL iom_put( "rscal_dcy", rscal(:,:)*smask0(:,:) ) !LB
! 3. update qsr with the diurnal cycle ! 3. update qsr with the diurnal cycle
! ------------------------------------ ! ------------------------------------
imask_night(:,:) = 0 imask_night(:,:) = 0
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
ztmpm = 0._wp ztmpm = 0._wp
IF( ABS(rab(ji,jj)) < 1. ) THEN ! day duration is less than 24h IF( ABS(rab(ji,jj)) < 1. ) THEN ! day duration is less than 24h
! !
...@@ -161,7 +161,7 @@ CONTAINS ...@@ -161,7 +161,7 @@ CONTAINS
SUBROUTINE sbc_dcy_param( ) SUBROUTINE sbc_dcy_param( )
!! !!
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
!INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask !INTEGER, DIMENSION(A2D(0)) :: imask_night ! night mask
REAL(wp) :: zdsws, zdecrad, ztx, zsin, zcos REAL(wp) :: zdsws, zdecrad, ztx, zsin, zcos
REAL(wp) :: ztmp, ztest REAL(wp) :: ztmp, ztest
!---------------------------statement functions------------------------ !---------------------------statement functions------------------------
...@@ -192,7 +192,7 @@ CONTAINS ...@@ -192,7 +192,7 @@ CONTAINS
! Compute A and B needed to compute the time integral of the diurnal cycle ! Compute A and B needed to compute the time integral of the diurnal cycle
zsin = SIN( zdecrad ) ; zcos = COS( zdecrad ) zsin = SIN( zdecrad ) ; zcos = COS( zdecrad )
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
ztmp = rad * gphit(ji,jj) ztmp = rad * gphit(ji,jj)
raa(ji,jj) = SIN( ztmp ) * zsin raa(ji,jj) = SIN( ztmp ) * zsin
rbb(ji,jj) = COS( ztmp ) * zcos rbb(ji,jj) = COS( ztmp ) * zcos
...@@ -201,7 +201,7 @@ CONTAINS ...@@ -201,7 +201,7 @@ CONTAINS
! rab to test if the day time is equal to 0, less than 24h of full day ! rab to test if the day time is equal to 0, less than 24h of full day
rab(:,:) = -raa(:,:) / rbb(:,:) rab(:,:) = -raa(:,:) / rbb(:,:)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
IF( ABS(rab(ji,jj)) < 1._wp ) THEN ! day duration is less than 24h IF( ABS(rab(ji,jj)) < 1._wp ) THEN ! day duration is less than 24h
! When is it night? ! When is it night?
ztx = 1._wp/(2._wp*rpi) * (ACOS(rab(ji,jj)) - rcc(ji,jj)) ztx = 1._wp/(2._wp*rpi) * (ACOS(rab(ji,jj)) - rcc(ji,jj))
...@@ -225,7 +225,7 @@ CONTAINS ...@@ -225,7 +225,7 @@ CONTAINS
! S* = the inverse of the time integral of the diurnal cycle from dawn to dusk ! S* = the inverse of the time integral of the diurnal cycle from dawn to dusk
! Avoid possible infinite scaling factor, associated with very short daylight ! Avoid possible infinite scaling factor, associated with very short daylight
! periods, by ignoring periods less than 1/1000th of a day (ticket #1040) ! periods, by ignoring periods less than 1/1000th of a day (ticket #1040)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
IF( ABS(rab(ji,jj)) < 1._wp ) THEN ! day duration is less than 24h IF( ABS(rab(ji,jj)) < 1._wp ) THEN ! day duration is less than 24h
rscal(ji,jj) = 0.0_wp rscal(ji,jj) = 0.0_wp
IF( rdawn_dcy(ji,jj) < rdusk_dcy(ji,jj) ) THEN ! day time in one part IF( rdawn_dcy(ji,jj) < rdusk_dcy(ji,jj) ) THEN ! day time in one part
......
src/OCE/SBC/sbcflx.F90
View file @ 3efbcb17
...@@ -114,13 +114,13 @@ CONTAINS ...@@ -114,13 +114,13 @@ CONTAINS
CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN
ENDIF ENDIF
DO ji= 1, jpfld DO ji= 1, jpfld
ALLOCATE( sf(ji)%fnow(jpi,jpj,1) ) ALLOCATE( sf(ji)%fnow(A2D(0),1) )
IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(A2D(0),1,2) )
END DO END DO
! ! fill sf with slf_i and control print ! ! fill sf with slf_i and control print
CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' ) CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' )
sf(jp_utau)%cltype = 'U' ; sf(jp_utau)%zsgn = -1._wp ! vector field at U point: overwrite default definition of cltype and zsgn sf(jp_utau)%cltype = 'T' ; sf(jp_utau)%zsgn = -1._wp ! vector field at T point: overwrite default definition of cltype and zsgn
sf(jp_vtau)%cltype = 'V' ; sf(jp_vtau)%zsgn = -1._wp ! vector field at V point: overwrite default definition of cltype and zsgn sf(jp_vtau)%cltype = 'T' ; sf(jp_vtau)%zsgn = -1._wp ! vector field at T point: overwrite default definition of cltype and zsgn
! !
ENDIF ENDIF
...@@ -129,29 +129,27 @@ CONTAINS ...@@ -129,29 +129,27 @@ CONTAINS
IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! update ocean fluxes at each SBC frequency IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! update ocean fluxes at each SBC frequency
IF( ln_dm2dc ) THEN ! modify now Qsr to include the diurnal cycle IF( ln_dm2dc ) THEN ! modify now Qsr to include the diurnal cycle
qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * smask0(:,:)
ELSE ELSE
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) qsr(:,:) = sf(jp_qsr)%fnow(:,:,1) * smask0(:,:)
qsr(ji,jj) = sf(jp_qsr)%fnow(ji,jj,1) * tmask(ji,jj,1)
END_2D
ENDIF ENDIF
#if defined key_top #if defined key_top
IF( ln_trcdc2dm ) THEN ! diurnal cycle in TOP IF( ln_trcdc2dm ) THEN ! diurnal cycle in TOP
IF( ln_dm2dc ) THEN IF( ln_dm2dc ) THEN
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 ) ! set the ocean fluxes from read fields
qsr_mean(ji,jj) = sf(jp_qsr)%fnow(ji,jj,1) * tmask(ji,jj,1) qsr_mean(ji,jj) = sf(jp_qsr)%fnow(ji,jj,1) * smask0(ji,jj)
END_2D END_2D
ELSE ELSE
ncpl_qsr_freq = sf(jp_qsr)%freqh * 3600 ! qsr_mean will be computed in TOP ncpl_qsr_freq = sf(jp_qsr)%freqh * 3600 ! qsr_mean will be computed in TOP
ENDIF ENDIF
ENDIF ENDIF
#endif #endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! set the ocean fluxes from read fields DO_2D( 0, 0, 0, 0 ) ! set the ocean fluxes from read fields
utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) * umask(ji,jj,1) utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) * smask0(ji,jj)
vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) * vmask(ji,jj,1) vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) * smask0(ji,jj)
qns (ji,jj) = ( sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) ) * tmask(ji,jj,1) qns (ji,jj) = ( sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) ) * smask0(ji,jj)
emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) * tmask(ji,jj,1) emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) * smask0(ji,jj)
!!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1) * tmask(ji,jj,1) !!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1) * smask0(ji,jj)
END_2D END_2D
! ! add to qns the heat due to e-p ! ! add to qns the heat due to e-p
!!clem: I do not think it is needed !!clem: I do not think it is needed
...@@ -170,19 +168,15 @@ CONTAINS ...@@ -170,19 +168,15 @@ CONTAINS
ENDIF ENDIF
! !
ENDIF ENDIF
! ! module of wind stress and wind speed at T-point !
! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines ! module of wind stress and wind speed at T-point
zcoef = 1. / ( zrhoa * zcdrag ) zcoef = 1. / ( zrhoa * zcdrag )
DO_2D( 0, 0, 0, 0 ) DO_2D( 0, 0, 0, 0 )
ztx = ( utau(ji-1,jj ) + utau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( umask(ji-1,jj ,1), umask(ji,jj,1) ) ) zmod = SQRT( utau(ji,jj) * utau(ji,jj) + vtau(ji,jj) * vtau(ji,jj) ) * smask0(ji,jj)
zty = ( vtau(ji ,jj-1) + vtau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( vmask(ji ,jj-1,1), vmask(ji,jj,1) ) )
zmod = SQRT( ztx * ztx + zty * zty ) * tmask(ji,jj,1)
taum(ji,jj) = zmod taum(ji,jj) = zmod
wndm(ji,jj) = SQRT( zmod * zcoef ) !!clem: not used? wndm(ji,jj) = SQRT( zmod * zcoef ) !!clem: not used?
END_2D END_2D
! !
CALL lbc_lnk( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp )
!
END SUBROUTINE sbc_flx END SUBROUTINE sbc_flx
!!====================================================================== !!======================================================================
......
src/OCE/SBC/sbcfwb.F90
View file @ 3efbcb17
...@@ -16,7 +16,7 @@ MODULE sbcfwb ...@@ -16,7 +16,7 @@ MODULE sbcfwb
USE oce ! ocean dynamics and tracers USE oce ! ocean dynamics and tracers
USE dom_oce ! ocean space and time domain USE dom_oce ! ocean space and time domain
USE sbc_oce ! surface ocean boundary condition USE sbc_oce ! surface ocean boundary condition
USE isf_oce , ONLY : fwfisf_cav, fwfisf_par ! ice shelf melting contribution USE isf_oce , ONLY : fwfisf_cav, fwfisf_par, ln_isfcpl, ln_isfcpl_cons, risfcpl_cons_ssh ! ice shelf melting contribution
USE sbc_ice , ONLY : snwice_mass, snwice_mass_b, snwice_fmass USE sbc_ice , ONLY : snwice_mass, snwice_mass_b, snwice_fmass
USE phycst ! physical constants USE phycst ! physical constants
USE sbcrnf ! ocean runoffs USE sbcrnf ! ocean runoffs
...@@ -40,6 +40,8 @@ MODULE sbcfwb ...@@ -40,6 +40,8 @@ MODULE sbcfwb
REAL(wp) :: a_fwb_ini ! initial domain averaged freshwater budget REAL(wp) :: a_fwb_ini ! initial domain averaged freshwater budget
REAL(wp) :: area ! global mean ocean surface (interior domain) REAL(wp) :: area ! global mean ocean surface (interior domain)
!! * Substitutions
# include "do_loop_substitute.h90"
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018) !! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: sbcfwb.F90 15439 2021-10-22 17:53:09Z clem $ !! $Id: sbcfwb.F90 15439 2021-10-22 17:53:09Z clem $
...@@ -100,7 +102,7 @@ CONTAINS ...@@ -100,7 +102,7 @@ CONTAINS
IF( kn_fwb == 3 .AND. nn_sssr /= 2 ) CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' ) IF( kn_fwb == 3 .AND. nn_sssr /= 2 ) CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' )
IF( kn_fwb == 3 .AND. ln_isfcav ) CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 with ln_isfcav = .TRUE. not working, we stop ' ) IF( kn_fwb == 3 .AND. ln_isfcav ) CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 with ln_isfcav = .TRUE. not working, we stop ' )
! !
area = glob_sum( 'sbcfwb', e1e2t(:,:) * tmask(:,:,1)) ! interior global domain surface area = glob_sum( 'sbcfwb', e1e2t(A2D(0)) * smask0(:,:) ) ! interior global domain surface
! isf cavities are excluded because it can feedback to the melting with generation of inhibition of plumes ! isf cavities are excluded because it can feedback to the melting with generation of inhibition of plumes
! and in case of no melt, it can generate HSSW. ! and in case of no melt, it can generate HSSW.
! !
...@@ -117,15 +119,15 @@ CONTAINS ...@@ -117,15 +119,15 @@ CONTAINS
CASE ( 1 ) !== global mean fwf set to zero ==! CASE ( 1 ) !== global mean fwf set to zero ==!
! !
IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
y_fwfnow(1) = local_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - fwfisf_cav(:,:) - fwfisf_par(:,:) - snwice_fmass(:,:) ) ) y_fwfnow(1) = local_sum( e1e2t(A2D(0)) * ( emp(A2D(0)) - rnf(A2D(0)) - fwfisf_cav(A2D(0)) - fwfisf_par(A2D(0)) &
& - snwice_fmass(A2D(0)) ) )
CALL mpp_delay_sum( 'sbcfwb', 'fwb', y_fwfnow(:), z_fwfprv(:), kt == nitend - nn_fsbc + 1 ) CALL mpp_delay_sum( 'sbcfwb', 'fwb', y_fwfnow(:), z_fwfprv(:), kt == nitend - nn_fsbc + 1 )
z_fwfprv(1) = z_fwfprv(1) / area zcoef = z_fwfprv(1) / area
zcoef = z_fwfprv(1) * rcp emp(A2D(0)) = emp(A2D(0)) - zcoef * smask0(:,:)
emp(:,:) = emp(:,:) - z_fwfprv(1) * tmask(:,:,1) qns(:,:) = qns(:,:) + zcoef * rcp * sst_m(A2D(0)) * smask0(:,:) ! account for change to the heat budget due to fw correction
qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
! outputs ! outputs
IF( iom_use('hflx_fwb_cea') ) CALL iom_put( 'hflx_fwb_cea', zcoef * sst_m(:,:) * tmask(:,:,1) ) IF( iom_use('hflx_fwb_cea') ) CALL iom_put( 'hflx_fwb_cea', zcoef * rcp * sst_m(A2D(0)) * smask0(:,:) )
IF( iom_use('vflx_fwb_cea') ) CALL iom_put( 'vflx_fwb_cea', z_fwfprv(1) * tmask(:,:,1) ) IF( iom_use('vflx_fwb_cea') ) CALL iom_put( 'vflx_fwb_cea', zcoef * smask0(:,:) )
ENDIF ENDIF
! !
CASE ( 2 ) !== fw adjustment based on fw budget at the end of the previous year ==! CASE ( 2 ) !== fw adjustment based on fw budget at the end of the previous year ==!
...@@ -136,7 +138,7 @@ CONTAINS ...@@ -136,7 +138,7 @@ CONTAINS
& .AND. iom_varid( numror, 'a_fwb', ldstop = .FALSE. ) > 0 ) THEN & .AND. iom_varid( numror, 'a_fwb', ldstop = .FALSE. ) > 0 ) THEN
IF(lwp) WRITE(numout,*) 'sbc_fwb : reading freshwater-budget from restart file' IF(lwp) WRITE(numout,*) 'sbc_fwb : reading freshwater-budget from restart file'
CALL iom_get( numror, 'a_fwb_b', a_fwb_b ) CALL iom_get( numror, 'a_fwb_b', a_fwb_b )
CALL iom_get( numror, 'a_fwb' , a_fwb ) CALL iom_get( numror, 'a_fwb' , a_fwb )
! !
a_fwb_ini = a_fwb_b a_fwb_ini = a_fwb_b
ELSE ! as specified in namelist ELSE ! as specified in namelist
...@@ -168,11 +170,11 @@ CONTAINS ...@@ -168,11 +170,11 @@ CONTAINS
! !
IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN ! correct the freshwater fluxes using previous year budget minus initial state IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN ! correct the freshwater fluxes using previous year budget minus initial state
zcoef = ( a_fwb - a_fwb_b ) zcoef = ( a_fwb - a_fwb_b )
emp(:,:) = emp(:,:) + zcoef * tmask(:,:,1) emp(A2D(0)) = emp(A2D(0)) + zcoef * smask0(:,:)
qns(:,:) = qns(:,:) - zcoef * rcp * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction qns(:,:) = qns(:,:) - zcoef * rcp * sst_m(A2D(0)) * smask0(:,:) ! account for change to the heat budget due to fw correction
! outputs ! outputs
IF( iom_use('hflx_fwb_cea') ) CALL iom_put( 'hflx_fwb_cea', -zcoef * rcp * sst_m(:,:) * tmask(:,:,1) ) IF( iom_use('hflx_fwb_cea') ) CALL iom_put( 'hflx_fwb_cea', -zcoef * rcp * sst_m(A2D(0)) * smask0(:,:) )
IF( iom_use('vflx_fwb_cea') ) CALL iom_put( 'vflx_fwb_cea', -zcoef * tmask(:,:,1) ) IF( iom_use('vflx_fwb_cea') ) CALL iom_put( 'vflx_fwb_cea', -zcoef * smask0(:,:) )
ENDIF ENDIF
! Output restart information ! Output restart information
IF( lrst_oce ) THEN IF( lrst_oce ) THEN
...@@ -190,53 +192,51 @@ CONTAINS ...@@ -190,53 +192,51 @@ CONTAINS
! !
CASE ( 3 ) !== global fwf set to zero and spread out over erp area ==! CASE ( 3 ) !== global fwf set to zero and spread out over erp area ==!
! !
ALLOCATE( ztmsk_neg(jpi,jpj) , ztmsk_pos(jpi,jpj) , ztmsk_tospread(jpi,jpj) , z_wgt(jpi,jpj) , zerp_cor(jpi,jpj) ) ALLOCATE( ztmsk_neg(A2D(0)) , ztmsk_pos(A2D(0)) , ztmsk_tospread(A2D(0)) , z_wgt(A2D(0)) , zerp_cor(A2D(0)) )
! !
IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
ztmsk_pos(:,:) = tmask_i(:,:) ! Select <0 and >0 area of erp ztmsk_pos(:,:) = smask0_i(:,:) ! Select <0 and >0 area of erp
WHERE( erp < 0._wp ) ztmsk_pos = 0._wp WHERE( erp < 0._wp ) ztmsk_pos = 0._wp
ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:) ztmsk_neg(:,:) = smask0_i(:,:) - ztmsk_pos(:,:)
! ! fwf global mean (excluding ocean to ice/snow exchanges) ! ! fwf global mean (excluding ocean to ice/snow exchanges)
z_fwf = glob_sum( 'sbcfwb', e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - fwfisf_cav(:,:) - fwfisf_par(:,:) - snwice_fmass(:,:) ) ) / area z_fwf = glob_sum( 'sbcfwb', e1e2t(A2D(0)) * ( emp(A2D(0)) - rnf(A2D(0)) - fwfisf_cav(A2D(0)) - fwfisf_par(A2D(0)) &
& - snwice_fmass(A2D(0)) ) ) / area
! !
IF( z_fwf < 0._wp ) THEN ! spread out over >0 erp area to increase evaporation IF( z_fwf < 0._wp ) THEN ! spread out over >0 erp area to increase evaporation
zsurf_pos = glob_sum( 'sbcfwb', e1e2t(:,:)*ztmsk_pos(:,:) ) zsurf_pos = glob_sum( 'sbcfwb', e1e2t(A2D(0))*ztmsk_pos(:,:) )
zsurf_tospread = zsurf_pos zsurf_tospread = zsurf_pos
ztmsk_tospread(:,:) = ztmsk_pos(:,:) ztmsk_tospread(:,:) = ztmsk_pos(:,:)
ELSE ! spread out over <0 erp area to increase precipitation ELSE ! spread out over <0 erp area to increase precipitation
zsurf_neg = glob_sum( 'sbcfwb', e1e2t(:,:)*ztmsk_neg(:,:) ) ! Area filled by <0 and >0 erp zsurf_neg = glob_sum( 'sbcfwb', e1e2t(A2D(0))*ztmsk_neg(:,:) ) ! Area filled by <0 and >0 erp
zsurf_tospread = zsurf_neg zsurf_tospread = zsurf_neg
ztmsk_tospread(:,:) = ztmsk_neg(:,:) ztmsk_tospread(:,:) = ztmsk_neg(:,:)
ENDIF ENDIF
! !
zsum_fwf = glob_sum( 'sbcfwb', e1e2t(:,:) * z_fwf ) ! fwf global mean over <0 or >0 erp area zsum_fwf = glob_sum( 'sbcfwb', e1e2t(A2D(0)) * z_fwf ) ! fwf global mean over <0 or >0 erp area
!!gm : zsum_fwf = z_fwf * area ??? it is right? I think so.... !!gm : zsum_fwf = z_fwf * area ??? it is right? I think so....
z_fwf_nsrf = zsum_fwf / ( zsurf_tospread + rsmall ) z_fwf_nsrf = zsum_fwf / ( zsurf_tospread + rsmall )
! ! weight to respect erp field 2D structure ! ! weight to respect erp field 2D structure
zsum_erp = glob_sum( 'sbcfwb', ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) ) zsum_erp = glob_sum( 'sbcfwb', ztmsk_tospread(:,:) * erp(:,:) * e1e2t(A2D(0)) )
z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall )
! ! final correction term to apply ! ! final correction term to apply
zerp_cor(:,:) = -1. * z_fwf_nsrf * zsurf_tospread * z_wgt(:,:) zerp_cor(:,:) = -1. * z_fwf_nsrf * zsurf_tospread * z_wgt(:,:)
! !
!!gm ===>>>> lbc_lnk should be useless as all the computation is done over the whole domain ! emp(A2D(0)) = emp(A2D(0)) + zerp_cor(:,:)
CALL lbc_lnk( 'sbcfwb', zerp_cor, 'T', 1.0_wp ) qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(A2D(0)) ! account for change to the heat budget due to fw correction
! erp(:,:) = erp(:,:) + zerp_cor(:,:)
emp(:,:) = emp(:,:) + zerp_cor(:,:)
qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:) ! account for change to the heat budget due to fw correction
erp(:,:) = erp(:,:) + zerp_cor(:,:)
! outputs ! outputs
IF( iom_use('hflx_fwb_cea') ) CALL iom_put( 'hflx_fwb_cea', -zerp_cor(:,:) * rcp * sst_m(:,:) ) IF( iom_use('hflx_fwb_cea') ) CALL iom_put( 'hflx_fwb_cea', -zerp_cor(:,:) * rcp * sst_m(A2D(0)) )
IF( iom_use('vflx_fwb_cea') ) CALL iom_put( 'vflx_fwb_cea', -zerp_cor(:,:) ) IF( iom_use('vflx_fwb_cea') ) CALL iom_put( 'vflx_fwb_cea', -zerp_cor(:,:) )
! !
IF( lwp ) THEN ! control print IF( lwp ) THEN ! control print
IF( z_fwf < 0._wp ) THEN IF( z_fwf < 0._wp ) THEN
WRITE(numout,*)' z_fwf < 0' WRITE(numout,*)' z_fwf < 0'
WRITE(numout,*)' SUM(erp+) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv' WRITE(numout,*)' SUM(erp+) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(A2D(0)) )*1.e-9,' Sv'
ELSE ELSE
WRITE(numout,*)' z_fwf >= 0' WRITE(numout,*)' z_fwf >= 0'
WRITE(numout,*)' SUM(erp-) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv' WRITE(numout,*)' SUM(erp-) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(A2D(0)) )*1.e-9,' Sv'
ENDIF ENDIF
WRITE(numout,*)' SUM(empG) = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv' WRITE(numout,*)' SUM(empG) = ', SUM( z_fwf*e1e2t(A2D(0)) )*1.e-9,' Sv'
WRITE(numout,*)' z_fwf = ', z_fwf ,' Kg/m2/s' WRITE(numout,*)' z_fwf = ', z_fwf ,' Kg/m2/s'
WRITE(numout,*)' z_fwf_nsrf = ', z_fwf_nsrf ,' Kg/m2/s' WRITE(numout,*)' z_fwf_nsrf = ', z_fwf_nsrf ,' Kg/m2/s'
WRITE(numout,*)' MIN(zerp_cor) = ', MINVAL(zerp_cor) WRITE(numout,*)' MIN(zerp_cor) = ', MINVAL(zerp_cor)
...@@ -245,6 +245,31 @@ CONTAINS ...@@ -245,6 +245,31 @@ CONTAINS
ENDIF ENDIF
DEALLOCATE( ztmsk_neg , ztmsk_pos , ztmsk_tospread , z_wgt , zerp_cor ) DEALLOCATE( ztmsk_neg , ztmsk_pos , ztmsk_tospread , z_wgt , zerp_cor )
! !
CASE ( 4 ) !== global mean fwf set to zero (ISOMIP case) ==!
!
IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
! ! fwf global mean (excluding ocean to ice/snow exchanges)
zcoef = glob_sum( 'sbcfwb', e1e2t(A2D(0)) * ( emp(A2D(0)) - rnf(A2D(0)) - fwfisf_cav(A2D(0)) - fwfisf_par(A2D(0)) &
& - snwice_fmass(A2D(0)) ) ) / area
! clem: use y_fwfnow instead to improve performance?
!y_fwfnow(1) = local_sum( e1e2t(A2D(0)) * ( emp(A2D(0)) - rnf(A2D(0)) - fwfisf_cav(A2D(0)) - fwfisf_par(A2D(0)) &
! & - snwice_fmass(A2D(0)) ) )
! correction for ice sheet coupling testing (ie remove the excess through the surface)
! test impact on the melt as conservation correction made in depth
! test conservation level as sbcfwb is conserving
! avoid the model to blow up for large ssh drop (isomip OCEAN3 with melt switch off and uniform T/S)
IF (ln_isfcpl .AND. ln_isfcpl_cons) THEN
zcoef = zcoef + glob_sum( 'sbcfwb', e1e2t(A2D(0)) * risfcpl_cons_ssh(A2D(0)) * rho0 ) / area
! y_fwfnow(1) = y_fwfnow(1) + local_sum( e1e2t(A2D(0)) * risfcpl_cons_ssh(A2D(0)) * rho0 )
END IF
!CALL mpp_delay_sum( 'sbcfwb', 'fwb', y_fwfnow(:), z_fwfprv(:), kt == nitend - nn_fsbc + 1 )
!zcoef = z_fwfprv(1) / area
!
emp(A2D(0)) = emp(A2D(0)) - zcoef * smask0(:,:) ! (Eq. 34 AD2015)
qns(:,:) = qns(:,:) + zcoef * rcp * sst_m(A2D(0)) * smask0(:,:) ! (Eq. 35 AD2015) ! use sst_m to avoid generation of any bouyancy fluxes
sfx(:,:) = sfx(:,:) + zcoef * sss_m(A2D(0)) * smask0(:,:) ! (Eq. 36 AD2015) ! use sss_m to avoid generation of any bouyancy fluxes
ENDIF
!
CASE DEFAULT !== you should never be there ==! CASE DEFAULT !== you should never be there ==!
CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1, 2 or 3' ) CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1, 2 or 3' )
! !
......