Skip to content
Snippets Groups Projects

Compare revisions

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

Source

Select target project
No results found

Target

Select target project
  • nemo/nemo
  • sparonuz/nemo
  • hatfield/nemo
  • extdevs/nemo
4 results
Show changes
Hide whitespace changes
Inline Side-by-side
Showing
with 149 additions and 155 deletions
src/TOP/trcbc.F90
View file @ c72255b2
...@@ -414,7 +414,7 @@ CONTAINS ...@@ -414,7 +414,7 @@ CONTAINS
! !
! Remove river dilution for tracers with absent river load ! Remove river dilution for tracers with absent river load
IF( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN IF( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN
DO_2D( 0, 0, 0, 1 ) DO_2D( 0, 0, 0, 0 )
DO jk = 1, nk_rnf(ji,jj) DO jk = 1, nk_rnf(ji,jj)
#if defined key_RK3 #if defined key_RK3
zrnf = rnf(ji,jj) * r1_rho0 / h_rnf(ji,jj) zrnf = rnf(ji,jj) * r1_rho0 / h_rnf(ji,jj)
...@@ -432,7 +432,7 @@ CONTAINS ...@@ -432,7 +432,7 @@ CONTAINS
IF( ln_trc_sbc(jn) ) THEN IF( ln_trc_sbc(jn) ) THEN
jl = n_trc_indsbc(jn) jl = n_trc_indsbc(jn)
sf_trcsbc(jl)%fnow(:,:,1) = MAX( rtrn, sf_trcsbc(jl)%fnow(:,:,1) ) ! avoid nedgative value due to interpolation sf_trcsbc(jl)%fnow(:,:,1) = MAX( rtrn, sf_trcsbc(jl)%fnow(:,:,1) ) ! avoid nedgative value due to interpolation
DO_2D( 0, 0, 0, 1 ) DO_2D( 0, 0, 0, 0 )
zfact = 1. / ( e3t(ji,jj,1,Kmm) * rn_sbc_time ) zfact = 1. / ( e3t(ji,jj,1,Kmm) * rn_sbc_time )
ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact
END_2D END_2D
...@@ -443,7 +443,7 @@ CONTAINS ...@@ -443,7 +443,7 @@ CONTAINS
IF( l_offline ) rn_rfact = 1._wp IF( l_offline ) rn_rfact = 1._wp
jl = n_trc_indcbc(jn) jl = n_trc_indcbc(jn)
sf_trccbc(jl)%fnow(:,:,1) = MAX( rtrn, sf_trccbc(jl)%fnow(:,:,1) ) ! avoid nedgative value due to interpolation sf_trccbc(jl)%fnow(:,:,1) = MAX( rtrn, sf_trccbc(jl)%fnow(:,:,1) ) ! avoid nedgative value due to interpolation
DO_2D( 0, 0, 0, 1 ) DO_2D( 0, 0, 0, 0 )
DO jk = 1, nk_rnf(ji,jj) DO jk = 1, nk_rnf(ji,jj)
zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time )
ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact
......
src/TOP/trcini.F90
View file @ c72255b2
...@@ -32,6 +32,8 @@ MODULE trcini ...@@ -32,6 +32,8 @@ MODULE trcini
PUBLIC trc_init ! called by opa PUBLIC trc_init ! called by opa
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90" # include "domzgr_substitute.h90"
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018) !! NEMO/TOP 4.0 , NEMO Consortium (2018)
...@@ -93,9 +95,8 @@ CONTAINS ...@@ -93,9 +95,8 @@ CONTAINS
!! ** Purpose : passive tracers inventories at initialsation phase !! ** Purpose : passive tracers inventories at initialsation phase
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
INTEGER, INTENT(in) :: Kmm ! time level index INTEGER, INTENT(in) :: Kmm ! time level index
INTEGER :: jk, jn ! dummy loop indices INTEGER :: ji, jj, jk, jn ! dummy loop indices
CHARACTER (len=25) :: charout CHARACTER (len=25) :: charout
REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: zzmsk
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*)
......
src/TOP/trcnam.F90
View file @ c72255b2
...@@ -254,7 +254,12 @@ CONTAINS ...@@ -254,7 +254,12 @@ CONTAINS
WRITE(numout,*) ' Namelist : namtrc_dcy ' WRITE(numout,*) ' Namelist : namtrc_dcy '
WRITE(numout,*) ' Diurnal cycle for TOP ln_trcdc2dm = ', ln_trcdc2dm WRITE(numout,*) ' Diurnal cycle for TOP ln_trcdc2dm = ', ln_trcdc2dm
ENDIF ENDIF
! ! Define logical parameter ton control dirunal cycle in TOP
l_trcdm2dc = ( ln_trcdc2dm .AND. .NOT. ln_dm2dc )
!
IF( l_trcdm2dc .AND. lwp ) CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.', &
& 'Computation of a daily mean shortwave for some biogeochemical models ' )
!
END SUBROUTINE trc_nam_dcy END SUBROUTINE trc_nam_dcy
SUBROUTINE trc_nam_trd SUBROUTINE trc_nam_trd
......
src/TOP/trcopt.F90
View file @ c72255b2
...@@ -58,12 +58,14 @@ CONTAINS ...@@ -58,12 +58,14 @@ CONTAINS
INTEGER, INTENT(in) :: kt, knt ! ocean time step INTEGER, INTENT(in) :: kt, knt ! ocean time step
INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: zchl ! chlorophyll field REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: zchl ! chlorophyll field
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(out) :: ze1, ze2, ze3 ! PAR for individual wavelength REAL(wp), DIMENSION(A2D(0),jpk), INTENT(out) :: ze1, ze2, ze3 ! PAR for individual wavelength
! !
INTEGER :: ji, jj, jk, irgb INTEGER :: ji, jj, jk, irgb
REAL(wp) :: ztmp REAL(wp) :: ztmp
REAL(wp), DIMENSION(jpi,jpj ) :: parsw, zqsr100, zqsr_corr REAL(wp), DIMENSION(A2D(0) ) :: parsw, zqsr100, zqsr_corr
REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze0 REAL(wp), DIMENSION(A2D(0),jpk) :: ze0
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zw2d
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
! !
IF( ln_timing ) CALL timing_start('trc_opt') IF( ln_timing ) CALL timing_start('trc_opt')
...@@ -85,7 +87,7 @@ CONTAINS ...@@ -85,7 +87,7 @@ CONTAINS
! Attenuation coef. function of Chlorophyll and wavelength (RGB) ! Attenuation coef. function of Chlorophyll and wavelength (RGB)
! -------------------------------------------------------------- ! --------------------------------------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) DO_3D( 0, 0, 0, 0, 1, jpkm1)
ztmp = ( zchl(ji,jj,jk) + rtrn ) * 1.e6 ztmp = ( zchl(ji,jj,jk) + rtrn ) * 1.e6
ztmp = MIN( 10. , MAX( 0.05, ztmp ) ) ztmp = MIN( 10. , MAX( 0.05, ztmp ) )
irgb = NINT( 41 + 20.* LOG10( ztmp ) + rtrn ) irgb = NINT( 41 + 20.* LOG10( ztmp ) + rtrn )
...@@ -99,54 +101,63 @@ CONTAINS ...@@ -99,54 +101,63 @@ CONTAINS
! ----------------------------------------------- ! -----------------------------------------------
IF( ln_qsr_bio ) THEN IF( ln_qsr_bio ) THEN
! !
zqsr_corr(:,:) = parsw(:,:) * qsr(:,:) DO_2D( 0, 0, 0, 0 )
zqsr_corr(ji,jj) = parsw(ji,jj) * qsr(ji,jj)
END_2D
! !
ze0(:,:,1) = (1._wp - 3._wp * parsw(:,:)) * qsr(:,:) ! ( 1 - 3 * alpha ) * q DO_2D( 0, 0, 0, 0 )
ze0(ji,jj,1) = (1._wp - 3._wp * parsw(ji,jj)) * qsr(ji,jj) ! ( 1 - 3 * alpha ) * q
END_2D
ze1(:,:,1) = zqsr_corr(:,:) ze1(:,:,1) = zqsr_corr(:,:)
ze2(:,:,1) = zqsr_corr(:,:) ze2(:,:,1) = zqsr_corr(:,:)
ze3(:,:,1) = zqsr_corr(:,:) ze3(:,:,1) = zqsr_corr(:,:)
! !
DO jk = 2, nksrp + 1 DO_3D( 0, 0, 0, 0, 2, nksrp + 1 )
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ze0(ji,jj,jk) = ze0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * (1. / rn_si0) )
ze0(ji,jj,jk) = ze0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * (1. / rn_si0) ) ze1(ji,jj,jk) = ze1(ji,jj,jk-1) * EXP( -ekb (ji,jj,jk-1 ) )
ze1(ji,jj,jk) = ze1(ji,jj,jk-1) * EXP( -ekb (ji,jj,jk-1 ) ) ze2(ji,jj,jk) = ze2(ji,jj,jk-1) * EXP( -ekg (ji,jj,jk-1 ) )
ze2(ji,jj,jk) = ze2(ji,jj,jk-1) * EXP( -ekg (ji,jj,jk-1 ) ) ze3(ji,jj,jk) = ze3(ji,jj,jk-1) * EXP( -ekr (ji,jj,jk-1 ) )
ze3(ji,jj,jk) = ze3(ji,jj,jk-1) * EXP( -ekr (ji,jj,jk-1 ) ) END_3D
END_2D
END DO
! !
etot3(:,:,1) = qsr(:,:) * tmask(:,:,1) DO_2D( 0, 0, 0, 0 )
DO jk = 2, nksrp + 1 etot3(ji,jj,1) = qsr(ji,jj) * tmask(ji,jj,1)
etot3(:,:,jk) = ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk) END_2D
END DO DO_3D( 0, 0, 0, 0, 2, nksrp+1 )
etot3(ji,jj,jk) = ( ze0(ji,jj,jk) + ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk) ) * tmask(ji,jj,jk)
END_3D
! ! ------------------------ ! ! ------------------------
ENDIF ENDIF
! Photosynthetically Available Radiation (PAR) ! Photosynthetically Available Radiation (PAR)
! -------------------------------------------- ! --------------------------------------------
zqsr_corr(:,:) = parsw(:,:) * qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) DO_2D( 0, 0, 0, 0 )
zqsr_corr(ji,jj) = parsw(ji,jj) * qsr(ji,jj) / ( 1.-fr_i(ji,jj) + rtrn )
END_2D
! !
CALL trc_opt_par( kt, zqsr_corr, ze1, ze2, ze3 ) CALL trc_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )
! !
DO jk = 1, nksrp DO_3D( 0, 0, 0, 0, 1, nksr )
etot (:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) etot(ji,jj,jk) = ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk)
ENDDO END_3D
! No Diurnal cycle PAR ! No Diurnal cycle PAR
IF( l_trcdm2dc ) THEN IF( l_trcdm2dc ) THEN
zqsr_corr(:,:) = parsw(:,:) * qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn ) DO_2D( 0, 0, 0, 0 )
zqsr_corr(ji,jj) = parsw(ji,jj) * qsr_mean(ji,jj) / ( 1.-fr_i(ji,jj) + rtrn )
END_2D
! !
CALL trc_opt_par( kt, zqsr_corr, ze1, ze2, ze3 ) CALL trc_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )
DO jk = 1, nksrp !
etot_ndcy(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) DO_3D( 0, 0, 0, 0, 1, nksr )
END DO etot_ndcy(ji,jj,jk) = ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk)
END_3D
ELSE ELSE
etot_ndcy(:,:,:) = etot(:,:,:) etot_ndcy(:,:,:) = etot(:,:,:)
ENDIF ENDIF
! Weighted broadband attenuation coefficient ! Weighted broadband attenuation coefficient
! ------------------------------------------ ! ------------------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) DO_3D( 0, 0, 0, 0, 1, jpkm1 )
ztmp = ze1(ji,jj,jk)* ekb(ji,jj,jk) + ze2(ji,jj,jk) * ekg(ji,jj,jk) + ze3(ji,jj,jk) * ekr(ji,jj,jk) ztmp = ze1(ji,jj,jk)* ekb(ji,jj,jk) + ze2(ji,jj,jk) * ekg(ji,jj,jk) + ze3(ji,jj,jk) * ekr(ji,jj,jk)
zeps(ji,jj,jk) = ztmp / e3t(ji,jj,jk,Kmm) / (etot(ji,jj,jk) + rtrn) zeps(ji,jj,jk) = ztmp / e3t(ji,jj,jk,Kmm) / (etot(ji,jj,jk) + rtrn)
END_3D END_3D
...@@ -154,26 +165,24 @@ CONTAINS ...@@ -154,26 +165,24 @@ CONTAINS
! Light at the euphotic depth ! Light at the euphotic depth
! --------------------------- ! ---------------------------
zqsr100 = 0.01 * 3. * zqsr_corr(:,:) zqsr100(:,:) = 0.01 * 3. * zqsr_corr(:,:)
! Euphotic depth and level ! Euphotic depth and level
! ------------------------ ! ------------------------
neln (:,:) = 1 DO_2D( 0, 0, 0, 0 )
heup (:,:) = gdepw(:,:,2,Kmm) neln (ji,jj) = 1
heup_01(:,:) = gdepw(:,:,2,Kmm) heup (ji,jj) = gdepw(ji,jj,2,Kmm)
! heup_01(ji,jj) = gdepw(ji,jj,2,Kmm)
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksrp ) END_2D
DO_3D( 0, 0, 0, 0, 2, nksr)
IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) ) THEN IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) ) THEN
! Euphotic level (1st T-level strictly below Euphotic layer) neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer
! NOTE: ensure compatibility with nmld_trc definition in trdmxl_trc ! ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint
neln(ji,jj) = jk+1 heup(ji,jj) = gdepw(ji,jj,jk+1,Kmm) ! Euphotic layer depth
!
! Euphotic layer depth
heup(ji,jj) = gdepw(ji,jj,jk+1,Kmm)
ENDIF ENDIF
! Euphotic layer depth (light level definition) IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.10 ) THEN
IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 ) THEN heup_01(ji,jj) = gdepw(ji,jj,jk+1,Kmm) ! Euphotic layer depth (light level definition)
heup_01(ji,jj) = gdepw(ji,jj,jk+1,Kmm)
ENDIF ENDIF
END_3D END_3D
! !
...@@ -181,8 +190,18 @@ CONTAINS ...@@ -181,8 +190,18 @@ CONTAINS
heup_01(:,:) = MIN( 300., heup_01(:,:) ) heup_01(:,:) = MIN( 300., heup_01(:,:) )
! !
IF( lk_iomput ) THEN IF( lk_iomput ) THEN
CALL iom_put( "xbla" , zeps(:,:,:) * tmask(:,:,:) ) IF( iom_use( "Heup" ) ) THEN
CALL iom_put( "Heup" , heup(:,: ) * tmask(:,:,1) ) ALLOCATE( zw2d(A2D(0)) )
zw2d(A2D(0)) = heup(A2D(0)) * tmask(A2D(0),1)
CALL iom_put( "Heup", zw2d ) ! Euphotic layer depth
DEALLOCATE( zw2d )
ENDIF
IF( iom_use( "xbla" ) ) THEN
ALLOCATE( zw3d(A2D(0),jpk)) ; zw3d(A2D(0),jpk) = 0._wp
zw3d(A2D(0),1:jpkm1) = zeps(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "xbla", zw3d ) ! Euphotic layer depth
DEALLOCATE( zw3d )
ENDIF
ENDIF ENDIF
! !
IF( ln_timing ) CALL timing_stop('trc_opt') IF( ln_timing ) CALL timing_stop('trc_opt')
...@@ -199,11 +218,11 @@ CONTAINS ...@@ -199,11 +218,11 @@ CONTAINS
!! !!
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
INTEGER , INTENT(in) :: kt ! ocean time-step INTEGER , INTENT(in) :: kt ! ocean time-step
REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: zqsr ! real shortwave REAL(wp), DIMENSION(A2D(0)) , INTENT(in) :: zqsr ! real shortwave
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(out) :: pe1 , pe2 , pe3 ! PAR (R-G-B) REAL(wp), DIMENSION(A2D(0),jpk), INTENT(out) :: pe1 , pe2 , pe3 ! PAR (R-G-B)
! !
INTEGER :: ji, jj, jk ! dummy loop indices INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp), DIMENSION(jpi,jpj) :: we1, we2, we3 ! PAR (R-G-B) at w-level REAL(wp), DIMENSION(A2D(0)) :: we1, we2, we3 ! PAR (R-G-B) at w-level
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
pe1(:,:,:) = 0. ; pe2(:,:,:) = 0. ; pe3(:,:,:) = 0. pe1(:,:,:) = 0. ; pe2(:,:,:) = 0. ; pe3(:,:,:) = 0.
! !
...@@ -213,7 +232,7 @@ CONTAINS ...@@ -213,7 +232,7 @@ CONTAINS
pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) ) pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) )
pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) )
! !
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksrp ) DO_3D( 0, 0, 0, 0, 2, nksrp )
pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) )
pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) )
pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) ) pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) )
...@@ -225,7 +244,7 @@ CONTAINS ...@@ -225,7 +244,7 @@ CONTAINS
we2(:,:) = zqsr(:,:) we2(:,:) = zqsr(:,:)
we3(:,:) = zqsr(:,:) we3(:,:) = zqsr(:,:)
! !
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksrp ) DO_3D( 0, 0, 0, 0, 1, nksrp )
! integrate PAR over current t-level ! integrate PAR over current t-level
pe1(ji,jj,jk) = we1(ji,jj) / (ekb(ji,jj,jk) + rtrn) * (1. - EXP( -ekb(ji,jj,jk) )) pe1(ji,jj,jk) = we1(ji,jj) / (ekb(ji,jj,jk) + rtrn) * (1. - EXP( -ekb(ji,jj,jk) ))
pe2(ji,jj,jk) = we2(ji,jj) / (ekg(ji,jj,jk) + rtrn) * (1. - EXP( -ekg(ji,jj,jk) )) pe2(ji,jj,jk) = we2(ji,jj) / (ekg(ji,jj,jk) + rtrn) * (1. - EXP( -ekg(ji,jj,jk) ))
...@@ -266,7 +285,9 @@ CONTAINS ...@@ -266,7 +285,9 @@ CONTAINS
IF( ln_varpar ) THEN IF( ln_varpar ) THEN
IF( kt == nittrc000 .OR. ( kt /= nittrc000 .AND. ntimes_par > 1 ) ) THEN IF( kt == nittrc000 .OR. ( kt /= nittrc000 .AND. ntimes_par > 1 ) ) THEN
CALL fld_read( kt, 1, sf_par ) CALL fld_read( kt, 1, sf_par )
par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0 DO_2D( 0, 0, 0, 0 )
par_varsw(ji,jj) = ( sf_par(1)%fnow(ji,jj,1) ) / 3.0
END_2D
ENDIF ENDIF
ENDIF ENDIF
! !
...@@ -348,8 +369,8 @@ CONTAINS ...@@ -348,8 +369,8 @@ CONTAINS
!! *** ROUTINE trc_opt_alloc *** !! *** ROUTINE trc_opt_alloc ***
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
ALLOCATE( ekb(jpi,jpj,jpk), ekr(jpi,jpj,jpk), & ALLOCATE( ekb(A2D(0),jpk),ekr(A2D(0),jpk), &
ekg(jpi,jpj,jpk),zeps(jpi,jpj,jpk), STAT= trc_opt_alloc ) ekg(A2D(0),jpk),zeps(A2D(0),jpk), STAT= trc_opt_alloc )
! !
IF( trc_opt_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trc_opt_alloc : failed to allocate arrays.' ) IF( trc_opt_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trc_opt_alloc : failed to allocate arrays.' )
! !
......
src/TOP/trcstp.F90
View file @ c72255b2
...@@ -37,6 +37,8 @@ MODULE trcstp ...@@ -37,6 +37,8 @@ MODULE trcstp
REAL(wp) :: rsecfst, rseclast ! ??? REAL(wp) :: rsecfst, rseclast ! ???
REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90" # include "domzgr_substitute.h90"
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018) !! NEMO/TOP 4.0 , NEMO Consortium (2018)
...@@ -74,17 +76,13 @@ CONTAINS ...@@ -74,17 +76,13 @@ CONTAINS
ll_trcstat = ( sn_cfctl%l_trcstat ) .AND. & ll_trcstat = ( sn_cfctl%l_trcstat ) .AND. &
& ( ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) ) & ( ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) )
IF( kt == nittrc000 ) CALL trc_stp_ctl ! control
IF( kt == nittrc000 .AND. lk_trdmxl_trc ) CALL trd_mxl_trc_init ! trends: Mixed-layer IF( kt == nittrc000 .AND. lk_trdmxl_trc ) CALL trd_mxl_trc_init ! trends: Mixed-layer
! !
IF( .NOT.ln_linssh ) THEN ! update ocean volume due to ssh temporal evolution IF( .NOT.ln_linssh ) THEN ! update ocean volume due to ssh temporal evolution
DO jk = 1, jpk DO jk = 1, jpk
cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
END DO END DO
IF ( ll_trcstat .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend ) & IF ( ll_trcstat .OR. kt == nitrst ) areatot = glob_sum( 'trcstp', cvol(:,:,:) )
& .OR. iom_use( "pno3tot" ) .OR. iom_use( "ppo4tot" ) .OR. iom_use( "psiltot" ) &
& .OR. iom_use( "palktot" ) .OR. iom_use( "pfertot" ) ) &
& areatot = glob_sum( 'trcstp', cvol(:,:,:) )
ENDIF ENDIF
! !
IF( l_trcdm2dc ) CALL trc_mean_qsr( kt ) IF( l_trcdm2dc ) CALL trc_mean_qsr( kt )
...@@ -141,20 +139,6 @@ CONTAINS ...@@ -141,20 +139,6 @@ CONTAINS
END SUBROUTINE trc_stp END SUBROUTINE trc_stp
SUBROUTINE trc_stp_ctl
!!----------------------------------------------------------------------
!! *** ROUTINE trc_stp_ctl ***
!!----------------------------------------------------------------------
!
! Define logical parameter ton control dirunal cycle in TOP
l_trcdm2dc = ( ln_trcdc2dm .AND. .NOT. ln_dm2dc )
!
IF( l_trcdm2dc .AND. lwp ) CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.', &
& 'Computation of a daily mean shortwave for some biogeochemical models ' )
!
END SUBROUTINE trc_stp_ctl
SUBROUTINE trc_mean_qsr( kt ) SUBROUTINE trc_mean_qsr( kt )
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! *** ROUTINE trc_mean_qsr *** !! *** ROUTINE trc_mean_qsr ***
...@@ -188,7 +172,7 @@ CONTAINS ...@@ -188,7 +172,7 @@ CONTAINS
WRITE(numout,*) WRITE(numout,*)
ENDIF ENDIF
! !
ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) ) ALLOCATE( qsr_arr(A2D(0),nb_rec_per_day ) )
! !
! !* Restart: read in restart file ! !* Restart: read in restart file
IF( ln_rsttr .AND. nn_rsttr /= 0 .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0 & IF( ln_rsttr .AND. nn_rsttr /= 0 .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0 &
...@@ -239,7 +223,7 @@ CONTAINS ...@@ -239,7 +223,7 @@ CONTAINS
qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1) qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
ENDDO ENDDO
qsr_arr (:,:,nb_rec_per_day) = qsr(:,:) qsr_arr (:,:,nb_rec_per_day) = qsr(:,:)
qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day qsr_mean(:,:) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
ENDIF ENDIF
! !
IF( lrst_trc ) THEN !* Write the mean of qsr in restart file IF( lrst_trc ) THEN !* Write the mean of qsr in restart file
......
src/TOP/trcstp_rk3.F90
View file @ c72255b2
...@@ -41,6 +41,8 @@ MODULE trcstp_rk3 ...@@ -41,6 +41,8 @@ MODULE trcstp_rk3
REAL(wp) :: rsecfst, rseclast ! ??? REAL(wp) :: rsecfst, rseclast ! ???
REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90" # include "domzgr_substitute.h90"
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018) !! NEMO/TOP 4.0 , NEMO Consortium (2018)
...@@ -71,15 +73,14 @@ CONTAINS ...@@ -71,15 +73,14 @@ CONTAINS
l_trcstat = ( sn_cfctl%l_trcstat ) .AND. & l_trcstat = ( sn_cfctl%l_trcstat ) .AND. &
& ( ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) ) & ( ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) )
! !
IF( kt == nittrc000 ) CALL trc_stp_ctl ! control IF( kt == nittrc000 ) CALL trc_stpsctl ! control
IF( kt == nittrc000 .AND. lk_trdmxl_trc ) CALL trd_mxl_trc_init ! trends: Mixed-layer IF( kt == nittrc000 .AND. lk_trdmxl_trc ) CALL trd_mxl_trc_init ! trends: Mixed-layer
! !
IF( .NOT.ln_linssh ) THEN ! update ocean volume due to ssh temporal evolution IF( .NOT.ln_linssh ) THEN ! update ocean volume due to ssh temporal evolution
DO jk = 1, jpk DO jk = 1, jpk
cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
END DO END DO
IF( l_trcstat .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend ) ) & IF( l_trcstat .OR. kt == nitrst ) areatot = glob_sum( 'trcstp', cvol(:,:,:) )
& areatot = glob_sum( 'trcstp', cvol(:,:,:) )
ENDIF ENDIF
! !
IF( l_trcdm2dc ) CALL trc_mean_qsr( kt ) IF( l_trcdm2dc ) CALL trc_mean_qsr( kt )
...@@ -146,22 +147,6 @@ CONTAINS ...@@ -146,22 +147,6 @@ CONTAINS
END SUBROUTINE trc_stp_end END SUBROUTINE trc_stp_end
SUBROUTINE trc_stp_ctl
!!----------------------------------------------------------------------
!! *** ROUTINE trc_stp_ctl ***
!! ** Purpose : Control + ocean volume
!!----------------------------------------------------------------------
!
! Define logical parameter ton control dirunal cycle in TOP
l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 .AND. ncpl_qsr_freq /= 0 )
l_trcdm2dc = l_trcdm2dc .AND. .NOT. l_offline
!
IF( l_trcdm2dc .AND. lwp ) CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.', &
& 'Computation of a daily mean shortwave for some biogeochemical models ' )
!
END SUBROUTINE trc_stp_ctl
SUBROUTINE trc_mean_qsr( kt ) SUBROUTINE trc_mean_qsr( kt )
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! *** ROUTINE trc_mean_qsr *** !! *** ROUTINE trc_mean_qsr ***
...@@ -185,13 +170,9 @@ CONTAINS ...@@ -185,13 +170,9 @@ CONTAINS
IF( ln_timing ) CALL timing_start('trc_mean_qsr') IF( ln_timing ) CALL timing_start('trc_mean_qsr')
! !
IF( kt == nittrc000 ) THEN IF( kt == nittrc000 ) THEN
IF( ln_cpl ) THEN !
rdt_sampl = rday / ncpl_qsr_freq rdt_sampl = REAL( ncpl_qsr_freq )
nb_rec_per_day = ncpl_qsr_freq nb_rec_per_day = INT( rday / ncpl_qsr_freq )
ELSE
rdt_sampl = MAX( 3600., rn_Dt )
nb_rec_per_day = INT( rday / rdt_sampl )
ENDIF
! !
IF(lwp) THEN IF(lwp) THEN
WRITE(numout,*) WRITE(numout,*)
...@@ -199,7 +180,7 @@ CONTAINS ...@@ -199,7 +180,7 @@ CONTAINS
WRITE(numout,*) WRITE(numout,*)
ENDIF ENDIF
! !
ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) ) ALLOCATE( qsr_arr(A2D(0),nb_rec_per_day ) )
! !
! !* Restart: read in restart file ! !* Restart: read in restart file
IF( ln_rsttr .AND. nn_rsttr /= 0 .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0 & IF( ln_rsttr .AND. nn_rsttr /= 0 .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0 &
...@@ -250,7 +231,7 @@ CONTAINS ...@@ -250,7 +231,7 @@ CONTAINS
qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1) qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
END DO END DO
qsr_arr (:,:,nb_rec_per_day) = qsr(:,:) qsr_arr (:,:,nb_rec_per_day) = qsr(:,:)
qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day qsr_mean(:,:) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
ENDIF ENDIF
! !
IF( lrst_trc ) THEN !* Write the mean of qsr in restart file IF( lrst_trc ) THEN !* Write the mean of qsr in restart file
......
src/TOP/trcwri.F90
View file @ c72255b2
...@@ -42,12 +42,12 @@ CONTAINS ...@@ -42,12 +42,12 @@ CONTAINS
INTEGER, INTENT( in ) :: kt INTEGER, INTENT( in ) :: kt
INTEGER, INTENT( in ) :: Kmm ! time level indices INTEGER, INTENT( in ) :: Kmm ! time level indices
! !
INTEGER :: jk, jn INTEGER :: ji,jj,jk,jn
CHARACTER (len=20) :: cltra CHARACTER (len=20) :: cltra
CHARACTER (len=40) :: clhstnam CHARACTER (len=40) :: clhstnam
INTEGER :: inum = 11 ! temporary logical unit INTEGER :: inum = 11 ! temporary logical unit
REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d ! 3D workspace
!!--------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
IF( ln_timing ) CALL timing_start('trc_wri') IF( ln_timing ) CALL timing_start('trc_wri')
! !
...@@ -59,6 +59,8 @@ CONTAINS ...@@ -59,6 +59,8 @@ CONTAINS
CLOSE(inum) CLOSE(inum)
ENDIF ENDIF
ALLOCATE( z3d(jpi,jpj,jpk) ) ; z3d(:,:,:) = 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(:,:,:) )
CALL iom_put( "e3u_0", e3u_0(:,:,:) ) CALL iom_put( "e3u_0", e3u_0(:,:,:) )
...@@ -66,25 +68,27 @@ CONTAINS ...@@ -66,25 +68,27 @@ CONTAINS
! !
IF( .NOT.ln_linssh ) CALL iom_put( "ssh" , ssh(:,:,Kmm) ) ! sea surface height IF( .NOT.ln_linssh ) CALL iom_put( "ssh" , ssh(:,:,Kmm) ) ! sea surface height
! !
IF ( iom_use("e3t") ) THEN ! time-varying e3t ! --- vertical scale factors --- !
DO jk = 1, jpk IF( iom_use("e3t") ) THEN ! time-varying e3t
z3d(:,:,jk) = e3t(:,:,jk,Kmm) DO_3D( 0, 0, 0, 0, 1, jpk )
END DO z3d(ji,jj,jk) = e3t(ji,jj,jk,Kmm)
CALL iom_put( "e3t", z3d(:,:,:) ) END_3D
CALL iom_put( "e3t", z3d )
ENDIF ENDIF
IF ( iom_use("e3u") ) THEN ! time-varying e3u IF ( iom_use("e3u") ) THEN ! time-varying e3u
DO jk = 1, jpk DO_3D( 0, 0, 0, 0, 1, jpk )
z3d(:,:,jk) = e3u(:,:,jk,Kmm) z3d(ji,jj,jk) = e3u(ji,jj,jk,Kmm)
END DO END_3D
CALL iom_put( "e3u", z3d(:,:,:) ) CALL iom_put( "e3u" , z3d )
ENDIF ENDIF
IF ( iom_use("e3v") ) THEN ! time-varying e3v IF ( iom_use("e3v") ) THEN ! time-varying e3v
DO jk = 1, jpk DO_3D( 0, 0, 0, 0, 1, jpk )
z3d(:,:,jk) = e3v(:,:,jk,Kmm) z3d(ji,jj,jk) = e3v(ji,jj,jk,Kmm)
END DO END_3D
CALL iom_put( "e3v", z3d(:,:,:) ) CALL iom_put( "e3v" , z3d )
ENDIF ENDIF
! !
DEALLOCATE( z3d )
ENDIF ENDIF
! !
! write the tracer concentrations in the file ! write the tracer concentrations in the file
......
tests/ADIAB_WAVE/MY_SRC/usrdef_hgr.F90
View file @ c72255b2
...@@ -80,14 +80,14 @@ CONTAINS ...@@ -80,14 +80,14 @@ CONTAINS
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
! DO_2D( 1, 1, 1, 1 ) ! DO_2D( 1, 1, 1, 1 )
! ! longitude ! ! longitude
plamt(ji,jj) = zfact * ( REAL( mig0(ji)-1 , wp ) ) plamt(ji,jj) = zfact * ( REAL( mig(ji,0)-1 , wp ) )
plamu(ji,jj) = zfact * ( 0.5 + REAL( mig0(ji)-1 , wp ) ) plamu(ji,jj) = zfact * ( 0.5 + REAL( mig(ji,0)-1 , wp ) )
plamv(ji,jj) = plamt(ji,jj) plamv(ji,jj) = plamt(ji,jj)
plamf(ji,jj) = plamu(ji,jj) plamf(ji,jj) = plamu(ji,jj)
! ! latitude ! ! latitude
pphit(ji,jj) = zfact2 * ( REAL( mjg0(jj)-1 , wp ) ) pphit(ji,jj) = zfact2 * ( REAL( mjg(jj,0)-1 , wp ) )
pphiu(ji,jj) = pphit(ji,jj) pphiu(ji,jj) = pphit(ji,jj)
pphiv(ji,jj) = zfact2 * ( 0.5 + REAL( mjg0(jj)-1 , wp ) ) pphiv(ji,jj) = zfact2 * ( 0.5 + REAL( mjg(jj,0)-1 , wp ) )
pphif(ji,jj) = pphiv(ji,jj) pphif(ji,jj) = pphiv(ji,jj)
END_2D END_2D
! !
......
tests/ADIAB_WAVE/MY_SRC/usrdef_zgr.F90
View file @ c72255b2
...@@ -14,8 +14,7 @@ MODULE usrdef_zgr ...@@ -14,8 +14,7 @@ MODULE usrdef_zgr
!! zgr_z1d : reference 1D z-coordinate !! zgr_z1d : reference 1D z-coordinate
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
USE oce ! ocean variables USE oce ! ocean variables
USE dom_oce , ONLY: mi0, mi1 ! ocean space and time domain USE dom_oce ! ocean space and time domain
USE dom_oce , ONLY: glamt ! ocean space and time domain
USE usrdef_nam ! User defined : namelist variables USE usrdef_nam ! User defined : namelist variables
! !
USE in_out_manager ! I/O manager USE in_out_manager ! I/O manager
...@@ -105,10 +104,10 @@ CONTAINS ...@@ -105,10 +104,10 @@ CONTAINS
END_2D END_2D
CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1. ) ! boundary condition: this mask the surrouding grid-points CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1. ) ! boundary condition: this mask the surrouding grid-points
! ! ==>>> set by hand non-zero value on first/last columns & rows ! ! ==>>> set by hand non-zero value on first/last columns & rows
DO ji = mi0(1), mi1(1) ! first row of global domain only DO ji = mi0(1,nn_hls), mi1(1,nn_hls) ! first row of global domain only
zhu(ji,2) = zht(ji,2) zhu(ji,2) = zht(ji,2)
END DO END DO
DO ji = mi0(jpiglo), mi1(jpiglo) ! last row of global domain only DO ji = mi0(jpiglo,nn_hls), mi1(jpiglo,nn_hls) ! last row of global domain only
zhu(ji,2) = zht(ji,2) zhu(ji,2) = zht(ji,2)
END DO END DO
zhu(:,1) = zhu(:,2) zhu(:,1) = zhu(:,2)
......
tests/BENCH/MY_SRC/usrdef_hgr.F90
View file @ c72255b2
...@@ -75,15 +75,15 @@ CONTAINS ...@@ -75,15 +75,15 @@ CONTAINS
! define unique value on each point of the inner global domain. z2d ranging from 0.05 to -0.05 ! define unique value on each point of the inner global domain. z2d ranging from 0.05 to -0.05
! !
DO_2D( 0, 0, 0, 0 ) ! +/- 0.5 DO_2D( 0, 0, 0, 0 ) ! +/- 0.5
z2d(ji,jj) = 0.5 - REAL( mig0(ji) + (mjg0(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) z2d(ji,jj) = 0.5 - REAL( mig(ji,0) + (mjg(jj,0)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp )
END_2D END_2D
! !
! Position coordinates (in grid points) ! Position coordinates (in grid points)
! ========== ! ==========
DO_2D( 0, 0, 0, 0 ) DO_2D( 0, 0, 0, 0 )
zti = REAL( mig0(ji), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos zti = REAL( mig(ji,0), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
ztj = REAL( mjg0(jj), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos ztj = REAL( mjg(jj,0), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
plamt(ji,jj) = zti * (1. + 1.0e-5 * z2d(ji,jj) ) plamt(ji,jj) = zti * (1. + 1.0e-5 * z2d(ji,jj) )
plamu(ji,jj) = ( zti + 0.5_wp ) * (1. + 2.0e-5 * z2d(ji,jj) ) plamu(ji,jj) = ( zti + 0.5_wp ) * (1. + 2.0e-5 * z2d(ji,jj) )
......
tests/BENCH/MY_SRC/usrdef_istate.F90
View file @ c72255b2
...@@ -65,7 +65,7 @@ CONTAINS ...@@ -65,7 +65,7 @@ CONTAINS
! define unique value on each point of the inner global domain. z2d ranging from 0.05 to -0.05 ! define unique value on each point of the inner global domain. z2d ranging from 0.05 to -0.05
! !
DO_2D( 0, 0, 0, 0 ) ! +/- 0.05 DO_2D( 0, 0, 0, 0 ) ! +/- 0.05
z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0(ji) + (mjg0(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) ) z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig(ji,0) + (mjg(jj,0)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
END_2D END_2D
! !
DO_3D( 0, 0, 0, 0, 1, jpkm1 ) DO_3D( 0, 0, 0, 0, 1, jpkm1 )
...@@ -108,7 +108,7 @@ CONTAINS ...@@ -108,7 +108,7 @@ CONTAINS
IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : BENCH configuration, analytical definition of initial ssh' IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : BENCH configuration, analytical definition of initial ssh'
! !
DO_2D( 0, 0, 0, 0 ) ! sea level: +/- 0.05 m DO_2D( 0, 0, 0, 0 ) ! sea level: +/- 0.05 m
pssh(ji,jj) = 0.1 * ( 0.5 - REAL( mig0(ji) + (mjg0(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) ) pssh(ji,jj) = 0.1 * ( 0.5 - REAL( mig(ji,0) + (mjg(jj,0)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
END_2D END_2D
! !
CALL lbc_lnk('usrdef_istate', pssh, 'T', 1. ) ! apply boundary conditions CALL lbc_lnk('usrdef_istate', pssh, 'T', 1. ) ! apply boundary conditions
......
tests/BENCH/MY_SRC/usrdef_sbc.F90
View file @ c72255b2
...@@ -104,12 +104,12 @@ CONTAINS ...@@ -104,12 +104,12 @@ CONTAINS
! define unique value on each point. z2d ranging from 0.05 to -0.05 ! define unique value on each point. z2d ranging from 0.05 to -0.05
! !
DO_2D( 0, 0, 0, 0 ) DO_2D( 0, 0, 0, 0 )
zztmp = 0.1 * ( 0.5 - REAL( mig0(ji) + (mjg0(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) ) zztmp = 0.1 * ( 0.5 - REAL( mig(ji,0) + (mjg(jj,0)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
utau_ice(ji,jj) = 0.1_wp + zztmp utau_ice(ji,jj) = 0.1_wp + zztmp
vtau_ice(ji,jj) = 0.1_wp + zztmp vtau_ice(ji,jj) = 0.1_wp + zztmp
END_2D END_2D
CALL lbc_lnk( 'usrdef_sbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) CALL lbc_lnk( 'usrdef_sbc', utau_ice, 'T', -1., vtau_ice, 'T', -1. )
#endif #endif
! !
END SUBROUTINE usrdef_sbc_ice_tau END SUBROUTINE usrdef_sbc_ice_tau
......
tests/BENCH/MY_SRC/usrdef_zgr.F90
View file @ c72255b2
...@@ -197,14 +197,14 @@ CONTAINS ...@@ -197,14 +197,14 @@ CONTAINS
! !
!!$ IF( c_NFtype == 'T' ) THEN ! add a small island in the upper corners to avoid model instabilities... !!$ IF( c_NFtype == 'T' ) THEN ! add a small island in the upper corners to avoid model instabilities...
!!$ z2d(mi0( nn_hls):mi1( nn_hls+2 ),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0._wp !!$ z2d(mi0( nn_hls,nn_hls):mi1( nn_hls+2 ,nn_hls),mj0(jpjglo-nn_hls-1,nn_hls):mj1(jpjglo-nn_hls+1,nn_hls)) = 0._wp
!!$ z2d(mi0(jpiglo-nn_hls):mi1(MIN(jpiglo,jpiglo-nn_hls+2)),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0._wp !!$ z2d(mi0(jpiglo-nn_hls,nn_hls):mi1(MIN(jpiglo,jpiglo-nn_hls+2),nn_hls),mj0(jpjglo-nn_hls-1,nn_hls):mj1(jpjglo-nn_hls+1,nn_hls)) = 0._wp
!!$ z2d(mi0(jpiglo/2 ):mi1( jpiglo/2 +2 ),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0._wp !!$ z2d(mi0(jpiglo/2 ,nn_hls):mi1( jpiglo/2 +2 ,nn_hls),mj0(jpjglo-nn_hls-1,nn_hls):mj1(jpjglo-nn_hls+1,nn_hls)) = 0._wp
!!$ ENDIF !!$ ENDIF
!!$ ! !!$ !
IF( c_NFtype == 'F' ) THEN ! Must mask the 2 pivot-points IF( c_NFtype == 'F' ) THEN ! Must mask the 2 pivot-points
z2d(mi0(nn_hls+1):mi1(nn_hls+1),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls)) = 0._wp z2d(mi0(nn_hls+1,nn_hls):mi1(nn_hls+1,nn_hls),mj0(jpjglo-nn_hls,nn_hls):mj1(jpjglo-nn_hls,nn_hls)) = 0._wp
z2d(mi0(jpiglo/2):mi1(jpiglo/2),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls)) = 0._wp z2d(mi0(jpiglo/2,nn_hls):mi1(jpiglo/2,nn_hls),mj0(jpjglo-nn_hls,nn_hls):mj1(jpjglo-nn_hls,nn_hls)) = 0._wp
ENDIF ENDIF
! !
CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1._wp ) ! set surrounding land to zero (closed boundaries) CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1._wp ) ! set surrounding land to zero (closed boundaries)
......
tests/C1D_ASICS/MY_SRC/usrdef_nam.F90
View file @ c72255b2
...@@ -13,7 +13,6 @@ MODULE usrdef_nam ...@@ -13,7 +13,6 @@ MODULE usrdef_nam
!! usr_def_nam : read user defined namelist and set global domain size !! usr_def_nam : read user defined namelist and set global domain size
!! usr_def_hgr : initialize the horizontal mesh !! usr_def_hgr : initialize the horizontal mesh
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain
USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate
USE par_oce ! ocean space and time domain USE par_oce ! ocean space and time domain
USE phycst ! physical constants USE phycst ! physical constants
......
tests/CANAL/EXPREF/file_def_nemo-oce.xml
View file @ c72255b2
...@@ -20,15 +20,15 @@ ...@@ -20,15 +20,15 @@
<field field_ref="ssrelpotvor" /> <field field_ref="ssrelpotvor" />
<field field_ref="saltc" /> <field field_ref="saltc" />
<field field_ref="salt2c" /> <field field_ref="salt2c" />
<field field_ref="utau" />
<field field_ref="vtau" />
</file> </file>
<file id="file3" name_suffix="_grid_U" description="ocean U grid variables" > <file id="file3" name_suffix="_grid_U" description="ocean U grid variables" >
<field field_ref="utau" />
<field field_ref="uoce" /> <field field_ref="uoce" />
</file> </file>
<file id="file4" name_suffix="_grid_V" description="ocean V grid variables" > <file id="file4" name_suffix="_grid_V" description="ocean V grid variables" >
<field field_ref="vtau" />
<field field_ref="voce" /> <field field_ref="voce" />
</file> </file>
......
tests/CANAL/MY_SRC/usrdef_hgr.F90
View file @ c72255b2
...@@ -88,8 +88,8 @@ CONTAINS ...@@ -88,8 +88,8 @@ CONTAINS
#endif #endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
zti = REAL( mig0(ji)-ii0, wp ) ! =0 at i=ii0 in the global grid without halos zti = REAL( mig(ji,0)-ii0, wp ) ! =0 at i=ii0 in the global grid without halos
ztj = REAL( mjg0(jj)-ij0, wp ) ! =0 at i=ij0 in the global grid without halos ztj = REAL( mjg(jj,0)-ij0, wp ) ! =0 at i=ij0 in the global grid without halos
plamt(ji,jj) = rn_dx * zti plamt(ji,jj) = rn_dx * zti
plamu(ji,jj) = rn_dx * ( zti + 0.5_wp ) plamu(ji,jj) = rn_dx * ( zti + 0.5_wp )
......
tests/DIA_GPU/EXPREF/file_def_nemo-oce.xml
View file @ c72255b2
...@@ -34,6 +34,8 @@ ...@@ -34,6 +34,8 @@
<field field_ref="qt_oce" name="qt_oce" /> <field field_ref="qt_oce" name="qt_oce" />
<field field_ref="saltflx" name="sfx" /> <field field_ref="saltflx" name="sfx" />
<field field_ref="taum" name="taum" /> <field field_ref="taum" name="taum" />
<field field_ref="utau" name="tauuo" />
<field field_ref="vtau" name="tauvo" />
<field field_ref="wspd" name="windsp" /> <field field_ref="wspd" name="windsp" />
<field field_ref="precip" name="precip" /> <field field_ref="precip" name="precip" />
<!-- ice and snow --> <!-- ice and snow -->
...@@ -44,7 +46,6 @@ ...@@ -44,7 +46,6 @@
<field field_ref="e3u" /> <field field_ref="e3u" />
<field field_ref="ssu" name="uos" /> <field field_ref="ssu" name="uos" />
<field field_ref="uoce" name="uo" operation="instant" freq_op="5d" > @uoce_e3u / @e3u </field> <field field_ref="uoce" name="uo" operation="instant" freq_op="5d" > @uoce_e3u / @e3u </field>
<field field_ref="utau" name="tauuo" />
<field field_ref="uocetr_eff" name="uocetr_eff" /> <field field_ref="uocetr_eff" name="uocetr_eff" />
<!-- available with diaar5 --> <!-- available with diaar5 -->
<field field_ref="u_masstr" name="vozomatr" /> <field field_ref="u_masstr" name="vozomatr" />
...@@ -56,7 +57,6 @@ ...@@ -56,7 +57,6 @@
<field field_ref="e3v" /> <field field_ref="e3v" />
<field field_ref="ssv" name="vos" /> <field field_ref="ssv" name="vos" />
<field field_ref="voce" name="vo" operation="instant" freq_op="5d" > @voce_e3v / @e3v </field> <field field_ref="voce" name="vo" operation="instant" freq_op="5d" > @voce_e3v / @e3v </field>
<field field_ref="vtau" name="tauvo" />
<field field_ref="vocetr_eff" name="vocetr_eff" /> <field field_ref="vocetr_eff" name="vocetr_eff" />
<!-- available with diaar5 --> <!-- available with diaar5 -->
<field field_ref="v_masstr" name="vomematr" /> <field field_ref="v_masstr" name="vomematr" />
......
tests/DIA_GPU/MY_SRC/stpctl.F90
View file @ c72255b2
...@@ -232,7 +232,7 @@ CONTAINS ...@@ -232,7 +232,7 @@ CONTAINS
iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) ) iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) )
iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) ) iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) )
DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos
iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) iloc(1:2,ji) = (/ mig(iloc(1,ji),0), mjg(iloc(2,ji),0) /)
END DO END DO
iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information
ENDIF ENDIF
......
tests/DOME/MY_SRC/usrdef_hgr.F90
View file @ c72255b2
...@@ -93,8 +93,8 @@ CONTAINS ...@@ -93,8 +93,8 @@ CONTAINS
#endif #endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
zti = REAL( mig0(ji) - 1, wp ) ! start at i=0 in the global grid without halos zti = REAL( mig(ji,0) - 1, wp ) ! start at i=0 in the global grid without halos
ztj = REAL( mjg0(jj) - 1, wp ) ! start at j=0 in the global grid without halos ztj = REAL( mjg(jj,0) - 1, wp ) ! start at j=0 in the global grid without halos
plamt(ji,jj) = roffsetx + rn_dx * 1.e-3 * ( zti - 0.5_wp ) plamt(ji,jj) = roffsetx + rn_dx * 1.e-3 * ( zti - 0.5_wp )
plamu(ji,jj) = roffsetx + rn_dx * 1.e-3 * zti plamu(ji,jj) = roffsetx + rn_dx * 1.e-3 * zti
......
tests/DOME/MY_SRC/usrdef_istate.F90
View file @ c72255b2
...@@ -105,10 +105,10 @@ CONTAINS ...@@ -105,10 +105,10 @@ CONTAINS
! ztd = 15._wp*gdepw_0(ji,jj,jk+1)-0.5*rho0*zn2/(rn_a0*grav)*gdepw_0(ji,jj,jk+1)**2 ! ztd = 15._wp*gdepw_0(ji,jj,jk+1)-0.5*rho0*zn2/(rn_a0*grav)*gdepw_0(ji,jj,jk+1)**2
! ztu = 15._wp*gdepw_0(ji,jj,jk )-0.5*rho0*zn2/(rn_a0*grav)*gdepw_0(ji,jj,jk )**2 ! ztu = 15._wp*gdepw_0(ji,jj,jk )-0.5*rho0*zn2/(rn_a0*grav)*gdepw_0(ji,jj,jk )**2
! pts(ji,jj,jk,jp_tem) = (ztd - ztu)/e3t_0(ji,jj,jk) * ptmask(ji,jj,jk) ! pts(ji,jj,jk,jp_tem) = (ztd - ztu)/e3t_0(ji,jj,jk) * ptmask(ji,jj,jk)
IF (Agrif_root().AND.( mjg0(jj) == Nj0glo-2 ) ) THEN IF (Agrif_root().AND.( mjg(jj,0) == Nj0glo-2 ) ) THEN
pv(ji,jj,jk) = -sqrt(zdb*zh0)*exp(-zxw/zro)*(1._wp-zf) * ptmask(ji,jj,jk) pv(ji,jj,jk) = -sqrt(zdb*zh0)*exp(-zxw/zro)*(1._wp-zf) * ptmask(ji,jj,jk)
ENDIF ENDIF
IF (Agrif_root().AND.( mjg0(jj) == Nj0glo-1 ) ) THEN IF (Agrif_root().AND.( mjg(jj,0) == Nj0glo-1 ) ) THEN
pts(ji,jj,jk,jp_tem) = MIN(pts(ji,jj,jk,jp_tem), 15._wp - zdb*rho0/grav/rn_a0*(1._wp-zf)) * ptmask(ji,jj,jk) pts(ji,jj,jk,jp_tem) = MIN(pts(ji,jj,jk,jp_tem), 15._wp - zdb*rho0/grav/rn_a0*(1._wp-zf)) * ptmask(ji,jj,jk)
pts(ji,jj,jk,jp_sal) = 1._wp * ptmask(ji,jj,jk) pts(ji,jj,jk,jp_sal) = 1._wp * ptmask(ji,jj,jk)
ENDIF ENDIF
......