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 500 additions and 426 deletions
src/ICE/icedyn_rhg_vp.F90
View file @ a0d550a1
...@@ -332,7 +332,10 @@ CONTAINS ...@@ -332,7 +332,10 @@ CONTAINS
v_oceU(ji,jj) = 0.25_wp * ( (v_oce(ji,jj) + v_oce(ji,jj-1)) + (v_oce(ji+1,jj) + v_oce(ji+1,jj-1)) ) * umask(ji,jj,1) v_oceU(ji,jj) = 0.25_wp * ( (v_oce(ji,jj) + v_oce(ji,jj-1)) + (v_oce(ji+1,jj) + v_oce(ji+1,jj-1)) ) * umask(ji,jj,1)
! Wind stress ! Wind stress
ztaux_ai(ji,jj) = za_iU(ji,jj) * utau_ice(ji,jj) ! 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
ztaux_ai(ji,jj) = za_iU(ji,jj) * 0.5_wp * ( utau_ice(ji,jj) + utau_ice(ji+1,jj) ) * &
& ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1), tmask(ji+1,jj,1) )
! Force due to sea surface tilt(- m*g*GRAD(ssh)) ! Force due to sea surface tilt(- m*g*GRAD(ssh))
zspgU(ji,jj) = - zmassU * grav * ( zsshdyn(ji+1,jj) - zsshdyn(ji,jj) ) * r1_e1u(ji,jj) zspgU(ji,jj) = - zmassU * grav * ( zsshdyn(ji+1,jj) - zsshdyn(ji,jj) ) * r1_e1u(ji,jj)
...@@ -369,7 +372,10 @@ CONTAINS ...@@ -369,7 +372,10 @@ CONTAINS
u_oceV(ji,jj) = 0.25_wp * ( (u_oce(ji,jj) + u_oce(ji-1,jj)) + (u_oce(ji,jj+1) + u_oce(ji-1,jj+1)) ) * vmask(ji,jj,1) u_oceV(ji,jj) = 0.25_wp * ( (u_oce(ji,jj) + u_oce(ji-1,jj)) + (u_oce(ji,jj+1) + u_oce(ji-1,jj+1)) ) * vmask(ji,jj,1)
! Wind stress ! Wind stress
ztauy_ai(ji,jj) = za_iV(ji,jj) * vtau_ice(ji,jj) ! 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
ztauy_ai(ji,jj) = za_iV(ji,jj) * 0.5_wp * ( vtau_ice(ji,jj) + vtau_ice(ji,jj+1) ) * &
& ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1), tmask(ji,jj+1,1) )
! Force due to sea surface tilt(- m*g*GRAD(ssh)) ! Force due to sea surface tilt(- m*g*GRAD(ssh))
zspgV(ji,jj) = - zmassV * grav * ( zsshdyn(ji,jj+1) - zsshdyn(ji,jj) ) * r1_e2v(ji,jj) zspgV(ji,jj) = - zmassV * grav * ( zsshdyn(ji,jj+1) - zsshdyn(ji,jj) ) * r1_e2v(ji,jj)
......
src/ICE/icesbc.F90
View file @ a0d550a1
...@@ -272,15 +272,13 @@ CONTAINS ...@@ -272,15 +272,13 @@ CONTAINS
zvel (ji,jj) = 0.5_wp * SQRT( ( u_ice(ji-1,jj ) + u_ice(ji,jj) ) * ( u_ice(ji-1,jj ) + u_ice(ji,jj) ) + & zvel (ji,jj) = 0.5_wp * SQRT( ( u_ice(ji-1,jj ) + u_ice(ji,jj) ) * ( u_ice(ji-1,jj ) + u_ice(ji,jj) ) + &
& ( v_ice(ji ,jj-1) + v_ice(ji,jj) ) * ( v_ice(ji ,jj-1) + v_ice(ji,jj) ) ) & ( v_ice(ji ,jj-1) + v_ice(ji,jj) ) * ( v_ice(ji ,jj-1) + v_ice(ji,jj) ) )
END_2D END_2D
CALL lbc_lnk( 'icesbc', zfric, 'T', 1.0_wp, zvel, 'T', 1.0_wp )
ELSE ! if no ice dynamics => transfer directly the atmospheric stress to the ocean ELSE ! if no ice dynamics => transfer directly the atmospheric stress to the ocean
DO_2D( 0, 0, 0, 0 ) DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
zfric(ji,jj) = r1_rho0 * SQRT( 0.5_wp * & zfric(ji,jj) = r1_rho0 * SQRT( utau(ji,jj)*utau(ji,jj) + vtau(ji,jj)*vtau(ji,jj) ) * tmask(ji,jj,1)
& ( utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj) & zvel (ji,jj) = 0._wp
& + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1)
zvel(ji,jj) = 0._wp
END_2D END_2D
ENDIF ENDIF
CALL lbc_lnk( 'icesbc', zfric, 'T', 1.0_wp, zvel, 'T', 1.0_wp )
! !
!--------------------------------------------------------------------! !--------------------------------------------------------------------!
! Partial computation of forcing for the thermodynamic sea ice model ! Partial computation of forcing for the thermodynamic sea ice model
......
src/ICE/icethd_do.F90
View file @ a0d550a1
...@@ -372,8 +372,8 @@ CONTAINS ...@@ -372,8 +372,8 @@ CONTAINS
DO_2D( 0, 0, 0, 0 ) DO_2D( 0, 0, 0, 0 )
IF ( qlead(ji,jj) < 0._wp ) THEN ! cooling IF ( qlead(ji,jj) < 0._wp ) THEN ! cooling
! -- Wind stress -- ! ! -- Wind stress -- !
ztaux = ( utau_ice(ji-1,jj ) * umask(ji-1,jj ,1) + utau_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp ztaux = utau_ice(ji,jj) * tmask(ji,jj,1)
ztauy = ( vtau_ice(ji ,jj-1) * vmask(ji ,jj-1,1) + vtau_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp ztauy = vtau_ice(ji,jj) * tmask(ji,jj,1)
! Square root of wind stress ! Square root of wind stress
ztenagm = SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) ztenagm = SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) )
......
src/ICE/iceupdate.F90
View file @ a0d550a1
...@@ -314,7 +314,7 @@ CONTAINS ...@@ -314,7 +314,7 @@ CONTAINS
!! !!
!! ** Action : * at each ice time step (every nn_fsbc time step): !! ** Action : * at each ice time step (every nn_fsbc time step):
!! - compute the modulus of ice-ocean relative velocity !! - compute the modulus of ice-ocean relative velocity
!! (*rho*Cd) at T-point (C-grid) or I-point (B-grid) !! (*rho*Cd) at T-point (C-grid)
!! tmod_io = rhoco * | U_ice-U_oce | !! tmod_io = rhoco * | U_ice-U_oce |
!! - update the modulus of stress at ocean surface !! - update the modulus of stress at ocean surface
!! taum = (1-a) * taum + a * tmod_io * | U_ice-U_oce | !! taum = (1-a) * taum + a * tmod_io * | U_ice-U_oce |
...@@ -325,19 +325,19 @@ CONTAINS ...@@ -325,19 +325,19 @@ CONTAINS
!! !!
!! NB: - ice-ocean rotation angle no more allowed !! NB: - ice-ocean rotation angle no more allowed
!! - here we make an approximation: taum is only computed every ice time step !! - here we make an approximation: taum is only computed every ice time step
!! This avoids mutiple average to pass from T -> U,V grids and next from U,V grids !! This avoids mutiple average to pass from U,V grids to T grids
!! to T grid. taum is used in TKE and GLS, which should not be too sensitive to this approximaton... !! taum is used in TKE and GLS, which should not be too sensitive to this approximaton...
!! !!
!! ** Outputs : - utau, vtau : surface ocean i- and j-stress (u- & v-pts) updated with ice-ocean fluxes !! ** Outputs : - utau, vtau : surface ocean i- and j-stress (T-pts) updated with ice-ocean fluxes
!! - taum : modulus of the surface ocean stress (T-point) updated with ice-ocean fluxes !! - taum : modulus of the surface ocean stress (T-point) updated with ice-ocean fluxes
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
INTEGER , INTENT(in) :: kt ! ocean time-step index INTEGER , INTENT(in) :: kt ! ocean time-step index
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pu_oce, pv_oce ! surface ocean currents REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pu_oce, pv_oce ! surface ocean currents
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zat_u, zutau_ice, zu_t, zmodt ! local scalar REAL(wp) :: zutau_ice, zu_t, zmodt ! local scalar
REAL(wp) :: zat_v, zvtau_ice, zv_t, zrhoco ! - - REAL(wp) :: zvtau_ice, zv_t, zrhoco ! - -
REAL(wp) :: zflagi ! - - REAL(wp) :: zflagi ! - -
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
IF( ln_timing ) CALL timing_start('iceupdate') IF( ln_timing ) CALL timing_start('iceupdate')
...@@ -352,8 +352,8 @@ CONTAINS ...@@ -352,8 +352,8 @@ CONTAINS
IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step)
DO_2D( 0, 0, 0, 0 ) !* update the modulus of stress at ocean surface (T-point) DO_2D( 0, 0, 0, 0 ) !* update the modulus of stress at ocean surface (T-point)
! ! 2*(U_ice-U_oce) at T-point ! ! 2*(U_ice-U_oce) at T-point
zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) ! u_oce = ssu_m
zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) ! v_oce = ssv_m
! ! |U_ice-U_oce|^2 ! ! |U_ice-U_oce|^2
zmodt = 0.25_wp * ( zu_t * zu_t + zv_t * zv_t ) zmodt = 0.25_wp * ( zu_t * zu_t + zv_t * zv_t )
! ! update the ocean stress modulus ! ! update the ocean stress modulus
...@@ -377,19 +377,14 @@ CONTAINS ...@@ -377,19 +377,14 @@ CONTAINS
ENDIF ENDIF
! !
DO_2D( 0, 0, 0, 0 ) !* update the stress WITHOUT an ice-ocean rotation angle DO_2D( 0, 0, 0, 0 ) !* update the stress WITHOUT an ice-ocean rotation angle
! ice area at u and v-points
zat_u = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji+1,jj ) * tmask(ji+1,jj ,1) ) &
& / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji+1,jj ,1) )
zat_v = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji ,jj+1 ) * tmask(ji ,jj+1,1) ) &
& / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji ,jj+1,1) )
! ! linearized quadratic drag formulation ! ! linearized quadratic drag formulation
zutau_ice = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - pu_oce(ji,jj) ) zutau_ice = 0.5_wp * tmod_io(ji,jj) * ( u_ice(ji,jj) + u_ice(ji-1,jj) - pu_oce(ji,jj) - pu_oce(ji-1,jj) )
zvtau_ice = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - pv_oce(ji,jj) ) zvtau_ice = 0.5_wp * tmod_io(ji,jj) * ( v_ice(ji,jj) + v_ice(ji,jj-1) - pv_oce(ji,jj) - pv_oce(ji,jj-1) )
! ! stresses at the ocean surface ! ! stresses at the ocean surface
utau(ji,jj) = ( 1._wp - zat_u ) * utau_oce(ji,jj) + zat_u * zutau_ice utau(ji,jj) = ( 1._wp - at_i(ji,jj) ) * utau_oce(ji,jj) + at_i(ji,jj) * zutau_ice
vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice vtau(ji,jj) = ( 1._wp - at_i(ji,jj) ) * vtau_oce(ji,jj) + at_i(ji,jj) * zvtau_ice
END_2D END_2D
CALL lbc_lnk( 'iceupdate', utau, 'U', -1.0_wp, vtau, 'V', -1.0_wp ) ! lateral boundary condition CALL lbc_lnk( 'iceupdate', utau, 'T', -1.0_wp, vtau, 'T', -1.0_wp ) ! lateral boundary condition
! !
IF( ln_timing ) CALL timing_stop('iceupdate') IF( ln_timing ) CALL timing_stop('iceupdate')
! !
......
src/NST/agrif_oce_interp.F90
View file @ a0d550a1
This diff is collapsed.
src/NST/agrif_oce_sponge.F90
View file @ a0d550a1
...@@ -161,15 +161,15 @@ CONTAINS ...@@ -161,15 +161,15 @@ CONTAINS
IF( lk_west ) THEN ! --- West --- ! IF( lk_west ) THEN ! --- West --- !
ind1 = nn_hls + nbghostcells ! halo + nbghostcells ind1 = nn_hls + nbghostcells ! halo + nbghostcells
ind2 = nn_hls + nbghostcells + ispongearea ind2 = nn_hls + nbghostcells + ispongearea
DO ji = mi0(ind1), mi1(ind2) DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ztabramp(ji,jj) = REAL(ind2 - mig(ji), wp) * z1_ispongearea ztabramp(ji,jj) = REAL(ind2 - mig(ji,nn_hls), wp) * z1_ispongearea
END DO END DO
END DO END DO
! ghost cells: ! ghost cells:
ind1 = 1 ind1 = 1
ind2 = nn_hls + nbghostcells ! halo + nbghostcells ind2 = nn_hls + nbghostcells ! halo + nbghostcells
DO ji = mi0(ind1), mi1(ind2) DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ztabramp(ji,jj) = 1._wp ztabramp(ji,jj) = 1._wp
END DO END DO
...@@ -178,15 +178,15 @@ CONTAINS ...@@ -178,15 +178,15 @@ CONTAINS
IF( lk_east ) THEN ! --- East --- ! IF( lk_east ) THEN ! --- East --- !
ind1 = jpiglo - ( nn_hls + nbghostcells -1 ) - ispongearea - 1 ind1 = jpiglo - ( nn_hls + nbghostcells -1 ) - ispongearea - 1
ind2 = jpiglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + land + nbghostcells - 1 ind2 = jpiglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + land + nbghostcells - 1
DO ji = mi0(ind1), mi1(ind2) DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea ) ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji,nn_hls) - ind1, wp) * z1_ispongearea )
END DO END DO
END DO END DO
! ghost cells: ! ghost cells:
ind1 = jpiglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + land + nbghostcells - 1 ind1 = jpiglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + land + nbghostcells - 1
ind2 = jpiglo - 1 ind2 = jpiglo - 1
DO ji = mi0(ind1), mi1(ind2) DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ztabramp(ji,jj) = 1._wp ztabramp(ji,jj) = 1._wp
END DO END DO
...@@ -195,15 +195,15 @@ CONTAINS ...@@ -195,15 +195,15 @@ CONTAINS
IF( lk_south ) THEN ! --- South --- ! IF( lk_south ) THEN ! --- South --- !
ind1 = nn_hls + nbghostcells ! halo + nbghostcells ind1 = nn_hls + nbghostcells ! halo + nbghostcells
ind2 = nn_hls + nbghostcells + jspongearea ind2 = nn_hls + nbghostcells + jspongearea
DO jj = mj0(ind1), mj1(ind2) DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea ) ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj,nn_hls), wp) * z1_jspongearea )
END DO END DO
END DO END DO
! ghost cells: ! ghost cells:
ind1 = 1 ind1 = 1
ind2 = nn_hls + nbghostcells ! halo + nbghostcells ind2 = nn_hls + nbghostcells ! halo + nbghostcells
DO jj = mj0(ind1), mj1(ind2) DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ztabramp(ji,jj) = 1._wp ztabramp(ji,jj) = 1._wp
END DO END DO
...@@ -212,15 +212,15 @@ CONTAINS ...@@ -212,15 +212,15 @@ CONTAINS
IF( lk_north ) THEN ! --- North --- ! IF( lk_north ) THEN ! --- North --- !
ind1 = jpjglo - ( nn_hls + nbghostcells -1 ) - jspongearea - 1 ind1 = jpjglo - ( nn_hls + nbghostcells -1 ) - jspongearea - 1
ind2 = jpjglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + nbghostcells - 1 ind2 = jpjglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + nbghostcells - 1
DO jj = mj0(ind1), mj1(ind2) DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea ) ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj,nn_hls) - ind1, wp) * z1_jspongearea )
END DO END DO
END DO END DO
! ghost cells: ! ghost cells:
ind1 = jpjglo - ( nn_hls + nbghostcells -1 ) ! halo + land + nbghostcells - 1 ind1 = jpjglo - ( nn_hls + nbghostcells -1 ) ! halo + land + nbghostcells - 1
ind2 = jpjglo ind2 = jpjglo
DO jj = mj0(ind1), mj1(ind2) DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ztabramp(ji,jj) = 1._wp ztabramp(ji,jj) = 1._wp
END DO END DO
...@@ -294,15 +294,15 @@ CONTAINS ...@@ -294,15 +294,15 @@ CONTAINS
IF( lk_west ) THEN ! --- West --- ! IF( lk_west ) THEN ! --- West --- !
ind1 = nn_hls + nbghostcells + ishift ind1 = nn_hls + nbghostcells + ishift
ind2 = nn_hls + nbghostcells + ishift + ispongearea ind2 = nn_hls + nbghostcells + ishift + ispongearea
DO ji = mi0(ind1), mi1(ind2) DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ztabramp(ji,jj) = REAL(ind2 - mig(ji), wp) * z1_ispongearea ztabramp(ji,jj) = REAL(ind2 - mig(ji,nn_hls), wp) * z1_ispongearea
END DO END DO
END DO END DO
! ghost cells: ! ghost cells:
ind1 = 1 ind1 = 1
ind2 = nn_hls + nbghostcells + ishift ! halo + nbghostcells ind2 = nn_hls + nbghostcells + ishift ! halo + nbghostcells
DO ji = mi0(ind1), mi1(ind2) DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ztabramp(ji,jj) = 1._wp ztabramp(ji,jj) = 1._wp
END DO END DO
...@@ -311,15 +311,15 @@ CONTAINS ...@@ -311,15 +311,15 @@ CONTAINS
IF( lk_east ) THEN ! --- East --- ! IF( lk_east ) THEN ! --- East --- !
ind1 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - ispongearea - 1 ind1 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - ispongearea - 1
ind2 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - 1 ! halo + nbghostcells - 1 ind2 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - 1 ! halo + nbghostcells - 1
DO ji = mi0(ind1), mi1(ind2) DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea ) ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji,nn_hls) - ind1, wp) * z1_ispongearea )
END DO END DO
END DO END DO
! ghost cells: ! ghost cells:
ind1 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - 1 ! halo + nbghostcells - 1 ind1 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - 1 ! halo + nbghostcells - 1
ind2 = jpiglo - 1 ind2 = jpiglo - 1
DO ji = mi0(ind1), mi1(ind2) DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ztabramp(ji,jj) = 1._wp ztabramp(ji,jj) = 1._wp
END DO END DO
...@@ -328,15 +328,15 @@ CONTAINS ...@@ -328,15 +328,15 @@ CONTAINS
IF( lk_south ) THEN ! --- South --- ! IF( lk_south ) THEN ! --- South --- !
ind1 = nn_hls + nbghostcells + jshift ! halo + nbghostcells ind1 = nn_hls + nbghostcells + jshift ! halo + nbghostcells
ind2 = nn_hls + nbghostcells + jshift + jspongearea ind2 = nn_hls + nbghostcells + jshift + jspongearea
DO jj = mj0(ind1), mj1(ind2) DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea ) ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj,nn_hls), wp) * z1_jspongearea )
END DO END DO
END DO END DO
! ghost cells: ! ghost cells:
ind1 = 1 ind1 = 1
ind2 = nn_hls + nbghostcells + jshift ! halo + land + nbghostcells ind2 = nn_hls + nbghostcells + jshift ! halo + land + nbghostcells
DO jj = mj0(ind1), mj1(ind2) DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ztabramp(ji,jj) = 1._wp ztabramp(ji,jj) = 1._wp
END DO END DO
...@@ -345,15 +345,15 @@ CONTAINS ...@@ -345,15 +345,15 @@ CONTAINS
IF( lk_north ) THEN ! --- North --- ! IF( lk_north ) THEN ! --- North --- !
ind1 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) - jspongearea - 1 ind1 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) - jspongearea - 1
ind2 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) - 1 ! halo + land + nbghostcells - 1 ind2 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) - 1 ! halo + land + nbghostcells - 1
DO jj = mj0(ind1), mj1(ind2) DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea ) ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj,nn_hls) - ind1, wp) * z1_jspongearea )
END DO END DO
END DO END DO
! ghost cells: ! ghost cells:
ind1 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) ! halo + land + nbghostcells - 1 ind1 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) ! halo + land + nbghostcells - 1
ind2 = jpjglo ind2 = jpjglo
DO jj = mj0(ind1), mj1(ind2) DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ztabramp(ji,jj) = 1._wp ztabramp(ji,jj) = 1._wp
END DO END DO
...@@ -730,7 +730,7 @@ CONTAINS ...@@ -730,7 +730,7 @@ CONTAINS
jmax = j2-1 jmax = j2-1
ind1 = jpjglo - ( nn_hls + nbghostcells + 1 ) ! North ind1 = jpjglo - ( nn_hls + nbghostcells + 1 ) ! North
DO jj = mj0(ind1), mj1(ind1) DO jj = mj0(ind1,nn_hls), mj1(ind1,nn_hls)
jmax = MIN(jmax,jj) jmax = MIN(jmax,jj)
END DO END DO
...@@ -858,7 +858,7 @@ CONTAINS ...@@ -858,7 +858,7 @@ CONTAINS
imax = i2 - 1 imax = i2 - 1
ind1 = jpiglo - ( nn_hls + nbghostcells + 1 ) ! East ind1 = jpiglo - ( nn_hls + nbghostcells + 1 ) ! East
DO ji = mi0(ind1), mi1(ind1) DO ji = mi0(ind1,nn_hls), mi1(ind1,nn_hls)
imax = MIN(imax,ji) imax = MIN(imax,ji)
END DO END DO
...@@ -958,7 +958,7 @@ CONTAINS ...@@ -958,7 +958,7 @@ CONTAINS
jmax = j2-1 jmax = j2-1
ind1 = jpjglo - ( nn_hls + nbghostcells + 1 ) ! North ind1 = jpjglo - ( nn_hls + nbghostcells + 1 ) ! North
DO jj = mj0(ind1), mj1(ind1) DO jj = mj0(ind1,nn_hls), mj1(ind1,nn_hls)
jmax = MIN(jmax,jj) jmax = MIN(jmax,jj)
END DO END DO
...@@ -1025,7 +1025,7 @@ CONTAINS ...@@ -1025,7 +1025,7 @@ CONTAINS
imax = i2 - 1 imax = i2 - 1
ind1 = jpiglo - ( nn_hls + nbghostcells + 1 ) ! East ind1 = jpiglo - ( nn_hls + nbghostcells + 1 ) ! East
DO ji = mi0(ind1), mi1(ind1) DO ji = mi0(ind1,nn_hls), mi1(ind1,nn_hls)
imax = MIN(imax,ji) imax = MIN(imax,ji)
END DO END DO
......
src/NST/agrif_oce_update.F90
View file @ a0d550a1
...@@ -1893,7 +1893,7 @@ CONTAINS ...@@ -1893,7 +1893,7 @@ CONTAINS
DO jk=k1,k2-1 DO jk=k1,k2-1
IF (ABS((ptab(ji,jj,jk)-e3u_0(ji,jj,jk))*umask(ji,jj,jk)).GE.1.e-6) THEN IF (ABS((ptab(ji,jj,jk)-e3u_0(ji,jj,jk))*umask(ji,jj,jk)).GE.1.e-6) THEN
kindic_agr = kindic_agr + 1 kindic_agr = kindic_agr + 1
print *, 'erro u-pt', mig0(ji), mjg0(jj), jk, mbku(ji,jj), ikbot, ptab(ji,jj,jk), e3u_0(ji,jj,jk) PRINT *, 'erro u-pt', mig(ji,0), mjg(jj,0), jk, mbku(ji,jj), ikbot, ptab(ji,jj,jk), e3u_0(ji,jj,jk)
ENDIF ENDIF
END DO END DO
ENDIF ENDIF
...@@ -1933,7 +1933,7 @@ CONTAINS ...@@ -1933,7 +1933,7 @@ CONTAINS
DO jk=k1,k2-1 DO jk=k1,k2-1
IF (ABS((ptab(ji,jj,jk)-e3v_0(ji,jj,jk))*vmask(ji,jj,jk)).GE.1.e-6) THEN IF (ABS((ptab(ji,jj,jk)-e3v_0(ji,jj,jk))*vmask(ji,jj,jk)).GE.1.e-6) THEN
kindic_agr = kindic_agr + 1 kindic_agr = kindic_agr + 1
print *, 'erro v-pt', mig0(ji), mjg0(jj), mbkv(ji,jj), ptab(ji,jj,jk), e3v_0(ji,jj,jk) PRINT *, 'erro v-pt', mig(ji,0), mjg(jj,0), mbkv(ji,jj), ptab(ji,jj,jk), e3v_0(ji,jj,jk)
ENDIF ENDIF
END DO END DO
ENDIF ENDIF
......
src/NST/agrif_user.F90
View file @ a0d550a1
...@@ -1095,8 +1095,8 @@ ...@@ -1095,8 +1095,8 @@
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
SELECT CASE( i ) SELECT CASE( i )
CASE(1) ; indglob = mig(indloc) CASE(1) ; indglob = mig(indloc,nn_hls)
CASE(2) ; indglob = mjg(indloc) CASE(2) ; indglob = mjg(indloc,nn_hls)
CASE DEFAULT ; indglob = indloc CASE DEFAULT ; indglob = indloc
END SELECT END SELECT
! !
...@@ -1115,10 +1115,10 @@ ...@@ -1115,10 +1115,10 @@
INTEGER, INTENT(out) :: jmin, jmax INTEGER, INTENT(out) :: jmin, jmax
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
imin = mig( 1 ) imin = mig( 1 ,nn_hls)
jmin = mjg( 1 ) jmin = mjg( 1 ,nn_hls)
imax = mig(jpi) imax = mig(jpi,nn_hls)
jmax = mjg(jpj) jmax = mjg(jpj,nn_hls)
! !
END SUBROUTINE Agrif_get_proc_info END SUBROUTINE Agrif_get_proc_info
......
src/OCE/BDY/bdyini.F90
View file @ a0d550a1
...@@ -491,10 +491,10 @@ CONTAINS ...@@ -491,10 +491,10 @@ CONTAINS
! Find lenght of boundaries and rim on local mpi domain ! Find lenght of boundaries and rim on local mpi domain
!------------------------------------------------------ !------------------------------------------------------
! !
iwe = mig(1) iwe = mig( 1,nn_hls)
ies = mig(jpi) ies = mig(jpi,nn_hls)
iso = mjg(1) iso = mjg( 1,nn_hls)
ino = mjg(jpj) ino = mjg(jpj,nn_hls)
! !
DO ib_bdy = 1, nb_bdy DO ib_bdy = 1, nb_bdy
DO igrd = 1, jpbgrd DO igrd = 1, jpbgrd
...@@ -554,8 +554,8 @@ CONTAINS ...@@ -554,8 +554,8 @@ CONTAINS
& nbrdta(ib,igrd,ib_bdy) == ir ) THEN & nbrdta(ib,igrd,ib_bdy) == ir ) THEN
! !
icount = icount + 1 icount = icount + 1
idx_bdy(ib_bdy)%nbi(icount,igrd) = nbidta(ib,igrd,ib_bdy) - mig(1) + 1 ! global to local indexes idx_bdy(ib_bdy)%nbi(icount,igrd) = nbidta(ib,igrd,ib_bdy) - mig(1,nn_hls) + 1 ! global to local indexes
idx_bdy(ib_bdy)%nbj(icount,igrd) = nbjdta(ib,igrd,ib_bdy) - mjg(1) + 1 ! global to local indexes idx_bdy(ib_bdy)%nbj(icount,igrd) = nbjdta(ib,igrd,ib_bdy) - mjg(1,nn_hls) + 1 ! global to local indexes
idx_bdy(ib_bdy)%nbr(icount,igrd) = nbrdta(ib,igrd,ib_bdy) idx_bdy(ib_bdy)%nbr(icount,igrd) = nbrdta(ib,igrd,ib_bdy)
idx_bdy(ib_bdy)%nbmap(icount,igrd) = ib idx_bdy(ib_bdy)%nbmap(icount,igrd) = ib
ENDIF ENDIF
...@@ -1014,7 +1014,7 @@ CONTAINS ...@@ -1014,7 +1014,7 @@ CONTAINS
DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
ii = idx_bdy(ib_bdy)%nbi(ib,igrd) ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
ij = idx_bdy(ib_bdy)%nbj(ib,igrd) ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
IF( mig0(ii) > 2 .AND. mig0(ii) < Ni0glo-2 .AND. mjg0(ij) > 2 .AND. mjg0(ij) < Nj0glo-2 ) THEN IF( mig(ii,0) > 2 .AND. mig(ii,0) < Ni0glo-2 .AND. mjg(ij,0) > 2 .AND. mjg(ij,0) < Nj0glo-2 ) THEN
WRITE(ctmp1,*) ' Orlanski is not safe when the open boundaries are on the interior of the computational domain' WRITE(ctmp1,*) ' Orlanski is not safe when the open boundaries are on the interior of the computational domain'
CALL ctl_stop( ctmp1 ) CALL ctl_stop( ctmp1 )
END IF END IF
...@@ -1090,7 +1090,7 @@ CONTAINS ...@@ -1090,7 +1090,7 @@ CONTAINS
! This error check only works if you are using the bdyXmask arrays (which are set to 0 on rims) ! This error check only works if you are using the bdyXmask arrays (which are set to 0 on rims)
IF( i_offset == 1 .and. zefl + zwfl == 2._wp ) THEN IF( i_offset == 1 .and. zefl + zwfl == 2._wp ) THEN
icount = icount + 1 icount = icount + 1
IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii),mjg(ij) IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii,nn_hls),mjg(ij,nn_hls)
ELSE ELSE
ztmp(ii,ij) = -zwfl + zefl ztmp(ii,ij) = -zwfl + zefl
ENDIF ENDIF
...@@ -1130,7 +1130,7 @@ CONTAINS ...@@ -1130,7 +1130,7 @@ CONTAINS
znfl = zmask(ii,ij+j_offset ) znfl = zmask(ii,ij+j_offset )
! This error check only works if you are using the bdyXmask arrays (which are set to 0 on rims) ! This error check only works if you are using the bdyXmask arrays (which are set to 0 on rims)
IF( j_offset == 1 .and. znfl + zsfl == 2._wp ) THEN IF( j_offset == 1 .and. znfl + zsfl == 2._wp ) THEN
IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii),mjg(ij) IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii,nn_hls),mjg(ij,nn_hls)
icount = icount + 1 icount = icount + 1
ELSE ELSE
ztmp(ii,ij) = -zsfl + znfl ztmp(ii,ij) = -zsfl + znfl
...@@ -1594,8 +1594,8 @@ CONTAINS ...@@ -1594,8 +1594,8 @@ CONTAINS
ztestmask(1:2)=0. ztestmask(1:2)=0.
DO ji = 1, jpi DO ji = 1, jpi
DO jj = 1, jpj DO jj = 1, jpj
IF( mig0(ji) == jpiwob(ib) .AND. mjg0(jj) == jpjwdt(ib) ) ztestmask(1) = tmask(ji,jj,1) IF( mig(ji,0) == jpiwob(ib) .AND. mjg(jj,0) == jpjwdt(ib) ) ztestmask(1) = tmask(ji,jj,1)
IF( mig0(ji) == jpiwob(ib) .AND. mjg0(jj) == jpjwft(ib) ) ztestmask(2) = tmask(ji,jj,1) IF( mig(ji,0) == jpiwob(ib) .AND. mjg(jj,0) == jpjwft(ib) ) ztestmask(2) = tmask(ji,jj,1)
END DO END DO
END DO END DO
CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain
...@@ -1630,8 +1630,8 @@ CONTAINS ...@@ -1630,8 +1630,8 @@ CONTAINS
ztestmask(1:2)=0. ztestmask(1:2)=0.
DO ji = 1, jpi DO ji = 1, jpi
DO jj = 1, jpj DO jj = 1, jpj
IF( mig0(ji) == jpieob(ib)+1 .AND. mjg0(jj) == jpjedt(ib) ) ztestmask(1) = tmask(ji,jj,1) IF( mig(ji,0) == jpieob(ib)+1 .AND. mjg(jj,0) == jpjedt(ib) ) ztestmask(1) = tmask(ji,jj,1)
IF( mig0(ji) == jpieob(ib)+1 .AND. mjg0(jj) == jpjeft(ib) ) ztestmask(2) = tmask(ji,jj,1) IF( mig(ji,0) == jpieob(ib)+1 .AND. mjg(jj,0) == jpjeft(ib) ) ztestmask(2) = tmask(ji,jj,1)
END DO END DO
END DO END DO
CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain
...@@ -1666,8 +1666,8 @@ CONTAINS ...@@ -1666,8 +1666,8 @@ CONTAINS
ztestmask(1:2)=0. ztestmask(1:2)=0.
DO ji = 1, jpi DO ji = 1, jpi
DO jj = 1, jpj DO jj = 1, jpj
IF( mjg0(jj) == jpjsob(ib) .AND. mig0(ji) == jpisdt(ib) ) ztestmask(1) = tmask(ji,jj,1) IF( mjg(jj,0) == jpjsob(ib) .AND. mig(ji,0) == jpisdt(ib) ) ztestmask(1) = tmask(ji,jj,1)
IF( mjg0(jj) == jpjsob(ib) .AND. mig0(ji) == jpisft(ib) ) ztestmask(2) = tmask(ji,jj,1) IF( mjg(jj,0) == jpjsob(ib) .AND. mig(ji,0) == jpisft(ib) ) ztestmask(2) = tmask(ji,jj,1)
END DO END DO
END DO END DO
CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain
...@@ -1688,8 +1688,8 @@ CONTAINS ...@@ -1688,8 +1688,8 @@ CONTAINS
ztestmask(1:2)=0. ztestmask(1:2)=0.
DO ji = 1, jpi DO ji = 1, jpi
DO jj = 1, jpj DO jj = 1, jpj
IF( mjg0(jj) == jpjnob(ib)+1 .AND. mig0(ji) == jpindt(ib) ) ztestmask(1) = tmask(ji,jj,1) IF( mjg(jj,0) == jpjnob(ib)+1 .AND. mig(ji,0) == jpindt(ib) ) ztestmask(1) = tmask(ji,jj,1)
IF( mjg0(jj) == jpjnob(ib)+1 .AND. mig0(ji) == jpinft(ib) ) ztestmask(2) = tmask(ji,jj,1) IF( mjg(jj,0) == jpjnob(ib)+1 .AND. mig(ji,0) == jpinft(ib) ) ztestmask(2) = tmask(ji,jj,1)
END DO END DO
END DO END DO
CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain
......
src/OCE/CRS/crsfld.F90
View file @ a0d550a1
...@@ -211,8 +211,8 @@ CONTAINS ...@@ -211,8 +211,8 @@ CONTAINS
! sbc fields ! 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( 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( 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', 'V', vmask, vtau_crs , p_e12=e1v , p_surf_crs=e1v_crs , psgn=1.0_wp ) 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( 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( 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 ) 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/diadct.F90
View file @ a0d550a1
...@@ -414,9 +414,9 @@ CONTAINS ...@@ -414,9 +414,9 @@ CONTAINS
!verify if the point is on the local domain:(1,Nie0)*(1,Nje0) !verify if the point is on the local domain:(1,Nie0)*(1,Nje0)
IF( iiloc >= 1 .AND. iiloc <= Nie0 .AND. & IF( iiloc >= 1 .AND. iiloc <= Nie0 .AND. &
ijloc >= 1 .AND. ijloc <= Nje0 )THEN ijloc >= 1 .AND. ijloc <= Nje0 )THEN
iptloc = iptloc + 1 ! count local points iptloc = iptloc + 1 ! count local points
secs(jsec)%listPoint(iptloc) = POINT_SECTION(mi0(iiglo),mj0(ijglo)) ! store local coordinates secs(jsec)%listPoint(iptloc) = POINT_SECTION(mi0(iiglo,nn_hls),mj0(ijglo,nn_hls)) ! store local coordinates
secs(jsec)%direction(iptloc) = directemp(jpt) ! store local direction secs(jsec)%direction(iptloc) = directemp(jpt) ! store local direction
ENDIF ENDIF
! !
END DO END DO
......
src/OCE/DIA/diadetide.F90
View file @ a0d550a1
...@@ -5,11 +5,11 @@ MODULE diadetide ...@@ -5,11 +5,11 @@ MODULE diadetide
!!====================================================================== !!======================================================================
!! History : ! 2019 (S. Mueller) !! History : ! 2019 (S. Mueller)
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
USE par_oce , ONLY : wp, jpi, jpj USE par_oce
USE in_out_manager , ONLY : lwp, numout USE in_out_manager
USE iom , ONLY : iom_put USE iom
USE dom_oce , ONLY : rn_Dt, nsec_day USE dom_oce
USE phycst , ONLY : rpi USE phycst
USE tide_mod USE tide_mod
#if defined key_xios #if defined key_xios
USE xios USE xios
...@@ -24,6 +24,8 @@ MODULE diadetide ...@@ -24,6 +24,8 @@ MODULE diadetide
PUBLIC :: dia_detide_init, dia_detide PUBLIC :: dia_detide_init, dia_detide
!! * Substitutions
# include "do_loop_substitute.h90"
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2019) !! NEMO/OCE 4.0 , NEMO Consortium (2019)
!! $Id$ !! $Id$
...@@ -90,9 +92,9 @@ CONTAINS ...@@ -90,9 +92,9 @@ CONTAINS
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
INTEGER, INTENT(in) :: kt INTEGER, INTENT(in) :: kt
REAL(wp), DIMENSION(jpi,jpj) :: zwght_2D REAL(wp), DIMENSION(A2D(0)) :: zwght_2D
REAL(wp) :: zwght, ztmp REAL(wp) :: zwght, ztmp
INTEGER :: jn INTEGER :: ji, jj, jn
! Compute detiding weight at the current time-step; the daily total weight ! Compute detiding weight at the current time-step; the daily total weight
! is one, and the daily summation of a diagnosed field multiplied by this ! is one, and the daily summation of a diagnosed field multiplied by this
...@@ -104,7 +106,10 @@ CONTAINS ...@@ -104,7 +106,10 @@ CONTAINS
zwght = zwght + 1.0_wp / REAL( ndiadetide, KIND=wp ) zwght = zwght + 1.0_wp / REAL( ndiadetide, KIND=wp )
END IF END IF
END DO END DO
zwght_2D(:,:) = zwght
DO_2D( 0, 0, 0, 0 )
zwght_2D(ji,jj) = zwght
END_2D
CALL iom_put( "diadetide_weight", zwght_2D) CALL iom_put( "diadetide_weight", zwght_2D)
END SUBROUTINE dia_detide END SUBROUTINE dia_detide
......
src/OCE/DIA/diahsb.F90
View file @ a0d550a1
...@@ -50,6 +50,7 @@ MODULE diahsb ...@@ -50,6 +50,7 @@ MODULE diahsb
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_ini REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_ini
!! * Substitutions !! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90" # include "domzgr_substitute.h90"
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018) !! NEMO/OCE 4.0 , NEMO Consortium (2018)
...@@ -82,30 +83,61 @@ CONTAINS ...@@ -82,30 +83,61 @@ CONTAINS
REAL(wp) :: z_frc_trd_v ! - - REAL(wp) :: z_frc_trd_v ! - -
REAL(wp) :: z_wn_trd_t , z_wn_trd_s ! - - REAL(wp) :: z_wn_trd_t , z_wn_trd_s ! - -
REAL(wp) :: z_ssh_hc , z_ssh_sc ! - - REAL(wp) :: z_ssh_hc , z_ssh_sc ! - -
REAL(wp), DIMENSION(jpi,jpj,13) :: ztmp REAL(wp), DIMENSION(A2D(0),13) :: ztmp
REAL(wp), DIMENSION(jpi,jpj,jpkm1,4) :: ztmpk REAL(wp), DIMENSION(A2D(0),jpkm1,4) :: ztmpk
REAL(wp), DIMENSION(17) :: zbg REAL(wp), DIMENSION(17) :: zbg
!!--------------------------------------------------------------------------- !!---------------------------------------------------------------------------
IF( ln_timing ) CALL timing_start('dia_hsb') IF( ln_timing ) CALL timing_start('dia_hsb')
! !
ztmp (:,:,:) = 0._wp ! should be better coded DO_2D( 0, 0, 0, 0 )
ztmpk(:,:,:,:) = 0._wp ! should be better coded ztmp (ji,jj,:) = 0._wp ! should be better coded
! ztmpk(ji,jj,:,:) = 0._wp ! should be better coded
ts(:,:,:,1,Kmm) = ts(:,:,:,1,Kmm) * tmask(:,:,:) ; ts(:,:,:,1,Kbb) = ts(:,:,:,1,Kbb) * tmask(:,:,:) ; !
ts(:,:,:,2,Kmm) = ts(:,:,:,2,Kmm) * tmask(:,:,:) ; ts(:,:,:,2,Kbb) = ts(:,:,:,2,Kbb) * tmask(:,:,:) ; ts(ji,jj,:,1,Kmm) = ts(ji,jj,:,1,Kmm) * tmask(ji,jj,:)
ts(ji,jj,:,1,Kbb) = ts(ji,jj,:,1,Kbb) * tmask(ji,jj,:)
!
ts(ji,jj,:,2,Kmm) = ts(ji,jj,:,2,Kmm) * tmask(ji,jj,:)
ts(ji,jj,:,2,Kbb) = ts(ji,jj,:,2,Kbb) * tmask(ji,jj,:)
END_2D
! !
! ------------------------- ! ! ------------------------- !
! 1 - Trends due to forcing ! ! 1 - Trends due to forcing !
! ------------------------- ! ! ------------------------- !
! prepare trends ! prepare trends
ztmp(:,:,1) = - r1_rho0 * ( emp(:,:) - rnf(:,:) - fwfisf_cav(:,:) - fwfisf_par(:,:) ) * surf(:,:) ! volume DO_2D( 0, 0, 0, 0 )
ztmp(:,:,2) = sbc_tsc(:,:,jp_tem) * surf(:,:) ! heat ztmp(ji,jj,1) = - r1_rho0 * ( emp(ji,jj) & ! volume
ztmp(:,:,3) = sbc_tsc(:,:,jp_sal) * surf(:,:) ! salt & - rnf(ji,jj) &
IF( ln_rnf ) ztmp(:,:,4) = rnf_tsc(:,:,jp_tem) * surf(:,:) ! runoff temp & - fwfisf_cav(ji,jj) &
IF( ln_rnf_sal ) ztmp(:,:,5) = rnf_tsc(:,:,jp_sal) * surf(:,:) ! runoff salt & - fwfisf_par(ji,jj) ) * surf(ji,jj)
IF( ln_isf ) ztmp(:,:,6) = ( risf_cav_tsc(:,:,jp_tem) + risf_par_tsc(:,:,jp_tem) ) * surf(:,:) ! isf temp ztmp(ji,jj,2) = sbc_tsc(ji,jj,jp_tem) * surf(ji,jj) ! heat
IF( ln_traqsr ) ztmp(:,:,7) = r1_rho0_rcp * qsr(:,:) * surf(:,:) ! penetrative solar radiation ztmp(ji,jj,3) = sbc_tsc(ji,jj,jp_sal) * surf(ji,jj) ! salt
IF( ln_trabbc ) ztmp(:,:,8) = qgh_trd0(:,:) * surf(:,:) ! geothermal heat END_2D
IF( ln_rnf ) THEN
DO_2D( 0, 0, 0, 0 )
ztmp(ji,jj,4) = rnf_tsc(ji,jj,jp_tem) * surf(ji,jj) ! runoff temp
END_2D
END IF
IF( ln_rnf_sal ) THEN
DO_2D( 0, 0, 0, 0 )
ztmp(ji,jj,5) = rnf_tsc(ji,jj,jp_sal) * surf(ji,jj) ! runoff salt
END_2D
END IF
IF( ln_isf ) THEN
DO_2D( 0, 0, 0, 0 )
ztmp(ji,jj,6) = ( risf_cav_tsc(ji,jj,jp_tem) &
& + risf_par_tsc(ji,jj,jp_tem) ) * surf(ji,jj) ! isf temp
END_2D
END IF
IF( ln_traqsr ) THEN
DO_2D( 0, 0, 0, 0 )
ztmp(ji,jj,7) = r1_rho0_rcp * qsr(ji,jj) * surf(ji,jj) ! penetrative solar radiation
END_2D
END IF
IF( ln_trabbc ) THEN
DO_2D( 0, 0, 0, 0 )
ztmp(ji,jj,8) = qgh_trd0(ji,jj) * surf(ji,jj) ! geothermal heat
END_2D
END IF
! !
IF( ln_linssh ) THEN ! Advection flux through fixed surface (z=0) IF( ln_linssh ) THEN ! Advection flux through fixed surface (z=0)
IF( ln_isfcav ) THEN IF( ln_isfcav ) THEN
...@@ -116,8 +148,10 @@ CONTAINS ...@@ -116,8 +148,10 @@ CONTAINS
END DO END DO
END DO END DO
ELSE ELSE
ztmp(:,:,9 ) = - surf(:,:) * ww(:,:,1) * ts(:,:,1,jp_tem,Kbb) DO_2D( 0, 0, 0, 0 )
ztmp(:,:,10) = - surf(:,:) * ww(:,:,1) * ts(:,:,1,jp_sal,Kbb) ztmp(ji,jj,9 ) = - surf(ji,jj) * ww(ji,jj,1) * ts(ji,jj,1,jp_tem,Kbb)
ztmp(ji,jj,10) = - surf(ji,jj) * ww(ji,jj,1) * ts(ji,jj,1,jp_sal,Kbb)
END_2D
END IF END IF
ENDIF ENDIF
...@@ -152,7 +186,9 @@ CONTAINS ...@@ -152,7 +186,9 @@ CONTAINS
! glob_sum is needed because you keep only the interior domain to compute the sum (iscpl) ! glob_sum is needed because you keep only the interior domain to compute the sum (iscpl)
! !
! ! volume variation (calculated with ssh) ! ! volume variation (calculated with ssh)
ztmp(:,:,11) = surf(:,:)*ssh(:,:,Kmm) - surf_ini(:,:)*ssh_ini(:,:) DO_2D( 0, 0, 0, 0 )
ztmp(ji,jj,11) = surf(ji,jj)*ssh(ji,jj,Kmm) - surf_ini(ji,jj)*ssh_ini(ji,jj)
END_2D
! ! heat & salt content variation (associated with ssh) ! ! heat & salt content variation (associated with ssh)
IF( ln_linssh ) THEN ! linear free surface case IF( ln_linssh ) THEN ! linear free surface case
...@@ -164,8 +200,10 @@ CONTAINS ...@@ -164,8 +200,10 @@ CONTAINS
END DO END DO
END DO END DO
ELSE ! no under ice-shelf seas ELSE ! no under ice-shelf seas
ztmp(:,:,12) = surf(:,:) * ( ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm) - ssh_hc_loc_ini(:,:) ) DO_2D( 0, 0, 0, 0 )
ztmp(:,:,13) = surf(:,:) * ( ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm) - ssh_sc_loc_ini(:,:) ) ztmp(ji,jj,12) = surf(ji,jj) * ( ts(ji,jj,1,jp_tem,Kmm) * ssh(ji,jj,Kmm) - ssh_hc_loc_ini(ji,jj) )
ztmp(ji,jj,13) = surf(ji,jj) * ( ts(ji,jj,1,jp_sal,Kmm) * ssh(ji,jj,Kmm) - ssh_sc_loc_ini(ji,jj) )
END_2D
END IF END IF
ENDIF ENDIF
...@@ -185,19 +223,27 @@ CONTAINS ...@@ -185,19 +223,27 @@ CONTAINS
! glob_sum is needed because you keep only the interior domain to compute the sum (iscpl) ! glob_sum is needed because you keep only the interior domain to compute the sum (iscpl)
! !
DO jk = 1, jpkm1 ! volume DO jk = 1, jpkm1 ! volume
ztmpk(:,:,jk,1) = surf (:,:) * e3t(:,:,jk,Kmm)*tmask(:,:,jk) & DO_2D( 0, 0, 0, 0 )
& - surf_ini(:,:) * e3t_ini(:,:,jk )*tmask_ini(:,:,jk) ztmpk(ji,jj,jk,1) = surf (ji,jj) * e3t(ji,jj,jk,Kmm)*tmask(ji,jj,jk) &
& - surf_ini(ji,jj) * e3t_ini(ji,jj,jk )*tmask_ini(ji,jj,jk)
END_2D
END DO END DO
DO jk = 1, jpkm1 ! heat DO jk = 1, jpkm1 ! heat
ztmpk(:,:,jk,2) = ( surf (:,:) * e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_tem,Kmm) & DO_2D( 0, 0, 0, 0 )
& - surf_ini(:,:) * hc_loc_ini(:,:,jk) ) ztmpk(ji,jj,jk,2) = ( surf (ji,jj) * e3t(ji,jj,jk,Kmm)*ts(ji,jj,jk,jp_tem,Kmm) &
& - surf_ini(ji,jj) * hc_loc_ini(ji,jj,jk) )
END_2D
END DO END DO
DO jk = 1, jpkm1 ! salt DO jk = 1, jpkm1 ! salt
ztmpk(:,:,jk,3) = ( surf (:,:) * e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_sal,Kmm) & DO_2D( 0, 0, 0, 0 )
& - surf_ini(:,:) * sc_loc_ini(:,:,jk) ) ztmpk(ji,jj,jk,3) = ( surf (ji,jj) * e3t(ji,jj,jk,Kmm)*ts(ji,jj,jk,jp_sal,Kmm) &
& - surf_ini(ji,jj) * sc_loc_ini(ji,jj,jk) )
END_2D
END DO END DO
DO jk = 1, jpkm1 ! total ocean volume DO jk = 1, jpkm1 ! total ocean volume
ztmpk(:,:,jk,4) = surf(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) DO_2D( 0, 0, 0, 0 )
ztmpk(ji,jj,jk,4) = surf(ji,jj) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
END_2D
END DO END DO
! global sum ! global sum
...@@ -315,14 +361,18 @@ CONTAINS ...@@ -315,14 +361,18 @@ CONTAINS
IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' dia_hsb_rst : initialise hsb at initial state ' IF(lwp) WRITE(numout,*) ' dia_hsb_rst : initialise hsb at initial state '
IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*)
surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface DO_2D( 0, 0, 0, 0 )
ssh_ini(:,:) = ssh(:,:,Kmm) ! initial ssh surf_ini(ji,jj) = e1e2t(ji,jj) * tmask_i(ji,jj) ! initial ocean surface
ssh_ini(ji,jj) = ssh(ji,jj,Kmm) ! initial ssh
END_2D
DO jk = 1, jpk DO jk = 1, jpk
! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance).
e3t_ini (:,:,jk) = e3t(:,:,jk,Kmm) * tmask(:,:,jk) ! initial vertical scale factors DO_2D( 0, 0, 0, 0 )
tmask_ini (:,:,jk) = tmask(:,:,jk) ! initial mask e3t_ini (ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) ! initial vertical scale factors
hc_loc_ini(:,:,jk) = ts(:,:,jk,jp_tem,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) ! initial heat content tmask_ini (ji,jj,jk) = tmask(ji,jj,jk) ! initial mask
sc_loc_ini(:,:,jk) = ts(:,:,jk,jp_sal,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) ! initial salt content hc_loc_ini(ji,jj,jk) = ts(ji,jj,jk,jp_tem,Kmm) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) ! initial heat content
sc_loc_ini(ji,jj,jk) = ts(ji,jj,jk,jp_sal,Kmm) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) ! initial salt content
END_2D
END DO END DO
frc_v = 0._wp ! volume trend due to forcing frc_v = 0._wp ! volume trend due to forcing
frc_t = 0._wp ! heat content - - - - frc_t = 0._wp ! heat content - - - -
...@@ -334,13 +384,15 @@ CONTAINS ...@@ -334,13 +384,15 @@ CONTAINS
ssh_hc_loc_ini(ji,jj) = ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm) ! initial heat content in ssh ssh_hc_loc_ini(ji,jj) = ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm) ! initial heat content in ssh
ssh_sc_loc_ini(ji,jj) = ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm) ! initial salt content in ssh ssh_sc_loc_ini(ji,jj) = ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm) ! initial salt content in ssh
END DO END DO
END DO END DO
ELSE ELSE
ssh_hc_loc_ini(:,:) = ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm) ! initial heat content in ssh DO_2D( 0, 0, 0, 0 )
ssh_sc_loc_ini(:,:) = ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm) ! initial salt content in ssh ssh_hc_loc_ini(ji,jj) = ts(ji,jj,1,jp_tem,Kmm) * ssh(ji,jj,Kmm) ! initial heat content in ssh
ssh_sc_loc_ini(ji,jj) = ts(ji,jj,1,jp_sal,Kmm) * ssh(ji,jj,Kmm) ! initial salt content in ssh
END_2D
END IF END IF
frc_wn_t = 0._wp ! initial heat content misfit due to free surface frc_wn_t = 0._wp ! initial heat content misfit due to free surface
frc_wn_s = 0._wp ! initial salt content misfit due to free surface frc_wn_s = 0._wp ! initial salt content misfit due to free surface
ENDIF ENDIF
ENDIF ENDIF
! !
...@@ -388,6 +440,7 @@ CONTAINS ...@@ -388,6 +440,7 @@ CONTAINS
INTEGER, INTENT(in) :: Kmm ! time level index INTEGER, INTENT(in) :: Kmm ! time level index
! !
INTEGER :: ierror, ios ! local integer INTEGER :: ierror, ios ! local integer
INTEGER :: ji, jj ! loop index
!! !!
NAMELIST/namhsb/ ln_diahsb NAMELIST/namhsb/ ln_diahsb
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
...@@ -427,7 +480,10 @@ CONTAINS ...@@ -427,7 +480,10 @@ CONTAINS
! ----------------------------------------------- ! ! ----------------------------------------------- !
! 2 - Time independant variables and file opening ! ! 2 - Time independant variables and file opening !
! ----------------------------------------------- ! ! ----------------------------------------------- !
surf(:,:) = e1e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area
DO_2D( 0, 0, 0, 0 )
surf(ji,jj) = e1e2t(ji,jj) * tmask_i(ji,jj) ! masked surface grid cell area
END_2D
surf_tot = glob_sum( 'diahsb', surf(:,:) ) ! total ocean surface area surf_tot = glob_sum( 'diahsb', surf(:,:) ) ! total ocean surface area
IF( ln_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' ) IF( ln_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' )
......
src/OCE/DIA/diahth.F90
View file @ a0d550a1
...@@ -86,22 +86,22 @@ CONTAINS ...@@ -86,22 +86,22 @@ CONTAINS
INTEGER, INTENT( in ) :: kt ! ocean time-step index INTEGER, INTENT( in ) :: kt ! ocean time-step index
INTEGER, INTENT( in ) :: Kmm ! ocean time level index INTEGER, INTENT( in ) :: Kmm ! ocean time level index
!! !!
INTEGER :: ji, jj, jk ! dummy loop arguments INTEGER :: ji, jj, jk ! dummy loop arguments
REAL(wp) :: zrho3 = 0.03_wp ! density criterion for mixed layer depth REAL(wp) :: zrho3 = 0.03_wp ! density criterion for mixed layer depth
REAL(wp) :: zrho1 = 0.01_wp ! density criterion for mixed layer depth REAL(wp) :: zrho1 = 0.01_wp ! density criterion for mixed layer depth
REAL(wp) :: ztem2 = 0.2_wp ! temperature criterion for mixed layer depth REAL(wp) :: ztem2 = 0.2_wp ! temperature criterion for mixed layer depth
REAL(wp) :: zztmp, zzdep ! temporary scalars inside do loop REAL(wp) :: zztmp, zzdep ! temporary scalars inside do loop
REAL(wp) :: zu, zv, zw, zut, zvt ! temporary workspace REAL(wp) :: zu, zv, zw, zut, zvt ! temporary workspace
REAL(wp), DIMENSION(jpi,jpj) :: zabs2 ! MLD: abs( tn - tn(10m) ) = ztem2 REAL(wp), DIMENSION(A2D(0)) :: zabs2 ! MLD: abs( tn - tn(10m) ) = ztem2
REAL(wp), DIMENSION(jpi,jpj) :: ztm2 ! Top of thermocline: tn = tn(10m) - ztem2 REAL(wp), DIMENSION(A2D(0)) :: ztm2 ! Top of thermocline: tn = tn(10m) - ztem2
REAL(wp), DIMENSION(jpi,jpj) :: zrho10_3 ! MLD: rho = rho10m + zrho3 REAL(wp), DIMENSION(A2D(0)) :: zrho10_3 ! MLD: rho = rho10m + zrho3
REAL(wp), DIMENSION(jpi,jpj) :: zpycn ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC) REAL(wp), DIMENSION(A2D(0)) :: zpycn ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC)
REAL(wp), DIMENSION(jpi,jpj) :: ztinv ! max of temperature inversion REAL(wp), DIMENSION(A2D(0)) :: ztinv ! max of temperature inversion
REAL(wp), DIMENSION(jpi,jpj) :: zdepinv ! depth of temperature inversion REAL(wp), DIMENSION(A2D(0)) :: zdepinv ! depth of temperature inversion
REAL(wp), DIMENSION(jpi,jpj) :: zrho0_3 ! MLD rho = rho(surf) = 0.03 REAL(wp), DIMENSION(A2D(0)) :: zrho0_3 ! MLD rho = rho(surf) = 0.03
REAL(wp), DIMENSION(jpi,jpj) :: zrho0_1 ! MLD rho = rho(surf) = 0.01 REAL(wp), DIMENSION(A2D(0)) :: zrho0_1 ! MLD rho = rho(surf) = 0.01
REAL(wp), DIMENSION(jpi,jpj) :: zmaxdzT ! max of dT/dz REAL(wp), DIMENSION(A2D(0)) :: zmaxdzT ! max of dT/dz
REAL(wp), DIMENSION(jpi,jpj) :: zdelr ! delta rho equivalent to deltaT = 0.2 REAL(wp), DIMENSION(A2D(0)) :: zdelr ! delta rho equivalent to deltaT = 0.2
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
IF( ln_timing ) CALL timing_start('dia_hth') IF( ln_timing ) CALL timing_start('dia_hth')
...@@ -131,7 +131,7 @@ CONTAINS ...@@ -131,7 +131,7 @@ CONTAINS
IF( iom_use( 'mlddzt' ) ) zmaxdzT(:,:) = 0._wp IF( iom_use( 'mlddzt' ) ) zmaxdzT(:,:) = 0._wp
IF( iom_use( 'mlddzt' ) .OR. iom_use( 'mld_dt02' ) .OR. iom_use( 'topthdep' ) & IF( iom_use( 'mlddzt' ) .OR. iom_use( 'mld_dt02' ) .OR. iom_use( 'topthdep' ) &
& .OR. iom_use( 'mldr10_3' ) .OR. iom_use( 'pycndep' ) ) THEN & .OR. iom_use( 'mldr10_3' ) .OR. iom_use( 'pycndep' ) ) THEN
DO_2D( 1, 1, 1, 1 ) DO_2D( 0, 0, 0, 0 )
zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)
hth (ji,jj) = zztmp hth (ji,jj) = zztmp
zabs2 (ji,jj) = zztmp zabs2 (ji,jj) = zztmp
...@@ -142,7 +142,7 @@ CONTAINS ...@@ -142,7 +142,7 @@ CONTAINS
ENDIF ENDIF
IF( iom_use( 'mldr0_3' ) .OR. iom_use( 'mldr0_1' ) ) THEN IF( iom_use( 'mldr0_3' ) .OR. iom_use( 'mldr0_1' ) ) THEN
IF( nla10 > 1 ) THEN IF( nla10 > 1 ) THEN
DO_2D( 1, 1, 1, 1 ) DO_2D( 0, 0, 0, 0 )
zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)
zrho0_3(ji,jj) = zztmp zrho0_3(ji,jj) = zztmp
zrho0_1(ji,jj) = zztmp zrho0_1(ji,jj) = zztmp
...@@ -157,7 +157,7 @@ CONTAINS ...@@ -157,7 +157,7 @@ CONTAINS
! MLD: rho = rho(1) + zrho3 ! ! MLD: rho = rho(1) + zrho3 !
! MLD: rho = rho(1) + zrho1 ! ! MLD: rho = rho(1) + zrho1 !
! ------------------------------------------------------------- ! ! ------------------------------------------------------------- !
DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) ! loop from bottom to 2 DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! loop from bottom to 2
! !
zzdep = gdepw(ji,jj,jk,Kmm) zzdep = gdepw(ji,jj,jk,Kmm)
zztmp = ( ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) & zztmp = ( ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) &
...@@ -189,7 +189,7 @@ CONTAINS ...@@ -189,7 +189,7 @@ CONTAINS
! !
! Preliminary computation ! Preliminary computation
! computation of zdelr = (dr/dT)(T,S,10m)*(-0.2 degC) ! computation of zdelr = (dr/dT)(T,S,10m)*(-0.2 degC)
DO_2D( 1, 1, 1, 1 ) DO_2D( 0, 0, 0, 0 )
IF( tmask(ji,jj,nla10) == 1. ) THEN IF( tmask(ji,jj,nla10) == 1. ) THEN
zu = 1779.50 + 11.250 * ts(ji,jj,nla10,jp_tem,Kmm) - 3.80 * ts(ji,jj,nla10,jp_sal,Kmm) & zu = 1779.50 + 11.250 * ts(ji,jj,nla10,jp_tem,Kmm) - 3.80 * ts(ji,jj,nla10,jp_sal,Kmm) &
& - 0.0745 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm) & & - 0.0745 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm) &
...@@ -213,7 +213,7 @@ CONTAINS ...@@ -213,7 +213,7 @@ CONTAINS
! temperature inversion: max( 0, max of tn - tn(10m) ) ! ! temperature inversion: max( 0, max of tn - tn(10m) ) !
! depth of temperature inversion ! ! depth of temperature inversion !
! ------------------------------------------------------------- ! ! ------------------------------------------------------------- !
DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) ! loop from bottom to nlb10 DO_3DS( 0, 0, 0, 0, jpkm1, nlb10, -1 ) ! loop from bottom to nlb10
! !
zzdep = gdepw(ji,jj,jk,Kmm) * tmask(ji,jj,1) zzdep = gdepw(ji,jj,jk,Kmm) * tmask(ji,jj,1)
! !
...@@ -305,13 +305,16 @@ CONTAINS ...@@ -305,13 +305,16 @@ CONTAINS
! !
INTEGER :: ji, jj, jk, iid INTEGER :: ji, jj, jk, iid
REAL(wp) :: zztmp, zzdep REAL(wp) :: zztmp, zzdep
INTEGER, DIMENSION(jpi,jpj) :: iktem INTEGER, DIMENSION(A2D(0)) :: iktem
! --------------------------------------- ! ! --------------------------------------- !
! search deepest level above ptem ! ! search deepest level above ptem !
! --------------------------------------- ! ! --------------------------------------- !
iktem(:,:) = 1 DO_2D( 0, 0, 0, 0 )
DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! beware temperature is not always decreasing with depth => loop from top to bottom iktem(ji,jj) = 1
END_2D
DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! beware temperature is not always decreasing with depth => loop from top to bottom
zztmp = ts(ji,jj,jk,jp_tem,Kmm) zztmp = ts(ji,jj,jk,jp_tem,Kmm)
IF( zztmp >= ptem ) iktem(ji,jj) = jk IF( zztmp >= ptem ) iktem(ji,jj) = jk
END_3D END_3D
...@@ -319,7 +322,7 @@ CONTAINS ...@@ -319,7 +322,7 @@ CONTAINS
! ------------------------------- ! ! ------------------------------- !
! Depth of ptem isotherm ! ! Depth of ptem isotherm !
! ------------------------------- ! ! ------------------------------- !
DO_2D( 1, 1, 1, 1 ) DO_2D( 0, 0, 0, 0 )
! !
zzdep = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) ! depth of the ocean bottom zzdep = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) ! depth of the ocean bottom
! !
...@@ -346,18 +349,29 @@ CONTAINS ...@@ -346,18 +349,29 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: phtc REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: phtc
! !
INTEGER :: ji, jj, jk, ik INTEGER :: ji, jj, jk, ik
REAL(wp), DIMENSION(jpi,jpj) :: zthick REAL(wp), DIMENSION(A2D(0)) :: zthick
INTEGER , DIMENSION(jpi,jpj) :: ilevel INTEGER , DIMENSION(A2D(0)) :: ilevel
! surface boundary condition ! surface boundary condition
IF( .NOT. ln_linssh ) THEN ; zthick(:,:) = 0._wp ; phtc(:,:) = 0._wp IF( .NOT. ln_linssh ) THEN
ELSE ; zthick(:,:) = ssh(:,:,Kmm) ; phtc(:,:) = pt(:,:,1) * ssh(:,:,Kmm) * tmask(:,:,1) DO_2D( 0, 0, 0, 0 )
zthick(ji,jj) = 0._wp
phtc (ji,jj) = 0._wp
END_2D
ELSE
DO_2D( 0, 0, 0, 0 )
zthick(ji,jj) = ssh(ji,jj,Kmm)
phtc (ji,jj) = pt(ji,jj,1) * ssh(ji,jj,Kmm) * tmask(ji,jj,1)
END_2D
ENDIF ENDIF
! !
ilevel(:,:) = 1 DO_2D( 0, 0, 0, 0 )
DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ilevel(ji,jj) = 1
END_2D
!
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
IF( ( gdepw(ji,jj,jk+1,Kmm) < pdep ) .AND. ( tmask(ji,jj,jk) == 1 ) ) THEN IF( ( gdepw(ji,jj,jk+1,Kmm) < pdep ) .AND. ( tmask(ji,jj,jk) == 1 ) ) THEN
ilevel(ji,jj) = jk+1 ilevel(ji,jj) = jk+1
zthick(ji,jj) = zthick(ji,jj) + e3t(ji,jj,jk,Kmm) zthick(ji,jj) = zthick(ji,jj) + e3t(ji,jj,jk,Kmm)
...@@ -365,7 +379,7 @@ CONTAINS ...@@ -365,7 +379,7 @@ CONTAINS
ENDIF ENDIF
END_3D END_3D
! !
DO_2D( 1, 1, 1, 1 ) DO_2D( 0, 0, 0, 0 )
ik = ilevel(ji,jj) ik = ilevel(ji,jj)
IF( tmask(ji,jj,ik) == 1 ) THEN IF( tmask(ji,jj,ik) == 1 ) THEN
zthick(ji,jj) = MIN ( gdepw(ji,jj,ik+1,Kmm), pdep ) - zthick(ji,jj) ! remaining thickness to reach dephw pdep zthick(ji,jj) = MIN ( gdepw(ji,jj,ik+1,Kmm), pdep ) - zthick(ji,jj) ! remaining thickness to reach dephw pdep
......
src/OCE/DIA/diamlr.F90
View file @ a0d550a1
...@@ -6,7 +6,7 @@ MODULE diamlr ...@@ -6,7 +6,7 @@ MODULE diamlr
!! History : 4.0 ! 2019 (S. Mueller) Original code !! History : 4.0 ! 2019 (S. Mueller) Original code
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
USE par_oce , ONLY : wp, jpi, jpj USE par_oce , ONLY : wp, jpi, jpj, ntsi, ntei, ntsj, ntej
USE phycst , ONLY : rpi USE phycst , ONLY : rpi
USE dom_oce , ONLY : adatrj USE dom_oce , ONLY : adatrj
USE tide_mod USE tide_mod
...@@ -407,8 +407,9 @@ CONTAINS ...@@ -407,8 +407,9 @@ CONTAINS
!! ** Purpose : update time used in multiple-linear-regression analysis !! ** Purpose : update time used in multiple-linear-regression analysis
!! !!
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj) :: zadatrj2d REAL(wp), DIMENSION(A2D(0)) :: zadatrj2d
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
INTEGER :: ji, jj
IF( ln_timing ) CALL timing_start('dia_mlr') IF( ln_timing ) CALL timing_start('dia_mlr')
...@@ -417,7 +418,9 @@ CONTAINS ...@@ -417,7 +418,9 @@ CONTAINS
! !
! A 2-dimensional field of constant value is sent, and subsequently used directly ! A 2-dimensional field of constant value is sent, and subsequently used directly
! or transformed to a scalar or a constant 3-dimensional field as required. ! or transformed to a scalar or a constant 3-dimensional field as required.
zadatrj2d(:,:) = adatrj*86400.0_wp DO_2D( 0, 0, 0, 0 )
zadatrj2d(ji,jj) = adatrj*86400.0_wp
END_2D
IF ( iom_use('diamlr_time') ) CALL iom_put('diamlr_time', zadatrj2d) IF ( iom_use('diamlr_time') ) CALL iom_put('diamlr_time', zadatrj2d)
! !
IF( ln_timing ) CALL timing_stop('dia_mlr') IF( ln_timing ) CALL timing_stop('dia_mlr')
......
src/OCE/DIA/diaptr.F90
View file @ a0d550a1
This diff is collapsed.
src/OCE/DIA/diawri.F90
View file @ a0d550a1
...@@ -135,8 +135,8 @@ CONTAINS ...@@ -135,8 +135,8 @@ CONTAINS
ENDIF ENDIF
! initialize arrays ! initialize arrays
z2d(:,:) = 0._wp z2d(A2D(0)) = 0._wp
z3d(:,:,:) = 0._wp z3d(A2D(0),:) = 0._wp
! Output of initial vertical scale factor ! Output of initial vertical scale factor
CALL iom_put("e3t_0", e3t_0(:,:,:) ) CALL iom_put("e3t_0", e3t_0(:,:,:) )
...@@ -868,7 +868,11 @@ CONTAINS ...@@ -868,7 +868,11 @@ CONTAINS
CALL histdef( nid_T, "sohtc300", "Heat content 300 m" , "J/m2" , & ! htc3 CALL histdef( nid_T, "sohtc300", "Heat content 300 m" , "J/m2" , & ! htc3
& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
#endif #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 ) CALL histend( nid_T, snc4chunks=snc4set )
! !!! nid_U : 3D ! !!! nid_U : 3D
...@@ -878,10 +882,7 @@ CONTAINS ...@@ -878,10 +882,7 @@ CONTAINS
CALL histdef( nid_U, "sdzocrtx", "Stokes Drift Zonal Current" , "m/s" , & ! usd 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 ) & jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
ENDIF 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 ) CALL histend( nid_U, snc4chunks=snc4set )
! !!! nid_V : 3D ! !!! nid_V : 3D
...@@ -891,10 +892,7 @@ CONTAINS ...@@ -891,10 +892,7 @@ CONTAINS
CALL histdef( nid_V, "sdmecrty", "Stokes Drift Meridional Current" , "m/s" , & ! vsd 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 ) & jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
ENDIF 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 ) CALL histend( nid_V, snc4chunks=snc4set )
! !!! nid_W : 3D ! !!! nid_W : 3D
...@@ -1066,12 +1064,12 @@ CONTAINS ...@@ -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, "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 CALL histwrite( nid_T, "sohtc300", it, htc3 , ndim_hT, ndex_hT ) ! first 300m heaat content
#endif #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, "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, "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 IF( ln_zad_Aimp ) THEN
DO_3D( 0, 0, 0, 0, 1, jpk ) DO_3D( 0, 0, 0, 0, 1, jpk )
......
src/OCE/DOM/dom_oce.F90
View file @ a0d550a1
...@@ -27,6 +27,8 @@ MODULE dom_oce ...@@ -27,6 +27,8 @@ MODULE dom_oce
PUBLIC dom_oce_alloc ! Called from nemogcm.F90 PUBLIC dom_oce_alloc ! Called from nemogcm.F90
!! * Substitutions
# include "do_loop_substitute.h90"
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! time & space domain namelist !! time & space domain namelist
!! ---------------------------- !! ----------------------------
...@@ -74,10 +76,10 @@ MODULE dom_oce ...@@ -74,10 +76,10 @@ MODULE dom_oce
INTEGER :: nn_ltile_i, nn_ltile_j INTEGER :: nn_ltile_i, nn_ltile_j
! Domain tiling ! Domain tiling
INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntsi_a !: start of internal part of tile domain INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntsi_a !: start of internal part of tile domain
INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntsj_a ! INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntsj_a !
INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntei_a !: end of internal part of tile domain INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntei_a !: end of internal part of tile domain
INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntej_a ! INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntej_a !
LOGICAL, PUBLIC :: l_istiled ! whether tiling is currently active or not LOGICAL, PUBLIC :: l_istiled ! whether tiling is currently active or not
! !: domain MPP decomposition parameters ! !: domain MPP decomposition parameters
...@@ -85,32 +87,30 @@ MODULE dom_oce ...@@ -85,32 +87,30 @@ MODULE dom_oce
INTEGER , PUBLIC :: narea !: number for local area (starting at 1) = MPI rank + 1 INTEGER , PUBLIC :: narea !: number for local area (starting at 1) = MPI rank + 1
INTEGER, PUBLIC :: nidom !: IOIPSL things... INTEGER, PUBLIC :: nidom !: IOIPSL things...
INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mig !: local ==> global domain, including halos (jpiglo), i-index INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mig !: local ==> global domain, i-index
INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mjg !: local ==> global domain, including halos (jpjglo), j-index INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mjg !: local ==> global domain, j-index
INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mig0 !: local ==> global domain, excluding halos (Ni0glo), i-index INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mi0, mi1 !: global ==> local domain, i-index
INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mjg0 !: local ==> global domain, excluding halos (Nj0glo), j-index
INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mi0, mi1 !: global, including halos (jpiglo) ==> local domain i-index
! !: (mi0=1 and mi1=0 if global index not in local domain) ! !: (mi0=1 and mi1=0 if global index not in local domain)
INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mj0, mj1 !: global, including halos (jpjglo) ==> local domain j-index INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mj0, mj1 !: global ==> local domain, j-index
! !: (mj0=1 and mj1=0 if global index not in local domain) ! !: (mj0=1 and mj1=0 if global index not in local domain)
INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nfimpp, nfproc, nfjpi INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: nfimpp, nfproc, nfjpi, nfni_0
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! horizontal curvilinear coordinate and scale factors !! horizontal curvilinear coordinate and scale factors
!! --------------------------------------------------------------------- !! ---------------------------------------------------------------------
REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: glamt , glamu, glamv , glamf !: longitude at t, u, v, f-points [degree] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: glamt , glamu, glamv , glamf !: longitude at t, u, v, f-points [degree]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: gphit , gphiu, gphiv , gphif !: latitude at t, u, v, f-points [degree] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: gphit , gphiu, gphiv , gphif !: latitude at t, u, v, f-points [degree]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1t , e2t , r1_e1t, r1_e2t !: t-point horizontal scale factors [m] REAL(wp), PUBLIC, ALLOCATABLE, TARGET, DIMENSION(:,:) :: e1t , e2t , r1_e1t, r1_e2t !: t-point horizontal scale factors [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1u , e2u , r1_e1u, r1_e2u !: horizontal scale factors at u-point [m] REAL(wp), PUBLIC, ALLOCATABLE, TARGET, DIMENSION(:,:) :: e1u , e2u , r1_e1u, r1_e2u !: horizontal scale factors at u-point [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1v , e2v , r1_e1v, r1_e2v !: horizontal scale factors at v-point [m] REAL(wp), PUBLIC, ALLOCATABLE, TARGET, DIMENSION(:,:) :: e1v , e2v , r1_e1v, r1_e2v !: horizontal scale factors at v-point [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1f , e2f , r1_e1f, r1_e2f !: horizontal scale factors at f-point [m] REAL(wp), PUBLIC, ALLOCATABLE, TARGET, DIMENSION(:,:) :: e1f , e2f , r1_e1f, r1_e2f !: horizontal scale factors at f-point [m]
! !
REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2t , r1_e1e2t !: associated metrics at t-point REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: e1e2t , r1_e1e2t !: associated metrics at t-point
REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2u , r1_e1e2u , e2_e1u !: associated metrics at u-point REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: e1e2u , r1_e1e2u , e2_e1u !: associated metrics at u-point
REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2v , r1_e1e2v , e1_e2v !: associated metrics at v-point REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: e1e2v , r1_e1e2v , e1_e2v !: associated metrics at v-point
REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2f , r1_e1e2f !: associated metrics at f-point REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: e1e2f , r1_e1e2f !: associated metrics at f-point
! !
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ff_f , ff_t !: Coriolis factor at f- & t-points [1/s] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ff_f , ff_t !: Coriolis factor at f- & t-points [1/s]
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! vertical coordinate and scale factors !! vertical coordinate and scale factors
...@@ -130,75 +130,76 @@ MODULE dom_oce ...@@ -130,75 +130,76 @@ MODULE dom_oce
LOGICAL, PUBLIC :: ln_sco !: s-coordinate or hybrid z-s coordinate LOGICAL, PUBLIC :: ln_sco !: s-coordinate or hybrid z-s coordinate
LOGICAL, PUBLIC :: ln_isfcav !: presence of ISF LOGICAL, PUBLIC :: ln_isfcav !: presence of ISF
! ! reference scale factors ! ! reference scale factors
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_0 !: t- vert. scale factor [m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3t_0 !: t- vert. scale factor [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3u_0 !: u- vert. scale factor [m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3u_0 !: u- vert. scale factor [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3v_0 !: v- vert. scale factor [m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3v_0 !: v- vert. scale factor [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3f_0 !: f- vert. scale factor [m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3f_0 !: f- vert. scale factor [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w_0 !: w- vert. scale factor [m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3w_0 !: w- vert. scale factor [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3uw_0 !: uw-vert. scale factor [m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3uw_0 !: uw-vert. scale factor [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_0 !: vw-vert. scale factor [m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3vw_0 !: vw-vert. scale factor [m]
! ! time-dependent scale factors (domvvl) ! ! time-dependent scale factors (domvvl)
#if defined key_qco || defined key_linssh #if defined key_qco || defined key_linssh
#else #else
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e3t, e3u, e3v, e3w, e3uw, e3vw !: vert. scale factor [m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:) :: e3t, e3u, e3v, e3w, e3uw, e3vw !: vert. scale factor [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3f !: F-point vert. scale factor [m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3f !: F-point vert. scale factor [m]
#endif #endif
! ! time-dependent ratio ssh / h_0 (domqco) ! ! time-dependent ratio ssh / h_0 (domqco)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: r3t, r3u, r3v !: time-dependent ratio at t-, u- and v-point [-] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: r3t, r3u, r3v !: time-dependent ratio at t-, u- and v-point [-]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r3f !: mid-time-level ratio at f-point [-] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: r3f !: mid-time-level ratio at f-point [-]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r3t_f, r3u_f, r3v_f !: now time-filtered ratio at t-, u- and v-point [-] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: r3t_f, r3u_f, r3v_f !: now time-filtered ratio at t-, u- and v-point [-]
! ! reference depths of cells ! ! reference depths of cells
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_0 !: t- depth [m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: gdept_0 !: t- depth [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdepw_0 !: w- depth [m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: gdepw_0 !: w- depth [m]
! ! time-dependent depths of cells (domvvl) ! ! time-dependent depths of cells (domvvl)
#if defined key_qco || defined key_linssh #if defined key_qco || defined key_linssh
#else #else
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w_0, gde3w !: w- depth (sum of e3w) [m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: gde3w_0, gde3w !: w- depth (sum of e3w) [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: gdept, gdepw REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:) :: gdept, gdepw
#endif #endif
! ! reference heights of ocean water column and its inverse ! ! reference heights of ocean water column and its inverse
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0, r1_ht_0 !: t-depth [m] and [1/m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ht_0, r1_ht_0 !: t-depth [m] and [1/m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0, r1_hu_0 !: u-depth [m] and [1/m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: hu_0, r1_hu_0 !: u-depth [m] and [1/m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hv_0, r1_hv_0 !: v-depth [m] and [1/m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: hv_0, r1_hv_0 !: v-depth [m] and [1/m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hf_0, r1_hf_0 !: f-depth [m] and [1/m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: hf_0, r1_hf_0 !: f-depth [m] and [1/m]
! ! time-dependent heights of ocean water column (domvvl) ! ! time-dependent heights of ocean water column (domvvl)
#if defined key_qco || defined key_linssh #if defined key_qco || defined key_linssh
#else #else
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht !: t-points [m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ht !: t-points [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hu, r1_hu !: u-depth [m] and [1/m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: hu, r1_hu !: u-depth [m] and [1/m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hv, r1_hv !: v-depth [m] and [1/m] REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: hv, r1_hv !: v-depth [m] and [1/m]
#endif #endif
INTEGER, PUBLIC :: nla10 !: deepest W level Above ~10m (nlb10 - 1) INTEGER, PUBLIC :: nla10 !: deepest W level Above ~10m (nlb10 - 1)
INTEGER, PUBLIC :: nlb10 !: shallowest W level Bellow ~10m (nla10 + 1) INTEGER, PUBLIC :: nlb10 !: shallowest W level Bellow ~10m (nla10 + 1)
!! 1D reference vertical coordinate !! 1D reference vertical coordinate
!! =-----------------====------ !! =-----------------====------
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gdept_1d, gdepw_1d !: reference depth of t- and w-points (m) REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: gdept_1d, gdepw_1d !: reference depth of t- and w-points (m)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: e3t_1d , e3w_1d !: reference vertical scale factors at T- and W-pts (m) REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: e3t_1d , e3w_1d !: reference vertical scale factors at T- and W-pts (m)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: risfdep, bathy REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: risfdep, bathy
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! masks, top and bottom ocean point position !! masks, top and bottom ocean point position
!! --------------------------------------------------------------------- !! ---------------------------------------------------------------------
!!gm Proposition of new name for top/bottom vertical indices !!gm Proposition of new name for top/bottom vertical indices
! INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mtk_t, mtk_u, mtk_v !: top first wet T-, U-, and V-level (ISF) ! INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mtk_t, mtk_u, mtk_v !: top first wet T-, U-, and V-level (ISF)
! INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbk_t, mbk_u, mbk_v !: bottom last wet T-, U-, and V-level ! INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mbk_t, mbk_u, mbk_v !: bottom last wet T-, U-, and V-level
!!gm !!gm
INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt, mbku, mbkv, mbkf !: bottom last wet T-, U-, V- and F-level INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mbkt, mbku, mbkv, mbkf !: bottom last wet T-, U-, V- and F-level
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_i !: interior (excluding halos+duplicated points) domain T-point mask REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tmask_i !: interior (excluding halos+duplicated points) domain T-point mask
INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mikt, miku, mikv, mikf !: top first wet T-, U-, V-, F-level (ISF) INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mikt, miku, mikv, mikf !: top first wet T-, U-, V-, F-level (ISF)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssmask, ssumask, ssvmask, ssfmask !: surface mask at T-,U-, V- and F-pts REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: smask0 !: surface mask at T-pts on inner domain
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, wmask, fmask !: land/ocean mask at T-, U-, V-, W- and F-pts REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ssmask, ssumask, ssvmask, ssfmask !: surface mask at T-,U-, V- and F-pts
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wumask, wvmask !: land/ocean mask at WU- and WV-pts REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, wmask, fmask !: land/ocean mask at T-, U-, V-, W- and F-pts
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: fe3mask !: land/ocean mask at F-pts REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:), TARGET :: wumask, wvmask !: land/ocean mask at WU- and WV-pts
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_upd, umask_upd, vmask_upd !: land/ocean mask at F-pts REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:), TARGET :: fe3mask !: land/ocean mask at F-pts
REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tmask_upd, umask_upd, vmask_upd !: land/ocean mask at F-pts
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! calendar variables !! calendar variables
...@@ -326,7 +327,7 @@ CONTAINS ...@@ -326,7 +327,7 @@ CONTAINS
ALLOCATE( risfdep(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(ii) ) ALLOCATE( risfdep(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(ii) )
! !
ii = ii+1 ii = ii+1
ALLOCATE( tmask_i(jpi,jpj) , & ALLOCATE( tmask_i(jpi,jpj) , smask0(A2D(0)) , &
& ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , & & ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , &
& mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv (jpi,jpj) , mbkf(jpi,jpj) , STAT=ierr(ii) ) & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv (jpi,jpj) , mbkf(jpi,jpj) , STAT=ierr(ii) )
! !
......
src/OCE/DOM/dommsk.F90
View file @ a0d550a1
...@@ -144,7 +144,8 @@ CONTAINS ...@@ -144,7 +144,8 @@ CONTAINS
tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj) tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj)
END_3D END_3D
ENDIF ENDIF
smask0(A2D(0)) = tmask(A2D(0),1)
! Ocean/land mask at u-, v-, and f-points (computed from tmask) ! Ocean/land mask at u-, v-, and f-points (computed from tmask)
! ---------------------------------------- ! ----------------------------------------
! NB: at this point, fmask is designed for free slip lateral boundary condition ! NB: at this point, fmask is designed for free slip lateral boundary condition
......
src/OCE/DOM/domtile.F90
View file @ a0d550a1
...@@ -52,16 +52,6 @@ CONTAINS ...@@ -52,16 +52,6 @@ CONTAINS
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
IF( ln_tile .AND. nn_hls /= 2 ) CALL ctl_stop('dom_tile_init: Tiling is only supported for nn_hls = 2') IF( ln_tile .AND. nn_hls /= 2 ) CALL ctl_stop('dom_tile_init: Tiling is only supported for nn_hls = 2')
ntile = 0 ! Initialise to full domain
nijtile = 1
ntsi = Nis0
ntsj = Njs0
ntei = Nie0
ntej = Nje0
nthl = 0
nthr = 0
nthb = 0
ntht = 0
l_istiled = .FALSE. l_istiled = .FALSE.
IF( ln_tile ) THEN ! Calculate tile domain indices IF( ln_tile ) THEN ! Calculate tile domain indices
......