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
Expand all Hide whitespace changes
Inline Side-by-side
Showing
with 410 additions and 547 deletions
src/OCE/CRS/crsfld.F90
View file @ 53efb739
......@@ -211,8 +211,8 @@ CONTAINS
! sbc fields
CALL crs_dom_ope( ssh(:,:,Kmm) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t , psgn=1.0_wp )
CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u , p_surf_crs=e2u_crs , psgn=1.0_wp )
CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v , p_surf_crs=e1v_crs , psgn=1.0_wp )
CALL crs_dom_ope( utau , 'SUM', 'T', tmask, utau_crs , p_e12=e2t , p_surf_crs=e2t_crs , psgn=1.0_wp ) !clem tau: check psgn ??
CALL crs_dom_ope( vtau , 'SUM', 'T', tmask, vtau_crs , p_e12=e1t , p_surf_crs=e1t_crs , psgn=1.0_wp ) !
CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp )
CALL crs_dom_ope( rnf , 'MAX', 'T', tmask, rnf_crs , psgn=1.0_wp )
CALL crs_dom_ope( qsr , 'SUM', 'T', tmask, qsr_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp )
......
src/OCE/DIA/diawri.F90
View file @ 53efb739
......@@ -868,7 +868,11 @@ CONTAINS
CALL histdef( nid_T, "sohtc300", "Heat content 300 m" , "J/m2" , & ! htc3
& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
#endif
CALL histdef( nid_T, "sozotaux", "Wind Stress along i-axis" , "N/m2" , & ! utau
& jpi, jpj, nh_T, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
CALL histdef( nid_T, "sometauy", "Wind Stress along j-axis" , "N/m2" , & ! vtau
& jpi, jpj, nh_T, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
!
CALL histend( nid_T, snc4chunks=snc4set )
! !!! nid_U : 3D
......@@ -878,10 +882,7 @@ CONTAINS
CALL histdef( nid_U, "sdzocrtx", "Stokes Drift Zonal Current" , "m/s" , & ! usd
& jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
ENDIF
! !!! nid_U : 2D
CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis" , "N/m2" , & ! utau
& jpi, jpj, nh_U, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
!
CALL histend( nid_U, snc4chunks=snc4set )
! !!! nid_V : 3D
......@@ -891,10 +892,7 @@ CONTAINS
CALL histdef( nid_V, "sdmecrty", "Stokes Drift Meridional Current" , "m/s" , & ! vsd
& jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
ENDIF
! !!! nid_V : 2D
CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis" , "N/m2" , & ! vtau
& jpi, jpj, nh_V, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
!
CALL histend( nid_V, snc4chunks=snc4set )
! !!! nid_W : 3D
......@@ -1066,12 +1064,12 @@ CONTAINS
CALL histwrite( nid_T, "so28chgt", it, hd28 , ndim_hT, ndex_hT ) ! depth of the 28 isotherm
CALL histwrite( nid_T, "sohtc300", it, htc3 , ndim_hT, ndex_hT ) ! first 300m heaat content
#endif
CALL histwrite( nid_T, "sozotaux", it, utau , ndim_hT, ndex_hT ) ! i-wind stress
CALL histwrite( nid_T, "sometauy", it, vtau , ndim_hT, ndex_hT ) ! j-wind stress
CALL histwrite( nid_U, "vozocrtx", it, uu(:,:,:,Kmm) , ndim_U , ndex_U ) ! i-current
CALL histwrite( nid_U, "sozotaux", it, utau , ndim_hU, ndex_hU ) ! i-wind stress
CALL histwrite( nid_V, "vomecrty", it, vv(:,:,:,Kmm) , ndim_V , ndex_V ) ! j-current
CALL histwrite( nid_V, "sometauy", it, vtau , ndim_hV, ndex_hV ) ! j-wind stress
IF( ln_zad_Aimp ) THEN
DO_3D( 0, 0, 0, 0, 1, jpk )
......
src/OCE/DYN/dynatf.F90
View file @ 53efb739
......@@ -331,7 +331,7 @@ CONTAINS
ALLOCATE(zutau(jpi,jpj))
DO_2D( 0, 0, 0, 0 )
jk = miku(ji,jj)
zutau(ji,jj) = utau(ji,jj) + 0.5_wp * rho0 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * puu(ji,jj,jk,Kaa)
zutau(ji,jj) = utau(ji,jj) + 0.5_wp * rho0 * rCdU_top(ji,jj) * ( puu(ji-1,jj,jk,Kaa) + puu(ji,jj,jk,Kaa) )
END_2D
CALL iom_put( "utau", zutau(:,:) )
DEALLOCATE(zutau)
......@@ -345,7 +345,7 @@ CONTAINS
ALLOCATE(zvtau(jpi,jpj))
DO_2D( 0, 0, 0, 0 )
jk = mikv(ji,jj)
zvtau(ji,jj) = vtau(ji,jj) + 0.5_wp * rho0 * ( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * pvv(ji,jj,jk,Kaa)
zvtau(ji,jj) = vtau(ji,jj) + 0.5_wp * rho0 * rCdU_top(ji,jj) * ( pvv(ji,jj-1,jk,Kaa) + pvv(ji,jj,jk,Kaa) )
END_2D
CALL iom_put( "vtau", zvtau(:,:) )
DEALLOCATE(zvtau)
......
src/OCE/DYN/dynatf_qco.F90
View file @ 53efb739
......@@ -248,7 +248,7 @@ CONTAINS
ALLOCATE(zutau(jpi,jpj))
DO_2D( 0, 0, 0, 0 )
jk = miku(ji,jj)
zutau(ji,jj) = utau(ji,jj) + 0.5_wp * rho0 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * puu(ji,jj,jk,Kaa)
zutau(ji,jj) = utau(ji,jj) + 0.5_wp * rho0 * rCdU_top(ji,jj) * ( puu(ji-1,jj,jk,Kaa) + puu(ji,jj,jk,Kaa) )
END_2D
CALL iom_put( "utau", zutau(:,:) )
DEALLOCATE(zutau)
......@@ -262,7 +262,7 @@ CONTAINS
ALLOCATE(zvtau(jpi,jpj))
DO_2D( 0, 0, 0, 0 )
jk = mikv(ji,jj)
zvtau(ji,jj) = vtau(ji,jj) + 0.5_wp * rho0 * ( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * pvv(ji,jj,jk,Kaa)
zvtau(ji,jj) = vtau(ji,jj) + 0.5_wp * rho0 * rCdU_top(ji,jj) * ( pvv(ji,jj-1,jk,Kaa) + pvv(ji,jj,jk,Kaa) )
END_2D
CALL iom_put( "vtau", zvtau(:,:) )
DEALLOCATE(zvtau)
......
src/OCE/DYN/dynspg_ts.F90
View file @ 53efb739
......@@ -334,14 +334,14 @@ CONTAINS
! ! ------------------ !
IF( ln_bt_fw ) THEN
DO_2D( 0, 0, 0, 0 )
zu_frc(ji,jj) = zu_frc(ji,jj) + r1_rho0 * utau(ji,jj) * r1_hu(ji,jj,Kmm)
zv_frc(ji,jj) = zv_frc(ji,jj) + r1_rho0 * vtau(ji,jj) * r1_hv(ji,jj,Kmm)
zu_frc(ji,jj) = zu_frc(ji,jj) + r1_rho0 * utauU(ji,jj) * r1_hu(ji,jj,Kmm)
zv_frc(ji,jj) = zv_frc(ji,jj) + r1_rho0 * vtauV(ji,jj) * r1_hv(ji,jj,Kmm)
END_2D
ELSE
zztmp = r1_rho0 * r1_2
DO_2D( 0, 0, 0, 0 )
zu_frc(ji,jj) = zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu(ji,jj,Kmm)
zv_frc(ji,jj) = zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv(ji,jj,Kmm)
zu_frc(ji,jj) = zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utauU(ji,jj) ) * r1_hu(ji,jj,Kmm)
zv_frc(ji,jj) = zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtauV(ji,jj) ) * r1_hv(ji,jj,Kmm)
END_2D
ENDIF
!
......
src/OCE/DYN/dynzdf.F90
View file @ 53efb739
......@@ -267,10 +267,10 @@ CONTAINS
DO_2D( 0, 0, 0, 0 ) !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==!
#if defined key_RK3
! ! RK3: use only utau (not utau_b)
puu(ji,jj,1,Kaa) = puu(ji,jj,1,Kaa) + rDt * utau(ji,jj) &
puu(ji,jj,1,Kaa) = puu(ji,jj,1,Kaa) + rDt * utauU(ji,jj) &
& / ( e3u(ji,jj,1,Kaa) * rho0 ) * umask(ji,jj,1)
#else
puu(ji,jj,1,Kaa) = puu(ji,jj,1,Kaa) + zDt_2 * ( utau_b(ji,jj) + utau(ji,jj) ) &
puu(ji,jj,1,Kaa) = puu(ji,jj,1,Kaa) + zDt_2 * ( utau_b(ji,jj) + utauU(ji,jj) ) &
& / ( e3u(ji,jj,1,Kaa) * rho0 ) * umask(ji,jj,1)
#endif
END_2D
......@@ -397,10 +397,10 @@ CONTAINS
DO_2D( 0, 0, 0, 0 ) !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==!
#if defined key_RK3
! ! RK3: use only vtau (not vtau_b)
pvv(ji,jj,1,Kaa) = pvv(ji,jj,1,Kaa) + rDt * vtau(ji,jj) &
pvv(ji,jj,1,Kaa) = pvv(ji,jj,1,Kaa) + rDt * vtauV(ji,jj) &
& / ( e3v(ji,jj,1,Kaa) * rho0 ) * vmask(ji,jj,1)
#else
pvv(ji,jj,1,Kaa) = pvv(ji,jj,1,Kaa) + zDt_2*( vtau_b(ji,jj) + vtau(ji,jj) ) &
pvv(ji,jj,1,Kaa) = pvv(ji,jj,1,Kaa) + zDt_2 * ( vtau_b(ji,jj) + vtauV(ji,jj) ) &
& / ( e3v(ji,jj,1,Kaa) * rho0 ) * vmask(ji,jj,1)
#endif
END_2D
......
src/OCE/SBC/cpl_oasis3.F90
View file @ 53efb739
......@@ -419,6 +419,7 @@ CONTAINS
IF( .NOT. ll_1st ) THEN
CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )
ENDIF
!!clem: mettre T instead of clgrid
ENDDO
!
......
src/OCE/SBC/sbc_ice.F90
View file @ 53efb739
......@@ -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(:,:,:) :: 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(:,:) :: vtau_ice !: atmos-ice v-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. 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(:,:,:) :: topmelt !: category topmelt
......
src/OCE/SBC/sbc_oce.F90
View file @ 53efb739
......@@ -103,34 +103,36 @@ MODULE sbc_oce
INTEGER , PUBLIC :: ncpl_qsr_freq = 0 !: qsr coupling frequency per days from atmosphere (used by top)
!
!! !! 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(:,:) :: vtau , vtau_b !: sea surface j-stress (ocean referential) [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]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau !: sea surface i-stress (ocean referential) T-pt [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(:,:) :: utauU , utau_b !: sea surface i-stress (ocean referential) U-pt [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
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(:,:) :: 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(:,:) :: 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(:,:) :: 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(:,:) :: 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(:,:) :: 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(:,:) :: 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(:,:) :: 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(:,:) :: 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(:,:) :: 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(:,:) :: 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(:,:) :: 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(:,:,:) :: 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(:,:) :: tprecip !: total 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(:,:) :: 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(:,:) :: cloud_fra !: cloud cover (fraction of cloud in a gridcell) [-]
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(:,:) :: 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(:,:,:) :: 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) [-]
!!---------------------------------------------------------------------
!! ABL Vertical Domain size
......@@ -177,8 +179,8 @@ CONTAINS
!!---------------------------------------------------------------------
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) )
ALLOCATE( utau(jpi,jpj) , utau_b(jpi,jpj) , utauU(jpi,jpj) , taum(jpi,jpj) , &
& vtau(jpi,jpj) , vtau_b(jpi,jpj) , vtauV(jpi,jpj) , wndm(jpi,jpj) , rhoa(jpi,jpj) , STAT=ierr(1) )
!
ALLOCATE( qns_tot(jpi,jpj) , qns (jpi,jpj) , qns_b(jpi,jpj), &
& qsr_tot(jpi,jpj) , qsr (jpi,jpj) , &
......@@ -205,9 +207,10 @@ CONTAINS
END FUNCTION sbc_oce_alloc
!!clem => this subroutine is never used in nemo
SUBROUTINE sbc_tau2wnd
!!---------------------------------------------------------------------
!! *** ROUTINE sbc_tau2wnd ***
!! *** ROUTINE ***
!!
!! ** Purpose : Estimation of wind speed as a function of wind stress
!!
......@@ -217,17 +220,14 @@ CONTAINS
USE lbclnk ! ocean lateral boundary conditions (or mpp link)
REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3
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
!!---------------------------------------------------------------------
zcoef = 0.5 / ( zrhoa * zcdrag )
DO_2D( 0, 0, 0, 0 )
ztx = utau(ji-1,jj ) + utau(ji,jj)
zty = vtau(ji ,jj-1) + vtau(ji,jj)
ztau = SQRT( ztx * ztx + zty * zty )
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
ztau = SQRT( utau(ji,jj)*utau(ji,jj) + vtau(ji,jj)*vtau(ji,jj) )
wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1)
END_2D
CALL lbc_lnk( 'sbc_oce', wndm(:,:) , 'T', 1.0_wp )
!
END SUBROUTINE sbc_tau2wnd
......
src/OCE/SBC/sbcblk.F90
View file @ 53efb739
This diff is collapsed.
src/OCE/SBC/sbccpl.F90
View file @ 53efb739
This diff is collapsed.
src/OCE/SBC/sbcflx.F90
View file @ 53efb739
......@@ -119,8 +119,8 @@ CONTAINS
END DO
! ! 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' )
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_vtau)%cltype = 'V' ; sf(jp_vtau)%zsgn = -1._wp ! vector field at V 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 = 'T' ; sf(jp_vtau)%zsgn = -1._wp ! vector field at T point: overwrite default definition of cltype and zsgn
!
ENDIF
......@@ -147,8 +147,8 @@ CONTAINS
ENDIF
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! set the ocean fluxes from read fields
utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) * umask(ji,jj,1)
vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) * vmask(ji,jj,1)
utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) * tmask(ji,jj,1)
vtau(ji,jj) = sf(jp_vtau)%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) ) * tmask(ji,jj,1)
emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) * tmask(ji,jj,1)
!!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1) * tmask(ji,jj,1)
......@@ -170,19 +170,15 @@ CONTAINS
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 )
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) ) )
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)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
zmod = SQRT( utau(ji,jj) * utau(ji,jj) + vtau(ji,jj) * vtau(ji,jj) ) * tmask(ji,jj,1)
taum(ji,jj) = zmod
wndm(ji,jj) = SQRT( zmod * zcoef ) !!clem: not used?
END_2D
!
CALL lbc_lnk( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp )
!
END SUBROUTINE sbc_flx
!!======================================================================
......
src/OCE/SBC/sbcmod.F90
View file @ 53efb739
......@@ -158,8 +158,8 @@ CONTAINS
!
IF( .NOT.ln_usr ) THEN ! the model calendar needs some specificities (except in user defined case)
IF( MOD( rday , rn_Dt ) /= 0. ) CALL ctl_stop( 'the time step must devide the number of second of in a day' )
IF( MOD( rday , 2. ) /= 0. ) CALL ctl_stop( 'the number of second of in a day must be an even number' )
IF( MOD( rn_Dt , 2. ) /= 0. ) CALL ctl_stop( 'the time step (in second) must be an even number' )
IF( MOD( rday , 2. ) /= 0. ) CALL ctl_stop( 'the number of second of in a day must be an even number' )
IF( MOD( rn_Dt, 2. ) /= 0. ) CALL ctl_stop( 'the time step (in second) must be an even number' )
ENDIF
! !** check option consistency
!
......@@ -395,16 +395,16 @@ CONTAINS
! ! ---------------------------------------- !
IF( kt /= nit000 ) THEN ! Swap of forcing fields !
! ! ---------------------------------------- !
utau_b(:,:) = utau(:,:) ! Swap the ocean forcing fields
vtau_b(:,:) = vtau(:,:) ! (except at nit000 where before fields
qns_b (:,:) = qns (:,:) ! are set at the end of the routine)
emp_b (:,:) = emp (:,:)
sfx_b (:,:) = sfx (:,:)
utau_b(:,:) = utauU(:,:) ! Swap the ocean forcing fields
vtau_b(:,:) = vtauV(:,:) ! (except at nit000 where before fields
qns_b (:,:) = qns (:,:) ! are set at the end of the routine)
emp_b (:,:) = emp (:,:)
sfx_b (:,:) = sfx (:,:)
IF( ln_rnf ) THEN
rnf_b (:,: ) = rnf (:,: )
rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
ENDIF
!
!
ENDIF
! ! ---------------------------------------- !
! ! forcing field computation !
......@@ -420,60 +420,62 @@ CONTAINS
!
SELECT CASE( nsbc ) ! Compute ocean surface boundary condition
! ! (i.e. utau,vtau, qns, qsr, emp, sfx)
CASE( jp_usr ) ; CALL usrdef_sbc_oce( kt, Kbb ) ! user defined formulation
CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation
CASE( jp_usr ) ; CALL usrdef_sbc_oce( kt, Kbb ) ! user defined formulation
CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation
CASE( jp_blk )
IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OCE-SAS coupling: SAS receiving fields from OCE
!!!!!!!!!!! ATTENTION:ln_wave is not only used for oasis coupling !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IF( ln_wave ) THEN
IF ( lk_oasis ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OCE-wave coupling
IF ( lk_oasis ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OCE-wave coupling
CALL sbc_wave ( kt, Kmm )
ENDIF
CALL sbc_blk ( kt ) ! bulk formulation for the ocean
CALL sbc_blk ( kt ) ! bulk formulation for the ocean
!
CASE( jp_abl )
IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OCE-SAS coupling: SAS receiving fields from OCE
CALL sbc_abl ( kt ) ! ABL formulation for the ocean
CALL sbc_abl ( kt ) ! ABL formulation for the ocean
!
CASE( jp_purecpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! pure coupled formulation
CASE( jp_none )
IF( ll_opa ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OCE-SAS coupling: OCE receiving fields from SAS
IF( ll_opa ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OCE-SAS coupling: OCE receiving fields from SAS
END SELECT
!
IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! forced-coupled mixed formulation after forcing
IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! forced-coupled mixed formulation after forcing
!
IF( ln_wave .AND. ln_tauoc ) THEN ! Wave stress reduction
DO_2D( 0, 0, 0, 0)
utau(ji,jj) = utau(ji,jj) * ( tauoc_wave(ji,jj) + tauoc_wave(ji+1,jj) ) * 0.5_wp
vtau(ji,jj) = vtau(ji,jj) * ( tauoc_wave(ji,jj) + tauoc_wave(ji,jj+1) ) * 0.5_wp
END_2D
!
CALL lbc_lnk( 'sbcwave', utau, 'U', -1. )
CALL lbc_lnk( 'sbcwave', vtau, 'V', -1. )
!
taum(:,:) = taum(:,:)*tauoc_wave(:,:)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
utau(ji,jj) = utau(ji,jj) * tauoc_wave(ji,jj)
vtau(ji,jj) = vtau(ji,jj) * tauoc_wave(ji,jj)
taum(ji,jj) = taum(ji,jj) * tauoc_wave(ji,jj)
END_2D
!
IF( kt == nit000 ) CALL ctl_warn( 'sbc: You are subtracting the wave stress to the ocean.', &
& 'If not requested select ln_tauoc=.false.' )
!
ELSEIF( ln_wave .AND. ln_taw ) THEN ! Wave stress reduction
utau(:,:) = utau(:,:) - tawx(:,:) + twox(:,:)
vtau(:,:) = vtau(:,:) - tawy(:,:) + twoy(:,:)
CALL lbc_lnk( 'sbcwave', utau, 'U', -1. )
CALL lbc_lnk( 'sbcwave', vtau, 'V', -1. )
!
DO_2D( 0, 0, 0, 0)
taum(ji,jj) = sqrt((.5*(utau(ji-1,jj)+utau(ji,jj)))**2 + (.5*(vtau(ji,jj-1)+vtau(ji,jj)))**2)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
utau(ji,jj) = utau(ji,jj) - tawx(ji,jj) + twox(ji,jj)
vtau(ji,jj) = vtau(ji,jj) - tawy(ji,jj) + twoy(ji,jj)
taum(ji,jj) = SQRT( utau(ji,jj)*utau(ji,jj) + vtau(ji,jj)*vtau(ji,jj) )
END_2D
!
IF( kt == nit000 ) CALL ctl_warn( 'sbc: You are subtracting the wave stress to the ocean.', &
& 'If not requested select ln_taw=.false.' )
!
ENDIF
CALL lbc_lnk( 'sbcmod', taum(:,:), 'T', 1. )
!
!
IF( ln_icebergs ) THEN ! save pure stresses (with no ice-ocean stress) for use by icebergs
utau_icb(:,:) = utau(:,:) ; vtau_icb(:,:) = vtau(:,:)
! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines
! and the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves
DO_2D( 0, 0, 0, 0 )
utau_icb(ji,jj) = 0.5_wp * ( utau(ji,jj) + utau(ji+1,jj) ) * &
& ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1), tmask(ji+1,jj,1) )
vtau_icb(ji,jj) = 0.5_wp * ( vtau(ji,jj) + vtau(ji,jj+1) ) * &
& ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1), tmask(ji,jj+1,1) )
END_2D
CALL lbc_lnk( 'sbcmod', utau_icb, 'U', -1.0_wp, vtau_icb, 'V', -1.0_wp )
ENDIF
!
! !== Misc. Options ==!
......@@ -507,9 +509,6 @@ CONTAINS
! Should not be run if ln_diurnal_only
IF( l_sbc_clo ) CALL sbc_clo( kt )
!!$!RBbug do not understand why see ticket 667
!!$!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why.
!!$ CALL lbc_lnk( 'sbcmod', emp, 'T', 1.0_wp )
IF( ll_wd ) THEN ! If near WAD point limit the flux for now
zthscl = atanh(rn_wd_sbcfra) ! taper frac default is .999
zwdht(:,:) = ssh(:,:,Kmm) + ht_0(:,:) - rn_wdmin1 ! do this calc of water
......@@ -534,6 +533,16 @@ CONTAINS
emp (:,:) = emp(:,:) * zwght(:,:)
END WHERE
ENDIF
! --- calculate utau and vtau on U,V-points --- !
! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines
! and the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves
DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
utauU (ji,jj) = 0.5_wp * ( utau(ji,jj) + utau(ji+1,jj) ) * &
& ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1), tmask(ji+1,jj,1) )
vtauV (ji,jj) = 0.5_wp * ( vtau(ji,jj) + vtau(ji,jj+1) ) * &
& ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1), tmask(ji,jj+1,1) )
END_2D
IF( nn_hls == 1 ) CALL lbc_lnk( 'sbcmod', utauU, 'U', -1.0_wp, vtauV, 'V', -1.0_wp )
!
IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 !
! ! ---------------------------------------- !
......@@ -543,27 +552,28 @@ CONTAINS
IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN !* MLF: Restart: read in restart file
#endif
IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields read in the restart file'
CALL iom_get( numror, jpdom_auto, 'utau_b', utau_b ) ! i-stress
CALL iom_get( numror, jpdom_auto, 'vtau_b', vtau_b ) ! j-stress
CALL iom_get( numror, jpdom_auto, 'qns_b', qns_b ) ! non solar heat flux
CALL iom_get( numror, jpdom_auto, 'emp_b', emp_b ) ! freshwater flux
CALL iom_get( numror, jpdom_auto, 'utau_b', utau_b, cd_type = 'U', psgn = -1._wp ) ! i-stress
CALL iom_get( numror, jpdom_auto, 'vtau_b', vtau_b, cd_type = 'V', psgn = -1._wp ) ! j-stress
CALL iom_get( numror, jpdom_auto, 'qns_b', qns_b, cd_type = 'T', psgn = 1._wp ) ! non solar heat flux
CALL iom_get( numror, jpdom_auto, 'emp_b', emp_b, cd_type = 'T', psgn = 1._wp ) ! freshwater flux
! NB: The 3D heat content due to qsr forcing (qsr_hc_b) is treated in traqsr
! To ensure restart capability with 3.3x/3.4 restart files !! to be removed in v3.6
IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN
CALL iom_get( numror, jpdom_auto, 'sfx_b', sfx_b ) ! before salt flux (T-point)
CALL iom_get( numror, jpdom_auto, 'sfx_b', sfx_b, cd_type = 'T', psgn = 1._wp ) ! before salt flux (T-point)
ELSE
sfx_b (:,:) = sfx(:,:)
ENDIF
ELSE !* no restart: set from nit000 values
IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields set to nit000'
utau_b(:,:) = utau(:,:)
vtau_b(:,:) = vtau(:,:)
utau_b(:,:) = utauU(:,:)
vtau_b(:,:) = vtauV(:,:)
qns_b (:,:) = qns (:,:)
emp_b (:,:) = emp (:,:)
sfx_b (:,:) = sfx (:,:)
ENDIF
ENDIF
!
!
#if defined key_RK3
! ! ---------------------------------------- !
IF( lrst_oce .AND. lk_SWE ) THEN ! RK3: Write in the ocean restart file !
......@@ -578,13 +588,13 @@ CONTAINS
IF(lwp) WRITE(numout,*) 'sbc : ocean surface forcing fields written in ocean restart file ', &
& 'at it= ', kt,' date= ', ndastp
IF(lwp) WRITE(numout,*) '~~~~'
CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau )
CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau )
CALL iom_rstput( kt, nitrst, numrow, 'qns_b' , qns )
CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utauU )
CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtauV )
CALL iom_rstput( kt, nitrst, numrow, 'qns_b' , qns )
! The 3D heat content due to qsr forcing is treated in traqsr
! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b' , qsr )
CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp )
CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx )
CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp )
CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx )
ENDIF
! ! ---------------------------------------- !
! ! Outputs and control print !
......@@ -628,8 +638,8 @@ CONTAINS
CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask - : ', mask1=tmask, kdim=jpk )
CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' sst - : ', mask1=tmask, kdim=1 )
CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sss - : ', mask1=tmask, kdim=1 )
CALL prt_ctl(tab2d_1=utau , clinfo1=' utau - : ', mask1=umask, &
& tab2d_2=vtau , clinfo2=' vtau - : ', mask2=vmask )
CALL prt_ctl(tab2d_1=utau , clinfo1=' utau - : ', mask1=tmask, &
& tab2d_2=vtau , clinfo2=' vtau - : ', mask2=tmask )
ENDIF
IF( kt == nitend ) CALL sbc_final ! Close down surface module if necessary
......
src/OCE/TRD/trddyn.F90
View file @ 53efb739
......@@ -140,8 +140,10 @@ CONTAINS
!
! ! wind stress trends
ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) )
z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u(:,:,1,Kmm) * rho0 )
z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v(:,:,1,Kmm) * rho0 )
DO_2D( 0, 0, 0, 0 )
z2dx(ji,jj) = ( utau_b(ji,jj) + utauU(ji,jj) ) / ( e3u(ji,jj,1,Kmm) * rho0 )
z2dy(ji,jj) = ( vtau_b(ji,jj) + vtauV(ji,jj) ) / ( e3v(ji,jj,1,Kmm) * rho0 )
END_2D
CALL iom_put( "utrd_tau", z2dx )
CALL iom_put( "vtrd_tau", z2dy )
DEALLOCATE( z2dx , z2dy )
......
src/OCE/TRD/trdglo.F90
View file @ 53efb739
......@@ -127,10 +127,10 @@ CONTAINS
IF( ktrd == jpdyn_zdf ) THEN ! zdf trend: compute separately the surface forcing trend
z1_2rho0 = 0.5_wp / rho0
DO_2D( 1, 0, 1, 0 )
zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk) &
& * z1_2rho0 * e1e2u(ji,jj)
zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) &
& * z1_2rho0 * e1e2v(ji,jj)
zvt = ( utau_b(ji,jj) + utauU(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk) &
& * z1_2rho0 * e1e2u(ji,jj)
zvs = ( vtau_b(ji,jj) + vtauV(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) &
& * z1_2rho0 * e1e2v(ji,jj)
umo(jpdyn_tau) = umo(jpdyn_tau) + zvt
vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs
hke(jpdyn_tau) = hke(jpdyn_tau) + uu(ji,jj,1,Kmm) * zvt + vv(ji,jj,1,Kmm) * zvs
......
src/OCE/TRD/trdken.F90
View file @ 53efb739
......@@ -118,16 +118,18 @@ CONTAINS
CASE( jpdyn_ldf ) ; CALL iom_put( "ketrd_ldf" , zke ) ! lateral diffusion
CASE( jpdyn_zdf ) ; CALL iom_put( "ketrd_zdf" , zke ) ! vertical diffusion
! ! ! wind stress trends
ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) , zke2d(jpi,jpj) )
z2dx(:,:) = uu(:,:,1,Kmm) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1)
z2dy(:,:) = vv(:,:,1,Kmm) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1)
zke2d(1:nn_hls,:) = 0._wp ; zke2d(:,1:nn_hls) = 0._wp
DO_2D( 0, nn_hls, 0, nn_hls )
zke2d(ji,jj) = r1_rho0 * 0.5_wp * ( z2dx(ji,jj) + z2dx(ji-1,jj) &
& + z2dy(ji,jj) + z2dy(ji,jj-1) ) * r1_bt(ji,jj,1)
END_2D
CALL iom_put( "ketrd_tau" , zke2d ) !
DEALLOCATE( z2dx , z2dy , zke2d )
ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) , zke2d(jpi,jpj) )
DO_2D( 1, 0, 1, 0 )
z2dx(ji,jj) = uu(ji,jj,1,Kmm) * ( utau_b(ji,jj) + utauU(ji,jj) ) * e1e2u(ji,jj) * umask(ji,jj,1)
z2dy(ji,jj) = vv(ji,jj,1,Kmm) * ( vtau_b(ji,jj) + vtauV(ji,jj) ) * e1e2v(ji,jj) * vmask(ji,jj,1)
END_2D
DO_2D( 0, 0, 0, 0 )
zke2d(ji,jj) = r1_rho0 * 0.5_wp * ( z2dx(ji,jj) + z2dx(ji-1,jj) &
& + z2dy(ji,jj) + z2dy(ji,jj-1) ) * r1_bt(ji,jj,1)
END_2D
CALL iom_put( "ketrd_tau" , zke2d ) !
DEALLOCATE( z2dx , z2dy , zke2d )
!
CASE( jpdyn_bfr ) ; CALL iom_put( "ketrd_bfr" , zke ) ! bottom friction (explicit case)
!!gm TO BE DONE properly
!!gm only valid if ln_drgimp=F otherwise the bottom stress as to be recomputed at the end of the computation....
......
src/OCE/TRD/trdvor.F90
View file @ 53efb739
......@@ -105,9 +105,9 @@ CONTAINS
CASE( jpdyn_zad ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_zad, Kmm ) ! Vertical Advection
CASE( jpdyn_spg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_spg, Kmm ) ! Surface Pressure Grad.
CASE( jpdyn_zdf ) ! Vertical Diffusion
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! wind stress trends
ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u(ji,jj,1,Kmm) * rho0 )
ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v(ji,jj,1,Kmm) * rho0 )
DO_2D( 0, 1, 0, 1 ) ! wind stress trends
ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utauU(ji,jj) ) / ( e3u(ji,jj,1,Kmm) * rho0 )
ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtauV(ji,jj) ) / ( e3v(ji,jj,1,Kmm) * rho0 )
END_2D
CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf, Kmm ) ! zdf trend including surf./bot. stresses
CALL trd_vor_zint( ztswu, ztswv, jpvor_swf, Kmm ) ! surface wind stress
......@@ -165,7 +165,7 @@ CONTAINS
SELECT CASE( ktrd )
!
CASE( jpvor_bfr ) ! bottom friction
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 1, 0, 1 )
ikbu = mbkv(ji,jj)
ikbv = mbkv(ji,jj)
zudpvor(ji,jj) = putrdvor(ji,jj) * e3u(ji,jj,ikbu,Kmm) * e1u(ji,jj) * umask(ji,jj,ikbu)
......@@ -173,14 +173,18 @@ CONTAINS
END_2D
!
CASE( jpvor_swf ) ! wind stress
zudpvor(:,:) = putrdvor(:,:) * e3u(:,:,1,Kmm) * e1u(:,:) * umask(:,:,1)
zvdpvor(:,:) = pvtrdvor(:,:) * e3v(:,:,1,Kmm) * e2v(:,:) * vmask(:,:,1)
DO_2D( 0, 1, 0, 1 )
zudpvor(ji,jj) = putrdvor(ji,jj) * e3u(ji,jj,1,Kmm) * e1u(ji,jj) * umask(ji,jj,1)
zvdpvor(ji,jj) = pvtrdvor(ji,jj) * e3v(ji,jj,1,Kmm) * e2v(ji,jj) * vmask(ji,jj,1)
END_2D
!
END SELECT
! Average except for Beta.V
zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm)
zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm)
DO_2D( 0, 1, 0, 1 )
zudpvor(ji,jj) = zudpvor(ji,jj) * r1_hu(ji,jj,Kmm)
zvdpvor(ji,jj) = zvdpvor(ji,jj) * r1_hv(ji,jj,Kmm)
END_2D
! Curl
DO_2D( 0, 0, 0, 0 )
......@@ -238,10 +242,11 @@ CONTAINS
! I vertical integration of 3D trends
! =====================================
! putrdvor and pvtrdvor terms
DO jk = 1,jpk
zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * e3u(:,:,jk,Kmm) * e1u(:,:) * umask(:,:,jk)
zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * e3v(:,:,jk,Kmm) * e2v(:,:) * vmask(:,:,jk)
END DO
zudpvor(:,:) = 0._wp ; zvdpvor(:,:) = 0._wp
DO_3D( 0, 1, 0, 1, 1, jpk )
zudpvor(ji,jj) = zudpvor(ji,jj) + putrdvor(ji,jj,jk) * e3u(ji,jj,jk,Kmm) * e1u(ji,jj) * umask(ji,jj,jk)
zvdpvor(ji,jj) = zvdpvor(ji,jj) + pvtrdvor(ji,jj,jk) * e3v(ji,jj,jk,Kmm) * e2v(ji,jj) * vmask(ji,jj,jk)
END_3D
! Planetary vorticity: 2nd computation (Beta.V term) store the vertical sum
! as Beta.V term need intergration, not average
......@@ -254,8 +259,10 @@ CONTAINS
ENDIF
!
! Average
zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm)
zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm)
DO_2D( 0, 1, 0, 1 )
zudpvor(ji,jj) = zudpvor(ji,jj) * r1_hu(ji,jj,Kmm)
zvdpvor(ji,jj) = zvdpvor(ji,jj) * r1_hv(ji,jj,Kmm)
END_2D
!
! Curl
DO_2D( 0, 0, 0, 0 )
......
src/OCE/USR/usrdef_sbc.F90
View file @ 53efb739
......@@ -166,19 +166,17 @@ CONTAINS
! seasonal oscillation intensity
ztau_sais = 0.015
ztaun = ztau - ztau_sais * COS( (ztime - ztimemax) / (ztimemin - ztimemax) * rpi )
DO_2D( 1, 1, 1, 1 )
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
! domain from 15deg to 50deg and 1/2 period along 14deg
! so 5/4 of half period with seasonal cycle
utau(ji,jj) = - ztaun * SIN( rpi * (gphiu(ji,jj) - 15.) / (29.-15.) )
vtau(ji,jj) = ztaun * SIN( rpi * (gphiv(ji,jj) - 15.) / (29.-15.) )
utau(ji,jj) = - ztaun * SIN( rpi * (gphit(ji,jj) - 15.) / (29.-15.) )
vtau(ji,jj) = ztaun * SIN( rpi * (gphit(ji,jj) - 15.) / (29.-15.) )
END_2D
! module of wind stress and wind speed at T-point
zcoef = 1. / ( zrhoa * zcdrag )
DO_2D( 0, 0, 0, 0 )
ztx = utau(ji-1,jj ) + utau(ji,jj)
zty = vtau(ji ,jj-1) + vtau(ji,jj)
zmod = 0.5 * SQRT( ztx * ztx + zty * zty )
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
zmod = SQRT( utau(ji,jj) * utau(ji,jj) + vtau(ji,jj) * vtau(ji,jj) )
taum(ji,jj) = zmod
wndm(ji,jj) = SQRT( zmod * zcoef )
END_2D
......
src/OCE/ZDF/zdfosm.F90
View file @ 53efb739
......@@ -486,8 +486,8 @@ CONTAINS
& grav * zbeta * swsav(ji,jj) ! OBSBL
END_2D
DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
suw0(ji,jj) = -0.5_wp * (utau(ji-1,jj) + utau(ji,jj)) * r1_rho0 * tmask(ji,jj,1) ! Surface upward velocity fluxes
zvw0 = -0.5_wp * (vtau(ji,jj-1) + vtau(ji,jj)) * r1_rho0 * tmask(ji,jj,1)
suw0(ji,jj) = - utau(ji,jj) * r1_rho0 * tmask(ji,jj,1) ! Surface upward velocity fluxes
zvw0 = - vtau(ji,jj) * r1_rho0 * tmask(ji,jj,1)
sustar(ji,jj) = MAX( SQRT( SQRT( suw0(ji,jj) * suw0(ji,jj) + zvw0 * zvw0 ) ), & ! Friction velocity (sustar), at
& 1e-8_wp ) ! T-point : LMD94 eq. 2
scos_wind(ji,jj) = -1.0_wp * suw0(ji,jj) / ( sustar(ji,jj) * sustar(ji,jj) )
......
src/OCE/ZDF/zdftke.F90
View file @ 53efb739
......@@ -210,7 +210,7 @@ CONTAINS
REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient
REAL(wp) :: zbbrau, zbbirau, zri ! local scalars
REAL(wp) :: zfact1, zfact2, zfact3 ! - -
REAL(wp) :: ztx2 , zty2 , zcof ! - -
REAL(wp) :: zcof ! - -
REAL(wp) :: ztau , zdif ! - -
REAL(wp) :: zus , zwlc , zind ! - -
REAL(wp) :: zzd_up, zzd_lw ! - -
......@@ -302,8 +302,8 @@ CONTAINS
! Projection of Stokes drift in the wind stress direction
!
DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
ztaui = 0.5_wp * ( utau(ji,jj) + utau(ji-1,jj) )
ztauj = 0.5_wp * ( vtau(ji,jj) + vtau(ji,jj-1) )
ztaui = utau(ji,jj)
ztauj = vtau(ji,jj)
z1_norm = 1._wp / MAX( SQRT(ztaui*ztaui+ztauj*ztauj), 1.e-12 ) * tmask(ji,jj,1)
zWlc2(ji,jj) = 0.5_wp * z1_norm * ( MAX( ut0sd(ji,jj)*ztaui + vt0sd(ji,jj)*ztauj, 0._wp ) )**2
END_2D
......@@ -483,9 +483,7 @@ CONTAINS
END_2D
ELSEIF( nn_etau == 3 ) THEN !* penetration belox the mixed layer (HF variability)
DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
ztx2 = utau(ji-1,jj ) + utau(ji,jj)
zty2 = vtau(ji ,jj-1) + vtau(ji,jj)
ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1) ! module of the mean stress
ztau = SQRT( utau(ji,jj)*utau(ji,jj) + vtau(ji,jj)*vtau(ji,jj) ) * tmask(ji,jj,1) ! module of the mean stress
zdif = taum(ji,jj) - ztau ! mean of modulus - modulus of the mean
zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add ) ! apply some modifications...
en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) &
......