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
No results found
Show changes
Hide whitespace changes
Inline Side-by-side
Showing
with 264 additions and 590 deletions
src/TOP/PISCES/P4Z/p5zlim.F90
View file @ 672ff863
......@@ -482,13 +482,6 @@ CONTAINS
xfracal(ji,jj,jk) = MAX( 0.02, MIN( 0.8 , xfracal(ji,jj,jk) ) )
END_3D
!
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
! denitrification factor computed from O2 levels
nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - tr(ji,jj,jk,jpoxy,Kbb) ) &
& / ( oxymin + tr(ji,jj,jk,jpoxy,Kbb) ) )
nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) )
END_3D
!
IF( lk_iomput .AND. knt == nrdttrc ) THEN ! save output diagnostics
CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) ) ! euphotic layer deptht
CALL iom_put( "LNnut" , xlimphy(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term
......@@ -610,17 +603,18 @@ CONTAINS
xpsinh4 = 1.8 * rno3
xpsiuptk = 1.0 / 6.625
!
nitrfac(:,:,jpk) = 0._wp
xfracal(:,:,jpk) = 0._wp
xlimphy(:,:,jpk) = 0._wp
xlimpic(:,:,jpk) = 0._wp
xlimdia(:,:,jpk) = 0._wp
xlimnfe(:,:,jpk) = 0._wp
xlimpfe(:,:,jpk) = 0._wp
xlimdfe(:,:,jpk) = 0._wp
sizen (:,:,jpk) = 0._wp
sizep (:,:,jpk) = 0._wp
sized (:,:,jpk) = 0._wp
nitrfac (:,:,jpk) = 0._wp
nitrfac2(:,:,jpk) = 0._wp
xfracal (:,:,jpk) = 0._wp
xlimphy (:,:,jpk) = 0._wp
xlimpic (:,:,jpk) = 0._wp
xlimdia (:,:,jpk) = 0._wp
xlimnfe (:,:,jpk) = 0._wp
xlimpfe (:,:,jpk) = 0._wp
xlimdfe (:,:,jpk) = 0._wp
sizen (:,:,jpk) = 0._wp
sizep (:,:,jpk) = 0._wp
sized (:,:,jpk) = 0._wp
!
END SUBROUTINE p5z_lim_init
......
src/TOP/PISCES/P4Z/p5zmeso.F90
View file @ 672ff863
......@@ -106,10 +106,10 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo2
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrarem, zgraref, zgrapoc, zgrapof
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrarep, zgraren, zgrapon, zgrapop
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgradoc, zgradon, zgradop
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgradoc, zgradon, zgradop, zgrabsi
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zgramigrem, zgramigref, zgramigpoc, zgramigpof
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zgramigrep, zgramigren, zgramigpop, zgramigpon
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zgramigdoc, zgramigdop, zgramigdon
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zgramigdoc, zgramigdop, zgramigdon, zgramigbsi
!!---------------------------------------------------------------------
......@@ -187,7 +187,7 @@ CONTAINS
! have low abundance, .i.e. zooplankton become less specific
! to avoid starvation.
! ----------------------------------------------------------
zsigma = 1.0 - zdenom**3/(0.1**3+zdenom**3)
zsigma = 1.0 - zdenom**3/(0.05**3+zdenom**3)
zsigma = xsigma2 + xsigma2del * zsigma
! Nanophytoplankton and diatoms are the only preys considered
! to be close enough to have potential interference
......@@ -196,7 +196,7 @@ CONTAINS
ztmp1 = xpref2n * zcompaph * ( zcompaph + zdiffdn * zcompadi ) / (1.0 + zdiffdn)
ztmp2 = xpref2m * zcompames**2
ztmp3 = xpref2c * zcompapoc**2
ztmp4 = xpref2d * zcompadi * ( zdiffdn * zcompadi + zcompaph ) / (1.0 + zdiffdn)
ztmp4 = xpref2d * zcompadi * ( zcompadi + zdiffdn * zcompaph ) / (1.0 + zdiffdn)
ztmp5 = xpref2z * zcompaz**2
ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn
ztmp1 = ztmp1 / ztmptot
......@@ -366,7 +366,7 @@ CONTAINS
! sinks
! --------------------------------------------------------------
tr(ji,jj,jk,jpmes,Krhs) = tr(ji,jj,jk,jpmes,Krhs) + zepsherv * zgraztotc - zrespirc &
& - ztortz - zgrazm
& - ztortz - zgrazm
tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazdc
tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zgrazdn
tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zgrazdp
......@@ -379,7 +379,7 @@ CONTAINS
tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgraznc * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn )
tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazdc * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazdc * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazdc * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
zgrabsi(ji,jj,jk) = zgrazdc * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zgrazpoc - zgrazffep + zfracc
prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfracc
......@@ -415,13 +415,13 @@ CONTAINS
IF( ln_dvm_meso ) THEN
ALLOCATE( zgramigrem(jpi,jpj), zgramigref(jpi,jpj), zgramigpoc(jpi,jpj), zgramigpof(jpi,jpj) )
ALLOCATE( zgramigrep(jpi,jpj), zgramigren(jpi,jpj), zgramigpop(jpi,jpj), zgramigpon(jpi,jpj) )
ALLOCATE( zgramigdoc(jpi,jpj), zgramigdon(jpi,jpj), zgramigdop(jpi,jpj) )
ALLOCATE( zgramigdoc(jpi,jpj), zgramigdon(jpi,jpj), zgramigdop(jpi,jpj), zgramigbsi(jpi,jpj) )
zgramigrem(:,:) = 0.0 ; zgramigref(:,:) = 0.0
zgramigrep(:,:) = 0.0 ; zgramigren(:,:) = 0.0
zgramigpoc(:,:) = 0.0 ; zgramigpof(:,:) = 0.0
zgramigpop(:,:) = 0.0 ; zgramigpon(:,:) = 0.0
zgramigdoc(:,:) = 0.0 ; zgramigdon(:,:) = 0.0
zgramigdop(:,:) = 0.0
zgramigdop(:,:) = 0.0 ; zgramigbsi(:,:) = 0.0
! Compute the amount of materials that will go into vertical migration
! This fraction is sumed over the euphotic zone and is removed from
......@@ -442,6 +442,8 @@ CONTAINS
zgramigdoc(ji,jj) = zgramigdoc(ji,jj) + xfracmig * zgradoc(ji,jj,jk) * zmigthick
zgramigdop(ji,jj) = zgramigdop(ji,jj) + xfracmig * zgradop(ji,jj,jk) * zmigthick
zgramigdon(ji,jj) = zgramigdon(ji,jj) + xfracmig * zgradon(ji,jj,jk) * zmigthick
zgramigbsi(ji,jj) = zgramigbsi(ji,jj) + xfracmig * zgrabsi(ji,jj,jk) * zmigthick
zgrarem(ji,jj,jk) = zgrarem(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime )
zgrarep(ji,jj,jk) = zgrarep(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime )
......@@ -454,6 +456,7 @@ CONTAINS
zgradoc(ji,jj,jk) = zgradoc(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime )
zgradop(ji,jj,jk) = zgradop(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime )
zgradon(ji,jj,jk) = zgradon(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime )
zgrabsi(ji,jj,jk) = zgrabsi(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime )
ENDIF
END_3D
......@@ -475,6 +478,7 @@ CONTAINS
zgradoc(ji,jj,jkt) = zgradoc(ji,jj,jkt) + zgramigdoc(ji,jj) * zdep
zgradop(ji,jj,jkt) = zgradop(ji,jj,jkt) + zgramigdop(ji,jj) * zdep
zgradon(ji,jj,jkt) = zgradon(ji,jj,jkt) + zgramigdon(ji,jj) * zdep
zgrabsi(ji,jj,jkt) = zgrabsi(ji,jj,jkt) + zgramigbsi(ji,jj) * zdep
ENDIF
END_2D
!
......@@ -482,7 +486,7 @@ CONTAINS
! ------------------------------
DEALLOCATE( zgramigrem, zgramigref, zgramigpoc, zgramigpof )
DEALLOCATE( zgramigrep, zgramigren, zgramigpop, zgramigpon )
DEALLOCATE( zgramigdoc, zgramigdon, zgramigdop )
DEALLOCATE( zgramigdoc, zgramigdon, zgramigdop, zgramigbsi )
! End of the ln_dvm_meso part
ENDIF
......@@ -510,6 +514,7 @@ CONTAINS
tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zgrapon(ji,jj,jk)
tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zgrapop(ji,jj,jk)
tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zgrapof(ji,jj,jk)
tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrabsi(ji,jj,jk)
END_3D
!
IF( lk_iomput .AND. knt == nrdttrc ) THEN
......
src/TOP/PISCES/P4Z/p5zmicro.F90
View file @ 672ff863
......@@ -242,7 +242,7 @@ CONTAINS
! Excess carbon in the food is used preferentially
! when activated by zmetexcess
! ------------------------------------------------
zexcess = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess
zexcess = zgraztotc * zepsherq * zepsherf * (1.0 - zepshert) * zmetexcess
zbasresb = MAX(0., zrespz - zexcess)
zbasresi = zexcess + MIN(0., zrespz - zexcess)
zrespirc = srespir * zepsherv * zgraztotc + zbasresb
......
src/TOP/PISCES/P4Z/p5zprod.F90
View file @ 672ff863
......@@ -77,11 +77,11 @@ CONTAINS
REAL(wp) :: zsilfac, znanotot, zpicotot, zdiattot, zconctemp, zconctemp2
REAL(wp) :: zration, zratiop, zratiof, zmax, ztn, zadap
REAL(wp) :: zpronmax, zpropmax, zprofmax, zratio
REAL(wp) :: zlim, zsilfac2, zsiborn, zprod, zprontot, zproptot, zprodtot
REAL(wp) :: zlim, zsiborn, zprod, zprontot, zproptot, zprodtot
REAL(wp) :: zproddoc, zproddon, zproddop, zprodsil, zprodfer, zprodlig, zresptot
REAL(wp) :: zprnutmax, zprochln, zprochld, zprochlp
REAL(wp) :: zpislopen, zpislopep, zpisloped
REAL(wp) :: zval, zpptot, zpnewtot, zpregtot
REAL(wp) :: zval, zpptot, zpnewtot, zpregtot, zpo4tot
REAL(wp) :: zqfpmax, zqfnmax, zqfdmax
REAL(wp) :: zfact, zrfact2, zmaxsi, zratiosi, zsizetmp, zlimfac, zsilim
CHARACTER (len=25) :: charout
......@@ -96,7 +96,6 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zproregn, zproregp, zproregd
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpropo4n, zpropo4p, zpropo4d
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprodopn, zprodopp, zprodopd
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrespn, zrespp, zrespd
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmxl_fac, zmxl_chl
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zpligprod
!!---------------------------------------------------------------------
......@@ -112,7 +111,6 @@ CONTAINS
zprdia (:,:,:) = 0._wp ; zprpic (:,:,:) = 0._wp ; zprbio (:,:,:) = 0._wp
zprodopn(:,:,:) = 0._wp ; zprodopp(:,:,:) = 0._wp ; zprodopd(:,:,:) = 0._wp
zysopt (:,:,:) = 0._wp
zrespn (:,:,:) = 0._wp ; zrespp (:,:,:) = 0._wp ; zrespd (:,:,:) = 0._wp
zmxl_fac(:,:,:) = 0._wp ; zmxl_chl(:,:,:) = 0._wp
! Computation of the optimal production rates and nutrient uptake
......@@ -134,8 +132,9 @@ CONTAINS
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
zval = 24.
IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
zval = MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn ))
zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn ))
ENDIF
zmxl_chl(ji,jj,jk) = zval / 24.
zmxl_fac(ji,jj,jk) = 1.0 - exp( -0.26 * zval )
......@@ -168,17 +167,14 @@ CONTAINS
! The formulation proposed by Geider et al. (1997) has been used.
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
! Computation of the P-I slope for nanos and diatoms
ztn = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. )
zadap = xadap * ztn / ( 2.+ ztn )
!
! Nanophytoplankton
zpislopeadn(ji,jj,jk) = pislopen * tr(ji,jj,jk,jpnch,Kbb) &
& /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn)
! Picophytoplankton
zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) ) &
& * tr(ji,jj,jk,jppch,Kbb) /( tr(ji,jj,jk,jppic,Kbb) * 12. + rtrn)
zpislopeadp(ji,jj,jk) = pislopep * tr(ji,jj,jk,jppch,Kbb) &
& /( tr(ji,jj,jk,jppic,Kbb) * 12. + rtrn)
! Diatoms
zpislopeadd(ji,jj,jk) = pisloped * tr(ji,jj,jk,jpdch,Kbb) &
......@@ -191,9 +187,9 @@ CONTAINS
! Computation of production function for Carbon
! Actual light levels are used here
! ---------------------------------------------
zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) / zmxl_fac(ji,jj,jk) ) )
zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) / zmxl_fac(ji,jj,jk) ) )
zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) / zmxl_fac(ji,jj,jk) ) )
zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) )
zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) ) )
zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) )
! Computation of production function for Chlorophyll
! Mean light level in the mixed layer (when appropriate)
......@@ -203,6 +199,7 @@ CONTAINS
zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
zpislopep = zpislopep * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
zprchln(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) )
zprchlp(ji,jj,jk) = zprmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epicom(ji,jj,jk) ) )
zprchld(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) )
......@@ -215,7 +212,7 @@ CONTAINS
! ------------------------
! Si/C increases with iron stress and silicate availability (zsilfac)
! Si/C is arbitrariliy increased for very high Si concentrations
! to mimic the very high ratios observed in the Southern Ocean (zsilfac2)
! to mimic the very high ratios observed in the Southern Ocean (zsilfac)
! A parameterization derived from Flynn (2003) is used for the control
! when Si is not limiting which is similar to the parameterisation
! proposed by Gurney and Davidson (1999).
......@@ -224,29 +221,31 @@ CONTAINS
zsilim = xlimdia(ji,jj,jk) * zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn )
zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb)
IF (gphit(ji,jj) < -30 ) THEN
zsilfac2 = 1. + 1. * zsiborn / ( zsiborn + xksi2**3 )
zsilfac = 1. + 1. * zsiborn / ( zsiborn + xksi2**3 )
ELSE
zsilfac2 = 1.
zsilfac = 1.
ENDIF
zratiosi = 1.0 - tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) / ( zsilfac2 * grosip * 3.0 + rtrn )
zratiosi = 1.0 - tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) / ( zsilfac * grosip * 3.0 + rtrn )
zratiosi = MAX(0., MIN(1.0, zratiosi) )
zmaxsi = (1.0 + 0.1**4) * zratiosi**4 / ( zratiosi**4 + 0.1**4 )
IF ( xlimsi(ji,jj,jk) /= xlimdia(ji,jj,jk) ) THEN
zysopt(ji,jj,jk) = zlim * zsilfac2 * grosip * 1.0 * zmaxsi
zysopt(ji,jj,jk) = zlim * zsilfac * grosip * 1.0 * zmaxsi
ELSE
zysopt(ji,jj,jk) = zlim * zsilfac2 * grosip * 1.0 * zsilim**0.7 * zmaxsi
zysopt(ji,jj,jk) = zlim * zsilfac * grosip * 1.0 * zsilim**0.7 * zmaxsi
ENDIF
ENDIF
END_3D
! Sea-ice effect on production
! Sea-ice effect on production
! No production is assumed below sea ice
! --------------------------------------
! --------------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
zprnut(ji,jj,jk) = zprnut(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * (1.0 - fr_i(ji,jj) )
zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * (1.0 - fr_i(ji,jj) )
zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * (1.0 - fr_i(ji,jj) )
zprnut(ji,jj,jk) = zprnut(ji,jj,jk) * (1.0 - fr_i(ji,jj) )
ENDIF
END_3D
! Computation of the various production and uptake terms of nanophytoplankton
......@@ -429,10 +428,12 @@ CONTAINS
! Update the arrays TRA which contain the biological sources and sinks
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
zpptot = zpropo4n(ji,jj,jk) + zpropo4d(ji,jj,jk) + zpropo4p(ji,jj,jk)
zpo4tot = zpropo4n(ji,jj,jk) + zpropo4d(ji,jj,jk) + zpropo4p(ji,jj,jk)
zpnewtot = zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk)
zpregtot = zproregn(ji,jj,jk) + zproregd(ji,jj,jk) + zproregp(ji,jj,jk)
zpptot = zprorcap(ji,jj,jk) + zprorcan(ji,jj,jk) + zprorcad(ji,jj,jk)
zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)
zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)
zprodtot = zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)
......@@ -448,17 +449,15 @@ CONTAINS
zproddon = excretd * zprodtot + excretn * zprontot + excretp * zproptot
zprodfer = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk)
zresptot = zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk)
!
tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zpptot
tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zpo4tot
tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpnewtot
tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zpregtot
!
tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) &
& + zprorcan(ji,jj,jk) * texcretn &
& - xpsino3 * zpronewn(ji,jj,jk) &
& - xpsinh4 * zproregn(ji,jj,jk) &
& - zrespn(ji,jj,jk)
& - xpsinh4 * zproregn(ji,jj,jk)
tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) + zprontot * texcretn
tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) + ( zpropo4n(ji,jj,jk) + zprodopn(ji,jj,jk) ) * texcretn
......@@ -468,8 +467,7 @@ CONTAINS
tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) &
& + zprorcap(ji,jj,jk) * texcretp &
& - xpsino3 * zpronewp(ji,jj,jk) &
& - xpsinh4 * zproregp(ji,jj,jk) &
& - zrespp(ji,jj,jk)
& - xpsinh4 * zproregp(ji,jj,jk)
tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) + zproptot * texcretp
tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) + ( zpropo4p(ji,jj,jk) + zprodopp(ji,jj,jk) ) * texcretp
......@@ -479,8 +477,7 @@ CONTAINS
tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) &
& + zprorcad(ji,jj,jk) * texcretd &
& - xpsino3 * zpronewd(ji,jj,jk) &
& - xpsinh4 * zproregd(ji,jj,jk) &
& - zrespd(ji,jj,jk)
& - xpsinh4 * zproregd(ji,jj,jk)
tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) + zprodtot * texcretd
tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) + ( zpropo4d(ji,jj,jk) + zprodopd(ji,jj,jk) ) * texcretd
......@@ -491,7 +488,7 @@ CONTAINS
tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zproddop
tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) &
& + o2ut * zpregtot + ( o2ut + o2nit ) * zpnewtot - o2ut * zresptot
& + o2ut * zpregtot + ( o2ut + o2nit ) * zpnewtot
tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zprodfer
consfe3(ji,jj,jk) = zprodfer * 75.0 / ( rtrn + ( plig(ji,jj,jk) + 75.0 * (1.0 - plig(ji,jj,jk) ) ) &
......@@ -524,14 +521,19 @@ CONTAINS
! Total primary production per year
IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) &
& tpp = glob_sum( 'p5zprod', ( zprorcan(:,:,:) + zprorcad(:,:,:) + zprorcap(:,:,:) ) * cvol(:,:,:) )
& tpp = glob_sum( 'p5zprod', ( ( zprorcan(:,:,:) - xpsino3 * zpronewn(:,:,:) - xpsinh4 * zproregn(:,:,:) &
& + zprorcad(:,:,:) - xpsino3 * zpronewd(:,:,:) - xpsinh4 * zproregd(:,:,:) &
& + zprorcap(:,:,:) - xpsino3 * zpronewp(:,:,:) - xpsinh4 * zproregp(:,:,:) ) * cvol(:,:,:) ) )
IF( lk_iomput .AND. knt == nrdttrc ) THEN
zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
!
CALL iom_put( "PPPHYP" , zprorcap(:,:,:) * zfact * tmask(:,:,:) ) ! primary production by picophyto
CALL iom_put( "PPPHYN" , zprorcan(:,:,:) * zfact * tmask(:,:,:) ) ! primary production by nanophyto
CALL iom_put( "PPPHYD" , zprorcad(:,:,:) * zfact * tmask(:,:,:) ) ! primary production by diatomes
CALL iom_put( "GPPHYP" , zprorcap(:,:,:) * zfact * tmask(:,:,:) ) ! primary production by picophyto
CALL iom_put( "GPPHYN" , zprorcan(:,:,:) * zfact * tmask(:,:,:) ) ! primary production by nanophyto
CALL iom_put( "GPPHYD" , zprorcad(:,:,:) * zfact * tmask(:,:,:) ) ! primary production by diatomes
CALL iom_put( "PPPHYP" , ( zprorcap(:,:,:) - xpsino3 * zpronewp(:,:,:) - xpsinh4 * zproregp(:,:,:) ) * zfact * tmask(:,:,:) ) ! primary production by picophyto
CALL iom_put( "PPPHYN" , ( zprorcan(:,:,:) - xpsino3 * zpronewn(:,:,:) - xpsinh4 * zproregn(:,:,:) ) * zfact * tmask(:,:,:) ) ! primary production by nanophyto
CALL iom_put( "PPPHYD" , ( zprorcad(:,:,:) - xpsino3 * zpronewd(:,:,:) - xpsinh4 * zproregd(:,:,:) ) * zfact * tmask(:,:,:) ) ! primary production by diatomes
CALL iom_put( "PPNEWN" , zpronewp(:,:,:) * zfact * tmask(:,:,:) ) ! new primary production by picophyto
CALL iom_put( "PPNEWN" , zpronewn(:,:,:) * zfact * tmask(:,:,:) ) ! new primary production by nanophyto
CALL iom_put( "PPNEWD" , zpronewd(:,:,:) * zfact * tmask(:,:,:) ) ! new primary production by diatomes
......@@ -590,7 +592,7 @@ CONTAINS
INTEGER :: ios ! Local integer output status for namelist read
!!
NAMELIST/namp5zprod/ pislopen, pislopep, pisloped, excretn, excretp, excretd, &
& thetannm, thetanpm, thetandm, chlcmin, grosip, bresp, xadap
& thetannm, thetanpm, thetandm, chlcmin, grosip, bresp
!!----------------------------------------------------------------------
READ ( numnatp_ref, namp5zprod, IOSTAT = ios, ERR = 901)
......@@ -608,7 +610,6 @@ CONTAINS
WRITE(numout,*) ' P-I slope pislopen =', pislopen
WRITE(numout,*) ' P-I slope for diatoms pisloped =', pisloped
WRITE(numout,*) ' P-I slope for picophytoplankton pislopep =', pislopep
WRITE(numout,*) ' Acclimation factor to low light xadap =', xadap
WRITE(numout,*) ' excretion ratio of nanophytoplankton excretn =', excretn
WRITE(numout,*) ' excretion ratio of picophytoplankton excretp =', excretp
WRITE(numout,*) ' excretion ratio of diatoms excretd =', excretd
......
src/TOP/README.rst deleted 100644 → 0
View file @ e3e3786b
***************
Oceanic tracers
***************
.. todo::
.. contents::
:local:
TOP (Tracers in the Ocean Paradigm) is the NEMO hardwired interface toward
biogeochemical models and provide the physical constraints/boundaries for oceanic tracers.
It consists of a modular framework to handle multiple ocean tracers,
including also a variety of built-in modules.
This component of the NEMO framework allows one to exploit available modules (see below) and
further develop a range of applications, spanning from the implementation of a dye passive tracer to
evaluate dispersion processes (by means of MY_TRC), track water masses age (AGE module),
assess the ocean interior penetration of persistent chemical compounds
(e.g., gases like CFC or even PCBs), up to the full set of equations involving
marine biogeochemical cycles.
Structure
=========
TOP interface has the following location in the source code :file:`./src/TOP` and
the following modules are available:
:file:`TRP`
Interface to NEMO physical core for computing tracers transport
:file:`CFC`
Inert carbon tracers (CFC11,CFC12,SF6)
:file:`C14`
Radiocarbon passive tracer
:file:`AGE`
Water age tracking
:file:`MY_TRC`
Template for creation of new modules and external BGC models coupling
:file:`PISCES`
Built in BGC model. See :cite:`gmd-8-2465-2015` for a throughout description.
The usage of TOP is activated
*i)* by including in the configuration definition the component ``TOP`` and
*ii)* by adding the macro ``key_top`` in the configuration CPP file
(see for more details :forge:`"Learn more about the model" <wiki/Users>`).
As an example, the user can refer to already available configurations in the code,
``GYRE_PISCES`` being the NEMO biogeochemical demonstrator and
``GYRE_BFM`` to see the required configuration elements to couple with an external biogeochemical model
(see also Section 4) .
Note that, since version 4.0,
TOP interface core functionalities are activated by means of logical keys and
all submodules preprocessing macros from previous versions were removed.
Here below the list of preprocessing keys that applies to the TOP interface (beside ``key_top``):
``key_xios``
use XIOS I/O
``key_agrif``
enable AGRIF coupling
``key_trdtrc`` & ``key_trdmxl_trc``
trend computation for tracers
Synthetic Workflow
==================
A synthetic description of the TOP interface workflow is given below to
summarize the steps involved in the computation of biogeochemical and physical trends and
their time integration and outputs,
by reporting also the principal Fortran subroutine herein involved.
Model initialization (:file:`./src/OCE/nemogcm.F90`)
----------------------------------------------------
Call to ``trc_init`` subroutine (:file:`./src/TOP/trcini.F90`) to initialize TOP.
.. literalinclude:: ../../../src/TOP/trcini.F90
:language: fortran
:lines: 41-86
:emphasize-lines: 21,30-32,38-40
:caption: ``trc_init`` subroutine
Time marching procedure (:file:`./src/OCE/step.F90`)
----------------------------------------------------
Call to ``trc_stp`` subroutine (:file:`./src/TOP/trcstp.F90`) to compute/update passive tracers.
.. literalinclude:: ../../../src/TOP/trcstp.F90
:language: fortran
:lines: 46-125
:emphasize-lines: 42,55-57
:caption: ``trc_stp`` subroutine
BGC trends computation for each submodule (:file:`./src/TOP/trcsms.F90`)
------------------------------------------------------------------------
.. literalinclude:: ../../../src/TOP/trcsms.F90
:language: fortran
:lines: 21
:caption: :file:`trcsms` snippet
Physical trends computation (:file:`./src/TOP/TRP/trctrp.F90`)
--------------------------------------------------------------
.. literalinclude:: ../../../src/TOP/TRP/trctrp.F90
:language: fortran
:lines: 46-95
:emphasize-lines: 17,21,29,33-35
:caption: ``trc_trp`` subroutine
Namelists walkthrough
=====================
:file:`namelist_top`
--------------------
Here below are listed the features/options of the TOP interface accessible through
the :file:`namelist_top_ref` and modifiable by means of :file:`namelist_top_cfg`
(as for NEMO physical ones).
Note that ``##`` is used to refer to a number in an array field.
.. literalinclude:: ../../namelists/namtrc_run
:language: fortran
.. literalinclude:: ../../namelists/namtrc
:language: fortran
.. literalinclude:: ../../namelists/namtrc_dta
:language: fortran
.. literalinclude:: ../../namelists/namtrc_adv
:language: fortran
.. literalinclude:: ../../namelists/namtrc_ldf
:language: fortran
.. literalinclude:: ../../namelists/namtrc_rad
:language: fortran
.. literalinclude:: ../../namelists/namtrc_snk
:language: fortran
.. literalinclude:: ../../namelists/namtrc_dmp
:language: fortran
.. literalinclude:: ../../namelists/namtrc_ice
:language: fortran
.. literalinclude:: ../../namelists/namtrc_trd
:language: fortran
.. literalinclude:: ../../namelists/namtrc_bc
:language: fortran
.. literalinclude:: ../../namelists/namtrc_bdy
:language: fortran
.. literalinclude:: ../../namelists/namage
:language: fortran
Two main types of data structure are used within TOP interface
to initialize tracer properties (1) and
to provide related initial and boundary conditions (2).
1. TOP tracers initialization: ``sn_tracer`` (``&namtrc``)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Beside providing name and metadata for tracers,
here are also defined the use of initial (``sn_tracer%llinit``) and
boundary (``sn_tracer%llsbc, sn_tracer%llcbc, sn_tracer%llobc``) conditions.
In the following, an example of the full structure definition is given for
two idealized tracers both with initial conditions given,
while the first has only surface boundary forcing and
the second both surface and coastal forcings:
.. code-block:: fortran
! ! name ! title of the field ! units ! initial data ! sbc ! cbc ! obc !
sn_tracer(1) = 'TRC1' , 'Tracer 1 Concentration ', ' - ' , .true. , .true., .false., .true.
sn_tracer(2) = 'TRC2 ' , 'Tracer 2 Concentration ', ' - ' , .true. , .true., .true. , .false.
As tracers in BGC models are increasingly growing,
the same structure can be written also in a more compact and readable way:
.. code-block:: fortran
! ! name ! title of the field ! units ! initial data !
sn_tracer(1) = 'TRC1' , 'Tracer 1 Concentration ', ' - ' , .true.
sn_tracer(2) = 'TRC2 ' , 'Tracer 2 Concentration ', ' - ' , .true.
! sbc
sn_tracer(1)%llsbc = .true.
sn_tracer(2)%llsbc = .true.
! cbc
sn_tracer(2)%llcbc = .true.
The data structure is internally initialized by code with dummy names and
all initialization/forcing logical fields set to ``.false.`` .
2. Structures to read input initial and boundary conditions: ``&namtrc_dta`` (``sn_trcdta``), ``&namtrc_bc`` (``sn_trcsbc`` / ``sn_trccbc`` / ``sn_trcobc``)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
The overall data structure (Fortran type) is based on the general one defined for NEMO core in the SBC component
(see details in ``SBC`` Chapter of :doc:`Reference Manual <cite>` on Input Data specification).
Input fields are prescribed within ``&namtrc_dta`` (with ``sn_trcdta`` structure),
while Boundary Conditions are applied to the model by means of ``&namtrc_bc``,
with dedicated structure fields for surface (``sn_trcsbc``), riverine (``sn_trccbc``), and
lateral open (``sn_trcobc``) boundaries.
The following example illustrates the data structure in the case of initial condition for
a single tracer contained in the file named :file:`tracer_1_data.nc`
(``.nc`` is implicitly assumed in namelist filename),
with a doubled initial value, and located in the :file:`usr/work/model/inputdata` folder:
.. code-block:: fortran
! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask !
! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename !
sn_trcdta(1) = 'tracer_1_data' , -12 , 'TRC1' , .false. , .true. , 'yearly' , '' , '' , ''
rf_trfac(1) = 2.0
cn_dir = 'usr/work/model/inputdata/'
Note that, the Lateral Open Boundaries conditions are applied on
the segments defined for the physical core of NEMO
(see ``BDY`` description in the :doc:`Reference Manual <cite>`).
:file:`namelist_trc`
--------------------
Here below the description of :file:`namelist_trc_ref` used to handle Carbon tracers modules,
namely CFC and C14.
.. literalinclude:: ../../../cfgs/SHARED/namelist_trc_ref
:language: fortran
:lines: 7,17,26,34
:caption: :file:`namelist_trc_ref` snippet
``MY_TRC`` interface for coupling external BGC models
=====================================================
The generalized interface is pivoted on MY_TRC module that contains template files to
build the coupling between
NEMO and any external BGC model.
The call to MY_TRC is activated by setting ``ln_my_trc = .true.`` (in ``&namtrc``)
The following 6 fortran files are available in MY_TRC with the specific purposes here described.
:file:`par_my_trc.F90`
This module allows to define additional arrays and public variables to
be used within the MY_TRC interface
:file:`trcini_my_trc.F90`
Here are initialized user defined namelists and
the call to the external BGC model initialization procedures to populate general tracer array
(``trn`` and ``trb``).
Here are also likely to be defined support arrays related to system metrics that
could be needed by the BGC model.
:file:`trcnam_my_trc.F90`
This routine is called at the beginning of ``trcini_my_trc`` and
should contain the initialization of additional namelists for the BGC model or user-defined code.
:file:`trcsms_my_trc.F90`
The routine performs the call to Boundary Conditions and its main purpose is to
contain the Source-Minus-Sinks terms due to the biogeochemical processes of the external model.
Be aware that lateral boundary conditions are applied in trcnxt routine.
.. warning::
The routines to compute the light penetration along the water column and
the tracer vertical sinking should be defined/called in here,
as generalized modules are still missing in the code.
:file:`trcice_my_trc.F90`
Here it is possible to prescribe the tracers concentrations in the sea-ice that
will be used as boundary conditions when ice melting occurs (``nn_ice_tr = 1`` in ``&namtrc_ice``).
See e.g. the correspondent PISCES subroutine.
:file:`trcwri_my_trc.F90`
This routine performs the output of the model tracers (only those defined in ``&namtrc``) using
IOM module (see chapter “Output and Diagnostics” in the :doc:`Reference Manual <cite>`).
It is possible to place here the output of additional variables produced by the model,
if not done elsewhere in the code, using the call to ``iom_put``.
Coupling an external BGC model using NEMO framework
===================================================
The coupling with an external BGC model through the NEMO compilation framework can be achieved in
different ways according to the degree of coding complexity of the Biogeochemical model, like e.g.,
the whole code is made only by one file or
it has multiple modules and interfaces spread across several subfolders.
Beside the 6 core files of MY_TRC module, let’s assume an external BGC model named *MYBGC* and
constituted by a rather essential coding structure, likely few Fortran files.
The new coupled configuration name is *NEMO_MYBGC*.
The best solution is to have all files (the modified ``MY_TRC`` routines and the BGC model ones)
placed in a unique folder with root ``MYBGCPATH`` and
to use the makenemo external readdressing of ``MY_SRC`` folder.
The coupled configuration listed in :file:`work_cfgs.txt` will look like
::
NEMO_MYBGC OCE TOP
and the related ``cpp_MYBGC.fcm`` content will be
.. code-block:: perl
bld::tool::fppkeys key_xios key_top
the compilation with :file:`makenemo` will be executed through the following syntax
.. code-block:: console
$ makenemo -n 'NEMO_MYBGC' -m '<arch_my_machine>' -j 8 -e '<MYBGCPATH>'
The makenemo feature ``-e`` was introduced to
readdress at compilation time the standard MY_SRC folder (usually found in NEMO configurations) with
a user defined external one.
The compilation of more articulated BGC model code & infrastructure,
like in the case of BFM (|BFM man|_), requires some additional features.
As before, let’s assume a coupled configuration name *NEMO_MYBGC*,
but in this case MYBGC model root becomes :file:`MYBGC` path that
contains 4 different subfolders for biogeochemistry,
named :file:`initialization`, :file:`pelagic`, and :file:`benthic`,
and a separate one named :file:`nemo_coupling` including the modified `MY_SRC` routines.
The latter folder containing the modified NEMO coupling interface will be still linked using
the makenemo ``-e`` option.
In order to include the BGC model subfolders in the compilation of NEMO code,
it will be necessary to extend the configuration :file:`cpp_NEMO_MYBGC.fcm` file to include the specific paths of :file:`MYBGC` folders, as in the following example
.. code-block:: perl
bld::tool::fppkeys key_xios key_top
src::MYBGC::initialization <MYBGCPATH>/initialization
src::MYBGC::pelagic <MYBGCPATH>/pelagic
src::MYBGC::benthic <MYBGCPATH>/benthic
bld::pp::MYBGC 1
bld::tool::fppflags::MYBGC %FPPFLAGS
bld::tool::fppkeys %bld::tool::fppkeys MYBGC_MACROS
where *MYBGC_MACROS* is the space delimited list of macros used in *MYBGC* model for
selecting/excluding specific parts of the code.
The BGC model code will be preprocessed in the configuration :file:`BLD` folder as for NEMO,
but with an independent path, like :file:`NEMO_MYBGC/BLD/MYBGC/<subforlders>`.
The compilation will be performed similarly to in the previous case with the following
.. code-block:: console
$ makenemo -n 'NEMO_MYBGC' -m '<arch_my_machine>' -j 8 -e '<MYBGCPATH>/nemo_coupling'
.. note::
The additional lines specific for the BGC model source and build paths can be written into
a separate file, e.g. named :file:`MYBGC.fcm`,
and then simply included in the :file:`cpp_NEMO_MYBGC.fcm` as follow
.. code-block:: perl
bld::tool::fppkeys key_xios key_top
inc <MYBGCPATH>/MYBGC.fcm
This will enable a more portable compilation structure for all MYBGC related configurations.
.. warning::
The coupling interface contained in :file:`nemo_coupling` cannot be added using the FCM syntax,
as the same files already exists in NEMO and they are overridden only with
the readdressing of MY_SRC contents to avoid compilation conflicts due to duplicate routines.
All modifications illustrated above, can be easily implemented using shell or python scripting
to edit the NEMO configuration :file:`CPP.fcm` file and
to create the BGC model specific FCM compilation file with code paths.
.. |BFM man| replace:: BFM-NEMO coupling manual
src/TOP/TRP/trcbbl.F90
View file @ 672ff863
......@@ -55,11 +55,6 @@ CONTAINS
!
IF( ln_timing ) CALL timing_start('trc_bbl')
!
IF( .NOT. l_offline ) THEN
CALL bbl( kt, nittrc000, 'TRC', Kbb, Kmm ) ! Online coupling with dynamics : Computation of bbl coef and bbl transport
l_bbl = .FALSE. ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files
ENDIF
IF( l_trdtrc ) THEN
ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) ! temporary save of trends
ztrtrd(:,:,:,:) = ptr(:,:,:,:,Krhs)
......
src/TOP/TRP/trcrad.F90
View file @ 672ff863
......@@ -28,7 +28,7 @@ MODULE trcrad
PUBLIC trc_rad_ini
LOGICAL , PUBLIC :: ln_trcrad !: flag to artificially correct negative concentrations
REAL(wp), DIMENSION(:,:), ALLOCATABLE:: gainmass
REAL(wp), DIMENSION(:), ALLOCATABLE:: gainmass
!! * Substitutions
# include "do_loop_substitute.h90"
......@@ -109,8 +109,8 @@ CONTAINS
ENDIF
ENDIF
!
ALLOCATE( gainmass(jptra,2) )
gainmass(:,:) = 0.
ALLOCATE( gainmass(jptra) )
gainmass(:) = 0.
!
END SUBROUTINE trc_rad_ini
......@@ -176,7 +176,7 @@ CONTAINS
zcoef = 1. + ztrneg(ji,jj,jn) / ztrpos(ji,jj,jn) ! ztrpos > 0 as ptr > 0
ptr(ji,jj,jk,jn,itime) = ptr(ji,jj,jk,jn,itime) * zcoef
IF( zcoef < 0. ) THEN ! if the compensation exceed the positive value
gainmass(jn,1) = gainmass(jn,1) - ptr(ji,jj,jk,jn,itime) * cvol(ji,jj,jk) ! we are adding mass...
gainmass(jn) = gainmass(jn) - ptr(ji,jj,jk,jn,itime) * cvol(ji,jj,jk) ! we are adding mass...
ptr(ji,jj,jk,jn,itime) = 0. ! limit the compensation to keep positive value
ENDIF
ENDIF
......@@ -192,12 +192,12 @@ CONTAINS
END DO
IF( kt == nitend ) THEN
CALL mpp_sum( 'trcrad', gainmass(:,1) )
CALL mpp_sum( 'trcrad', gainmass(:) )
DO jn = jp_sms0, jp_sms1
IF( gainmass(jn,1) > 0. ) THEN
IF( gainmass(jn) > 0. ) THEN
ztotmass = glob_sum( 'trcrad', ptr(:,:,:,jn,itime) * cvol(:,:,:) )
IF(lwp) WRITE(numout, '(a, i2, a, D23.16, a, D23.16)') 'trcrad ptrb, traceur ', jn &
& , ' total mass : ', ztotmass, ', mass gain : ', gainmass(jn,1)
IF(lwp) WRITE(numout, '(a, i2, a, D23.16, a, D23.16)') 'trcrad ptrb, tracer ', jn &
& , ' total mass : ', ztotmass, ', mass gain : ', gainmass(jn)
END IF
END DO
ENDIF
......
src/TOP/TRP/trdmxl_trc.F90
View file @ 672ff863
......@@ -5,7 +5,6 @@ MODULE trdmxl_trc
!!======================================================================
!! History : 9.0 ! 06-08 (C. Deltel) Original code (from trdmxl.F90)
!! ! 07-04 (C. Deltel) Bug fix : add trcrad trends
!! ! 07-06 (C. Deltel) key_gyre : do not call lbc_lnk
!!----------------------------------------------------------------------
#if defined key_top && defined key_trdmxl_trc
!!----------------------------------------------------------------------
......@@ -283,7 +282,7 @@ CONTAINS
DO jn = 1, jptra
IF( ln_trdtrc(jn) ) THEN
DO jl = 1, jpltrd_trc
CALL lbc_lnk( 'trdmxl_trc', tmltrd_trc(:,:,jl,jn), 'T', 1. ) ! lateral boundary conditions
CALL lbc_lnk( 'trdmxl_trc', tmltrd_trc(:,:,jl,jn), 'T', 1._wp ) ! lateral boundary conditions
END DO
ENDIF
END DO
......@@ -418,8 +417,8 @@ CONTAINS
!-- Lateral boundary conditions
IF ( cn_cfg .NE. 'gyre' ) THEN
CALL lbc_lnk( 'trdmxl_trc', ztmltot(:,:,jn) , 'T', 1. , ztmlres(:,:,jn) , 'T', 1., &
& ztmlatf(:,:,jn) , 'T', 1. , ztmlrad(:,:,jn) , 'T', 1. )
CALL lbc_lnk( 'trdmxl_trc', ztmltot(:,:,jn) , 'T', 1._wp , ztmlres(:,:,jn) , 'T', 1._wp, &
& ztmlatf(:,:,jn) , 'T', 1._wp , ztmlrad(:,:,jn) , 'T', 1._wp )
ENDIF
......@@ -469,9 +468,9 @@ CONTAINS
!-- Lateral boundary conditions
IF ( cn_cfg .NE. 'gyre' ) THEN ! other than GYRE configuration
CALL lbc_lnk( 'trdmxl_trc', ztmltot2(:,:,jn), 'T', 1., ztmlres2(:,:,jn), 'T', 1. )
CALL lbc_lnk( 'trdmxl_trc', ztmltot2(:,:,jn), 'T', 1._wp, ztmlres2(:,:,jn), 'T', 1._wp )
DO jl = 1, jpltrd_trc
CALL lbc_lnk( 'trdmxl_trc', ztmltrd2(:,:,jl,jn), 'T', 1. ) ! will be output in the NetCDF trends file
CALL lbc_lnk( 'trdmxl_trc', ztmltrd2(:,:,jl,jn), 'T', 1._wp ) ! will be output in the NetCDF trends file
END DO
ENDIF
......
src/TOP/trc.F90
View file @ 672ff863
......@@ -131,6 +131,7 @@ MODULE trc
CHARACTER(len=20), PUBLIC, DIMENSION(jp_bdy) :: cn_trc_dflt ! Default OBC condition for all tracers
CHARACTER(len=20), PUBLIC, DIMENSION(jp_bdy) :: cn_trc ! Choice of boundary condition for tracers
INTEGER, PUBLIC, DIMENSION(jp_bdy) :: nn_trcdmp_bdy !: =T Tracer damping
LOGICAL, PUBLIC, DIMENSION(jp_bdy) :: ln_zintobc !: =T obc data requires a vertical interpolation
!
! Vertical axis used in the sediment module
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: profsed
......
src/TOP/trcbc.F90
View file @ 672ff863
......@@ -35,9 +35,9 @@ MODULE trcbc
TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trccbc ! structure of data input CBC (file informations, fields read)
REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trofac ! multiplicative factor for OBCtracer values
#if defined key_agrif
TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcobc ! structure of data input OBC (file informations, fields read)
TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: sf_trcobc ! structure of data input OBC (file informations, fields read)
#else
TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET :: sf_trcobc
TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET :: sf_trcobc
#endif
#if defined key_top
......@@ -71,20 +71,22 @@ CONTAINS
INTEGER :: ierr0, ierr1, ierr2, ierr3 ! temporary integers
INTEGER :: ios ! Local integer output status for namelist read
INTEGER :: nblen, igrd ! support arrays for BDY
CHARACTER(len=100) :: clndta, clntrc
CHARACTER(len=10) :: clnbdy
!
CHARACTER(len=100) :: cn_dir_sbc, cn_dir_cbc, cn_dir_obc
TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! local array of namelist informations on the fields to read
TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc ! open
TYPE(FLD_N), DIMENSION(jp_bdy) :: sn_trcobc ! open
TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcsbc ! surface
TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trccbc ! coastal
REAL(wp) , DIMENSION(jpmaxtrc) :: rn_trofac ! multiplicative factor for tracer values
REAL(wp) , DIMENSION(jpmaxtrc) :: rn_trsfac ! multiplicative factor for tracer values
REAL(wp) , DIMENSION(jpmaxtrc) :: rn_trcfac ! multiplicative factor for tracer values
CHARACTER(len=lca), DIMENSION(jpmaxtrc) :: cn_tronam ! tracer- to variable-name translation
!!
NAMELIST/namtrc_bc/ cn_dir_obc, sn_trcobc, rn_trofac, cn_dir_sbc, sn_trcsbc, rn_trsfac, &
& cn_dir_cbc, sn_trccbc, rn_trcfac, ln_rnf_ctl, rn_sbc_time, rn_cbc_time
NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy
NAMELIST/namtrc_bc/ cn_dir_obc, sn_trcobc, rn_trofac, cn_tronam, &
& cn_dir_sbc, sn_trcsbc, rn_trsfac, &
& cn_dir_cbc, sn_trccbc, rn_trcfac, &
& ln_rnf_ctl, rn_sbc_time, rn_cbc_time
!!----------------------------------------------------------------------
!
IF( lwp ) THEN
......@@ -106,6 +108,10 @@ CONTAINS
ENDIF
nb_trcobc = 0
n_trc_indobc(:) = 0
rn_trofac(:) = 1._wp
DO jn = 1, ntrc
cn_tronam(jn) = TRIM( ctrcnm(jn) ) ! Default variable name of open-boundary input data
END DO
!
ALLOCATE( n_trc_indsbc(ntrc), STAT=ierr0 )
IF( ierr0 > 0 ) THEN
......@@ -113,6 +119,7 @@ CONTAINS
ENDIF
nb_trcsbc = 0
n_trc_indsbc(:) = 0
rn_trsfac(:) = 1._wp
!
ALLOCATE( n_trc_indcbc(ntrc), STAT=ierr0 )
IF( ierr0 > 0 ) THEN
......@@ -120,6 +127,7 @@ CONTAINS
ENDIF
nb_trccbc = 0
n_trc_indcbc(:) = 0
rn_trcfac(:) = 1._wp
!
! Read Boundary Conditions Namelists
READ ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901)
......@@ -128,37 +136,8 @@ CONTAINS
902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist' )
IF(lwm) WRITE ( numont, namtrc_bc )
IF ( ln_bdy ) THEN
READ ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903)
903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist' )
! make sur that all elements of the namelist variables have a default definition from namelist_ref
cn_trc (2:jp_bdy) = cn_trc (1)
cn_trc_dflt(2:jp_bdy) = cn_trc_dflt(1)
READ ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 )
904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist' )
IF(lwm) WRITE ( numont, namtrc_bdy )
! setup up preliminary informations for BDY structure
DO jn = 1, ntrc
DO ib = 1, nb_bdy
! Set type of obc in BDY data structure (around here we may plug user override of obc type from nml)
IF ( ln_trc_obc(jn) ) THEN ; trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc (ib) )
ELSE ; trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) )
ENDIF
! set damping use in BDY data structure
trcdta_bdy(jn,ib)%dmp = .false.
IF(nn_trcdmp_bdy(ib) == 1 .AND. ln_trc_obc(jn) ) trcdta_bdy(jn,ib)%dmp = .true.
IF(nn_trcdmp_bdy(ib) == 2 ) trcdta_bdy(jn,ib)%dmp = .true.
IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) /= 0 ) &
& CALL ctl_stop( 'trc_bc_ini: Use FRS OR relaxation' )
IF( .NOT.( 0 <= nn_trcdmp_bdy(ib) .AND. nn_trcdmp_bdy(ib) <= 2 ) ) &
& CALL ctl_stop( 'trc_bc_ini: Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' )
END DO
END DO
ELSE
! Force all tracers OBC to false if bdy not used
ln_trc_obc = .false.
ENDIF
! Disable passive-tracer OBC data input if BDY is inactive
IF( .NOT. ln_bdy ) ln_trc_obc(:) = .FALSE.
! compose BC data indexes
DO jn = 1, ntrc
......@@ -174,6 +153,7 @@ CONTAINS
END DO
! Print summmary of Boundary Conditions
IF( .NOT.ln_rnf .OR. .NOT.ln_linssh ) ln_rnf_ctl = .FALSE.
IF( lwp ) THEN
WRITE(numout,*)
WRITE(numout,'(a,i3)') ' Total tracers to be initialized with SURFACE BCs data:', nb_trcsbc
......@@ -194,67 +174,49 @@ CONTAINS
END DO
ENDIF
WRITE(numout,'(2a)') ' COASTAL BC data repository : ', TRIM(cn_dir_cbc)
IF( .NOT.ln_rnf .OR. .NOT.ln_linssh ) ln_rnf_ctl = .FALSE.
IF( ln_rnf_ctl ) WRITE(numout,'(a)') &
& ' -> Remove runoff dilution effect on tracers with absent river load (ln_rnf_ctl = .TRUE.)'
WRITE(numout,*)
WRITE(numout,'(a,i3)') ' Total tracers to be initialized with OPEN BCs data:', nb_trcobc
IF( ln_bdy .AND. nb_trcobc > 0 ) THEN
WRITE(numout,*) ' #trc NAME Boundary Mult.Fact. OBC Settings'
IF( nb_trcobc > 0 ) THEN
WRITE(numout,*) ' #trc NAME Boundary Mult.Fact. '
DO jn = 1, ntrc
IF ( ln_trc_obc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trcobc(jn)%clvar ), 'OBC', rn_trofac(jn), &
& (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy)
IF ( .NOT. ln_trc_obc(jn) ) WRITE(numout, 9002) jn, 'Set data to IC and use default condition' , &
& (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy)
END DO
WRITE(numout,*) ' '
DO ib = 1, nb_bdy
IF(nn_trcdmp_bdy(ib) == 0) WRITE(numout,9003) ' Boundary ', ib, &
& ' -> NO damping of tracers'
IF(nn_trcdmp_bdy(ib) == 1) WRITE(numout,9003) ' Boundary ', ib, &
& ' -> damping ONLY for tracers with external data provided'
IF(nn_trcdmp_bdy(ib) == 2) WRITE(numout,9003) ' Boundary ', ib, &
& ' -> damping of ALL tracers'
IF(nn_trcdmp_bdy(ib) > 0) THEN
WRITE(numout,9003) ' USE damping parameters from nambdy for boundary ', ib,' : '
WRITE(numout,'(a,f10.2,a)') ' - Inflow damping time scale : ',rn_time_dmp (ib),' days'
WRITE(numout,'(a,f10.2,a)') ' - Outflow damping time scale : ',rn_time_dmp_out(ib),' days'
ENDIF
IF ( ln_trc_obc(jn) ) WRITE(numout, 9001) jn, TRIM( cn_tronam(jn) ), 'OBC', rn_trofac(jn)
END DO
ENDIF
!
WRITE(numout,'(2a)') ' OPEN BC data repository : ', TRIM(cn_dir_obc)
ENDIF
9001 FORMAT(2x,i5, 3x, a15, 3x, a5, 6x, e11.3, 4x, 10a13)
9002 FORMAT(2x,i5, 3x, a41, 3x, 10a13)
9003 FORMAT(a, i5, a)
!
!
! OPEN Lateral boundary conditions
IF( ln_bdy .AND. nb_trcobc > 0 ) THEN
ALLOCATE ( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), STAT=ierr1 )
ALLOCATE ( sf_trcobc(nb_trcobc, nb_bdy), rf_trofac(nb_trcobc), STAT=ierr1 )
IF( ierr1 > 0 ) THEN
CALL ctl_stop( 'trc_bc_ini: unable to allocate sf_trcobc structure' ) ; RETURN
ENDIF
!
igrd = 1 ! Everything is at T-points here
!
DO jn = 1, ntrc
DO ib = 1, nb_bdy
DO ib = 1, nb_bdy
write(clnbdy,'(i2)') ib
DO jn = 1, ntrc
!
nblen = idx_bdy(ib)%nblen(igrd)
!
IF( ln_trc_obc(jn) ) THEN !* Initialise from external data *!
jl = n_trc_indobc(jn)
slf_i(jl) = sn_trcobc(jn)
slf_i(jl) = sn_trcobc(ib)
slf_i(jl)%clvar = TRIM(cn_tronam(jn))
rf_trofac(jl) = rn_trofac(jn)
ALLOCATE( sf_trcobc(jl)%fnow(nblen,1,jpk) , STAT=ierr2 )
IF( sn_trcobc(jn)%ln_tint ) ALLOCATE( sf_trcobc(jl)%fdta(nblen,1,jpk,2) , STAT=ierr3 )
ALLOCATE( sf_trcobc(jl,ib)%fnow(nblen,1,jpk) , STAT=ierr2 )
IF( sn_trcobc(ib)%ln_tint ) ALLOCATE( sf_trcobc(jl,ib)%fdta(nblen,1,jpk,2) , STAT=ierr3 )
IF( ierr2 + ierr3 > 0 ) THEN
CALL ctl_stop( 'trc_bc_ini : unable to allocate passive tracer OBC data arrays' ) ; RETURN
ENDIF
trcdta_bdy(jn,ib)%trc => sf_trcobc(jl)%fnow(:,1,:)
trcdta_bdy(jn,ib)%trc => sf_trcobc(jl,ib)%fnow(:,1,:)
trcdta_bdy(jn,ib)%rn_fac = rf_trofac(jl)
ELSE !* Initialise obc arrays from initial conditions *!
ALLOCATE ( trcdta_bdy(jn,ib)%trc(nblen,jpk) )
......@@ -268,14 +230,18 @@ CONTAINS
trcdta_bdy(jn,ib)%rn_fac = 1._wp
ENDIF
END DO
!
CALL fld_fill( sf_trcobc(:,ib), slf_i, cn_dir_obc, 'trc_bc_ini', 'Passive tracer OBC data at boundary '//TRIM(clnbdy), 'namtrc_bc' )
END DO
!
CALL fld_fill( sf_trcobc, slf_i, cn_dir_obc, 'trc_bc_ini', 'Passive tracer OBC data', 'namtrc_bc' )
DO jn = 1, ntrc ! define imap pointer, must be done after the call to fld_fill
DO ib = 1, nb_bdy
IF( ln_trc_obc(jn) ) THEN !* Initialise from external data *!
jl = n_trc_indobc(jn)
sf_trcobc(jl)%imap => idx_bdy(ib)%nbmap(1:idx_bdy(ib)%nblen(igrd),igrd)
sf_trcobc(jl,ib)%imap => idx_bdy(ib)%nbmap(1:idx_bdy(ib)%nblen(igrd),igrd)
sf_trcobc(jl,ib)%igrd = igrd
sf_trcobc(jl,ib)%ibdy = ib
sf_trcobc(jl,ib)%lzint = ln_zintobc(ib) ! vertical interpolation
ENDIF
END DO
END DO
......@@ -353,8 +319,9 @@ CONTAINS
INTEGER , INTENT(in), OPTIONAL :: jit ! subcycle time-step index (for timesplitting option)
REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation
!!
INTEGER :: ji, jj, jk, jn, jl ! Loop index
INTEGER :: ji, jj, jk, jn, jl, ib ! Loop index
REAL(wp) :: zfact, zrnf
LOGICAL :: lwriter
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('trc_bc')
......@@ -365,24 +332,29 @@ CONTAINS
WRITE(numout,*) '~~~~~~~ '
ENDIF
lwriter = .FALSE.
IF( kt - nit000 <= 20 .OR. nitend - kt <= 20 ) lwriter = lwp
! 1. Update Boundary conditions data
IF( PRESENT(jit) ) THEN
!
! BDY: use pt_offset=0.5 as applied at the end of the step and fldread is referenced at the middle of the step
IF( nb_trcobc > 0 ) THEN
if (lwp) write(numout,'(a,i5,a,i10)') ' reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt
CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, kit=jit, pt_offset = 0.5_wp )
DO ib = 1, nb_bdy
if (lwriter) write(numout,'(a,i3,a,i10)') ' reading OBC data for segment ', ib ,' at step ', kt
CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc(:,ib), kit=jit, pt_offset = 0.5_wp )
ENDDO
ENDIF
!
! SURFACE boundary conditions
IF( nb_trcsbc > 0 ) THEN
if (lwp) write(numout,'(a,i5,a,i10)') ' reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt
if (lwriter) write(numout,'(a,i5,a,i10)') ' reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt
CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit)
ENDIF
!
! COASTAL boundary conditions
IF( nb_trccbc > 0 ) THEN
if (lwp) write(numout,'(a,i5,a,i10)') ' reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt
if (lwriter) write(numout,'(a,i5,a,i10)') ' reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt
CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit)
ENDIF
!
......@@ -390,19 +362,21 @@ CONTAINS
!
! BDY: use pt_offset=0.5 as applied at the end of the step and fldread is referenced at the middle of the step
IF( nb_trcobc > 0 ) THEN
if (lwp) write(numout,'(a,i5,a,i10)') ' reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt
CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, pt_offset = 0.5_wp )
DO ib = 1, nb_bdy
if (lwriter) write(numout,'(a,i3,a,i10)') ' reading OBC data for segment ', ib ,' at step ', kt
CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc(:,ib), pt_offset = 0.5_wp )
ENDDO
ENDIF
!
! SURFACE boundary conditions
IF( nb_trcsbc > 0 ) THEN
if (lwp) write(numout,'(a,i5,a,i10)') ' reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt
if (lwriter) write(numout,'(a,i5,a,i10)') ' reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt
CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcsbc )
ENDIF
!
! COASTAL boundary conditions
IF( nb_trccbc > 0 ) THEN
if (lwp) write(numout,'(a,i5,a,i10)') ' reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt
if (lwriter) write(numout,'(a,i5,a,i10)') ' reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt
CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trccbc )
ENDIF
!
......
src/TOP/trcbdy.F90
View file @ 672ff863
......@@ -26,6 +26,7 @@ MODULE trcbdy
IMPLICIT NONE
PRIVATE
PUBLIC trc_bdy_ini ! routine called in trcini.F90
PUBLIC trc_bdy ! routine called in trcnxt.F90
PUBLIC trc_bdy_dmp ! routine called in trcstp.F90
......@@ -36,6 +37,90 @@ MODULE trcbdy
!!----------------------------------------------------------------------
CONTAINS
SUBROUTINE trc_bdy_ini( ntrc )
!!----------------------------------------------------------------------
!! *** ROUTINE trc_bdy_ini ***
!!
!! ** Purpose : initialisation of the passive-tracer open boundary
!! conditions
!!
!! ** Action : reading in of the namtrc_bdy namelist
!!
!!----------------------------------------------------------------------
INTEGER, INTENT(in) :: ntrc ! number of tracers
!!
INTEGER :: jn, ib ! loop indices
INTEGER :: ios ! namelist input status
!!
NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy, ln_zintobc
!!----------------------------------------------------------------------
!
IF(lwp) THEN
WRITE(numout,*)
WRITE(numout,*) 'trc_bdy_ini : passive-tracer open boundary conditions'
WRITE(numout,*) '~~~~~~~~~~~'
END IF
!
READ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903 )
903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist' )
! make sure that all elements of the namelist variables have a default definition from namelist_top_ref
cn_trc (2:jp_bdy) = cn_trc (1)
cn_trc_dflt (2:jp_bdy) = cn_trc_dflt (1)
nn_trcdmp_bdy(2:jp_bdy) = nn_trcdmp_bdy(1)
READ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 )
904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist' )
IF(lwm) WRITE ( numont, namtrc_bdy )
! setup up preliminary information for BDY structure
DO jn = 1, ntrc
DO ib = 1, nb_bdy
! set type of obc in BDY data structure
IF ( ln_trc_obc(jn) ) THEN
trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc (ib) )
ELSE
trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) )
ENDIF
! set damping use in BDY data structure
trcdta_bdy(jn,ib)%dmp = .FALSE.
IF(nn_trcdmp_bdy(ib) == 1 .AND. ln_trc_obc(jn) ) trcdta_bdy(jn,ib)%dmp = .TRUE.
IF(nn_trcdmp_bdy(ib) == 2 ) trcdta_bdy(jn,ib)%dmp = .TRUE.
IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) /= 0 ) &
& CALL ctl_stop( 'trc_bc_ini: use FRS OR relaxation' )
IF( .NOT. ( 0 <= nn_trcdmp_bdy(ib) .AND. nn_trcdmp_bdy(ib) <= 2 ) ) &
& CALL ctl_stop( 'trc_bc_ini: not a valid option for nn_trcdmp_bdy (0, 1, or 2)' )
END DO
END DO
!
IF(lwp) THEN
WRITE(numout,*) ' #trc NAME Boundary Mult.Fact. OBC Settings'
DO jn = 1, ntrc
IF ( ln_trc_obc(jn) ) WRITE(numout, 9001) jn, TRIM(ctrcnm(jn)), 'OBC', &
& (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy)
IF ( .NOT. ln_trc_obc(jn) ) WRITE(numout, 9002) jn, TRIM(ctrcnm(jn)), 'Boundary data from IC', &
& (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy)
END DO
WRITE(numout,*) ' '
DO ib = 1, nb_bdy
IF(nn_trcdmp_bdy(ib) == 0) WRITE(numout,9003) ' Boundary ', ib, &
& ' -> NO damping of tracers'
IF(nn_trcdmp_bdy(ib) == 1) WRITE(numout,9003) ' Boundary ', ib, &
& ' -> damping ONLY for tracers with external data provided'
IF(nn_trcdmp_bdy(ib) == 2) WRITE(numout,9003) ' Boundary ', ib, &
& ' -> damping of ALL tracers'
IF(nn_trcdmp_bdy(ib) > 0) THEN
WRITE(numout,9003) ' USE damping parameters from nambdy for boundary ', ib,' : '
WRITE(numout,'(a,f10.2,a)') ' - Inflow damping time scale : ',rn_time_dmp (ib),' days'
WRITE(numout,'(a,f10.2,a)') ' - Outflow damping time scale : ',rn_time_dmp_out(ib),' days'
ENDIF
END DO
!
WRITE(numout,*) ' '
WRITE(numout,*) ' Vertical interpolation on segment(s) : ', (ln_zintobc(ib),ib=1,nb_bdy)
END IF
9001 FORMAT(2x, i5, 3x, a15, 3x, a5, 21x, 10a13)
9002 FORMAT(2x, i5, 3x, a15, 3x, a22, 4x, 10a13)
9003 FORMAT(a, i5, a)
END SUBROUTINE trc_bdy_ini
SUBROUTINE trc_bdy( kt, Kbb, Kmm, Krhs )
!!----------------------------------------------------------------------
!! *** SUBROUTINE trc_bdy ***
......
src/TOP/trcini.F90
View file @ 672ff863
......@@ -26,6 +26,7 @@ MODULE trcini
USE trcice ! tracers in sea ice
USE trcbc ! generalized Boundary Conditions
USE trcais ! tracers from Antartic Ice Sheet
USE trcbdy ! passive-tracer open boundary conditions
IMPLICIT NONE
PRIVATE
......@@ -265,7 +266,8 @@ CONTAINS
!
tr(:,:,:,:,Kaa) = 0._wp
!
IF( ln_trcbc .AND. lltrcbc ) THEN
IF( ln_bdy ) CALL trc_bdy_ini( jptra )
IF( ln_trcbc .AND. lltrcbc ) THEN
CALL trc_bc_ini ( jptra, Kmm ) ! set tracers Boundary Conditions
CALL trc_bc ( nit000, Kmm, tr, Kaa ) ! tracers: surface and lateral Boundary Conditions
ENDIF
......
src/TOP/trcnam.F90
View file @ 672ff863
......@@ -62,16 +62,12 @@ CONTAINS
!
!
IF(lwp) THEN ! control print
WRITE(numout,*)
IF( ln_rsttr ) THEN
WRITE(numout,*)
WRITE(numout,*) ' ==>>> Read a restart file for passive tracer : ', TRIM( cn_trcrst_in )
ENDIF
IF( ln_trcdta .AND. .NOT.ln_rsttr ) THEN
WRITE(numout,*)
ELSE IF( ln_trcdta ) THEN
WRITE(numout,*) ' ==>>> Some of the passive tracers are initialised from climatologies '
ENDIF
IF( .NOT.ln_trcdta ) THEN
WRITE(numout,*)
ELSE
WRITE(numout,*) ' ==>>> All the passive tracers are initialised with constant values '
ENDIF
ENDIF
......
src/TOP/trcrst.F90
View file @ 672ff863
......@@ -133,9 +133,14 @@ CONTAINS
CALL iom_get( numrtr, jpdom_auto, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kmm) )
END DO
DO jn = 1, jptra
CALL iom_get( numrtr, jpdom_auto, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) )
END DO
IF( l_1st_euler .OR. ln_top_euler ) THEN
IF(lwp) WRITE(numout,*) ' + adjustment for forward Euler time stepping'
tr(:,:,:,1:jptra,Kbb) = tr(:,:,:,1:jptra,Kmm)
ELSE
DO jn = 1, jptra
CALL iom_get( numrtr, jpdom_auto, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) )
END DO
END IF
!
IF(.NOT.lrxios) CALL iom_delay_rst( 'READ', 'TOP', numrtr ) ! read only TOP delayed global communication variables
END SUBROUTINE trc_rst_read
......@@ -356,7 +361,7 @@ CONTAINS
ENDIF
!
DO jk = 1, jpk
zvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Krhs) * tmask(:,:,jk)
zvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
END DO
!
DO jn = 1, jptra
......
src/TOP/trcstp.F90
View file @ 672ff863
......@@ -58,15 +58,18 @@ CONTAINS
INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! time level indices
!
INTEGER :: jk, jn ! dummy loop indices
INTEGER :: ibb ! local time-level index
REAL(wp):: ztrai ! local scalar
LOGICAL :: ll_trcstat ! local logical
LOGICAL :: ll_trcstat, ll_trcpis ! local logical
CHARACTER (len=25) :: charout !
!!-------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('trc_stp')
!
ibb = Kbb ! default "before" time-level index
IF( l_1st_euler .OR. ln_top_euler ) THEN ! at nittrc000
rDt_trc = rn_Dt ! = rn_Dt (use or restarting with Euler time stepping)
ibb = Kmm ! time-level index used to substitute the "before" with the "now" time level
ELSEIF( kt <= nittrc000 + 1 ) THEN ! at nittrc000 or nittrc000+1
rDt_trc = 2. * rn_Dt ! = 2 rn_Dt (leapfrog)
ENDIF
......@@ -81,9 +84,14 @@ CONTAINS
DO jk = 1, jpk
cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
END DO
IF ( ll_trcstat .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend ) &
& .OR. iom_use( "pno3tot" ) .OR. iom_use( "ppo4tot" ) .OR. iom_use( "psiltot" ) &
& .OR. iom_use( "palktot" ) .OR. iom_use( "pfertot" ) ) &
IF( ln_pisces ) THEN
IF ( iom_use( "pno3tot" ) .OR. iom_use( "ppo4tot" ) .OR. iom_use( "psiltot" ) &
& .OR. iom_use( "palktot" ) .OR. iom_use( "pfertot" ) ) &
& ll_trcpis = .TRUE.
ELSE
ll_trcpis = .FALSE.
ENDIF
IF ( ll_trcstat .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend ) .OR. ll_trcpis ) &
& areatot = glob_sum( 'trcstp', cvol(:,:,:) )
ENDIF
!
......@@ -100,9 +108,9 @@ CONTAINS
CALL trc_rst_opn ( kt ) ! Open tracer restart file
IF( lrst_trc ) CALL trc_rst_cal ( kt, 'WRITE' ) ! calendar
CALL trc_wri ( kt, Kmm ) ! output of passive tracers with iom I/O manager
CALL trc_sms ( kt, Kbb, Kmm, Krhs ) ! tracers: sinks and sources
CALL trc_sms ( kt, ibb, Kmm, Krhs ) ! tracers: sinks and sources
#if ! defined key_sed_off
CALL trc_trp ( kt, Kbb, Kmm, Krhs, Kaa ) ! transport of passive tracers
CALL trc_trp ( kt, ibb, Kmm, Krhs, Kaa ) ! transport of passive tracers
#endif
!
! Note passive tracers have been time-filtered in trc_trp but the time level
......@@ -115,7 +123,6 @@ CONTAINS
IF(lrxios) CALL iom_context_finalize( cr_toprst_cxt )
IF(lwm) CALL FLUSH( numont ) ! flush namelist output
ENDIF
IF( lrst_trc ) CALL trc_rst_wri ( kt, Kmm, Kaa, Kbb ) ! write tracer restart file
IF( lk_trdmxl_trc ) CALL trd_mxl_trc ( kt, Kaa ) ! trends: Mixed-layer
!
IF( ln_top_euler ) THEN
......@@ -125,6 +132,8 @@ CONTAINS
tr(:,:,:,:,Kmm) = tr(:,:,:,:,Kaa)
ENDIF
!
IF( lrst_trc ) CALL trc_rst_wri( kt, Kmm, Kaa, ibb ) ! write tracer restart file
!
IF (ll_trcstat) THEN
ztrai = 0._wp ! content of all tracers
DO jn = 1, jptra
......
tests/ADIAB_WAVE/MY_SRC/usrdef_zgr.F90
View file @ 672ff863
......@@ -103,7 +103,7 @@ CONTAINS
DO_2D(0,0,0,0)
zhu(ji,jj) = 0.5_wp * ( zht(ji,jj) + zht(ji+1,jj) )
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._wp ) ! boundary condition: this mask the surrouding grid-points
! ! ==>>> set by hand non-zero value on first/last columns & rows
DO ji = mi0(1), mi1(1) ! first row of global domain only
zhu(ji,2) = zht(ji,2)
......@@ -122,7 +122,7 @@ CONTAINS
! no ocean cavities : top ocean level is ONE, except over land
! the ocean basin surrounded by land (1+nn_hls grid-points) set through lbc_lnk call
z2d(:,:) = 1._wp ! surface ocean is the 1st level
CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. ) ! closed basin, see userdef_nam.F90
CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1._wp ) ! closed basin, see userdef_nam.F90
k_top(:,:) = NINT( z2d(:,:) )
!
!
......
tests/BENCH/MY_SRC/usrdef_istate.F90
View file @ 672ff863
......@@ -82,9 +82,9 @@ CONTAINS
pu( :,:,jpk ) = 0._wp
pv( :,:,jpk ) = 0._wp
!
CALL lbc_lnk('usrdef_istate', pts, 'T', 1. ) ! apply boundary conditions
CALL lbc_lnk('usrdef_istate', pu, 'U', -1. ) ! apply boundary conditions
CALL lbc_lnk('usrdef_istate', pv, 'V', -1. ) ! apply boundary conditions
CALL lbc_lnk('usrdef_istate', pts, 'T', 1._wp ) ! apply boundary conditions
CALL lbc_lnk('usrdef_istate', pu, 'U', -1._wp ) ! apply boundary conditions
CALL lbc_lnk('usrdef_istate', pv, 'V', -1._wp ) ! apply boundary conditions
END SUBROUTINE usr_def_istate
......@@ -111,7 +111,7 @@ CONTAINS
pssh(ji,jj) = 0.1 * ( 0.5 - REAL( mig0(ji) + (mjg0(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
END_2D
!
CALL lbc_lnk('usrdef_istate', pssh, 'T', 1. ) ! apply boundary conditions
CALL lbc_lnk('usrdef_istate', pssh, 'T', 1._wp ) ! apply boundary conditions
!
END SUBROUTINE usr_def_istate_ssh
......
tests/BENCH/MY_SRC/usrdef_sbc.F90
View file @ 672ff863
......@@ -109,7 +109,7 @@ CONTAINS
vtau_ice(ji,jj) = 0.1_wp + zztmp
END_2D
CALL lbc_lnk( 'usrdef_sbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. )
CALL lbc_lnk( 'usrdef_sbc', utau_ice, 'U', -1._wp, vtau_ice, 'V', -1._wp )
#endif
!
END SUBROUTINE usrdef_sbc_ice_tau
......
tests/CANAL/MY_SRC/usrdef_istate.F90
View file @ 672ff863
......@@ -237,8 +237,8 @@ CONTAINS
!
END SELECT
!
CALL lbc_lnk( 'usrdef_istate', pts , 'T', 1. )
CALL lbc_lnk( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. )
CALL lbc_lnk( 'usrdef_istate', pts , 'T', 1._wp )
CALL lbc_lnk( 'usrdef_istate', pu, 'U', -1._wp, pv, 'V', -1._wp )
END SUBROUTINE usr_def_istate
......@@ -322,7 +322,7 @@ CONTAINS
DO_2D( 0, 0, 0, 0 )
pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * rn_uzonal * EXP( - 0.5 * gphit(ji,jj)**2 / rn_lambda**2 ) * e2t(ji,jj)
END_2D
CALL lbc_lnk( 'usrdef_istate_ssh', pssh, 'T', 1. )
CALL lbc_lnk( 'usrdef_istate_ssh', pssh, 'T', 1._wp )
END DO
!
CASE(4) !== geostrophic zonal pulse !!st need to implement a way to separate ssh properly ==!
......@@ -374,7 +374,7 @@ CONTAINS
CALL RANDOM_NUMBER(zrandom)
pssh(:,:) = pssh(:,:) + ( 0.1 * zrandom(:,:) - 0.05 )
ENDIF
CALL lbc_lnk( 'usrdef_istate_ssh', pssh, 'T', 1. )
CALL lbc_lnk( 'usrdef_istate_ssh', pssh, 'T', 1._wp )
!
END SUBROUTINE usr_def_istate_ssh
......
tests/CANAL/MY_SRC/usrdef_zgr.F90
View file @ 672ff863
......@@ -201,7 +201,7 @@ CONTAINS
z2d(:,:) = REAL(jpkm1 - NINT( 0.5 * REAL(jpkm1,wp) * z2d(:,:) ), wp)
END SELECT
!
CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. ) ! set surrounding land to zero (closed boundaries)
CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1._wp ) ! set surrounding land to zero (closed boundaries)
!
k_bot(:,:) = NINT( z2d(:,:) ) ! =jpkm1 over the ocean point, =0 elsewhere
!
......