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
Showing
with 293 additions and 157 deletions
...@@ -151,14 +151,14 @@ CONTAINS ...@@ -151,14 +151,14 @@ CONTAINS
! !* wind forcing *! ! !* wind forcing *!
IF( ln_bt_fw ) THEN IF( ln_bt_fw ) THEN
DO_2D( 0, 0, 0, 0 ) DO_2D( 0, 0, 0, 0 )
Ue_rhs(ji,jj) = Ue_rhs(ji,jj) + r1_rho0 * utau(ji,jj) * r1_hu(ji,jj,Kbb) Ue_rhs(ji,jj) = Ue_rhs(ji,jj) + r1_rho0 * utauU(ji,jj) * r1_hu(ji,jj,Kbb)
Ve_rhs(ji,jj) = Ve_rhs(ji,jj) + r1_rho0 * vtau(ji,jj) * r1_hv(ji,jj,Kbb) Ve_rhs(ji,jj) = Ve_rhs(ji,jj) + r1_rho0 * vtauV(ji,jj) * r1_hv(ji,jj,Kbb)
END_2D END_2D
ELSE ELSE
zztmp = r1_rho0 * r1_2 zztmp = r1_rho0 * r1_2
DO_2D( 0, 0, 0, 0 ) DO_2D( 0, 0, 0, 0 )
Ue_rhs(ji,jj) = Ue_rhs(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu(ji,jj,Kbb) Ue_rhs(ji,jj) = Ue_rhs(ji,jj) + zztmp * ( utau_b(ji,jj) + utauU(ji,jj) ) * r1_hu(ji,jj,Kbb)
Ve_rhs(ji,jj) = Ve_rhs(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv(ji,jj,Kbb) Ve_rhs(ji,jj) = Ve_rhs(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtauV(ji,jj) ) * r1_hv(ji,jj,Kbb)
END_2D END_2D
ENDIF ENDIF
! !
......
...@@ -317,22 +317,22 @@ CONTAINS ...@@ -317,22 +317,22 @@ CONTAINS
! !
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
CALL histdef( nid_U, "ssu_m", "Velocity component in x-direction", "m/s" , & ! ssu CALL histdef( nid_U, "ssu_m", "Velocity component in x-direction", "m/s" , & ! ssu
& jpi, jpj, nh_U, 1 , 1, 1 , - 99, 32, clop, zsto, zout ) & jpi, jpj, nh_U, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
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
CALL histdef( nid_V, "ssv_m", "Velocity component in y-direction", "m/s", & ! ssv_m CALL histdef( nid_V, "ssv_m", "Velocity component in y-direction", "m/s", & ! ssv_m
& jpi, jpj, nh_V, 1 , 1, 1 , - 99, 32, clop, zsto, zout ) & jpi, jpj, nh_V, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
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 )
...@@ -366,6 +366,8 @@ CONTAINS ...@@ -366,6 +366,8 @@ CONTAINS
CALL histwrite( nid_T, "soshfldo", it, qsr , ndim_hT, ndex_hT ) ! solar heat flux CALL histwrite( nid_T, "soshfldo", it, qsr , ndim_hT, ndex_hT ) ! solar heat flux
CALL histwrite( nid_T, "soicecov", it, fr_i , ndim_hT, ndex_hT ) ! ice fraction CALL histwrite( nid_T, "soicecov", it, fr_i , ndim_hT, ndex_hT ) ! ice fraction
CALL histwrite( nid_T, "sowindsp", it, wndm , ndim_hT, ndex_hT ) ! wind speed CALL histwrite( nid_T, "sowindsp", it, wndm , ndim_hT, ndex_hT ) ! wind speed
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
! !
IF( ln_abl ) THEN IF( ln_abl ) THEN
ALLOCATE( zw3d_abl(jpi,jpj,jpka) ) ALLOCATE( zw3d_abl(jpi,jpj,jpka) )
...@@ -393,11 +395,9 @@ CONTAINS ...@@ -393,11 +395,9 @@ CONTAINS
! Write fields on U grid ! Write fields on U grid
CALL histwrite( nid_U, "ssu_m" , it, ssu_m , ndim_hU, ndex_hU ) ! i-current speed CALL histwrite( nid_U, "ssu_m" , it, ssu_m , ndim_hU, ndex_hU ) ! i-current speed
CALL histwrite( nid_U, "sozotaux", it, utau , ndim_hU, ndex_hU ) ! i-wind stress
! Write fields on V grid ! Write fields on V grid
CALL histwrite( nid_V, "ssv_m" , it, ssv_m , ndim_hV, ndex_hV ) ! j-current speed CALL histwrite( nid_V, "ssv_m" , it, ssv_m , ndim_hV, ndex_hV ) ! j-current speed
CALL histwrite( nid_V, "sometauy", it, vtau , ndim_hV, ndex_hV ) ! j-wind stress
! 3. Close all files ! 3. Close all files
! --------------------------------------- ! ---------------------------------------
......
...@@ -114,9 +114,9 @@ CONTAINS ...@@ -114,9 +114,9 @@ CONTAINS
zrhs_u = - grav * ( ssh(ji+1,jj,Nnn) - ssh(ji,jj,Nnn) ) * r1_e1u(ji,jj) zrhs_u = - grav * ( ssh(ji+1,jj,Nnn) - ssh(ji,jj,Nnn) ) * r1_e1u(ji,jj)
zrhs_v = - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) * r1_e2v(ji,jj) zrhs_v = - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) * r1_e2v(ji,jj)
! ! wind stress and layer friction ! ! wind stress and layer friction
zrhs_u = zrhs_u + z1_2rho0 * ( utau_b(ji,jj) + utau(ji,jj) ) / e3u(ji,jj,jk,Nnn) & zrhs_u = zrhs_u + z1_2rho0 * ( utau_b(ji,jj) + utauU(ji,jj) ) / e3u(ji,jj,jk,Nnn) &
& - rn_rfr * uu(ji,jj,jk,Nbb) & - rn_rfr * uu(ji,jj,jk,Nbb)
zrhs_v = zrhs_v + z1_2rho0 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / e3v(ji,jj,jk,Nnn) & zrhs_v = zrhs_v + z1_2rho0 * ( vtau_b(ji,jj) + vtauV(ji,jj) ) / e3v(ji,jj,jk,Nnn) &
& - rn_rfr * vv(ji,jj,jk,Nbb) & - rn_rfr * vv(ji,jj,jk,Nbb)
! ! ==> RHS ! ! ==> RHS
uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) + zrhs_u uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) + zrhs_u
......
...@@ -135,9 +135,9 @@ CONTAINS ...@@ -135,9 +135,9 @@ CONTAINS
zrhs_v = - grav * ( ssh(ji,jj+1,Nbb) - ssh(ji,jj,Nbb) ) * r1_e2v(ji,jj) zrhs_v = - grav * ( ssh(ji,jj+1,Nbb) - ssh(ji,jj,Nbb) ) * r1_e2v(ji,jj)
#if defined key_RK3all #if defined key_RK3all
! ! wind stress and layer friction ! ! wind stress and layer friction
zrhs_u = zrhs_u + r1_rho0 * ( z5_6*utau_b(ji,jj) + (1._wp - z5_6)*utau(ji,jj) ) / e3u(ji,jj,jk,Nbb) & zrhs_u = zrhs_u + r1_rho0 * ( z5_6*utau_b(ji,jj) + (1._wp - z5_6)*utauU(ji,jj) ) / e3u(ji,jj,jk,Nbb) &
& - rn_rfr * uu(ji,jj,jk,Nbb) & - rn_rfr * uu(ji,jj,jk,Nbb)
zrhs_v = zrhs_v + r1_rho0 * ( z5_6*vtau_b(ji,jj) + (1._wp - z5_6)*vtau(ji,jj) ) / e3v(ji,jj,jk,Nbb) & zrhs_v = zrhs_v + r1_rho0 * ( z5_6*vtau_b(ji,jj) + (1._wp - z5_6)*vtauV(ji,jj) ) / e3v(ji,jj,jk,Nbb) &
& - rn_rfr * vv(ji,jj,jk,Nbb) & - rn_rfr * vv(ji,jj,jk,Nbb)
#endif #endif
! ! ==> RHS ! ! ==> RHS
...@@ -201,9 +201,9 @@ CONTAINS ...@@ -201,9 +201,9 @@ CONTAINS
zrhs_v = - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) * r1_e2v(ji,jj) zrhs_v = - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) * r1_e2v(ji,jj)
#if defined key_RK3all #if defined key_RK3all
! ! wind stress and layer friction ! ! wind stress and layer friction
zrhs_u = zrhs_u + r1_rho0 * ( z3_4*utau_b(ji,jj) + (1._wp - z3_4)*utau(ji,jj) ) / e3u(ji,jj,jk,Nnn) & zrhs_u = zrhs_u + r1_rho0 * ( z3_4*utau_b(ji,jj) + (1._wp - z3_4)*utauU(ji,jj) ) / e3u(ji,jj,jk,Nnn) &
& - rn_rfr * uu(ji,jj,jk,Nbb) & - rn_rfr * uu(ji,jj,jk,Nbb)
zrhs_v = zrhs_v + r1_rho0 * ( z3_4*vtau_b(ji,jj) + (1._wp - z3_4)*vtau(ji,jj) ) / e3v(ji,jj,jk,Nnn) & zrhs_v = zrhs_v + r1_rho0 * ( z3_4*vtau_b(ji,jj) + (1._wp - z3_4)*vtauV(ji,jj) ) / e3v(ji,jj,jk,Nnn) &
& - rn_rfr * vv(ji,jj,jk,Nbb) & - rn_rfr * vv(ji,jj,jk,Nbb)
#endif #endif
! ! ==> RHS ! ! ==> RHS
...@@ -265,9 +265,9 @@ CONTAINS ...@@ -265,9 +265,9 @@ CONTAINS
zrhs_u = - grav * ( ssh(ji+1,jj,Nnn) - ssh(ji,jj,Nnn) ) * r1_e1u(ji,jj) zrhs_u = - grav * ( ssh(ji+1,jj,Nnn) - ssh(ji,jj,Nnn) ) * r1_e1u(ji,jj)
zrhs_v = - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) * r1_e2v(ji,jj) zrhs_v = - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) * r1_e2v(ji,jj)
! ! wind stress and layer friction ! ! wind stress and layer friction
zrhs_u = zrhs_u + z1_2rho0 * ( utau_b(ji,jj) + utau(ji,jj) ) / e3u(ji,jj,jk,Nnn) & zrhs_u = zrhs_u + z1_2rho0 * ( utau_b(ji,jj) + utauU(ji,jj) ) / e3u(ji,jj,jk,Nnn) &
& - rn_rfr * uu(ji,jj,jk,Nbb) & - rn_rfr * uu(ji,jj,jk,Nbb)
zrhs_v = zrhs_v + z1_2rho0 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / e3v(ji,jj,jk,Nnn) & zrhs_v = zrhs_v + z1_2rho0 * ( vtau_b(ji,jj) + vtauV(ji,jj) ) / e3v(ji,jj,jk,Nnn) &
& - rn_rfr * vv(ji,jj,jk,Nbb) & - rn_rfr * vv(ji,jj,jk,Nbb)
! ! ==> RHS ! ! ==> RHS
uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) + zrhs_u uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) + zrhs_u
......
...@@ -46,7 +46,7 @@ CONTAINS ...@@ -46,7 +46,7 @@ CONTAINS
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
INTEGER, INTENT(in) :: kt ! ocean time-step index INTEGER, INTENT(in) :: kt ! ocean time-step index
INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! ocean time level INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! ocean time level
INTEGER :: jn, jk ! dummy loop index INTEGER :: jk ! dummy loop index
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
IF( ln_timing ) CALL timing_start('trc_sms_age') IF( ln_timing ) CALL timing_start('trc_sms_age')
...@@ -74,7 +74,7 @@ CONTAINS ...@@ -74,7 +74,7 @@ CONTAINS
tr(:,:,jk,jp_age,Krhs) = tmask(:,:,jk) * rryear tr(:,:,jk,jp_age,Krhs) = tmask(:,:,jk) * rryear
END DO END DO
! !
IF( l_trdtrc ) CALL trd_trc( tr(:,:,:,jp_age,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends IF( l_trdtrc ) CALL trd_trc( tr(:,:,:,jp_age,Krhs), jp_age, jptra_sms, kt, Kmm ) ! save trends
! !
IF( ln_timing ) CALL timing_stop('trc_sms_age') IF( ln_timing ) CALL timing_stop('trc_sms_age')
! !
......
...@@ -28,7 +28,6 @@ CONTAINS ...@@ -28,7 +28,6 @@ CONTAINS
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
INTEGER, INTENT(in) :: Kmm ! time level indices INTEGER, INTENT(in) :: Kmm ! time level indices
CHARACTER (len=20) :: cltra CHARACTER (len=20) :: cltra
INTEGER :: jn
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
! write the tracer concentrations in the file ! write the tracer concentrations in the file
......
...@@ -70,7 +70,7 @@ CONTAINS ...@@ -70,7 +70,7 @@ CONTAINS
! PISCES part ! PISCES part
IF( ln_p4z ) THEN IF( ln_p4z ) THEN
! !
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) DO_3D( 0, 0, 0, 0, 1, jpkm1 )
! !
zfact = xstep * xdiss(ji,jj,jk) zfact = xstep * xdiss(ji,jj,jk)
! Part I : Coagulation dependent on turbulence ! Part I : Coagulation dependent on turbulence
...@@ -117,7 +117,7 @@ CONTAINS ...@@ -117,7 +117,7 @@ CONTAINS
ELSE ! ln_p5z ELSE ! ln_p5z
! PISCES-QUOTA part ! PISCES-QUOTA part
! !
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) DO_3D( 0, 0, 0, 0, 1, jpkm1 )
! !
zfact = xstep * xdiss(ji,jj,jk) zfact = xstep * xdiss(ji,jj,jk)
! Part I : Coagulation dependent on turbulence ! Part I : Coagulation dependent on turbulence
......
...@@ -99,7 +99,7 @@ CONTAINS ...@@ -99,7 +99,7 @@ CONTAINS
! Atmospheric input of Iron dissolves in the water column ! Atmospheric input of Iron dissolves in the water column
IF ( ln_trc_sbc(jpfer) ) THEN IF ( ln_trc_sbc(jpfer) ) THEN
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 ) DO_3D( 0, 0, 0, 0, 2, jpkm1 )
zdustdep = dust(ji,jj) * zwdust * rfact * EXP( -gdept(ji,jj,jk,Kmm) /( 250. * wdust ) ) zdustdep = dust(ji,jj) * zwdust * rfact * EXP( -gdept(ji,jj,jk,Kmm) /( 250. * wdust ) )
! !
tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zdustdep * mfrac / mMass_Fe tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zdustdep * mfrac / mMass_Fe
...@@ -116,7 +116,7 @@ CONTAINS ...@@ -116,7 +116,7 @@ CONTAINS
! Atmospheric input of PO4 dissolves in the water column ! Atmospheric input of PO4 dissolves in the water column
IF ( ln_trc_sbc(jppo4) ) THEN IF ( ln_trc_sbc(jppo4) ) THEN
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 ) DO_3D( 0, 0, 0, 0, 2, jpkm1 )
zdustdep = dust(ji,jj) * zwdust * rfact * EXP( -gdept(ji,jj,jk,Kmm) /( 250. * wdust ) ) zdustdep = dust(ji,jj) * zwdust * rfact * EXP( -gdept(ji,jj,jk,Kmm) /( 250. * wdust ) )
! !
tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zdustdep * 1.e-3 / mMass_P tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zdustdep * 1.e-3 / mMass_P
...@@ -125,7 +125,7 @@ CONTAINS ...@@ -125,7 +125,7 @@ CONTAINS
! Atmospheric input of Si dissolves in the water column ! Atmospheric input of Si dissolves in the water column
IF ( ln_trc_sbc(jpsil) ) THEN IF ( ln_trc_sbc(jpsil) ) THEN
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 ) DO_3D( 0, 0, 0, 0, 2, jpkm1 )
zdustdep = dust(ji,jj) * zwdust * rfact * EXP( -gdept(ji,jj,jk,Kmm) /( 250. * wdust ) ) zdustdep = dust(ji,jj) * zwdust * rfact * EXP( -gdept(ji,jj,jk,Kmm) /( 250. * wdust ) )
! !
tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) + zdustdep * 0.269 / mMass_Si tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) + zdustdep * 0.269 / mMass_Si
...@@ -144,7 +144,7 @@ CONTAINS ...@@ -144,7 +144,7 @@ CONTAINS
! ---------------------------------------------------------- ! ----------------------------------------------------------
IF( ll_river ) THEN IF( ll_river ) THEN
jl = n_trc_indcbc(jpno3) jl = n_trc_indcbc(jpno3)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
DO jk = 1, nk_rnf(ji,jj) DO jk = 1, nk_rnf(ji,jj)
zcoef = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1) zcoef = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1)
zrivdin = rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zcoef zrivdin = rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zcoef
...@@ -158,14 +158,14 @@ CONTAINS ...@@ -158,14 +158,14 @@ CONTAINS
IF( ll_ndepo ) THEN IF( ll_ndepo ) THEN
IF( ln_trc_sbc(jpno3) ) THEN IF( ln_trc_sbc(jpno3) ) THEN
jl = n_trc_indsbc(jpno3) jl = n_trc_indsbc(jpno3)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zndep = rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) / e3t(ji,jj,1,Kmm) / rn_sbc_time zndep = rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) / e3t(ji,jj,1,Kmm) / rn_sbc_time
tr(ji,jj,1,jptal,Krhs) = tr(ji,jj,1,jptal,Krhs) - rno3 * zndep * rfact tr(ji,jj,1,jptal,Krhs) = tr(ji,jj,1,jptal,Krhs) - rno3 * zndep * rfact
END_2D END_2D
ENDIF ENDIF
IF( ln_trc_sbc(jpnh4) ) THEN IF( ln_trc_sbc(jpnh4) ) THEN
jl = n_trc_indsbc(jpnh4) jl = n_trc_indsbc(jpnh4)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zndep = rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) / e3t(ji,jj,1,Kmm) / rn_sbc_time zndep = rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) / e3t(ji,jj,1,Kmm) / rn_sbc_time
tr(ji,jj,1,jptal,Krhs) = tr(ji,jj,1,jptal,Krhs) + rno3 * zndep * rfact tr(ji,jj,1,jptal,Krhs) = tr(ji,jj,1,jptal,Krhs) + rno3 * zndep * rfact
END_2D END_2D
...@@ -183,7 +183,7 @@ CONTAINS ...@@ -183,7 +183,7 @@ CONTAINS
! Simple parameterization assuming a fixed constant concentration in ! Simple parameterization assuming a fixed constant concentration in
! sea-ice (icefeinput) ! sea-ice (icefeinput)
! ------------------------------------------------------------------ ! ------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zdep = rfact / e3t(ji,jj,1,Kmm) zdep = rfact / e3t(ji,jj,1,Kmm)
zwflux = fmmflx(ji,jj) / 1000._wp zwflux = fmmflx(ji,jj) / 1000._wp
zironice = MAX( -0.99 * tr(ji,jj,1,jpfer,Kbb), -zwflux * icefeinput * zdep ) zironice = MAX( -0.99 * tr(ji,jj,1,jpfer,Kbb), -zwflux * icefeinput * zdep )
...@@ -350,7 +350,7 @@ CONTAINS ...@@ -350,7 +350,7 @@ CONTAINS
! !
CALL lbc_lnk( 'p4zbc', zcmask , 'T', 1.0_wp ) ! lateral boundary conditions on cmask (sign unchanged) CALL lbc_lnk( 'p4zbc', zcmask , 'T', 1.0_wp ) ! lateral boundary conditions on cmask (sign unchanged)
! !
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zexpide = MIN( 8.,( gdept(ji,jj,jk,Kmm) / 500. )**(-1.5) ) zexpide = MIN( 8.,( gdept(ji,jj,jk,Kmm) / 500. )**(-1.5) )
zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2
zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 )
......
...@@ -179,7 +179,7 @@ CONTAINS ...@@ -179,7 +179,7 @@ CONTAINS
! potential temperature to in situ temperature. The errors is less than ! potential temperature to in situ temperature. The errors is less than
! 0.04°C relative to an exact computation ! 0.04°C relative to an exact computation
! --------------------------------------------------------------------- ! ---------------------------------------------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) DO_3D( 0, 0, 0, 0, 1, jpk )
zpres = gdept(ji,jj,jk,Kmm) / 1000. zpres = gdept(ji,jj,jk,Kmm) / 1000.
za1 = 0.04 * ( 1.0 + 0.185 * ts(ji,jj,jk,jp_tem,Kmm) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) za1 = 0.04 * ( 1.0 + 0.185 * ts(ji,jj,jk,jp_tem,Kmm) + 0.035 * (salinprac(ji,jj,jk) - 35.0) )
za2 = 0.0075 * ( 1.0 - ts(ji,jj,jk,jp_tem,Kmm) / 30.0 ) za2 = 0.0075 * ( 1.0 - ts(ji,jj,jk,jp_tem,Kmm) / 30.0 )
...@@ -188,7 +188,7 @@ CONTAINS ...@@ -188,7 +188,7 @@ CONTAINS
! !
! CHEMICAL CONSTANTS - SURFACE LAYER ! CHEMICAL CONSTANTS - SURFACE LAYER
! ---------------------------------- ! ----------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
! ! SET ABSOLUTE TEMPERATURE ! ! SET ABSOLUTE TEMPERATURE
ztkel = tempis(ji,jj,1) + 273.15 ztkel = tempis(ji,jj,1) + 273.15
zt = ztkel * 0.01 zt = ztkel * 0.01
...@@ -216,7 +216,7 @@ CONTAINS ...@@ -216,7 +216,7 @@ CONTAINS
! OXYGEN SOLUBILITY - DEEP OCEAN ! OXYGEN SOLUBILITY - DEEP OCEAN
! ------------------------------- ! -------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) DO_3D( 0, 0, 0, 0, 1, jpk )
ztkel = tempis(ji,jj,jk) + 273.15 ztkel = tempis(ji,jj,jk) + 273.15
zsal = salinprac(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 35. zsal = salinprac(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 35.
zsal2 = zsal * zsal zsal2 = zsal * zsal
...@@ -235,7 +235,7 @@ CONTAINS ...@@ -235,7 +235,7 @@ CONTAINS
! CHEMICAL CONSTANTS - DEEP OCEAN ! CHEMICAL CONSTANTS - DEEP OCEAN
! ------------------------------- ! -------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) DO_3D( 0, 0, 0, 0, 1, jpk )
! SET PRESSION ACCORDING TO SAUNDER (1980) ! SET PRESSION ACCORDING TO SAUNDER (1980)
zplat = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) ) zplat = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) )
zc1 = 5.92E-3 + zplat**2 * 5.25E-3 zc1 = 5.92E-3 + zplat**2 * 5.25E-3
...@@ -452,7 +452,7 @@ CONTAINS ...@@ -452,7 +452,7 @@ CONTAINS
!! and the 2nd order approximation does not have !! and the 2nd order approximation does not have
!! a solution !! a solution
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_hini REAL(wp), DIMENSION(A2D(0),jpk), INTENT(OUT) :: p_hini
INTEGER, INTENT(in) :: Kbb ! time level indices INTEGER, INTENT(in) :: Kbb ! time level indices
INTEGER :: ji, jj, jk INTEGER :: ji, jj, jk
REAL(wp) :: zca1, zba1 REAL(wp) :: zca1, zba1
...@@ -463,7 +463,7 @@ CONTAINS ...@@ -463,7 +463,7 @@ CONTAINS
IF( ln_timing ) CALL timing_start('ahini_for_at') IF( ln_timing ) CALL timing_start('ahini_for_at')
! !
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) DO_3D( 0, 0, 0, 0, 1, jpk )
zrhd = 1._wp / ( rhd(ji,jj,jk) + 1. ) zrhd = 1._wp / ( rhd(ji,jj,jk) + 1. )
p_alkcb = tr(ji,jj,jk,jptal,Kbb) * zrhd p_alkcb = tr(ji,jj,jk,jptal,Kbb) * zrhd
p_dictot = tr(ji,jj,jk,jpdic,Kbb) * zrhd p_dictot = tr(ji,jj,jk,jpdic,Kbb) * zrhd
...@@ -512,13 +512,13 @@ CONTAINS ...@@ -512,13 +512,13 @@ CONTAINS
! inf(TA - [OH-] + [H+]) and sup(TA - [OH-] + [H+]) ! inf(TA - [OH-] + [H+]) and sup(TA - [OH-] + [H+])
! Argument variables ! Argument variables
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf REAL(wp), DIMENSION(A2D(0),jpk), INTENT(OUT) :: p_alknw_inf
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup REAL(wp), DIMENSION(A2D(0),jpk), INTENT(OUT) :: p_alknw_sup
INTEGER, INTENT(in) :: Kbb ! time level indices INTEGER, INTENT(in) :: Kbb ! time level indices
INTEGER :: ji, jj, jk INTEGER :: ji, jj, jk
REAL(wp) :: zrhd REAL(wp) :: zrhd
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) DO_3D( 0, 0, 0, 0, 1, jpk )
zrhd = 1._wp / ( rhd(ji,jj,jk) + 1. ) zrhd = 1._wp / ( rhd(ji,jj,jk) + 1. )
p_alknw_inf(ji,jj,jk) = -tr(ji,jj,jk,jppo4,Kbb) * zrhd - sulfat(ji,jj,jk) & p_alknw_inf(ji,jj,jk) = -tr(ji,jj,jk,jppo4,Kbb) * zrhd - sulfat(ji,jj,jk) &
& - fluorid(ji,jj,jk) & - fluorid(ji,jj,jk)
...@@ -536,8 +536,8 @@ CONTAINS ...@@ -536,8 +536,8 @@ CONTAINS
! Argument variables ! Argument variables
!-------------------- !--------------------
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: p_hini REAL(wp), DIMENSION(A2D(0),jpk), INTENT(IN) :: p_hini
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: zhi REAL(wp), DIMENSION(A2D(0),jpk), INTENT(OUT) :: zhi
INTEGER, INTENT(in) :: Kbb ! time level indices INTEGER, INTENT(in) :: Kbb ! time level indices
! Local variables ! Local variables
...@@ -557,17 +557,17 @@ CONTAINS ...@@ -557,17 +557,17 @@ CONTAINS
REAL(wp) :: zrhd, p_alktot, zdic, zbot, zpt, zst, zft, zsit REAL(wp) :: zrhd, p_alktot, zdic, zbot, zpt, zst, zft, zsit
LOGICAL :: l_exitnow LOGICAL :: l_exitnow
REAL(wp), PARAMETER :: pz_exp_threshold = 1.0 REAL(wp), PARAMETER :: pz_exp_threshold = 1.0
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zalknw_inf, zalknw_sup, rmask, zh_min, zh_max, zeqn_absmin REAL(wp), DIMENSION(A2D(0),jpk) :: zalknw_inf, zalknw_sup, rmask, zh_min, zh_max, zeqn_absmin
IF( ln_timing ) CALL timing_start('solve_at_general') IF( ln_timing ) CALL timing_start('solve_at_general')
CALL anw_infsup( zalknw_inf, zalknw_sup, Kbb ) CALL anw_infsup( zalknw_inf, zalknw_sup, Kbb )
rmask(:,:,:) = tmask(:,:,:) rmask(A2D(0),1:jpk) = tmask(A2D(0),1:jpk)
zhi(:,:,:) = 0. zhi(:,:,:) = 0.
! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) DO_3D( 0, 0, 0, 0, 1, jpk )
IF (rmask(ji,jj,jk) == 1.) THEN IF (rmask(ji,jj,jk) == 1.) THEN
zrhd = 1._wp / ( rhd(ji,jj,jk) + 1. ) zrhd = 1._wp / ( rhd(ji,jj,jk) + 1. )
p_alktot = tr(ji,jj,jk,jptal,Kbb) * zrhd p_alktot = tr(ji,jj,jk,jptal,Kbb) * zrhd
...@@ -597,7 +597,7 @@ CONTAINS ...@@ -597,7 +597,7 @@ CONTAINS
zeqn_absmin(:,:,:) = HUGE(1._wp) zeqn_absmin(:,:,:) = HUGE(1._wp)
DO jn = 1, jp_maxniter_atgen DO jn = 1, jp_maxniter_atgen
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) DO_3D( 0, 0, 0, 0, 1, jpk )
IF (rmask(ji,jj,jk) == 1.) THEN IF (rmask(ji,jj,jk) == 1.) THEN
zrhd = 1._wp / ( rhd(ji,jj,jk) + 1. ) zrhd = 1._wp / ( rhd(ji,jj,jk) + 1. )
p_alktot = tr(ji,jj,jk,jptal,Kbb) * zrhd p_alktot = tr(ji,jj,jk,jptal,Kbb) * zrhd
...@@ -799,7 +799,7 @@ CONTAINS ...@@ -799,7 +799,7 @@ CONTAINS
ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk), STAT=ierr(1) ) ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk), STAT=ierr(1) )
ALLOCATE( akb3(jpi,jpj,jpk) , tempis(jpi, jpj, jpk), & ALLOCATE( akb3(jpi,jpj,jpk) , tempis(jpi,jpj,jpk), &
& akw3(jpi,jpj,jpk) , borat (jpi,jpj,jpk) , & & akw3(jpi,jpj,jpk) , borat (jpi,jpj,jpk) , &
& aks3(jpi,jpj,jpk) , akf3(jpi,jpj,jpk) , & & aks3(jpi,jpj,jpk) , akf3(jpi,jpj,jpk) , &
& ak1p3(jpi,jpj,jpk) , ak2p3(jpi,jpj,jpk) , & & ak1p3(jpi,jpj,jpk) , ak2p3(jpi,jpj,jpk) , &
......
...@@ -53,7 +53,7 @@ CONTAINS ...@@ -53,7 +53,7 @@ CONTAINS
! Computation of the silicon dependant half saturation constant for silica uptake ! Computation of the silicon dependant half saturation constant for silica uptake
! This is based on an old study by Pondaven et al. (1998) ! This is based on an old study by Pondaven et al. (1998)
! -------------------------------------------------------------------------------- ! --------------------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zvar = tr(ji,jj,1,jpsil,Kbb) * tr(ji,jj,1,jpsil,Kbb) zvar = tr(ji,jj,1,jpsil,Kbb) * tr(ji,jj,1,jpsil,Kbb)
xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 )
END_2D END_2D
...@@ -74,13 +74,13 @@ CONTAINS ...@@ -74,13 +74,13 @@ CONTAINS
! day length in hours ! day length in hours
strn(:,:) = 0. strn(:,:) = 0.
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
zargu = MAX( -1., MIN( 1., zargu ) ) zargu = MAX( -1., MIN( 1., zargu ) )
strn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) strn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
END_2D END_2D
! !
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) DO_3D( 0, 0, 0, 0, 1, jpkm1 )
! denitrification factor computed from O2 levels ! denitrification factor computed from O2 levels
! This factor diagnoses below which level of O2 denitrification ! This factor diagnoses below which level of O2 denitrification
! is active ! is active
......
This diff is collapsed.
This diff is collapsed.
...@@ -74,7 +74,7 @@ CONTAINS ...@@ -74,7 +74,7 @@ CONTAINS
IF( ln_timing ) CALL timing_start('p4z_mort_nano') IF( ln_timing ) CALL timing_start('p4z_mort_nano')
! !
prodcal(:,:,:) = 0._wp ! calcite production variable set to zero prodcal(:,:,:) = 0._wp ! calcite production variable set to zero
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 ) zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 )
! Quadratic mortality of nano due to aggregation during ! Quadratic mortality of nano due to aggregation during
...@@ -152,7 +152,7 @@ CONTAINS ...@@ -152,7 +152,7 @@ CONTAINS
! This is due to the production of EPS by stressed cells ! This is due to the production of EPS by stressed cells
! ------------------------------------------------------------- ! -------------------------------------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1e-9), 0. ) zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1e-9), 0. )
......
This diff is collapsed.
This diff is collapsed.
...@@ -80,7 +80,7 @@ CONTAINS ...@@ -80,7 +80,7 @@ CONTAINS
IF( ln_timing ) CALL timing_start('p5z_mort_nano') IF( ln_timing ) CALL timing_start('p5z_mort_nano')
! !
prodcal(:,:,:) = 0. !: calcite production variable set to zero prodcal(:,:,:) = 0. !: calcite production variable set to zero
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 ) zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 )
! Quadratic mortality of nano due to aggregation during ! Quadratic mortality of nano due to aggregation during
...@@ -151,7 +151,7 @@ CONTAINS ...@@ -151,7 +151,7 @@ CONTAINS
! !
IF( ln_timing ) CALL timing_start('p5z_mort_pico') IF( ln_timing ) CALL timing_start('p5z_mort_pico')
! !
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 ) zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 )
! Quadratic mortality of pico due to aggregation during ! Quadratic mortality of pico due to aggregation during
...@@ -215,7 +215,7 @@ CONTAINS ...@@ -215,7 +215,7 @@ CONTAINS
IF( ln_timing ) CALL timing_start('p5z_mort_diat') IF( ln_timing ) CALL timing_start('p5z_mort_diat')
! !
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. ) zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. )
......
...@@ -124,6 +124,8 @@ MODULE sms_pisces ...@@ -124,6 +124,8 @@ MODULE sms_pisces
LOGICAL, SAVE :: lk_sed LOGICAL, SAVE :: lk_sed
!! * Substitutions
# include "do_loop_substitute.h90"
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018) !! NEMO/TOP 4.0 , NEMO Consortium (2018)
!! $Id: sms_pisces.F90 15459 2021-10-29 08:19:18Z cetlod $ !! $Id: sms_pisces.F90 15459 2021-10-29 08:19:18Z cetlod $
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.