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 655 additions and 811 deletions
src/OCE/SBC/sbc_ice.F90
View file @ 4b23ba89
......@@ -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 @ 4b23ba89
......@@ -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 @ 4b23ba89
This diff is collapsed.
src/OCE/SBC/sbccpl.F90
View file @ 4b23ba89
This diff is collapsed.
src/OCE/SBC/sbcflx.F90
View file @ 4b23ba89
......@@ -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 @ 4b23ba89
......@@ -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/TRA/eosbn2.F90
View file @ 4b23ba89
......@@ -1336,10 +1336,10 @@ CONTAINS
!! pab_pe(:,:,:,jp_tem) is alpha_pe
!! pab_pe(:,:,:,jp_sal) is beta_pe
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: Kmm ! time level index
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab_pe ! alpha_pe and beta_pe
REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: ppen ! potential energy anomaly
INTEGER , INTENT(in ) :: Kmm ! time level index
REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity
REAL(wp), DIMENSION(:,:,:,:), INTENT( out) :: pab_pe ! alpha_pe and beta_pe
REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: ppen ! potential energy anomaly
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zt , zh , zs , ztm ! local scalars
......@@ -1352,7 +1352,7 @@ CONTAINS
!
CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
!
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
!
zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth
zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature
......@@ -1411,9 +1411,9 @@ CONTAINS
!
CASE( np_seos ) !== Vallis (2006) simplified EOS ==!
!
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zt = pts(ji,jj,jk,jp_tem) - 10._wp ! temperature anomaly (t-T0)
zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0)
zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0)
zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point
ztm = tmask(ji,jj,jk) ! tmask
zn = 0.5_wp * zh * r1_rho0 * ztm
......
src/OCE/TRA/traadv.F90
View file @ 4b23ba89
......@@ -178,7 +178,7 @@ CONTAINS
!
!!gm ???
! TEMP: [tiling] This copy-in not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
IF( l_diaptr ) CALL dia_ptr( kt, Kmm, zvv(A2D(nn_hls),:) ) ! diagnose the effective MSF
IF( l_diaptr ) CALL dia_ptr( kt, Kmm, zvv(A2D(0),:) ) ! diagnose the effective MSF
!!gm ???
!
......
src/OCE/TRD/trddyn.F90
View file @ 4b23ba89
......@@ -56,10 +56,13 @@ CONTAINS
INTEGER , INTENT(in ) :: ktrd ! trend index
INTEGER , INTENT(in ) :: kt ! time step
INTEGER , INTENT(in ) :: Kmm ! time level index
INTEGER :: ji, jj, jk ! lopp indices
!!----------------------------------------------------------------------
!
putrd(:,:,:) = putrd(:,:,:) * umask(:,:,:) ! mask the trends
pvtrd(:,:,:) = pvtrd(:,:,:) * vmask(:,:,:)
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
putrd(ji,jj,jk) = putrd(ji,jj,jk) * umask(ji,jj,jk) ! mask the trends
pvtrd(ji,jj,jk) = pvtrd(ji,jj,jk) * vmask(ji,jj,jk)
END_3D
!
!!gm NB : here a lbc_lnk should probably be added
......@@ -120,10 +123,10 @@ CONTAINS
CALL iom_put( "vtrd_rvo", pvtrd )
CASE( jpdyn_keg ) ; CALL iom_put( "utrd_keg", putrd ) ! Kinetic Energy gradient (or had)
CALL iom_put( "vtrd_keg", pvtrd )
ALLOCATE( z3dx(jpi,jpj,jpk) , z3dy(jpi,jpj,jpk) )
z3dx(:,:,:) = 0._wp ! U.dxU & V.dyV (approximation)
z3dy(:,:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! no mask as un,vn are masked
ALLOCATE( z3dx(A2D(0),jpk) , z3dy(A2D(0),jpk) ) ! U.dxU & V.dyV (approximation)
z3dx(A2D(0),jpk) = 0._wp
z3dy(A2D(0),jpk) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! no mask as un,vn are masked
z3dx(ji,jj,jk) = uu(ji,jj,jk,Kmm) * ( uu(ji+1,jj,jk,Kmm) - uu(ji-1,jj,jk,Kmm) ) / ( 2._wp * e1u(ji,jj) )
z3dy(ji,jj,jk) = vv(ji,jj,jk,Kmm) * ( vv(ji,jj+1,jk,Kmm) - vv(ji,jj-1,jk,Kmm) ) / ( 2._wp * e2v(ji,jj) )
END_3D
......@@ -139,9 +142,11 @@ CONTAINS
CALL iom_put( "vtrd_zdf", pvtrd )
!
! ! 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 )
ALLOCATE( z2dx(A2D(0)) , z2dy(A2D(0)) )
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 @ 4b23ba89
......@@ -42,6 +42,7 @@ MODULE trdglo
REAL(wp) :: tvolv ! volume of the whole ocean computed at v-points
REAL(wp) :: rpktrd ! potential to kinetic energy conversion
REAL(wp) :: peke ! conversion potential energy - kinetic energy trend
REAL(wp) :: xcof
! !!! domain averaged trends
REAL(wp), DIMENSION(jptot_tra) :: tmo, smo ! temperature and salinity trends
......@@ -77,44 +78,47 @@ CONTAINS
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: ikbu, ikbv ! local integers
REAL(wp):: zvm, zvt, zvs, z1_2rho0 ! local scalars
REAL(wp), DIMENSION(jpi,jpj) :: ztswu, ztswv, z2dx, z2dy ! 2D workspace
REAL(wp), DIMENSION(A2D(0)) :: ztswu, ztswv, z2dx, z2dy ! 2D workspace
!!----------------------------------------------------------------------
!
IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN
!
SELECT CASE( ctype )
!
CASE( 'TRA' ) !== Tracers (T & S) ==!
DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! global sum of mask volume trend and trend*T (including interior mask)
zvm = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * tmask_i(ji,jj)
zvt = ptrdx(ji,jj,jk) * zvm
zvs = ptrdy(ji,jj,jk) * zvm
tmo(ktrd) = tmo(ktrd) + zvt
smo(ktrd) = smo(ktrd) + zvs
t2 (ktrd) = t2(ktrd) + zvt * ts(ji,jj,jk,jp_tem,Kmm)
s2 (ktrd) = s2(ktrd) + zvs * ts(ji,jj,jk,jp_sal,Kmm)
END_3D
SELECT CASE( ctype )
!
CASE( 'TRA' ) !== Tracers (T & S) ==!
DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! global sum of mask volume trend and trend*T (including interior mask)
zvm = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * tmask_i(ji,jj)
zvt = ptrdx(ji,jj,jk) * zvm
zvs = ptrdy(ji,jj,jk) * zvm
tmo(ktrd) = tmo(ktrd) + zvt
smo(ktrd) = smo(ktrd) + zvs
t2 (ktrd) = t2(ktrd) + zvt * ts(ji,jj,jk,jp_tem,Kmm)
s2 (ktrd) = s2(ktrd) + zvs * ts(ji,jj,jk,jp_sal,Kmm)
END_3D
! ! linear free surface: diagnose advective flux trough the fixed k=1 w-surface
IF( ln_linssh .AND. ktrd == jptra_zad ) THEN
tmo(jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) * e1e2t(:,:) * tmask_i(:,:) )
smo(jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) * e1e2t(:,:) * tmask_i(:,:) )
t2 (jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) * ts(:,:,1,jp_tem,Kmm) * e1e2t(:,:) * tmask_i(:,:) )
s2 (jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) * ts(:,:,1,jp_sal,Kmm) * e1e2t(:,:) * tmask_i(:,:) )
ENDIF
IF( ln_linssh .AND. ktrd == jptra_zad ) THEN
DO_2D( 0, 0, 0, 0 ) ! global sum of mask volume trend and trend*T (including interior mask)
zvm = ww(ji,jj,1) * e1e2t(ji,jj) * tmask_i(ji,jj)
tmo(jptra_sad) = tmo(jptra_sad) + ts(ji,jj,1,jp_tem,Kmm) * zvm
smo(jptra_sad) = smo(jptra_sad) + ts(ji,jj,1,jp_sal,Kmm) * zvm
t2 (jptra_sad) = t2 (jptra_sad) + ts(ji,jj,1,jp_tem,Kmm) * ts(ji,jj,1,jp_tem,Kmm) * zvm
s2 (jptra_sad) = s2 (jptra_sad) + ts(ji,jj,1,jp_sal,Kmm) * ts(ji,jj,1,jp_sal,Kmm) * zvm
END_2D
ENDIF
!
IF( ktrd == jptra_atf ) THEN ! last trend (asselin time filter)
!
CALL glo_tra_wri( kt ) ! print the results in ocean.output
!
tmo(:) = 0._wp ! prepare the next time step (domain averaged array reset to zero)
smo(:) = 0._wp
t2 (:) = 0._wp
s2 (:) = 0._wp
!
ENDIF
IF( ktrd == jptra_atf ) THEN ! last trend (asselin time filter)
!
CALL glo_tra_wri( kt ) ! print the results in ocean.output
!
tmo(:) = 0._wp ! prepare the next time step (domain averaged array reset to zero)
smo(:) = 0._wp
t2 (:) = 0._wp
s2 (:) = 0._wp
!
ENDIF
!
CASE( 'DYN' ) !== Momentum and KE ==!
DO_3D( 1, 0, 1, 0, 1, jpkm1 )
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk) &
& * e1e2u (ji,jj) * e3u(ji,jj,jk,Kmm)
zvs = ptrdy(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) &
......@@ -126,11 +130,11 @@ 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)
DO_2D( 0, 0, 0, 0 )
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
......@@ -184,8 +188,7 @@ CONTAINS
INTEGER, INTENT(in) :: Kmm ! time level index
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zcof ! local scalar
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zkx, zky, zkz, zkepe
REAL(wp), DIMENSION(A2D(0),jpk) :: zkx, zky, zkz, zkepe
!!----------------------------------------------------------------------
! I. Momentum trends
......@@ -196,24 +199,24 @@ CONTAINS
! I.1 Conversion potential energy - kinetic energy
! --------------------------------------------------
! c a u t i o n here, trends are computed at kt+1 (now , but after the swap)
zkx (:,:,:) = 0._wp
zky (:,:,:) = 0._wp
zkz (:,:,:) = 0._wp
zkepe(:,:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! loop from top to bottom
zkx (ji,jj,jk) = 0._wp
zky (ji,jj,jk) = 0._wp
zkz (ji,jj,jk) = 0._wp
zkepe(ji,jj,jk) = 0._wp
END_3D
CALL eos( ts(:,:,:,:,Kmm), rhd, rhop ) ! now potential density
zcof = 0.5_wp / rho0 ! Density flux at w-point
zkz(:,:,1) = 0._wp
DO jk = 2, jpk
zkz(:,:,jk) = zcof * e1e2t(:,:) * ww(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:)
END DO
zkz(A2D(0),1) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpk ) ! loop from top to bottom
zkz(ji,jj,jk) = xcof * e1e2t(ji,jj) * ww(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj,jk-1) ) * tmask_i(ji,jj)
END_3D
zcof = 0.5_wp / rho0 ! Density flux at u and v-points
DO_3D( 1, 0, 1, 0, 1, jpkm1 )
zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) &
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zkx(ji,jj,jk) = xcof * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) &
& * uu(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) )
zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) &
zky(ji,jj,jk) = xcof * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) &
& * vv(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) )
END_3D
......@@ -227,10 +230,9 @@ CONTAINS
! I.2 Basin averaged kinetic energy trend
! ----------------------------------------
peke = 0._wp
DO jk = 1, jpkm1
peke = peke + SUM( zkepe(:,:,jk) * gdept(:,:,jk,Kmm) * e1e2t(:,:) &
& * e3t(:,:,jk,Kmm) )
END DO
DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! loop from top to bottom
peke = peke + zkepe(ji,jj,jk) * gdept(ji,jj,jk,Kmm) * e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm)
END_3D
peke = grav * peke
! I.3 Sums over the global domain
......@@ -509,11 +511,14 @@ CONTAINS
WRITE(numout,*) '~~~~~~~~~~~~~'
ENDIF
xcof = 0.5_wp / rho0
! Total volume at t-points:
tvolt = 0._wp
DO jk = 1, jpkm1
tvolt = tvolt + SUM( e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) * tmask_i(:,:) )
END DO
DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Density flux divergence at t-point
tvolt = tvolt + e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * tmask_i(ji,jj)
END_3D
CALL mpp_sum( 'trdglo', tvolt ) ! sum over the global domain
IF(lwp) WRITE(numout,*) ' total ocean volume at T-point tvolt = ',tvolt
......
src/OCE/TRD/trdken.F90
View file @ 4b23ba89
......@@ -30,6 +30,10 @@ MODULE trdken
IMPLICIT NONE
PRIVATE
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
PUBLIC trd_ken ! called by trddyn module
PUBLIC trd_ken_init ! called by trdini module
......@@ -38,9 +42,6 @@ MODULE trdken
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: bu, bv ! volume of u- and v-boxes
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: r1_bt ! inverse of t-box volume
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: trdken.F90 15104 2021-07-07 14:36:00Z clem $
......@@ -52,7 +53,7 @@ CONTAINS
!!---------------------------------------------------------------------
!! *** FUNCTION trd_ken_alloc ***
!!---------------------------------------------------------------------
ALLOCATE( bu(jpi,jpj,jpk) , bv(jpi,jpj,jpk) , r1_bt(jpi,jpj,jpk) , STAT= trd_ken_alloc )
ALLOCATE( bu(A2D(0),jpk) , bv(A2D(0),jpk) , r1_bt(A2D(0),jpk) , STAT= trd_ken_alloc )
!
CALL mpp_sum ( 'trdken', trd_ken_alloc )
IF( trd_ken_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trd_ken_alloc: failed to allocate arrays' )
......@@ -77,31 +78,32 @@ CONTAINS
!
!
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: putrd, pvtrd ! U and V masked trends
INTEGER , INTENT(in ) :: ktrd ! trend index
INTEGER , INTENT(in ) :: kt ! time step
INTEGER , INTENT(in ) :: Kmm ! time level index
REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: putrd, pvtrd ! U and V masked trends
INTEGER , INTENT(in ) :: ktrd ! trend index
INTEGER , INTENT(in ) :: kt ! time step
INTEGER , INTENT(in ) :: Kmm ! time level index
!
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: ikbu , ikbv ! local integers
INTEGER :: ikbum1, ikbvm1 ! - -
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: z2dx, z2dy, zke2d ! 2D workspace
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zke ! 3D workspace
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zke2d ! 2D workspace
REAL(wp) :: z2dx, z2dy, z2dxm1, z2dym1 ! 2D workspace
REAL(wp), DIMENSION(A2D(0),jpk) :: zke ! 3D workspace
!!----------------------------------------------------------------------
!
CALL lbc_lnk( 'trdken', putrd, 'U', -1.0_wp , pvtrd, 'V', -1.0_wp ) ! lateral boundary conditions
!
nkstp = kt
DO jk = 1, jpkm1
bu (:,:,jk) = e1e2u(:,:) * e3u(:,:,jk,Kmm)
bv (:,:,jk) = e1e2v(:,:) * e3v(:,:,jk,Kmm)
r1_bt(:,:,jk) = r1_e1e2t(:,:) / e3t(:,:,jk,Kmm) * tmask(:,:,jk)
DO_2D( 0, 0, 0, 0 )
bu (ji,jj,jk) = e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm)
bv (ji,jj,jk) = e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
r1_bt(ji,jj,jk) = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
END_2D
END DO
!
zke(:,:,jpk) = 0._wp
zke(1:nn_hls,:, : ) = 0._wp
zke(:,1:nn_hls, : ) = 0._wp
DO_3D( 0, nn_hls, 0, nn_hls, 1, jpkm1 )
zke(A2D(0),:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zke(ji,jj,jk) = 0.5_wp * rho0 *( uu(ji ,jj,jk,Kmm) * putrd(ji ,jj,jk) * bu(ji ,jj,jk) &
& + uu(ji-1,jj,jk,Kmm) * putrd(ji-1,jj,jk) * bu(ji-1,jj,jk) &
& + vv(ji,jj ,jk,Kmm) * pvtrd(ji,jj ,jk) * bv(ji,jj ,jk) &
......@@ -118,35 +120,31 @@ 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
ALLOCATE( zke2d(A2D(0)) ) ; zke2d(A2D(0)) = 0._wp
DO_2D( 0, 0, 0, 0 )
z2dx = uu(ji,jj,1,Kmm) * ( utau_b(ji,jj) + utauU(ji,jj) ) * e1e2u(ji,jj) * umask(ji,jj,1)
z2dy = vv(ji,jj,1,Kmm) * ( vtau_b(ji,jj) + vtauV(ji,jj) ) * e1e2v(ji,jj) * vmask(ji,jj,1)
z2dxm1 = uu(ji-1,jj,1,Kmm) * ( utau_b(ji-1,jj) + utauU(ji-1,jj) ) * e1e2u(ji-1,jj) * umask(ji-1,jj,1)
z2dym1 = vv(ji,jj-1,1,Kmm) * ( vtau_b(ji,jj-1) + vtauV(ji,jj-1) ) * e1e2v(ji,jj-1) * vmask(ji,jj-1,1)
zke2d(ji,jj) = r1_rho0 * 0.5_wp * ( z2dx + z2dxm1 + z2dy + z2dym1 ) * r1_bt(ji,jj,1)
END_2D
CALL iom_put( "ketrd_tau" , zke2d ) !
DEALLOCATE( z2dx , z2dy , zke2d )
DEALLOCATE( 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....
! IF(.NOT. ln_drgimp) THEN
! DO jj = 1, jpj !
! DO ji = 1, jpi
! ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels
! ikbv = mbkv(ji,jj)
! z2dx(ji,jj) = uu(ji,jj,ikbu,Kmm) * bfrua(ji,jj) * uu(ji,jj,ikbu,Kmm)
! z2dy(ji,jj) = vv(ji,jj,ikbu,Kmm) * bfrva(ji,jj) * vv(ji,jj,ikbv,Kmm)
! END DO
! END DO
! zke2d(A2D(0)) = 0._wp
! DO_2D( 0, 0, 0, 0 )
! ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels
! ikbv = mbkv(ji,jj)
! z2dx = uu(ji,jj,ikbu,Kmm) * bfrua(ji,jj) * uu(ji,jj,ikbu,Kmm)
! z2dy = vv(ji,jj,ikbu,Kmm) * bfrva(ji,jj) * vv(ji,jj,ikbv,Kmm)
! z2dxm1 = uu(ji-1,jj,ikbu,Kmm) * bfrua(ji-1,jj) * uu(ji-1,jj,ikbu,Kmm)
! z2dym1 = vv(ji,jj-1,ikbu,Kmm) * bfrva(ji,jj-1) * vv(ji,jj-1,ikbv,Kmm)
! zke2d(ji,jj) = 0.5_wp * ( z2dx + z2dxm1 + z2dy + z2dym1 ) * r1_bt(ji,jj,1)
! END_2D
! zke2d(1,:) = 0._wp ; zke2d(:,1) = 0._wp
! DO jj = 2, jpj
! DO ji = 2, jpi
! zke2d(ji,jj) = 0.5_wp * ( z2dx(ji,jj) + z2dx(ji-1,jj) &
! & + z2dy(ji,jj) + z2dy(ji,jj-1) ) * r1_bt(ji,jj, BEURK!!!
! END DO
! END DO
! CALL iom_put( "ketrd_bfr" , zke2d ) ! bottom friction (explicit case)
! ENDIF
!!gm end
......@@ -175,11 +173,11 @@ CONTAINS
CASE( jpdyn_ken ) ; ! kinetic energy
! called in dynnxt.F90 before asselin time filter
! with putrd=uu(Krhs) and pvtrd=vv(Krhs)
zke(:,:,:) = 0.5_wp * zke(:,:,:)
zke(A2D(0),:) = 0.5_wp * zke(A2D(0),:)
CALL iom_put( "KE", zke )
!
CALL ken_p2k( kt , zke, Kmm )
CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rau*g*w
CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rau*g*w
!
END SELECT
!
......@@ -203,22 +201,23 @@ CONTAINS
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: iku, ikv ! local integers
REAL(wp) :: zcoef ! local scalars
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zconv ! 3D workspace
REAL(wp), DIMENSION(A2D(0),jpk) :: zconv ! 3D workspace
!!----------------------------------------------------------------------
!
! Local constant initialization
zcoef = - rho0 * grav * 0.5_wp
! Surface value (also valid in partial step case)
zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * ww(:,:,1) * e3w(:,:,1,Kmm)
DO_2D( 0, 0, 0, 0 )
zconv(ji,jj,1) = zcoef * ( 2._wp * rhd(ji,jj,1) ) * ww(ji,jj,1) * e3w(ji,jj,1,Kmm)
END_2D
! interior value (2=<jk=<jpkm1)
DO jk = 2, jpk
zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * ww(:,:,jk) * e3w(:,:,jk,Kmm)
END DO
DO_3D( 0, 0, 0, 0 , 2, jpk )
zconv(ji,jj,jk) = zcoef * ( rhd(ji,jj,jk) + rhd(ji,jj,jk-1) ) * ww(ji,jj,jk) * e3w(ji,jj,jk,Kmm)
END_3D
! conv value on T-point
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zcoef = 0.5_wp / e3t(ji,jj,jk,Kmm)
pconv(ji,jj,jk) = zcoef * ( zconv(ji,jj,jk) + zconv(ji,jj,jk+1) ) * tmask(ji,jj,jk)
END_3D
......
src/OCE/TRD/trdmxl.F90
View file @ 4b23ba89
......@@ -45,20 +45,7 @@ MODULE trdmxl
PUBLIC trd_mxl_init ! routine called by opa.F90
PUBLIC trd_mxl_zint ! routine called by tracers routines
INTEGER :: nkstp ! current time step
!!gm to be moved from trdmxl_oce
! REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: hml ! ML depth (sum of e3t over nmln-1 levels) [m]
! REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: tml , sml ! now ML averaged T & S
! REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: tmlb_nf, smlb_nf ! not filtered before ML averaged T & S
!
!
! REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: hmlb, hmln ! before, now, and after Mixed Layer depths [m]
!
! REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: tb_mlb, tb_mln ! before (not filtered) tracer averaged over before and now ML
!
! REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: tn_mln ! now tracer averaged over now ML
!!gm end
INTEGER :: nkstp ! current time step
CHARACTER (LEN=40) :: clhstnam ! name of the trends NetCDF file
INTEGER :: nh_t, nmoymltrd
......@@ -111,44 +98,41 @@ CONTAINS
IF ( kt /= nkstp ) THEN != 1st call at kt time step =!
! !==============================!
nkstp = kt
! !== reset trend arrays to zero ==!
tmltrd(:,:,:) = 0._wp ; smltrd(:,:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpktrd )
tmltrd(ji,jj,jk) = 0._wp
smltrd(ji,jj,jk) = 0._wp
END_3D
!
wkx(:,:,:) = 0._wp !== now ML weights for vertical averaging ==!
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpktrd ) ! initialize wkx with vertical scale factor in mixed-layer
! !== now ML weights for vertical averaging ==!
DO_3D( 0, 0, 0, 0, 1, jpktrd ) ! initialize wkx with vertical scale factor in mixed-layer
IF( jk - kmxln(ji,jj) < 0 ) THEN
wkx(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
ELSE
wkx(ji,jj,jk) = 0._wp
ENDIF
END_3D
!
hmxl(:,:) = 0._wp ! NOW mixed-layer depth
DO jk = 1, jpktrd
hmxl(:,:) = hmxl(:,:) + wkx(:,:,jk)
END DO
DO jk = 1, jpktrd ! integration weights
wkx(:,:,jk) = wkx(:,:,jk) / MAX( 1.e-20_wp, hmxl(:,:) ) * tmask(:,:,1)
END DO
DO_3D( 0, 0, 0, 0, 1, jpktrd )
hmxl(ji,jj) = hmxl(ji,jj) + wkx(ji,jj,jk)
wkx (ji,jj,jk) = wkx (ji,jj,jk) / MAX( 1.e-20_wp, hmxl(ji,jj) ) * tmask(ji,jj,1)
END_3D
!
! !== Vertically averaged T and S ==!
tml(:,:) = 0._wp ; sml(:,:) = 0._wp
DO jk = 1, jpktrd
tml(:,:) = tml(:,:) + wkx(:,:,jk) * ts(:,:,jk,jp_tem,Kmm)
sml(:,:) = sml(:,:) + wkx(:,:,jk) * ts(:,:,jk,jp_sal,Kmm)
END DO
DO_3D( 0, 0, 0, 0, 1, jpktrd )
tml(ji,jj) = tml(ji,jj) + wkx(ji,jj,jk) * ts(ji,jj,jk,jp_tem,Kmm)
sml(ji,jj) = sml(ji,jj) + wkx(ji,jj,jk) * ts(ji,jj,jk,jp_sal,Kmm)
END_3D
!
ENDIF
! mean now trends over the now ML
tmltrd(:,:,ktrd) = tmltrd(:,:,ktrd) + ptrdx(:,:,jk) * wkx(:,:,jk) ! temperature
smltrd(:,:,ktrd) = smltrd(:,:,ktrd) + ptrdy(:,:,jk) * wkx(:,:,jk) ! salinity
DO_2D( 0, 0, 0, 0 )
tmltrd(ji,jj,ktrd) = tmltrd(ji,jj,ktrd) + ptrdx(ji,jj,jk) * wkx(ji,jj,jk) ! temperature
smltrd(ji,jj,ktrd) = smltrd(ji,jj,ktrd) + ptrdy(ji,jj,jk) * wkx(ji,jj,jk) ! salinity
END_2D
!!gm to be put juste before the output !
......@@ -249,11 +233,11 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: ktrd ! ocean trend index
CHARACTER(len=2) , INTENT( in ) :: ctype ! 2D surface/bottom or 3D interior physics
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pttrdmxl ! temperature trend
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pstrdmxl ! salinity trend
REAL(wp), DIMENSION(A2D(0),jpk), INTENT( in ) :: pttrdmxl ! temperature trend
REAL(wp), DIMENSION(A2D(0),jpk), INTENT( in ) :: pstrdmxl ! salinity trend
!
INTEGER :: ji, jj, jk, isum
REAL(wp), DIMENSION(jpi,jpj) :: zvlmsk
REAL(wp), DIMENSION(A2D(0)) :: zvlmsk
!!----------------------------------------------------------------------
! I. Definition of control surface and associated fields
......@@ -268,11 +252,13 @@ CONTAINS
! ... Set nmxl(ji,jj) = index of first T point below control surf. or outside mixed-layer
IF( nn_ctls == 0 ) THEN ! * control surface = mixed-layer with density criterion
nmxl(:,:) = nmln(:,:) ! array nmln computed in zdfmxl.F90
ELSEIF( nn_ctls == 1 ) THEN ! * control surface = read index from file
IF( nn_ctls == 0 ) THEN ! * control surface = mixed-layer with density criterion
DO_2D( 0, 0, 0, 0 )
nmxl(ji,jj) = nmln(ji,jj) ! array nmln computed in zdfmxl.F90
END_2D
ELSEIF( nn_ctls == 1 ) THEN ! * control surface = read index from file
nmxl(:,:) = nbol(:,:)
ELSEIF( nn_ctls >= 2 ) THEN ! * control surface = model level
ELSEIF( nn_ctls >= 2 ) THEN ! * control surface = model level
nn_ctls = MIN( nn_ctls, jpktrd - 1 )
nmxl(:,:) = nn_ctls + 1
ENDIF
......@@ -335,9 +321,9 @@ CONTAINS
REAL(wp) :: zavt, zfn, zfn2
! ! z(ts)mltot : dT/dt over the anlysis window (including Asselin)
! ! z(ts)mlres : residual = dh/dt entrainment term
REAL(wp), DIMENSION(jpi,jpj ) :: ztmltot , zsmltot , ztmlres , zsmlres , ztmlatf , zsmlatf
REAL(wp), DIMENSION(jpi,jpj ) :: ztmltot2, zsmltot2, ztmlres2, zsmlres2, ztmlatf2, zsmlatf2, ztmltrdm2, zsmltrdm2
REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmltrd2, zsmltrd2 ! only needed for mean diagnostics
REAL(wp), DIMENSION(A2D(0) ) :: ztmltot , zsmltot , ztmlres , zsmlres , ztmlatf , zsmlatf
REAL(wp), DIMENSION(A2D(0) ) :: ztmltot2, zsmltot2, ztmlres2, zsmlres2, ztmlatf2, zsmlatf2, ztmltrdm2, zsmltrdm2
REAL(wp), DIMENSION(A2D(0),jpk) :: ztmltrd2, zsmltrd2 ! only needed for mean diagnostics
!!----------------------------------------------------------------------
! ======================================================================
......@@ -446,12 +432,7 @@ CONTAINS
itmod = kt - nit000 + 1
MODULO_NTRD : IF( MOD( itmod, nn_trd ) == 0 ) THEN ! nitend MUST be multiple of nn_trd
!
ztmltot (:,:) = 0.e0 ; zsmltot (:,:) = 0.e0 ! reset arrays to zero
ztmlres (:,:) = 0.e0 ; zsmlres (:,:) = 0.e0
ztmltot2(:,:) = 0.e0 ; zsmltot2(:,:) = 0.e0
ztmlres2(:,:) = 0.e0 ; zsmlres2(:,:) = 0.e0
!
zfn = REAL( nmoymltrd, wp ) ; zfn2 = zfn * zfn
! III.1 Prepare fields for output ("instantaneous" diagnostics)
......@@ -469,25 +450,18 @@ CONTAINS
ztmlatf(:,:) = tmlatfm(:,:) - tmlatfn(:,:) + tmlatfb(:,:)
zsmlatf(:,:) = smlatfm(:,:) - smlatfn(:,:) + smlatfb(:,:)
!-- Lateral boundary conditions
! ... temperature ... ... salinity ...
CALL lbc_lnk( 'trdmxl', ztmltot , 'T', 1.0_wp, zsmltot , 'T', 1.0_wp, &
& ztmlres , 'T', 1.0_wp, zsmlres , 'T', 1.0_wp, &
& ztmlatf , 'T', 1.0_wp, zsmlatf , 'T', 1.0_wp )
! III.2 Prepare fields for output ("mean" diagnostics)
! ----------------------------------------------------
!-- Update the ML depth time sum (to build the Leap-Frog time mean)
hmxl_sum(:,:) = hmxlbn(:,:) + 2 * ( hmxl_sum(:,:) - hmxl(:,:) ) + hmxl(:,:)
hmxl_sum(:,:) = hmxlbn(:,:) + 2._wp * ( hmxl_sum(:,:) - hmxl(:,:) ) + hmxl(:,:)
!-- Compute temperature total trends
tml_sum (:,:) = tmlbn(:,:) + 2 * ( tml_sum(:,:) - tml(:,:) ) + tml(:,:)
tml_sum (:,:) = tmlbn(:,:) + 2._wp * ( tml_sum(:,:) - tml(:,:) ) + tml(:,:)
ztmltot2(:,:) = ( tml_sum(:,:) - tml_sumb(:,:) ) / p2dt ! now in degC/s
!-- Compute salinity total trends
sml_sum (:,:) = smlbn(:,:) + 2 * ( sml_sum(:,:) - sml(:,:) ) + sml(:,:)
sml_sum (:,:) = smlbn(:,:) + 2._wp * ( sml_sum(:,:) - sml(:,:) ) + sml(:,:)
zsmltot2(:,:) = ( sml_sum(:,:) - sml_sumb(:,:) ) / p2dt ! now in psu/s
!-- Compute temperature residuals
......@@ -495,7 +469,7 @@ CONTAINS
ztmltrd2(:,:,jl) = tmltrd_csum_ub(:,:,jl) + tmltrd_csum_ln(:,:,jl)
END DO
ztmltrdm2(:,:) = 0.e0
ztmltrdm2(:,:) = 0._wp
DO jl = 1, jpltrd
ztmltrdm2(:,:) = ztmltrdm2(:,:) + ztmltrd2(:,:,jl)
END DO
......@@ -508,7 +482,7 @@ CONTAINS
zsmltrd2(:,:,jl) = smltrd_csum_ub(:,:,jl) + smltrd_csum_ln(:,:,jl)
END DO
zsmltrdm2(:,:) = 0.
zsmltrdm2(:,:) = 0._wp
DO jl = 1, jpltrd
zsmltrdm2(:,:) = zsmltrdm2(:,:) + zsmltrd2(:,:,jl)
END DO
......@@ -519,13 +493,6 @@ CONTAINS
!-- Diagnose Asselin trend over the analysis window
ztmlatf2(:,:) = ztmltrd2(:,:,jpmxl_atf) - tmltrd_sum(:,:,jpmxl_atf) + tmltrd_atf_sumb(:,:)
zsmlatf2(:,:) = zsmltrd2(:,:,jpmxl_atf) - smltrd_sum(:,:,jpmxl_atf) + smltrd_atf_sumb(:,:)
!-- Lateral boundary conditions
! ... temperature ... ... salinity ...
CALL lbc_lnk( 'trdmxl', ztmltot2, 'T', 1.0_wp, zsmltot2, 'T', 1.0_wp, &
& ztmlres2, 'T', 1.0_wp, zsmlres2, 'T', 1.0_wp )
!
CALL lbc_lnk( 'trdmxl', ztmltrd2(:,:,:), 'T', 1.0_wp, zsmltrd2(:,:,:), 'T', 1.0_wp ) ! / in the NetCDF trends file
! III.3 Time evolution array swap
! -------------------------------
......@@ -622,6 +589,8 @@ CONTAINS
! ======================================================================
!-- Write the trends for T/S instantaneous diagnostics
! clem => these fields do not exist in field_def
IF( ln_trdmxl_instant ) THEN
......
src/OCE/TRD/trdmxl_oce.F90
View file @ 4b23ba89
......@@ -80,6 +80,8 @@ MODULE trdmxl_oce
smltrd_csum_ln, & !: ( idem for salinity )
smltrd_csum_ub !:
!! * Substitutions
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: trdmxl_oce.F90 10425 2018-12-19 21:54:16Z smasson $
......@@ -101,29 +103,29 @@ CONTAINS
ierr(:) = 0
ALLOCATE( nmxl (jpi,jpj) , nbol (jpi,jpj), &
& wkx (jpi,jpj,jpk), hmxl (jpi,jpj), &
& tml (jpi,jpj) , sml (jpi,jpj), &
& tmlb (jpi,jpj) , smlb (jpi,jpj), &
& tmlbb(jpi,jpj) , smlbb(jpi,jpj), STAT = ierr(1) )
ALLOCATE( tmlbn(jpi,jpj) , smlbn(jpi,jpj), &
& tmltrdm(jpi,jpj), smltrdm(jpi,jpj), &
& tml_sum(jpi,jpj), tml_sumb(jpi,jpj),&
& tmltrd_atf_sumb(jpi,jpj) , STAT=ierr(2) )
ALLOCATE( sml_sum(jpi,jpj), sml_sumb(jpi,jpj), &
& smltrd_atf_sumb(jpi,jpj), &
& hmxl_sum(jpi,jpj), hmxlbn(jpi,jpj), &
& tmlatfb(jpi,jpj), tmlatfn(jpi,jpj), STAT = ierr(3) )
ALLOCATE( smlatfb(jpi,jpj), smlatfn(jpi,jpj), &
& tmlatfm(jpi,jpj), smlatfm(jpi,jpj), &
& tmltrd(jpi,jpj,jpltrd), smltrd(jpi,jpj,jpltrd), STAT=ierr(4))
ALLOCATE( tmltrd_sum(jpi,jpj,jpltrd),tmltrd_csum_ln(jpi,jpj,jpltrd), &
& tmltrd_csum_ub(jpi,jpj,jpltrd), smltrd_sum(jpi,jpj,jpltrd), &
& smltrd_csum_ln(jpi,jpj,jpltrd), smltrd_csum_ub(jpi,jpj,jpltrd), STAT=ierr(5) )
ALLOCATE( nmxl (A2D(0)) , nbol (A2D(0)), &
& wkx (A2D(0),jpk), hmxl (A2D(0)), &
& tml (A2D(0)) , sml (A2D(0)), &
& tmlb (A2D(0)) , smlb (A2D(0)), &
& tmlbb(A2D(0)) , smlbb(A2D(0)), STAT = ierr(1) )
ALLOCATE( tmlbn(A2D(0)) , smlbn(A2D(0)), &
& tmltrdm(A2D(0)), smltrdm(A2D(0)), &
& tml_sum(A2D(0)), tml_sumb(A2D(0)),&
& tmltrd_atf_sumb(A2D(0)) , STAT=ierr(2) )
ALLOCATE( sml_sum(A2D(0)), sml_sumb(A2D(0)), &
& smltrd_atf_sumb(A2D(0)), &
& hmxl_sum(A2D(0)), hmxlbn(A2D(0)), &
& tmlatfb(A2D(0)), tmlatfn(A2D(0)), STAT = ierr(3) )
ALLOCATE( smlatfb(A2D(0)), smlatfn(A2D(0)), &
& tmlatfm(A2D(0)), smlatfm(A2D(0)), &
& tmltrd(A2D(0),jpltrd), smltrd(A2D(0),jpltrd), STAT=ierr(4))
ALLOCATE( tmltrd_sum(A2D(0),jpltrd),tmltrd_csum_ln(A2D(0),jpltrd), &
& tmltrd_csum_ub(A2D(0),jpltrd), smltrd_sum(A2D(0),jpltrd), &
& smltrd_csum_ln(A2D(0),jpltrd), smltrd_csum_ub(A2D(0),jpltrd), STAT=ierr(5) )
!
trdmxl_oce_alloc = MAXVAL( ierr )
CALL mpp_sum ( 'trdmxl_oce', trdmxl_oce_alloc )
......
src/OCE/TRD/trdpen.F90
View file @ 4b23ba89
......@@ -35,6 +35,7 @@ MODULE trdpen
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: rab_pe ! partial derivatives of PE anomaly with respect to T and S
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
......@@ -48,7 +49,7 @@ CONTAINS
!!---------------------------------------------------------------------
!! *** FUNCTION trd_tra_alloc ***
!!---------------------------------------------------------------------
ALLOCATE( rab_pe(jpi,jpj,jpk,jpts) , STAT= trd_pen_alloc )
ALLOCATE( rab_pe(A2D(0),jpk,jpts) , STAT= trd_pen_alloc )
!
CALL mpp_sum ( 'trdpen', trd_pen_alloc )
IF( trd_pen_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trd_pen_alloc: failed to allocate arrays' )
......@@ -69,37 +70,40 @@ CONTAINS
INTEGER , INTENT(in) :: Kmm ! time level index
REAL(wp) , INTENT(in) :: pdt ! time step [s]
!
INTEGER :: jk ! dummy loop indices
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2d ! 2D workspace
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpe ! 3D workspace
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2d ! 2D workspace
REAL(wp), DIMENSION(A2D(0),jpk) :: zpe ! 3D workspace
!!----------------------------------------------------------------------
!
zpe(:,:,:) = 0._wp
zpe(A2D(0),:) = 0._wp
!
IF( kt /= nkstp ) THEN ! full eos: set partial derivatives at the 1st call of kt time step
nkstp = kt
CALL eos_pen( ts(:,:,:,:,Kmm), rab_PE, zpe, Kmm )
CALL eos_pen( ts(A2D(0),:,:,Kmm), rab_pe, zpe, Kmm )
CALL iom_put( "alphaPE", rab_pe(:,:,:,jp_tem) )
CALL iom_put( "betaPE" , rab_pe(:,:,:,jp_sal) )
CALL iom_put( "PEanom" , zpe )
ENDIF
!
zpe(:,:,jpk) = 0._wp
DO jk = 1, jpkm1
zpe(:,:,jk) = ( - ( rab_n(:,:,jk,jp_tem) + rab_pe(:,:,jk,jp_tem) ) * ptrdx(:,:,jk) &
& + ( rab_n(:,:,jk,jp_sal) + rab_pe(:,:,jk,jp_sal) ) * ptrdy(:,:,jk) )
END DO
zpe(A2D(0),jpk) = 0._wp
!
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zpe(ji,jj,jk) = ( - ( rab_n(ji,jj,jk,jp_tem) + rab_pe(ji,jj,jk,jp_tem) ) * ptrdx(ji,jj,jk) &
& + ( rab_n(ji,jj,jk,jp_sal) + rab_pe(ji,jj,jk,jp_sal) ) * ptrdy(ji,jj,jk) )
END_3D
SELECT CASE ( ktrd )
CASE ( jptra_xad ) ; CALL iom_put( "petrd_xad", zpe ) ! zonal advection
CASE ( jptra_yad ) ; CALL iom_put( "petrd_yad", zpe ) ! merid. advection
CASE ( jptra_zad ) ; CALL iom_put( "petrd_zad", zpe ) ! vertical advection
IF( ln_linssh ) THEN ! cst volume : adv flux through z=0 surface
ALLOCATE( z2d(jpi,jpj) )
z2d(:,:) = ww(:,:,1) * ( &
& - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * ts(:,:,1,jp_tem,Kmm) &
& + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * ts(:,:,1,jp_sal,Kmm) &
& ) / e3t(:,:,1,Kmm)
ALLOCATE( z2d(A2D(0)) )
DO_2D( 0, 0, 0, 0 )
z2d(ji,jj) = ww(ji,jj,1) * ( &
& - ( rab_n(ji,jj,1,jp_tem) + rab_pe(ji,jj,1,jp_tem) ) * ts(ji,jj,1,jp_tem,Kmm) &
& + ( rab_n(ji,jj,1,jp_sal) + rab_pe(ji,jj,1,jp_sal) ) * ts(ji,jj,1,jp_sal,Kmm) &
& ) / e3t(ji,jj,1,Kmm)
END_2D
CALL iom_put( "petrd_sad" , z2d )
DEALLOCATE( z2d )
ENDIF
......
src/OCE/TRD/trdtra.F90
View file @ 4b23ba89
......@@ -53,7 +53,7 @@ CONTAINS
!!---------------------------------------------------------------------
!! *** FUNCTION trd_tra_alloc ***
!!---------------------------------------------------------------------
ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , avt_evd(jpi,jpj,jpk), STAT= trd_tra_alloc )
ALLOCATE( trdtx(A2D(0),jpk), trdty(A2D(0),jpk), trdt(A2D(0),jpk), avt_evd(A2D(0),jpk), STAT= trd_tra_alloc )
!
CALL mpp_sum ( 'trdtra', trd_tra_alloc )
IF( trd_tra_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trd_tra_alloc: failed to allocate arrays' )
......@@ -73,24 +73,25 @@ CONTAINS
!! - 'TRA' case : regroup T & S trends
!! - send the trends to trd_tra_mng (trdtrc) for further processing
!!----------------------------------------------------------------------
INTEGER , INTENT(in) :: kt ! time step
CHARACTER(len=3) , INTENT(in) :: ctype ! tracers trends type 'TRA'/'TRC'
INTEGER , INTENT(in) :: ktra ! tracer index
INTEGER , INTENT(in) :: ktrd ! tracer trend index
INTEGER , INTENT(in) :: Kmm, Krhs ! time level indices
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: ptrd ! tracer trend or flux
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pu ! now velocity
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! now tracer variable
INTEGER , INTENT(in) :: kt ! time step
CHARACTER(len=3) , INTENT(in) :: ctype ! tracers trends type 'TRA'/'TRC'
INTEGER , INTENT(in) :: ktra ! tracer index
INTEGER , INTENT(in) :: ktrd ! tracer trend index
INTEGER , INTENT(in) :: Kmm, Krhs ! time level indices
REAL(wp), DIMENSION(:,:,:), INTENT(in) :: ptrd ! tracer trend or flux
REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: pu ! now velocity
REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: ptra ! now tracer variable
!
INTEGER :: jk ! loop indices
INTEGER :: i01 ! 0 or 1
REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrds ! 3D workspace
INTEGER :: ji,jj,jk ! loop indices
INTEGER :: i01 ! 0 or 1
REAL(wp) :: z1e3w
REAL(wp), DIMENSION(A2D(0),jpk) :: ztrds ! 3D workspace
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwt, zws, ztrdt ! 3D workspace
!!----------------------------------------------------------------------
!
IF( .NOT. ALLOCATED( trdtx ) ) THEN ! allocate trdtra arrays
IF( trd_tra_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' )
avt_evd(:,:,:) = 0._wp
avt_evd(A2D(0),:) = 0._wp
ENDIF
!
i01 = COUNT( (/ PRESENT(pu) .OR. ( ktrd /= jptra_xad .AND. ktrd /= jptra_yad .AND. ktrd /= jptra_zad ) /) )
......@@ -103,13 +104,13 @@ CONTAINS
CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd, pu, ptra, 'Y', trdty, Kmm )
CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd, pu, ptra, 'Z', trdt, Kmm )
CASE( jptra_bbc, & ! qsr, bbc: on temperature only, send to trd_tra_mng
& jptra_qsr ) ; trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)
ztrds(:,:,:) = 0._wp
& jptra_qsr ) ; trdt(A2D(0),:) = ptrd(A2D(0),:) * tmask(A2D(0),:)
ztrds(A2D(0),:) = 0._wp
CALL trd_tra_mng( trdt, ztrds, ktrd, kt, Kmm )
!!gm Gurvan, verify the jptra_evd trend please !
CASE( jptra_evd ) ; avt_evd(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)
CASE( jptra_evd ) ; avt_evd(A2D(0),:) = ptrd(A2D(0),:) * tmask(A2D(0),:)
CASE DEFAULT ! other trends: masked trends
trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) ! mask & store
trdt(A2D(0),:) = ptrd(A2D(0),:) * tmask(A2D(0),:) ! mask & store
END SELECT
!
ENDIF
......@@ -127,44 +128,44 @@ CONTAINS
CALL trd_tra_mng( trdt , ztrds, ktrd, kt, Kmm )
CASE( jptra_zdfp ) ! diagnose the "PURE" Kz trend (here: just before the swap)
! ! iso-neutral diffusion case otherwise jptra_zdf is "PURE"
ALLOCATE( zwt(jpi,jpj,jpk), zws(jpi,jpj,jpk), ztrdt(jpi,jpj,jpk) )
ALLOCATE( zwt(A2D(0),jpk), zws(A2D(0),jpk), ztrdt(A2D(0),jpk) )
!
zwt(:,:, 1 ) = 0._wp ; zws(:,:, 1 ) = 0._wp ! vertical diffusive fluxes
zwt(:,:,jpk) = 0._wp ; zws(:,:,jpk) = 0._wp
DO jk = 2, jpk
zwt(:,:,jk) = avt(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) &
& / e3w(:,:,jk,Kmm) * tmask(:,:,jk)
zws(:,:,jk) = avs(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) &
& / e3w(:,:,jk,Kmm) * tmask(:,:,jk)
END DO
zwt(A2D(0), 1 ) = 0._wp ; zws(A2D(0), 1 ) = 0._wp ! vertical diffusive fluxes
zwt(A2D(0),jpk) = 0._wp ; zws(A2D(0),jpk) = 0._wp
DO_3D( 0, 0, 0, 0, 2, jpk )
z1e3w = 1._wp / ( e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) )
zwt(ji,jj,jk) = avt(ji,jj,jk) * ( ts(ji,jj,jk-1,jp_tem,Krhs) - ts(ji,jj,jk,jp_tem,Krhs) ) * z1e3w
zws(ji,jj,jk) = avs(ji,jj,jk) * ( ts(ji,jj,jk-1,jp_sal,Krhs) - ts(ji,jj,jk,jp_sal,Krhs) ) * z1e3w
END_3D
!
ztrdt(:,:,jpk) = 0._wp ; ztrds(:,:,jpk) = 0._wp
DO jk = 1, jpkm1
ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm)
ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm)
END DO
ztrdt(A2D(0),jpk) = 0._wp ; ztrds(A2D(0),jpk) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
z1e3w = 1._wp / e3w(ji,jj,jk,Kmm)
ztrdt(ji,jj,jk) = ( zwt(ji,jj,jk) - zwt(ji,jj,jk+1) ) * z1e3w
ztrds(ji,jj,jk) = ( zws(ji,jj,jk) - zws(ji,jj,jk+1) ) * z1e3w
END_3D
CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt, Kmm )
!
! ! Also calculate EVD trend at this point.
zwt(:,:,:) = 0._wp ; zws(:,:,:) = 0._wp ! vertical diffusive fluxes
DO jk = 2, jpk
zwt(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) &
& / e3w(:,:,jk,Kmm) * tmask(:,:,jk)
zws(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) &
& / e3w(:,:,jk,Kmm) * tmask(:,:,jk)
END DO
zwt(A2D(0), :) = 0._wp ; zws(A2D(0), :) = 0._wp ! vertical diffusive fluxes
DO_3D( 0, 0, 0, 0, 2, jpk )
z1e3w = 1._wp / ( e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) )
zwt(ji,jj,jk) = avt_evd(ji,jj,jk) * ( ts(ji,jj,jk-1,jp_tem,Krhs) - ts(ji,jj,jk,jp_tem,Krhs) ) * z1e3w
zws(ji,jj,jk) = avt_evd(ji,jj,jk) * ( ts(ji,jj,jk-1,jp_sal,Krhs) - ts(ji,jj,jk,jp_sal,Krhs) ) * z1e3w
END_3D
!
ztrdt(:,:,jpk) = 0._wp ; ztrds(:,:,jpk) = 0._wp
DO jk = 1, jpkm1
ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm)
ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm)
END DO
ztrdt(A2D(0),jpk) = 0._wp ; ztrds(A2D(0),jpk) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
z1e3w = 1._wp / e3w(ji,jj,jk,Kmm)
ztrdt(ji,jj,jk) = ( zwt(ji,jj,jk) - zwt(ji,jj,jk+1) ) * z1e3w
ztrds(ji,jj,jk) = ( zws(ji,jj,jk) - zws(ji,jj,jk+1) ) * z1e3w
END_3D
CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt, Kmm )
!
DEALLOCATE( zwt, zws, ztrdt )
!
CASE DEFAULT ! other trends: mask and send T & S trends to trd_tra_mng
ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)
ztrds(A2D(0),:) = ptrd(A2D(0),:) * tmask(A2D(0),:)
CALL trd_tra_mng( trdt, ztrds, ktrd, kt, Kmm )
END SELECT
ENDIF
......@@ -177,7 +178,7 @@ CONTAINS
CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'Y', ztrds, Kmm )
CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'Z', ztrds, Kmm )
CASE DEFAULT ! other trends: just masked
ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)
ztrds(A2D(0),:) = ptrd(A2D(0),:) * tmask(A2D(0),:)
END SELECT
! ! send trend to trd_trc
CALL trd_trc( ztrds, ktra, ktrd, kt, Kmm )
......@@ -199,12 +200,12 @@ CONTAINS
!! k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] )
!! where fi is the incoming advective flux.
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pf ! advective flux in one direction
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu ! now velocity in one direction
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pt ! now or before tracer
CHARACTER(len=1) , INTENT(in ) :: cdir ! X/Y/Z direction
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: ptrd ! advective trend in one direction
INTEGER, INTENT(in) :: Kmm ! time level index
REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pf ! advective flux in one direction
REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pu ! now velocity in one direction
REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pt ! now or before tracer
CHARACTER(len=1) , INTENT(in ) :: cdir ! X/Y/Z direction
REAL(wp), DIMENSION(:,:,:), INTENT( out) :: ptrd ! advective trend in one direction
INTEGER, INTENT(in) :: Kmm ! time level index
!
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: ii, ij, ik ! index shift as function of the direction
......@@ -217,9 +218,7 @@ CONTAINS
END SELECT
!
! ! set to zero uncomputed values
ptrd(jpi,:,:) = 0._wp ; ptrd(1,:,:) = 0._wp
ptrd(:,jpj,:) = 0._wp ; ptrd(:,1,:) = 0._wp
ptrd(:,:,jpk) = 0._wp
ptrd(:,:,:) = 0._wp
!
DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! advective trend
ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) &
......@@ -248,7 +247,7 @@ CONTAINS
! ! 3D output of tracers trends using IOM interface
IF( ln_tra_trd ) CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt, Kmm )
! ! Integral Constraints Properties for tracers trends !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
! ! Integral Constraints Properties for tracers trends
IF( ln_glo_trd ) CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt, Kmm )
! ! Potential ENergy trends
......@@ -305,8 +304,8 @@ CONTAINS
INTEGER , INTENT(in ) :: kt ! time step
INTEGER , INTENT(in ) :: Kmm ! time level index
!!
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: ikbu, ikbv ! local integers
INTEGER :: ji, jj
REAL(wp) :: z1e3
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace
!!----------------------------------------------------------------------
!
......@@ -329,9 +328,12 @@ CONTAINS
CASE( jptra_zad ) ; CALL iom_put( "ttrd_zad" , ptrdx ) ! z- vertical advection
CALL iom_put( "strd_zad" , ptrdy )
IF( ln_linssh ) THEN ! cst volume : adv flux through z=0 surface
ALLOCATE( z2dx(jpi,jpj), z2dy(jpi,jpj) )
z2dx(:,:) = ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) / e3t(:,:,1,Kmm)
z2dy(:,:) = ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) / e3t(:,:,1,Kmm)
ALLOCATE( z2dx(A2D(0)), z2dy(A2D(0)) )
DO_2D( 0, 0, 0, 0 )
z1e3 = ww(ji,jj,1) / e3t(ji,jj,1,Kmm)
z2dx(ji,jj) = ts(ji,jj,1,jp_tem,Kmm) * z1e3
z2dy(ji,jj) = ts(ji,jj,1,jp_sal,Kmm) * z1e3
END_2D
CALL iom_put( "ttrd_sad", z2dx )
CALL iom_put( "strd_sad", z2dy )
DEALLOCATE( z2dx, z2dy )
......
src/OCE/TRD/trdvor.F90
View file @ 4b23ba89
......@@ -68,9 +68,9 @@ CONTAINS
!!----------------------------------------------------------------------------
!! *** ROUTINE trd_vor_alloc ***
!!----------------------------------------------------------------------------
ALLOCATE( vor_avr (jpi,jpj) , vor_avrb(jpi,jpj) , vor_avrbb (jpi,jpj) , &
& vor_avrbn (jpi,jpj) , rotot (jpi,jpj) , vor_avrtot(jpi,jpj) , &
& vor_avrres(jpi,jpj) , vortrd (jpi,jpj,jpltot_vor) , &
ALLOCATE( vor_avr (A2D(0)) , vor_avrb(A2D(0)) , vor_avrbb (A2D(0)) , &
& vor_avrbn (A2D(0)) , rotot (A2D(0)) , vor_avrtot(A2D(0)) , &
& vor_avrres(A2D(0)) , vortrd (A2D(0),jpltot_vor) , &
& ndexvor1 (jpi*jpj) , STAT= trd_vor_alloc )
!
CALL mpp_sum ( 'trdvor', trd_vor_alloc )
......@@ -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 )
......@@ -368,10 +375,6 @@ CONTAINS
zmean = 1._wp / REAL( nmoydpvor, wp )
vor_avrres(:,:) = vor_avrtot(:,:) - rotot(:,:) / zmean
! Boundary conditions
CALL lbc_lnk( 'trdvor', vor_avrtot, 'F', 1.0_wp , vor_avrres, 'F', 1.0_wp )
! III.3 time evolution array swap
! ------------------------------
vor_avrbb(:,:) = vor_avrb(:,:)
......
src/OCE/USR/usrdef_sbc.F90
View file @ 4b23ba89
......@@ -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 @ 4b23ba89
......@@ -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 @ 4b23ba89
......@@ -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) ) &
......
src/OCE/lib_fortran_generic.h90
View file @ 4b23ba89
......@@ -51,8 +51,8 @@
iis = Nis0 ; iie = Nie0
ijs = Njs0 ; ije = Nje0
ELSE
iis = 1 ; iie = jpi
ijs = 1 ; ije = jpj
iis = 1 ; iie = ipi
ijs = 1 ; ije = ipj
ENDIF
!
ctmp = CMPLX( 0.e0, 0.e0, dp ) ! warning ctmp is cumulated
......