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 610 additions and 321 deletions
src/TOP/PISCES/P4Z/p4zsed.F90
View file @ c72255b2
......@@ -69,30 +69,30 @@ CONTAINS
REAL(wp) :: xdiano3, xdianh4
!
CHARACTER (len=25) :: charout
REAL(wp), DIMENSION(jpi,jpj ) :: zdenit2d, zbureff, zwork
REAL(wp), DIMENSION(jpi,jpj ) :: zwsbio3, zwsbio4
REAL(wp), DIMENSION(jpi,jpj ) :: zsedcal, zsedsi, zsedc
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsoufer, zlight
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrpo4, ztrdop, zirondep, zpdep
REAL(wp), DIMENSION(A2D(0)) :: zdenit2d, zbureff, zwork
REAL(wp), DIMENSION(A2D(0)) :: zwsbio3, zwsbio4
REAL(wp), DIMENSION(A2D(0)) :: zsedcal, zsedsi, zsedc
REAL(wp), DIMENSION(A2D(0),jpk) :: zsoufer, zlight
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrpo4, ztrdop, zw3d
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p4z_sed')
!
! Allocate temporary workspace
ALLOCATE( ztrpo4(jpi,jpj,jpk) )
IF( ln_p5z ) ALLOCATE( ztrdop(jpi,jpj,jpk) )
ALLOCATE( ztrpo4(A2D(0),jpk) )
IF( ln_p5z ) ALLOCATE( ztrdop(A2D(0),jpk) )
zdenit2d(:,:) = 0.e0
zbureff (:,:) = 0.e0
zwork (:,:) = 0.e0
zsedsi (:,:) = 0.e0
zsedcal (:,:) = 0.e0
zsedc (:,:) = 0.e0
! zwork (:,:) = 0.e0
! zsedsi (:,:) = 0.e0
! zsedcal (:,:) = 0.e0
! zsedc (:,:) = 0.e0
! OA: Warning, the following part is necessary to avoid CFL problems above the sediments
! --------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
zdep = e3t(ji,jj,ikt,Kmm) / xstep
zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) )
......@@ -103,7 +103,7 @@ CONTAINS
! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used
! Computation of the fraction of organic matter that is permanently buried from Dunne's model
! -------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
IF( tmask(ji,jj,1) == 1 ) THEN
ikt = mbkt(ji,jj)
zflx = ( tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj) &
......@@ -129,7 +129,7 @@ CONTAINS
! ------------------------------------------------------
IF( .NOT.lk_sed ) zrivsil = 1._wp - sedsilfrac
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
zdep = xstep / e3t(ji,jj,ikt,Kmm)
zwsc = zwsbio4(ji,jj) * zdep
......@@ -141,7 +141,7 @@ CONTAINS
END_2D
!
IF( .NOT.lk_sed ) THEN
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
zdep = xstep / e3t(ji,jj,ikt,Kmm)
zwsc = zwsbio4(ji,jj) * zdep
......@@ -159,7 +159,7 @@ CONTAINS
END_2D
ENDIF
!
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
zdep = xstep / e3t(ji,jj,ikt,Kmm)
zws4 = zwsbio4(ji,jj) * zdep
......@@ -171,7 +171,7 @@ CONTAINS
END_2D
!
IF( ln_p5z ) THEN
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
zdep = xstep / e3t(ji,jj,ikt,Kmm)
zws4 = zwsbio4(ji,jj) * zdep
......@@ -186,7 +186,7 @@ CONTAINS
IF( .NOT.lk_sed ) THEN
! The 0.5 factor in zpdenit is to avoid negative NO3 concentration after
! denitrification in the sediments. Not very clever, but simpliest option.
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
zdep = xstep / e3t(ji,jj,ikt,Kmm)
zws4 = zwsbio4(ji,jj) * zdep
......@@ -218,12 +218,13 @@ CONTAINS
! Nitrogen fixation process
! Small source iron from particulate inorganic iron
!-----------------------------------
DO jk = 1, jpkm1
zlight (:,:,jk) = ( 1.- EXP( -etot_ndcy(:,:,jk) / diazolight ) ) * ( 1. - fr_i(:,:) )
zsoufer(:,:,jk) = zlight(:,:,jk) * 2E-11 / ( 2E-11 + biron(:,:,jk) )
ENDDO
DO_3D( 0, 0, 0, 0, 1, jpkm1)
zlight (ji,jj,jk) = ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) ) * ( 1. - fr_i(ji,jj) )
zsoufer(ji,jj,jk) = zlight(ji,jj,jk) * 2E-11 / ( 2E-11 + biron(ji,jj,jk) )
END_3D
!
IF( ln_p4z ) THEN
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
! ! Potential nitrogen fixation dependant on temperature and iron
ztemp = ts(ji,jj,jk,jp_tem,Kmm)
zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) / rno3
......@@ -239,7 +240,7 @@ CONTAINS
nitrpot(ji,jj,jk) = zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk)
END_3D
ELSE ! p5z
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
! ! Potential nitrogen fixation dependant on temperature and iron
ztemp = ts(ji,jj,jk,jp_tem,Kmm)
zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625
......@@ -260,7 +261,7 @@ CONTAINS
! Nitrogen change due to nitrogen fixation
! ----------------------------------------
IF( ln_p4z ) THEN
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
zfact = nitrpot(ji,jj,jk) * nitrfix
tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0
tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0
......@@ -278,7 +279,7 @@ CONTAINS
& * 0.001 * tr(ji,jj,jk,jpdoc,Kbb) * xstep
END_3D
ELSE ! p5z
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
zfact = nitrpot(ji,jj,jk) * nitrfix
tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0
tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0
......@@ -306,12 +307,20 @@ CONTAINS
ENDIF
IF( lk_iomput .AND. knt == nrdttrc ) THEN
zfact = 1.e+3 * rfact2r ! conversion from molC/l/kt to molN/m3/s
CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) ) ! nitrogen fixation
CALL iom_put( "SedCal", zsedcal(:,:) * zfact )
CALL iom_put( "SedSi" , zsedsi (:,:) * zfact )
CALL iom_put( "SedC" , zsedc (:,:) * zfact )
CALL iom_put( "Sdenit", sdenit (:,:) * zfact * rno3 )
zfact = 1.e+3 * rfact2r ! conversion from molC/l/kt to molN/m3/s
!
IF( iom_use ( "Nfix" ) ) THEN ! nitrogen fixation
ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
zw3d(A2D(0),1:jpkm1) = nitrpot(A2D(0),1:jpkm1) * nitrfix * rno3 * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "Nfix", zw3d )
DEALLOCATE( zw3d )
ENDIF
!
IF( iom_use( "Sdenit" ) ) CALL iom_put( "Sdenit", sdenit(:,:) * rno3 * zfact )
IF( iom_use( "SedCal" ) ) CALL iom_put( "SedCal", zsedcal(:,:) * zfact )
IF( iom_use( "SedSi" ) ) CALL iom_put( "SedSi" , zsedsi(:,:) * zfact )
IF( iom_use( "SedC" ) ) CALL iom_put( "SedC" , zsedc(:,:) * zfact )
!
ENDIF
!
IF(sn_cfctl%l_prttrc) THEN ! print mean trneds (USEd for debugging)
......@@ -320,7 +329,8 @@ CONTAINS
CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm)
ENDIF
!
IF( ln_p5z ) DEALLOCATE( ztrpo4, ztrdop )
DEALLOCATE( ztrpo4 )
IF( ln_p5z ) DEALLOCATE( ztrdop )
!
IF( ln_timing ) CALL timing_stop('p4z_sed')
!
......@@ -367,7 +377,7 @@ CONTAINS
!
lk_sed = ln_sediment .AND. ln_sed_2way
!
nitrpot(:,:,jpk) = 0._wp ! define last level for iom_put
! nitrpot(:,:,jpk) = 0._wp ! define last level for iom_put
!
END SUBROUTINE p4z_sed_init
......@@ -375,7 +385,7 @@ CONTAINS
!!----------------------------------------------------------------------
!! *** ROUTINE p4z_sed_alloc ***
!!----------------------------------------------------------------------
ALLOCATE( nitrpot(jpi,jpj,jpk), sdenit(jpi,jpj), STAT=p4z_sed_alloc )
ALLOCATE( nitrpot(A2D(0),jpk), sdenit(A2D(0)), STAT=p4z_sed_alloc )
!
IF( p4z_sed_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_sed_alloc: failed to allocate arrays' )
!
......
src/TOP/PISCES/P4Z/p4zsink.F90
View file @ c72255b2
......@@ -68,6 +68,8 @@ CONTAINS
INTEGER :: ji, jj, jk
CHARACTER (len=25) :: charout
REAL(wp) :: zmax, zfact
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zw2d
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p4z_sink')
......@@ -86,7 +88,7 @@ CONTAINS
! CaCO3 and bSi are supposed to sink at the big particles speed
! due to their high density
! ---------------------------------------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
zmax = MAX( heup_01(ji,jj), hmld(ji,jj) )
zfact = MAX( 0., gdepw(ji,jj,jk+1,Kmm) - zmax ) / wsbio2scale
wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact
......@@ -129,28 +131,69 @@ CONTAINS
ENDIF
! Total carbon export per year
IF( iom_use( "tcexp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) &
& t_oce_co2_exp = glob_sum( 'p4zsink', ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * e1e2t(:,:) * tmask(:,:,1) )
IF( iom_use( "tcexp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) THEN
ALLOCATE( zw2d(A2D(0)) )
zw2d(A2D(0)) = ( sinking(A2D(0),ik100) + sinking2(A2D(0),ik100) ) * e1e2t(A2D(0)) * tmask(A2D(0),1)
t_oce_co2_exp = glob_sum( 'p4zsink', zw2d(:,:) )
DEALLOCATE( zw2d )
ENDIF
!
IF( lk_iomput .AND. knt == nrdttrc ) THEN
zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
!
CALL iom_put( "EPC100" , ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * zfact * tmask(:,:,1) ) ! Export of carbon at 100m
CALL iom_put( "EPFE100" , ( sinkfer(:,:,ik100) + sinkfer2(:,:,ik100) ) * zfact * tmask(:,:,1) ) ! Export of iron at 100m
CALL iom_put( "EPCAL100", sinkcal(:,:,ik100) * zfact * tmask(:,:,1) ) ! Export of calcite at 100m
CALL iom_put( "EPSI100" , sinksil(:,:,ik100) * zfact * tmask(:,:,1) ) ! Export of bigenic silica at 100m
CALL iom_put( "EXPC" , ( sinking(:,:,:) + sinking2(:,:,:) ) * zfact * tmask(:,:,:) ) ! Export of carbon in the water column
CALL iom_put( "EXPFE" , ( sinkfer(:,:,:) + sinkfer2(:,:,:) ) * zfact * tmask(:,:,:) ) ! Export of iron
CALL iom_put( "EXPCAL" , sinkcal(:,:,:) * zfact * tmask(:,:,:) ) ! Export of calcite
CALL iom_put( "EXPSI" , sinksil(:,:,:) * zfact * tmask(:,:,:) ) ! Export of bigenic silica
CALL iom_put( "tcexp" , t_oce_co2_exp * zfact ) ! molC/s
ALLOCATE( zw3d(A2D(0),jpk), zw2d(A2D(0)) ) ; zw3d(A2D(0),jpk) = 0._wp
!
IF( iom_use ( "EPC100" ) ) THEN ! Export of carbon at 100m
zw2d(A2D(0)) = ( sinking(A2D(0),ik100) + sinking2(A2D(0),ik100) ) * zfact * tmask(A2D(0),1)
CALL iom_put( "EPC100", zw2d )
ENDIF
!
IF( iom_use ( "EPFE100" ) ) THEN ! Export of iron at 100m
zw2d(A2D(0)) = ( sinkfer(A2D(0),ik100) + sinkfer2(A2D(0),ik100) ) * zfact * tmask(A2D(0),1)
CALL iom_put( "EPFE100", zw2d )
ENDIF
!
IF( iom_use ( "EPCAL100" ) ) THEN ! Export of calcite at 100m
zw2d(A2D(0)) = sinkcal(A2D(0),ik100) * zfact * tmask(A2D(0),1)
CALL iom_put( "EPCAL100", zw2d )
ENDIF
!
IF( iom_use ( "EPSI100" ) ) THEN ! Export of bigenic silica at 100m
zw2d(A2D(0)) = sinksil(A2D(0),ik100) * zfact * tmask(A2D(0),1)
CALL iom_put( "EPSI100", zw2d )
ENDIF
!
IF( iom_use ( "EXPC" ) ) THEN ! Export of carbon in the water column
zw3d(A2D(0),1:jpkm1) = ( sinking(A2D(0),1:jpkm1) + sinking2(A2D(0),1:jpkm1) ) * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "EXPC", zw3d )
ENDIF
!
IF( iom_use ( "EXPFE" ) ) THEN ! Export of iron
zw3d(A2D(0),1:jpkm1) = ( sinkfer(A2D(0),1:jpkm1) + sinkfer2(A2D(0),1:jpkm1) ) * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "EXPFE", zw3d )
ENDIF
!
IF( iom_use ( "EXPCAL" ) ) THEN ! Export of calcite
zw3d(A2D(0),1:jpkm1) = sinkcal(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "EXPCAL", zw3d )
ENDIF
!
IF( iom_use ( "EXPSI" ) ) THEN ! Export of bigenic silica
zw3d(A2D(0),1:jpkm1) = sinksil(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "EXPSI", zw3d )
ENDIF
!
IF( iom_use ( "tcexp" ) ) THEN ! molC/s
CALL iom_put( "tcexp" , t_oce_co2_exp * zfact )
ENDIF
!
DEALLOCATE( zw3d, zw2d )
ENDIF
!
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
WRITE(charout, FMT="('sink')")
CALL prt_ctl_info( charout, cdcomp = 'top' )
CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm)
CALL prt_ctl(tab4d_1=tr(:,:,:,:,Kbb), mask1=tmask, clinfo=ctrcnm)
ENDIF
!
IF( ln_timing ) CALL timing_stop('p4z_sink')
......@@ -192,13 +235,13 @@ CONTAINS
!
ierr(:) = 0
!
ALLOCATE( sinking(jpi,jpj,jpk) , sinking2(jpi,jpj,jpk) , &
& sinkcal(jpi,jpj,jpk) , sinksil (jpi,jpj,jpk) , &
& sinkfer2(jpi,jpj,jpk) , &
& sinkfer(jpi,jpj,jpk) , STAT=ierr(1) )
ALLOCATE( sinking(A2D(0),jpk) , sinking2(A2D(0),jpk) , &
& sinkcal(A2D(0),jpk) , sinksil (A2D(0),jpk) , &
& sinkfer2(A2D(0),jpk) , &
& sinkfer(A2D(0),jpk) , STAT=ierr(1) )
!
IF( ln_p5z ) ALLOCATE( sinkingn(jpi,jpj,jpk), sinking2n(jpi,jpj,jpk) , &
& sinkingp(jpi,jpj,jpk), sinking2p(jpi,jpj,jpk) , STAT=ierr(2) )
IF( ln_p5z ) ALLOCATE( sinkingn(A2D(0),jpk), sinking2n(A2D(0),jpk) , &
& sinkingp(A2D(0),jpk), sinking2p(A2D(0),jpk) , STAT=ierr(2) )
!
p4z_sink_alloc = MAXVAL( ierr )
IF( p4z_sink_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_sink_alloc : failed to allocate arrays.' )
......
src/TOP/PISCES/P4Z/p4zsms.F90
View file @ c72255b2
......@@ -140,7 +140,7 @@ CONTAINS
! ------------------------------------------------------------------
xnegtr(:,:,:) = 1.e0
DO jn = jp_pcs0, jp_pcs1
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk)
DO_3D( 0, 0, 0, 0, 1, jpk)
IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN
ztra = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn )
xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra )
......@@ -157,45 +157,56 @@ CONTAINS
IF( iom_use( 'INTdtAlk' ) .OR. iom_use( 'INTdtDIC' ) .OR. iom_use( 'INTdtFer' ) .OR. &
& iom_use( 'INTdtDIN' ) .OR. iom_use( 'INTdtDIP' ) .OR. iom_use( 'INTdtSil' ) ) THEN
!
ALLOCATE( zw3d(jpi,jpj,jpk), zw2d(jpi,jpj) )
zw3d(:,:,jpk) = 0.
DO jk = 1, jpkm1
zw3d(:,:,jk) = xnegtr(:,:,jk) * xfact * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
ENDDO
ALLOCATE( zw3d(A2D(0),jpk), zw2d(A2D(0)) )
DO_3D( 0, 0, 0, 0, 1, jpkm1)
zw3d(ji,jj,jk) = xnegtr(ji,jj,jk) * xfact * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
END_3D
!
zw2d(:,:) = 0.
DO jk = 1, jpkm1
zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jptal,Krhs)
DO_2D( 0, 0, 0, 0 )
zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) * tr(ji,jj,jk,jptal,Krhs)
END_2D
ENDDO
CALL iom_put( 'INTdtAlk', zw2d )
!
zw2d(:,:) = 0.
DO jk = 1, jpkm1
zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpdic,Krhs)
DO_2D( 0, 0, 0, 0 )
zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) * tr(ji,jj,jk,jpdic,Krhs)
END_2D
ENDDO
CALL iom_put( 'INTdtDIC', zw2d )
!
zw2d(:,:) = 0.
DO jk = 1, jpkm1
zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * rno3 * ( tr(:,:,jk,jpno3,Krhs) + tr(:,:,jk,jpnh4,Krhs) )
DO_2D( 0, 0, 0, 0 )
zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) * rno3 * ( tr(ji,jj,jk,jpno3,Krhs) + tr(ji,jj,jk,jpnh4,Krhs) )
END_2D
ENDDO
CALL iom_put( 'INTdtDIN', zw2d )
!
zw2d(:,:) = 0.
DO jk = 1, jpkm1
zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * po4r * tr(:,:,jk,jppo4,Krhs)
DO_2D( 0, 0, 0, 0 )
zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) * po4r * tr(ji,jj,jk,jppo4,Krhs)
END_2D
ENDDO
CALL iom_put( 'INTdtDIP', zw2d )
!
zw2d(:,:) = 0.
DO jk = 1, jpkm1
zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpfer,Krhs)
DO_2D( 0, 0, 0, 0 )
zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) * tr(ji,jj,jk,jpfer,Krhs)
END_2D
ENDDO
CALL iom_put( 'INTdtFer', zw2d )
!
zw2d(:,:) = 0.
DO jk = 1, jpkm1
zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpsil,Krhs)
DO_2D( 0, 0, 0, 0 )
zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) * tr(ji,jj,jk,jpsil,Krhs)
END_2D
ENDDO
CALL iom_put( 'INTdtSil', zw2d )
!
......@@ -522,8 +533,9 @@ CONTAINS
INTEGER, INTENT( in ) :: Kmm ! time level indices
REAL(wp) :: zrdenittot, zsdenittot, znitrpottot
CHARACTER(LEN=100) :: cltxt
INTEGER :: jk
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork
INTEGER :: ji, jj, jk
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zw2d
!!----------------------------------------------------------------------
!
IF( kt == nittrc000 ) THEN
......@@ -542,82 +554,113 @@ CONTAINS
! Compute the budget of NO3
IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
IF( ln_p4z ) THEN
zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) &
& + tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm) &
& + tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm) + tr(:,:,:,jpdoc,Kmm) &
& + tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm)
DO_3D( 0, 0, 0, 0, 1, jpk)
zw3d(ji,jj,jk) = ( tr(ji,jj,jk,jpno3,Kmm) + tr(ji,jj,jk,jpnh4,Kmm) &
& + tr(ji,jj,jk,jpphy,Kmm) + tr(ji,jj,jk,jpdia,Kmm) &
& + tr(ji,jj,jk,jppoc,Kmm) + tr(ji,jj,jk,jpgoc,Kmm) + tr(ji,jj,jk,jpdoc,Kmm) &
& + tr(ji,jj,jk,jpzoo,Kmm) + tr(ji,jj,jk,jpmes,Kmm) ) * cvol(ji,jj,jk)
END_3D
ELSE
zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) + tr(:,:,:,jpnph,Kmm) &
& + tr(:,:,:,jpndi,Kmm) + tr(:,:,:,jpnpi,Kmm) &
& + tr(:,:,:,jppon,Kmm) + tr(:,:,:,jpgon,Kmm) + tr(:,:,:,jpdon,Kmm) &
& + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * no3rat3
DO_3D( 0, 0, 0, 0, 1, jpk)
zw3d(ji,jj,jk) = ( tr(ji,jj,jk,jpno3,Kmm) + tr(ji,jj,jk,jpnh4,Kmm) + tr(ji,jj,jk,jpnph,Kmm) &
& + tr(ji,jj,jk,jpndi,Kmm) + tr(ji,jj,jk,jpnpi,Kmm) &
& + tr(ji,jj,jk,jppon,Kmm) + tr(ji,jj,jk,jpgon,Kmm) + tr(ji,jj,jk,jpdon,Kmm) &
& + ( tr(ji,jj,jk,jpzoo,Kmm) + tr(ji,jj,jk,jpmes,Kmm) ) * no3rat3 ) * cvol(ji,jj,jk)
END_3D
ENDIF
!
no3budget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
no3budget = glob_sum( 'p4zsms', zw3d(:,:,:) )
no3budget = no3budget / areatot
CALL iom_put( "pno3tot", no3budget )
DEALLOCATE( zw3d )
ENDIF
!
! Compute the budget of PO4
IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
IF( ln_p4z ) THEN
zwork(:,:,:) = tr(:,:,:,jppo4,Kmm) &
& + tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm) &
& + tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm) + tr(:,:,:,jpdoc,Kmm) &
& + tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm)
ELSE
zwork(:,:,:) = tr(:,:,:,jppo4,Kmm) + tr(:,:,:,jppph,Kmm) &
& + tr(:,:,:,jppdi,Kmm) + tr(:,:,:,jpppi,Kmm) &
& + tr(:,:,:,jppop,Kmm) + tr(:,:,:,jpgop,Kmm) + tr(:,:,:,jpdop,Kmm) &
& + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * po4rat3
DO_3D( 0, 0, 0, 0, 1, jpk)
zw3d(ji,jj,jk) = ( tr(ji,jj,jk,jppo4,Kmm) &
& + tr(ji,jj,jk,jpphy,Kmm) + tr(ji,jj,jk,jpdia,Kmm) &
& + tr(ji,jj,jk,jppoc,Kmm) + tr(ji,jj,jk,jpgoc,Kmm) + tr(ji,jj,jk,jpdoc,Kmm) &
& + tr(ji,jj,jk,jpzoo,Kmm) + tr(ji,jj,jk,jpmes,Kmm) ) * cvol(ji,jj,jk)
END_3D
ELSE
DO_3D( 0, 0, 0, 0, 1, jpk)
zw3d(ji,jj,jk) = ( tr(ji,jj,jk,jppo4,Kmm) + tr(ji,jj,jk,jppph,Kmm) &
& + tr(ji,jj,jk,jppdi,Kmm) + tr(ji,jj,jk,jpppi,Kmm) &
& + tr(ji,jj,jk,jppop,Kmm) + tr(ji,jj,jk,jpgop,Kmm) + tr(ji,jj,jk,jpdop,Kmm) &
& + ( tr(ji,jj,jk,jpzoo,Kmm) + tr(ji,jj,jk,jpmes,Kmm) ) * po4rat3 ) * cvol(ji,jj,jk)
END_3D
ENDIF
!
po4budget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
po4budget = glob_sum( 'p4zsms', zw3d(:,:,:) )
po4budget = po4budget / areatot
CALL iom_put( "ppo4tot", po4budget )
DEALLOCATE( zw3d )
ENDIF
!
! Compute the budget of SiO3
IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
zwork(:,:,:) = tr(:,:,:,jpsil,Kmm) + tr(:,:,:,jpgsi,Kmm) + tr(:,:,:,jpdsi,Kmm)
ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpk)
zw3d(ji,jj,jk) = ( tr(ji,jj,jk,jpsil,Kmm) + tr(ji,jj,jk,jpgsi,Kmm) + tr(ji,jj,jk,jpdsi,Kmm) ) * cvol(ji,jj,jk)
END_3D
!
silbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
silbudget = glob_sum( 'p4zsms', zw3d(:,:,:) )
silbudget = silbudget / areatot
CALL iom_put( "psiltot", silbudget )
DEALLOCATE( zw3d )
ENDIF
!
IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) * rno3 + tr(:,:,:,jptal,Kmm) + tr(:,:,:,jpcal,Kmm) * 2.
ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpk)
zw3d(ji,jj,jk) = ( tr(ji,jj,jk,jpno3,Kmm) * rno3 + tr(ji,jj,jk,jptal,Kmm) + tr(ji,jj,jk,jpcal,Kmm) * 2. ) * cvol(ji,jj,jk)
END_3D
!
alkbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) !
alkbudget = glob_sum( 'p4zsms', zw3d(:,:,:) ) !
alkbudget = alkbudget / areatot
CALL iom_put( "palktot", alkbudget )
DEALLOCATE( zw3d )
ENDIF
!
! Compute the budget of Iron
IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
zwork(:,:,:) = tr(:,:,:,jpfer,Kmm) + tr(:,:,:,jpnfe,Kmm) + tr(:,:,:,jpdfe,Kmm) &
& + tr(:,:,:,jpbfe,Kmm) + tr(:,:,:,jpsfe,Kmm) &
& + ( tr(:,:,:,jpzoo,Kmm) * feratz + tr(:,:,:,jpmes,Kmm) ) * feratm
ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpk)
zw3d(ji,jj,jk) = ( tr(ji,jj,jk,jpfer,Kmm) + tr(ji,jj,jk,jpnfe,Kmm) + tr(ji,jj,jk,jpdfe,Kmm) &
& + tr(ji,jj,jk,jpbfe,Kmm) + tr(ji,jj,jk,jpsfe,Kmm) &
& + tr(ji,jj,jk,jpzoo,Kmm) * feratz + tr(ji,jj,jk,jpmes,Kmm) * feratm ) * cvol(ji,jj,jk)
END_3D
!
ferbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
ferbudget = glob_sum( 'p4zsms', zw3d(:,:,:) )
ferbudget = ferbudget / areatot
CALL iom_put( "pfertot", ferbudget )
DEALLOCATE( zw3d )
ENDIF
!
! Global budget of N SMS : denitrification in the water column and in the sediment
! nitrogen fixation by the diazotrophs
! --------------------------------------------------------------------------------
IF( iom_use( "tnfix" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
znitrpottot = glob_sum ( 'p4zsms', nitrpot(:,:,:) * nitrfix * cvol(:,:,:) )
ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
zw3d(A2D(0),1:jpkm1) = nitrpot(A2D(0),1:jpkm1) * nitrfix * cvol(A2D(0),1:jpkm1)
znitrpottot = glob_sum ( 'p4zsms', zw3d)
CALL iom_put( "tnfix" , znitrpottot * xfact3 ) ! Global nitrogen fixation molC/l to molN/m3
DEALLOCATE( zw3d )
ENDIF
!
IF( iom_use( "tdenit" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
zrdenittot = glob_sum ( 'p4zsms', denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) )
zsdenittot = glob_sum ( 'p4zsms', sdenit(:,:) * e1e2t(:,:) * tmask(:,:,1) )
ALLOCATE( zw3d(A2D(0),jpk), zw2d(A2D(0)) ) ; zw3d(A2D(0),jpk) = 0._wp
zw3d(A2D(0),1:jpkm1) = denitr(A2D(0),1:jpkm1) * rdenit * xnegtr(A2D(0),1:jpkm1) * cvol(A2D(0),1:jpkm1)
zw2d(A2D(0)) = sdenit(A2D(0)) * e1e2t(A2D(0)) * tmask(A2D(0),1)
zrdenittot = glob_sum ( 'p4zsms', zw3d )
zsdenittot = glob_sum ( 'p4zsms', Zw2d )
CALL iom_put( "tdenit" , ( zrdenittot + zsdenittot ) * xfact3 ) ! Total denitrification molC/l to molN/m3
DEALLOCATE( zw3d, zw2d )
ENDIF
!
IF( ln_check_mass .AND. kt == nitend ) THEN ! Compute the budget of NO3, ALK, Si, Fer
......
src/TOP/PISCES/P4Z/p5zlim.F90
View file @ c72255b2
......@@ -136,7 +136,8 @@ CONTAINS
REAL(wp) :: zfvn, zfvp, zfvf, zsizen, zsizep, zsized, znanochl, zpicochl, zdiatchl
REAL(wp) :: zqfemn, zqfemp, zqfemd, zbactno3, zbactnh4, zbiron
REAL(wp) :: znutlimtot, zlimno3, zlimnh4, zlim1f, zsizetmp
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrassn, zrassp, zrassd
REAL(wp), DIMENSION(A2D(0),jpk) :: zrassn, zrassp, zrassd
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p5z_lim')
......@@ -144,7 +145,7 @@ CONTAINS
zratchl = 6.0
sizena(:,:,:) = 0.0 ; sizepa(:,:,:) = 0.0 ; sizeda(:,:,:) = 0.0
!
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
! Computation of the Chl/C ratio of each phytoplankton group
! -------------------------------------------------------
z1_trnphy = 1. / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn )
......@@ -407,7 +408,7 @@ CONTAINS
! nutrient uptake pool and assembly machinery. DNA is assumed to represent 1% of the dry mass of
! phytoplankton (see Daines et al., 2013).
! --------------------------------------------------------------------------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
! Size estimation of nanophytoplankton based on total biomass
! Assumes that larger biomass implies addition of larger cells
! ------------------------------------------------------------
......@@ -465,7 +466,7 @@ CONTAINS
! This is a purely adhoc formulation described in Aumont et al. (2015)
! This fraction depends on nutrient limitation, light, temperature
! --------------------------------------------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
zlim1 = tr(ji,jj,jk,jpnh4,Kbb) / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) + tr(ji,jj,jk,jpno3,Kbb) &
& / ( tr(ji,jj,jk,jpno3,Kbb) + concnno3 ) * ( 1.0 - tr(ji,jj,jk,jpnh4,Kbb) &
& / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) )
......@@ -482,7 +483,7 @@ 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)
DO_3D( 0, 0, 0, 0, 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) ) )
......@@ -490,19 +491,75 @@ CONTAINS
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
CALL iom_put( "LPnut" , xlimpic(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term
CALL iom_put( "LDnut" , xlimdia(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term
CALL iom_put( "LNFe" , xlimnfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term
CALL iom_put( "LPFe" , xlimpfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term
CALL iom_put( "LDFe" , xlimdfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term
CALL iom_put( "SIZEN" , sizen (:,:,:) * tmask(:,:,:) ) ! Iron limitation term
CALL iom_put( "SIZEP" , sizep (:,:,:) * tmask(:,:,:) ) ! Iron limitation term
CALL iom_put( "SIZED" , sized (:,:,:) * tmask(:,:,:) ) ! Iron limitation term
CALL iom_put( "RASSN" , zrassn (:,:,:) * tmask(:,:,:) ) ! Iron limitation term
CALL iom_put( "RASSP" , zrassp (:,:,:) * tmask(:,:,:) ) ! Iron limitation term
CALL iom_put( "RASSD" , zrassd (:,:,:) * tmask(:,:,:) ) ! Iron limitation term
!
ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
!
IF( iom_use ( "xfracal" ) ) THEN ! euphotic layer deptht
zw3d(A2D(0),1:jpkm1) = xfracal(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "xfracal", zw3d)
ENDIF
!
IF( iom_use ( "LNnut" ) ) THEN ! Nutrient limitation term
zw3d(A2D(0),1:jpkm1) = xlimphy(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "LNnut", zw3d)
ENDIF
!
IF( iom_use ( "LPnut" ) ) THEN ! Nutrient limitation term
zw3d(A2D(0),1:jpkm1) = xlimpic(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "LPnut", zw3d)
ENDIF
!
IF( iom_use ( "LDnut" ) ) THEN ! Nutrient limitation term
zw3d(A2D(0),1:jpkm1) = xlimdia(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "LDnut", zw3d)
ENDIF
!
IF( iom_use ( "LNFe" ) ) THEN ! Iron limitation term
zw3d(A2D(0),1:jpkm1) = xlimnfe(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "LNFe", zw3d)
ENDIF
!
IF( iom_use ( "LPFe" ) ) THEN ! Iron limitation term
zw3d(A2D(0),1:jpkm1) = xlimpfe(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "LPFe", zw3d)
ENDIF
!
IF( iom_use ( "LDFe" ) ) THEN ! Iron limitation term
zw3d(A2D(0),1:jpkm1) = xlimdfe(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "LDFe", zw3d)
ENDIF
!
IF( iom_use ( "SIZEN" ) ) THEN ! Iron limitation term
zw3d(A2D(0),1:jpkm1) = sizen(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "SIZEN", zw3d)
ENDIF
!
IF( iom_use ( "SIZEP" ) ) THEN ! Iron limitation term
zw3d(A2D(0),1:jpkm1) = sizep(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "SIZEP", zw3d)
ENDIF
!
IF( iom_use ( "SIZED" ) ) THEN ! Iron limitation term
zw3d(A2D(0),1:jpkm1) = sized(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "SIZED", zw3d)
ENDIF
!
IF( iom_use ( "RASSN" ) ) THEN ! Iron limitation term
zw3d(A2D(0),1:jpkm1) = zrassn(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "RASSN", zw3d)
ENDIF
!
IF( iom_use ( "RASSP" ) ) THEN ! Iron limitation term
zw3d(A2D(0),1:jpkm1) = zrassp(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "RASSP", zw3d)
ENDIF
!
IF( iom_use ( "RASSD" ) ) THEN ! Iron limitation term
zw3d(A2D(0),1:jpkm1) = zrassd(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "RASSD", zw3d)
ENDIF
!
DEALLOCATE( zw3d )
ENDIF
!
IF( ln_timing ) CALL timing_stop('p5z_lim')
......@@ -635,24 +692,24 @@ CONTAINS
ierr(:) = 0
!
!* Biological arrays for phytoplankton growth
ALLOCATE( xpicono3(jpi,jpj,jpk), xpiconh4(jpi,jpj,jpk), &
& xpicopo4(jpi,jpj,jpk), xpicodop(jpi,jpj,jpk), &
& xnanodop(jpi,jpj,jpk), xdiatdop(jpi,jpj,jpk), &
& xpicofer(jpi,jpj,jpk), xlimpfe (jpi,jpj,jpk), &
& fvnuptk (jpi,jpj,jpk), fvduptk (jpi,jpj,jpk), &
& xlimphys(jpi,jpj,jpk), xlimdias(jpi,jpj,jpk), &
& xlimnpp (jpi,jpj,jpk), xlimnpn (jpi,jpj,jpk), &
& xlimnpd (jpi,jpj,jpk), &
& xlimpics(jpi,jpj,jpk), xqfuncfecp(jpi,jpj,jpk), &
& fvpuptk (jpi,jpj,jpk), xlimpic (jpi,jpj,jpk), STAT=ierr(1) )
ALLOCATE( xpicono3(A2D(0),jpk), xpiconh4(A2D(0),jpk), &
& xpicopo4(A2D(0),jpk), xpicodop(A2D(0),jpk), &
& xnanodop(A2D(0),jpk), xdiatdop(A2D(0),jpk), &
& xpicofer(A2D(0),jpk), xlimpfe (A2D(0),jpk), &
& fvnuptk (A2D(0),jpk), fvduptk (A2D(0),jpk), &
& xlimphys(A2D(0),jpk), xlimdias(A2D(0),jpk), &
& xlimnpp (A2D(0),jpk), xlimnpn (A2D(0),jpk), &
& xlimnpd (A2D(0),jpk), &
& xlimpics(A2D(0),jpk), xqfuncfecp(A2D(0),jpk), &
& fvpuptk (A2D(0),jpk), xlimpic (A2D(0),jpk), STAT=ierr(1) )
!
!* Minimum/maximum quotas of phytoplankton
ALLOCATE( xqnnmin (jpi,jpj,jpk), xqnnmax(jpi,jpj,jpk), &
& xqpnmin (jpi,jpj,jpk), xqpnmax(jpi,jpj,jpk), &
& xqnpmin (jpi,jpj,jpk), xqnpmax(jpi,jpj,jpk), &
& xqppmin (jpi,jpj,jpk), xqppmax(jpi,jpj,jpk), &
& xqndmin (jpi,jpj,jpk), xqndmax(jpi,jpj,jpk), &
& xqpdmin (jpi,jpj,jpk), xqpdmax(jpi,jpj,jpk), STAT=ierr(2) )
ALLOCATE( xqnnmin (A2D(0),jpk), xqnnmax(A2D(0),jpk), &
& xqpnmin (A2D(0),jpk), xqpnmax(A2D(0),jpk), &
& xqnpmin (A2D(0),jpk), xqnpmax(A2D(0),jpk), &
& xqppmin (A2D(0),jpk), xqppmax(A2D(0),jpk), &
& xqndmin (A2D(0),jpk), xqndmax(A2D(0),jpk), &
& xqpdmin (A2D(0),jpk), xqpdmax(A2D(0),jpk), STAT=ierr(2) )
!
p5z_lim_alloc = MAXVAL( ierr )
!
......
src/TOP/PISCES/P4Z/p5zmeso.F90
View file @ c72255b2
......@@ -103,14 +103,14 @@ CONTAINS
REAL(wp) :: zmigreltime, zrum, zcodel, zargu, zval, zmigthick
CHARACTER (len=25) :: charout
REAL(wp) :: zrfact2, zmetexcess, zsigma, zdiffdn
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(A2D(0),jpk) :: zgrazing, zfezoo2
REAL(wp), DIMENSION(A2D(0),jpk) :: zgrarem, zgraref, zgrapoc, zgrapof
REAL(wp), DIMENSION(A2D(0),jpk) :: zgrarep, zgraren, zgrapon, zgrapop
REAL(wp), DIMENSION(A2D(0),jpk) :: zgradoc, zgradon, zgradop
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(:,:,:) :: zw3d
!!---------------------------------------------------------------------
!
......@@ -136,7 +136,7 @@ CONTAINS
zmetexcess = 0.0
IF ( bmetexc2 ) zmetexcess = 1.0
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompam = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 )
zfact = xstep * tgfunc2(ji,jj,jk) * zcompam
......@@ -427,7 +427,7 @@ CONTAINS
! This fraction is sumed over the euphotic zone and is removed from
! the fluxes driven by mesozooplankton in the euphotic zone.
! --------------------------------------------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
zmigreltime = (1. - strn(ji,jj))
IF( gdept(ji,jj,jk,Kmm) <= heup(ji,jj) ) THEN
zmigthick = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * ( 1. - zmigreltime )
......@@ -460,7 +460,7 @@ CONTAINS
! The inorganic and organic fluxes induced by migrating organisms are added at the
! the migration depth (corresponding indice is set by kmig)
! --------------------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
IF( tmask(ji,jj,1) == 1. ) THEN
jkt = kmig(ji,jj)
zdep = 1. / e3t(ji,jj,jkt,Kmm)
......@@ -490,7 +490,7 @@ CONTAINS
! This only concerns the variables which are affected by DVM (inorganic
! nutrients, DOC agands, and particulate organic carbon).
! ---------------------------------------------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarep(ji,jj,jk)
tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgraren(ji,jj,jk)
tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgradoc(ji,jj,jk)
......@@ -513,11 +513,30 @@ CONTAINS
END_3D
!
IF( lk_iomput .AND. knt == nrdttrc ) THEN
CALL iom_put( "PCAL" , prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) ! Calcite production
CALL iom_put( "GRAZ2" , zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) ! Total grazing of phyto by zoo
CALL iom_put( "FEZOO2", zfezoo2(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
IF( ln_ligand ) &
& CALL iom_put( "LPRODZ2", zgradoc(:,:,:) * ldocz * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
!
ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
!
IF( iom_use ( "PCAL" ) ) THEN ! Calcite production
zw3d(A2D(0),1:jpkm1) = prodcal(A2D(0),1:jpkm1) * 1.e+3 * rfact2r * tmask(A2D(0),1:jpkm1)
CALL iom_put( "PCAL", zw3d )
ENDIF
!
IF( iom_use ( "GRAZ2" ) ) THEN ! Total grazing of phyto by zoo
zw3d(A2D(0),1:jpkm1) = zgrazing(A2D(0),1:jpkm1) * 1.e+3 * rfact2r * tmask(A2D(0),1:jpkm1)
CALL iom_put( "GRAZ2", zw3d )
ENDIF
!
IF( iom_use ( "FEZOO2" ) ) THEN
zw3d(A2D(0),1:jpkm1) = zfezoo2(A2D(0),1:jpkm1) * 1e9 * 1.e+3 * rfact2r * tmask(A2D(0),1:jpkm1)
CALL iom_put( "FEZOO2", zw3d )
ENDIF
!
IF( ln_ligand .AND. iom_use( "LPRODZ2" ) ) THEN
zw3d(A2D(0),1:jpkm1) = zgradoc(A2D(0),1:jpkm1) * ldocz * 1e9 * 1.e+3 * rfact2r * tmask(A2D(0),1:jpkm1)
CALL iom_put( "LPRODZ2" , zw3d * ldocz * 1e9 )
ENDIF
!
DEALLOCATE( zw3d )
ENDIF
!
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
......@@ -626,7 +645,7 @@ CONTAINS
! Compute the averaged values of oxygen, temperature over the domain
! 150m to 500 m depth.
! ------------------------------------------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
DO_3D( 0, 0, 0, 0, 1, jpk )
IF( tmask(ji,jj,jk) == 1.) THEN
IF( gdept(ji,jj,jk,Kmm) >= 150. .AND. gdept(ji,jj,jk,kmm) <= 500.) THEN
oxymoy(ji,jj) = oxymoy(ji,jj) + tr(ji,jj,jk,jpoxy,Kbb) * 1E6 * e3t(ji,jj,jk,Kmm)
......@@ -639,7 +658,7 @@ CONTAINS
! Compute the difference between surface values and the mean values in the mesopelagic
! domain
! ------------------------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
z1dep = 1. / ( zdepmoy(ji,jj) + rtrn )
oxymoy(ji,jj) = tr(ji,jj,1,jpoxy,Kbb) * 1E6 - oxymoy(ji,jj) * z1dep
tempmoy(ji,jj) = ts(ji,jj,1,jp_tem,Kmm) - tempmoy(ji,jj) * z1dep
......@@ -648,7 +667,7 @@ CONTAINS
! Computation of the migration depth based on the parameterization of
! Bianchi et al. (2013)
! -------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
IF( tmask(ji,jj,1) == 1. ) THEN
ztotchl = ( tr(ji,jj,1,jppch,Kbb) + tr(ji,jj,1,jpnch,Kbb) + tr(ji,jj,1,jpdch,Kbb) ) * 1E6
depmig(ji,jj) = 398. - 0.56 * oxymoy(ji,jj) -115. * log10(ztotchl) + 0.36 * hmld(ji,jj) -2.4 * tempmoy(ji,jj)
......@@ -657,7 +676,7 @@ CONTAINS
! Computation of the corresponding jk indice
! ------------------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
IF( depmig(ji,jj) >= gdepw(ji,jj,jk,Kmm) .AND. depmig(ji,jj) < gdepw(ji,jj,jk+1,Kmm) ) THEN
kmig(ji,jj) = jk
ENDIF
......@@ -669,7 +688,7 @@ CONTAINS
! to 0. Thus, to avoid that problem, the migration depth is adjusted so
! that it falls above the OMZ
! -----------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
IF( tr(ji,jj,kmig(ji,jj),jpoxy,Kbb) < 5E-6 ) THEN
DO jk = kmig(ji,jj),1,-1
IF( tr(ji,jj,jk,jpoxy,Kbb) >= 5E-6 .AND. tr(ji,jj,jk+1,jpoxy,Kbb) < 5E-6) THEN
......@@ -689,7 +708,7 @@ CONTAINS
!! *** ROUTINE p5z_meso_alloc ***
!!----------------------------------------------------------------------
!
ALLOCATE( depmig(jpi,jpj), kmig(jpi,jpj), STAT= p5z_meso_alloc )
ALLOCATE( depmig(A2D(0)), kmig(A2D(0)), STAT= p5z_meso_alloc )
!
IF( p5z_meso_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p5z_meso_alloc : failed to allocate arrays.' )
!
......
src/TOP/PISCES/P4Z/p5zmicro.F90
View file @ c72255b2
......@@ -88,8 +88,9 @@ CONTAINS
REAL(wp) :: zgraznc, zgraznn, zgraznp, zgrazpoc, zgrazpon, zgrazpop, zgrazpof
REAL(wp) :: zgrazdc, zgrazdn, zgrazdp, zgrazdf, zgraznf, zgrazz
REAL(wp) :: zgrazpc, zgrazpn, zgrazpp, zgrazpf, zbeta, zrfact2, zmetexcess
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo, zzligprod
REAL(wp), DIMENSION(A2D(0),jpk) :: zgrazing, zfezoo
REAL(wp) :: zsigma, zdiffdn, zdiffpn, zdiffdp, zproport, zproport2
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
CHARACTER (len=25) :: charout
!!---------------------------------------------------------------------
!
......@@ -99,7 +100,7 @@ CONTAINS
zmetexcess = 0.0
IF ( bmetexc ) zmetexcess = 1.0
!
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 )
zfact = xstep * tgfunc2(ji,jj,jk) * zcompaz
! Proportion of nano and diatoms that are within the size range
......@@ -298,7 +299,6 @@ CONTAINS
!
IF( ln_ligand ) THEN
tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zgradoc * ldocz
zzligprod(ji,jj,jk) = zgradoc * ldocz
ENDIF
!
tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zgradon
......@@ -342,15 +342,25 @@ CONTAINS
END_3D
!
IF( lk_iomput .AND. knt == nrdttrc ) THEN
IF( iom_use("GRAZ1") ) THEN ! Total grazing of phyto by zooplankton
zgrazing(:,:,jpk) = 0._wp ; CALL iom_put( "GRAZ1" , zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) )
ENDIF
IF( iom_use("FEZOO") ) THEN
zfezoo (:,:,jpk) = 0._wp ; CALL iom_put( "FEZOO" , zfezoo(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
ENDIF
IF( ln_ligand ) THEN
zzligprod(:,:,jpk) = 0._wp ; CALL iom_put( "LPRODZ", zzligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:))
ENDIF
!
ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
!
IF( iom_use ( "GRAZ1" ) ) THEN ! Total grazing of phyto by zooplankton
zw3d(A2D(0),1:jpkm1) = zgrazing(A2D(0),1:jpkm1) * 1.e+3 * rfact2r * tmask(A2D(0),1:jpkm1)
CALL iom_put( "GRAZ1", zw3d )
ENDIF
!
IF( iom_use ( "FEZOO" ) ) THEN
zw3d(A2D(0),1:jpkm1) = zfezoo(A2D(0),1:jpkm1) * 1e9 * 1.e+3 * rfact2r * tmask(A2D(0),1:jpkm1)
CALL iom_put( "FEZOO", zw3d )
ENDIF
!
IF( ln_ligand .AND. iom_use ( "LPRODZ" ) ) THEN
zw3d(A2D(0),1:jpkm1) = zgradoc * ldocz * 1e9 * 1.e+3 * rfact2r * tmask(A2D(0),1:jpkm1)
CALL iom_put( "LPRODZ", zw3d )
ENDIF
!
DEALLOCATE( zw3d )
ENDIF
!
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
......
src/TOP/PISCES/P4Z/p5zmort.F90
View file @ c72255b2
......@@ -80,7 +80,7 @@ CONTAINS
IF( ln_timing ) CALL timing_start('p5z_mort_nano')
!
prodcal(:,:,:) = 0. !: calcite production variable set to zero
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 )
! Quadratic mortality of nano due to aggregation during
......@@ -151,7 +151,7 @@ CONTAINS
!
IF( ln_timing ) CALL timing_start('p5z_mort_pico')
!
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 )
! Quadratic mortality of pico due to aggregation during
......@@ -215,7 +215,7 @@ CONTAINS
IF( ln_timing ) CALL timing_start('p5z_mort_diat')
!
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. )
......
src/TOP/PISCES/P4Z/p5zprod.F90
View file @ c72255b2
......@@ -85,20 +85,19 @@ CONTAINS
REAL(wp) :: zqfpmax, zqfnmax, zqfdmax
REAL(wp) :: zfact, zrfact2, zmaxsi, zratiosi, zsizetmp, zlimfac, zsilim
CHARACTER (len=25) :: charout
REAL(wp), DIMENSION(jpi,jpj ) :: zmixnano, zmixpico, zmixdiat
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpislopeadn, zpislopeadp, zpislopeadd
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprnut, zprmaxp, zprmaxn, zprmaxd
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprbio, zprpic, zprdia, zysopt
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprchln, zprchlp, zprchld
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprorcan, zprorcap, zprorcad
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprofed, zprofep, zprofen
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpronewn, zpronewp, zpronewd
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
REAL(wp), DIMENSION(A2D(0),jpk) :: zpislopeadn, zpislopeadp, zpislopeadd
REAL(wp), DIMENSION(A2D(0),jpk) :: zprnut, zprmaxp, zprmaxn, zprmaxd
REAL(wp), DIMENSION(A2D(0),jpk) :: zprbio, zprpic, zprdia, zysopt
REAL(wp), DIMENSION(A2D(0),jpk) :: zprchln, zprchlp, zprchld
REAL(wp), DIMENSION(A2D(0),jpk) :: zprorcan, zprorcap, zprorcad
REAL(wp), DIMENSION(A2D(0),jpk) :: zprofed, zprofep, zprofen
REAL(wp), DIMENSION(A2D(0),jpk) :: zpronewn, zpronewp, zpronewd
REAL(wp), DIMENSION(A2D(0),jpk) :: zproregn, zproregp, zproregd
REAL(wp), DIMENSION(A2D(0),jpk) :: zpropo4n, zpropo4p, zpropo4d
REAL(wp), DIMENSION(A2D(0),jpk) :: zprodopn, zprodopp, zprodopd
REAL(wp), DIMENSION(A2D(0),jpk) :: zrespn, zrespp, zrespd
REAL(wp), DIMENSION(A2D(0),jpk) :: zmxl_fac, zmxl_chl
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('p5z_prod')
......@@ -132,7 +131,7 @@ CONTAINS
IF ( ln_p4z_dcyc ) THEN ! Diurnal cycle in PISCES
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
zval = MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn ))
......@@ -144,7 +143,7 @@ CONTAINS
ELSE ! No diurnal cycle in PISCES
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
zval = MAX( 1., strn(ji,jj) )
IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
......@@ -166,7 +165,7 @@ CONTAINS
! Computation of the P-I slope for nanos, picos and diatoms
! The formulation proposed by Geider et al. (1997) has been used.
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 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. )
......@@ -209,7 +208,7 @@ CONTAINS
ENDIF
END_3D
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
! Si/C of diatoms
! ------------------------
......@@ -242,7 +241,7 @@ CONTAINS
! Sea-ice effect on production
! No production is assumed below sea ice
! --------------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 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) )
......@@ -256,7 +255,7 @@ CONTAINS
! quota, uptake is downregulated according to a sigmoidal function
! (power 2), as proposed by Flynn (2003)
! ---------------------------------------------------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
! production terms for nanophyto.
zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2
......@@ -307,7 +306,7 @@ CONTAINS
! quota, uptake is downregulated according to a sigmoidal function
! (power 2), as proposed by Flynn (2003)
! ---------------------------------------------------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
! production terms for picophyto.
zprorcap(ji,jj,jk) = zprpic(ji,jj,jk) * xlimpic(ji,jj,jk) * tr(ji,jj,jk,jppic,Kbb) * rfact2
......@@ -357,7 +356,7 @@ CONTAINS
! quota, uptake is downregulated according to a sigmoidal function
! (power 2), as proposed by Flynn (2003)
! ---------------------------------------------------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
! production terms for diatomees
zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2
......@@ -403,7 +402,7 @@ CONTAINS
! Production of Chlorophyll. The formulation proposed by Geider et al.
! is adopted here.
! --------------------------------------------------------------------
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
! production terms for nanophyto. ( chlorophyll )
znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
......@@ -428,7 +427,7 @@ CONTAINS
END_3D
! Update the arrays TRA which contain the biological sources and sinks
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
zpptot = 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)
......@@ -513,7 +512,7 @@ CONTAINS
! Shaked and Lis (2012)
! -------------------------------------------------------------------------
IF( ln_ligand ) THEN
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
DO_3D( 0, 0, 0, 0, 1, jpkm1)
zproddoc = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk)
zprodfer = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk)
zprodlig = plig(ji,jj,jk) / ( rtrn + plig(ji,jj,jk) + 75.0 * (1.0 - plig(ji,jj,jk) ) ) * lthet
......@@ -522,6 +521,7 @@ CONTAINS
END_3D
ENDIF
! Output of the diagnostics
! 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(:,:,:) )
......@@ -529,40 +529,137 @@ CONTAINS
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( "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
CALL iom_put( "PBSi" , zprmaxd (:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production
CALL iom_put( "PFeP" , zprofep (:,:,:) * zfact * tmask(:,:,:) ) ! biogenic iron production by picophyto
CALL iom_put( "PFeN" , zprofen(:,:,:) * zfact * tmask(:,:,:) ) ! biogenic iron production by nanophyto
CALL iom_put( "PFeD" , zprofed(:,:,:) * zfact * tmask(:,:,:) ) ! biogenic iron production by diatomes
ALLOCATE( zw3d(A2D(0),jpk) ) ; zw3d(A2D(0),jpk) = 0._wp
!
IF( iom_use ( "PPPHYP" ) ) THEN ! primary production by picophyto
zw3d(A2D(0),1:jpkm1) = zprorcap(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "PPPHYP", zw3d )
ENDIF
!
IF( iom_use ( "PPPHYN" ) ) THEN ! primary production by nanophyto
zw3d(A2D(0),1:jpkm1) = zprorcan(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "PPPHYN", zw3d )
ENDIF
!
IF( iom_use ( "PPPHYD" ) ) THEN ! primary production by diatoms
zw3d(A2D(0),1:jpkm1) = zprorcad(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "PPPHYD", zw3d )
ENDIF
!
IF( iom_use ( "PPNEWP" ) ) THEN ! new primary production by picophyto
zw3d(A2D(0),1:jpkm1) = zpronewp(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "PPNEWP", zw3d )
ENDIF
!
IF( iom_use ( "PPNEWN" ) ) THEN ! new primary production by nanophyto
zw3d(A2D(0),1:jpkm1) = zpronewn(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "PPNEWN", zw3d )
ENDIF
!
IF( iom_use ( "PPNEWD" ) ) THEN ! new primary production by diatoms
zw3d(A2D(0),1:jpkm1) = zpronewd(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "PPNEWD", zw3d )
ENDIF
!
IF( iom_use ( "PBSi" ) ) THEN ! biogenic silica production
zw3d(A2D(0),1:jpkm1) = zprmaxd(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1) * zysopt(A2D(0),1:jpkm1)
CALL iom_put( "PBSi", zw3d )
ENDIF
!
IF( iom_use ( "PFeP" ) ) THEN ! biogenic iron production by picophyto
zw3d(A2D(0),1:jpkm1) = zprofep(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "PFeP", zw3d )
ENDIF
!
IF( iom_use ( "PFeN" ) ) THEN ! biogenic iron production by nanophyto
zw3d(A2D(0),1:jpkm1) = zprofen(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "PFeN", zw3d )
ENDIF
!
IF( iom_use ( "PFeD" ) ) THEN ! biogenic iron production by diatoms
zw3d(A2D(0),1:jpkm1) = zprofed(A2D(0),1:jpkm1) * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "PFeD", zw3d )
ENDIF
IF( ln_ligand .AND. ( iom_use( "LPRODP" ) .OR. iom_use( "LDETP" ) ) ) THEN
ALLOCATE( zpligprod(jpi,jpj,jpk) )
zpligprod(:,:,:) = excretd * zprorcad(:,:,:) + excretn * zprorcan(:,:,:) + excretp * zprorcap(:,:,:)
CALL iom_put( "LPRODP" , zpligprod(:,:,:) * ldocp * 1e9 * zfact * tmask(:,:,:) )
zw3d(A2D(0),1:jpkm1) = ( excretd * zprorcad(A2D(0),1:jpkm1) + excretn * zprorcan(A2D(0),1:jpkm1) &
& + excretp * zprorcap(A2D(0),1:jpkm1) ) * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "LPRODP" , zw3d * ldocp * 1e9 )
!
zpligprod(:,:,:) = ( texcretn * zprofen(:,:,:) + texcretd * zprofed(:,:,:) + texcretp * zprofep(:,:,:) ) &
& * plig(:,:,:) / ( rtrn + plig(:,:,:) + 75.0 * (1.0 - plig(:,:,:) ) )
CALL iom_put( "LDETP" , zpligprod(:,:,:) * lthet * 1e9 * zfact * tmask(:,:,:) )
DEALLOCATE( zpligprod )
zw3d(A2D(0),1:jpkm1) = ( texcretn * zprofen(A2D(0),1:jpkm1) + texcretd * zprofed(A2D(0),1:jpkm1) &
& + texcretp * zprofep(A2D(0),1:jpkm1) ) * plig(A2D(0),1:jpkm1) &
& / ( rtrn + plig(A2D(0),1:jpkm1) + 75.0 * (1.0 - plig(A2D(0),1:jpkm1) ) ) &
& * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "LDETP" , zw3d * lthet * 1e9 )
ENDIF
IF( iom_use ( "Mumax" ) ) THEN ! Maximum growth rate
zw3d(A2D(0),1:jpkm1) = zprmaxn(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "Mumax", zw3d )
ENDIF
!
IF( iom_use ( "MuP" ) ) THEN ! Realized growth rate for picophyto
zw3d(A2D(0),1:jpkm1) = zprpic(A2D(0),1:jpkm1) * xlimpic(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "MuP", zw3d )
ENDIF
!
!
IF( iom_use ( "MuN" ) ) THEN ! Realized growth rate for nanophyto
zw3d(A2D(0),1:jpkm1) = zprbio(A2D(0),1:jpkm1) * xlimphy(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "MuN", zw3d )
ENDIF
!
IF( iom_use ( "MuD" ) ) THEN ! Realized growth rate for diatoms
zw3d(A2D(0),1:jpkm1) = zprdia(A2D(0),1:jpkm1) * xlimdia(A2D(0),1:jpkm1) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "MuD", zw3d )
ENDIF
!
IF( iom_use ( "LPlight" ) ) THEN ! light limitation term for pico
zw3d(A2D(0),1:jpkm1) = zprpic(A2D(0),1:jpkm1) / ( zprmaxp(A2D(0),1:jpkm1) + rtrn ) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "LPlight", zw3d )
ENDIF
!
IF( iom_use ( "LNlight" ) ) THEN ! light limitation term for nano
zw3d(A2D(0),1:jpkm1) = zprbio(A2D(0),1:jpkm1) / ( zprmaxn(A2D(0),1:jpkm1) + rtrn ) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "LNlight", zw3d )
ENDIF
!
IF( iom_use ( "LDlight" ) ) THEN ! light limitation term for diatoms
zw3d(A2D(0),1:jpkm1) = zprdia(A2D(0),1:jpkm1) / ( zprmaxd(A2D(0),1:jpkm1) + rtrn ) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "LDlight", zw3d )
ENDIF
!
IF( iom_use ( "MunetP" ) ) THEN ! Realized growth rate for picophyto
zw3d(A2D(0),1:jpkm1) = tr(A2D(0),1:jpkm1,jppic,Krhs)/rfact2/(tr(A2D(0),1:jpkm1,jppic,Kbb) + rtrn ) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "MunetP", zw3d )
ENDIF
CALL iom_put( "Mumax" , zprmaxn(:,:,:) * tmask(:,:,:) ) ! Maximum growth rate
CALL iom_put( "MuP" , zprpic(:,:,:) * xlimpic(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for picophyto
CALL iom_put( "MuN" , zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for nanophyto
CALL iom_put( "MuD" , zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for diatoms
CALL iom_put( "LPlight" , zprpic(:,:,:) / (zprmaxp(:,:,:) + rtrn) * tmask(:,:,:) ) ! light limitation term
CALL iom_put( "LNlight" , zprbio(:,:,:) / (zprmaxn(:,:,:) + rtrn) * tmask(:,:,:) ) ! light limitation term
CALL iom_put( "LDlight" , zprdia(:,:,:) / (zprmaxd(:,:,:) + rtrn) * tmask(:,:,:) )
CALL iom_put( "MunetP" , ( tr(:,:,:,jppic,Krhs)/rfact2/(tr(:,:,:,jppic,Kbb)+ rtrn ) * tmask(:,:,:)) ) ! Realized growth rate for picophyto
CALL iom_put( "MunetN" , ( tr(:,:,:,jpphy,Krhs)/rfact2/(tr(:,:,:,jpphy,Kbb)+ rtrn ) * tmask(:,:,:)) ) ! Realized growth rate for picophyto
CALL iom_put( "MunetD" , ( tr(:,:,:,jpdia,Krhs)/rfact2/(tr(:,:,:,jpdia,Kbb)+ rtrn ) * tmask(:,:,:)) ) ! Realized growth rate for picophyto
CALL iom_put( "TPP" , ( zprorcap(:,:,:) + zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:) ) ! total primary production
CALL iom_put( "TPNEW" , ( zpronewp(:,:,:) + zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:) ) ! total new production
CALL iom_put( "TPBFE" , ( zprofep (:,:,:) + zprofen (:,:,:) + zprofed (:,:,:) ) * zfact * tmask(:,:,:) ) ! total biogenic iron production
CALL iom_put( "tintpp" , tpp * zfact ) ! global total integrated primary production molC/s
!
IF( iom_use ( "MunetN" ) ) THEN ! Realized growth rate for nanophyto
zw3d(A2D(0),1:jpkm1) = tr(A2D(0),1:jpkm1,jpphy,Krhs)/rfact2/(tr(A2D(0),1:jpkm1,jpphy,Kbb) + rtrn ) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "MunetN", zw3d )
ENDIF
!
IF( iom_use ( "MunetD" ) ) THEN ! Realized growth rate for diatoms
zw3d(A2D(0),1:jpkm1) = tr(A2D(0),1:jpkm1,jpdia,Krhs)/rfact2/(tr(A2D(0),1:jpkm1,jpdia,Kbb) + rtrn ) * tmask(A2D(0),1:jpkm1)
CALL iom_put( "MunetD", zw3d )
ENDIF
!
IF( iom_use ( "TPP" ) ) THEN ! total primary production
zw3d(A2D(0),1:jpkm1) = ( zprorcap(A2D(0),1:jpkm1) + zprorcan(A2D(0),1:jpkm1) + zprorcad(A2D(0),1:jpkm1) ) * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "TPP", zw3d )
ENDIF
!
IF( iom_use ( "TPNEW" ) ) THEN ! total new production
zw3d(A2D(0),1:jpkm1) = ( zpronewp(A2D(0),1:jpkm1) + zpronewn(A2D(0),1:jpkm1) + zpronewd(A2D(0),1:jpkm1) ) * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "TPNEW", zw3d )
ENDIF
!
IF( iom_use ( "TPBFE" ) ) THEN ! total biogenic iron production
zw3d(A2D(0),1:jpkm1) = ( zprofep(A2D(0),1:jpkm1) + zprofen(A2D(0),1:jpkm1) + zprofed(A2D(0),1:jpkm1) ) * zfact * tmask(A2D(0),1:jpkm1)
CALL iom_put( "TPBFE", zw3d )
ENDIF
!
IF( iom_use( "tintpp") ) CALL iom_put( "tintpp" , tpp * zfact ) ! global total integrated primary production molC/s
!
DEALLOCATE( zw3d )
ENDIF
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
......@@ -632,7 +729,7 @@ CONTAINS
!!----------------------------------------------------------------------
!! *** ROUTINE p5z_prod_alloc ***
!!----------------------------------------------------------------------
ALLOCATE( zdaylen(jpi,jpj), STAT = p5z_prod_alloc )
ALLOCATE( zdaylen(A2D(0)), STAT = p5z_prod_alloc )
!
IF( p5z_prod_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p5z_prod_alloc : failed to allocate arrays.' )
!
......
src/TOP/PISCES/SED/sedchem.F90
View file @ c72255b2
......@@ -138,7 +138,7 @@ CONTAINS
IF (ln_sediment_offline) THEN
CALL sed_chem_cst
ELSE
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
IF ( tmask(ji,jj,ikt) == 1 ) THEN
zchem_data(ji,jj,1) = ak13 (ji,jj,ikt)
......
src/TOP/PISCES/SED/sedsfc.F90
View file @ c72255b2
......@@ -49,7 +49,7 @@ CONTAINS
CALL unpack_arr ( jpoce, trc_data(1:jpi,1:jpj,8), iarroce(1:jpoce), pwcp(1:jpoce,1,jwfe2) )
CALL unpack_arr ( jpoce, trc_data(1:jpi,1:jpj,9), iarroce(1:jpoce), pwcp(1:jpoce,1,jwlgw) )
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
IF ( tmask(ji,jj,ikt) == 1 ) THEN
tr(ji,jj,ikt,jptal,Kbb) = trc_data(ji,jj,1)
......
src/TOP/PISCES/SED/trcdmp_sed.F90
View file @ c72255b2
......@@ -92,7 +92,7 @@ CONTAINS
jl = n_trc_index(jn)
CALL trc_dta( kt, jl, ztrcdta ) ! read tracer data at nit000
!
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
ikt = mbkt(ji,jj)
tr(ji,jj,ikt,jn,Kbb) = ztrcdta(ji,jj,ikt) + ( tr(ji,jj,ikt,jn,Kbb) - ztrcdta(ji,jj,ikt) ) &
& * exp( -restosed(ji,jj,ikt) * dtsed )
......
src/TOP/PISCES/sms_pisces.F90
View file @ c72255b2
......@@ -124,6 +124,8 @@ MODULE sms_pisces
LOGICAL, SAVE :: lk_sed
!! * Substitutions
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
!! $Id: sms_pisces.F90 15459 2021-10-29 08:19:18Z cetlod $
......@@ -140,52 +142,52 @@ CONTAINS
!!----------------------------------------------------------------------
ierr(:) = 0
!* Biological fluxes for light : shared variables for pisces & lobster
ALLOCATE( xksi(jpi,jpj), strn(jpi,jpj), STAT=ierr(1) )
ALLOCATE( xksi(A2D(0)), strn(A2D(0)), STAT=ierr(1) )
IF( ln_p4z .OR. ln_p5z ) THEN
!* Optics
ALLOCATE( enano(jpi,jpj,jpk) , ediat(jpi,jpj,jpk) , &
& enanom(jpi,jpj,jpk), ediatm(jpi,jpj,jpk), &
& emoy(jpi,jpj,jpk) , etotm(jpi,jpj,jpk), STAT=ierr(2) )
ALLOCATE( enano(A2D(0),jpk) , ediat(A2D(0),jpk) , &
& enanom(A2D(0),jpk), ediatm(A2D(0),jpk), &
& emoy(A2D(0),jpk) , etotm(A2D(0),jpk), STAT=ierr(2) )
!* Biological SMS
ALLOCATE( xksimax(jpi,jpj) , biron(jpi,jpj,jpk) , STAT=ierr(3) )
ALLOCATE( xksimax(A2D(0)) , biron(A2D(0),jpk) , STAT=ierr(3) )
! Biological SMS
ALLOCATE( xfracal (jpi,jpj,jpk), orem (jpi,jpj,jpk), &
& nitrfac (jpi,jpj,jpk), nitrfac2(jpi,jpj,jpk), &
& prodcal (jpi,jpj,jpk), xdiss (jpi,jpj,jpk), &
& prodpoc (jpi,jpj,jpk), conspoc (jpi,jpj,jpk), &
& prodgoc (jpi,jpj,jpk), consgoc (jpi,jpj,jpk), &
& blim (jpi,jpj,jpk), consfe3 (jpi,jpj,jpk), &
& xfecolagg(jpi,jpj,jpk), xcoagfe (jpi,jpj,jpk), STAT=ierr(4) )
ALLOCATE( xfracal (A2D(0),jpk), orem (A2D(0),jpk), &
& nitrfac (A2D(0),jpk), nitrfac2(A2D(0),jpk), &
& prodcal (A2D(0),jpk), xdiss (A2D(0),jpk), &
& prodpoc (A2D(0),jpk), conspoc (A2D(0),jpk), &
& prodgoc (A2D(0),jpk), consgoc (A2D(0),jpk), &
& blim (A2D(0),jpk), consfe3 (A2D(0),jpk), &
& xfecolagg(A2D(0),jpk), xcoagfe (A2D(0),jpk), STAT=ierr(4) )
!* Carbonate chemistry
ALLOCATE( ak13 (jpi,jpj,jpk) , &
& ak23(jpi,jpj,jpk) , aksp (jpi,jpj,jpk) , &
& hi (jpi,jpj,jpk) , excess(jpi,jpj,jpk) , &
& aphscale(jpi,jpj,jpk), STAT=ierr(5) )
ALLOCATE( ak13(A2D(0),jpk), &
& ak23(A2D(0),jpk), aksp (A2D(0),jpk) , &
& hi (A2D(0),jpk), excess(A2D(0),jpk) , &
& aphscale(A2D(0),jpk), STAT=ierr(5) )
!
!* Temperature dependency of SMS terms
ALLOCATE( tgfunc (jpi,jpj,jpk) , tgfunc2(jpi,jpj,jpk), STAT=ierr(6) )
ALLOCATE( tgfunc (A2D(0),jpk) , tgfunc2(A2D(0),jpk), STAT=ierr(6) )
!
!* Sinking speed
ALLOCATE( wsbio3 (jpi,jpj,jpk) , wsbio4 (jpi,jpj,jpk), STAT=ierr(7) )
ALLOCATE( wsbio3 (A2D(0),jpk) , wsbio4 (A2D(0),jpk), STAT=ierr(7) )
!* Size of phytoplankton cells
ALLOCATE( sizen (jpi,jpj,jpk), sized (jpi,jpj,jpk), &
& sizena(jpi,jpj,jpk), sizeda(jpi,jpj,jpk), STAT=ierr(8) )
ALLOCATE( sizen (A2D(0),jpk), sized (A2D(0),jpk), &
& sizena(A2D(0),jpk), sizeda(A2D(0),jpk), STAT=ierr(8) )
!
ALLOCATE( plig(jpi,jpj,jpk) , STAT=ierr(9) )
ALLOCATE( plig(A2D(0),jpk) , STAT=ierr(9) )
ENDIF
!
IF( ln_p5z ) THEN
! PISCES-QUOTA specific part
ALLOCATE( epico(jpi,jpj,jpk) , epicom(jpi,jpj,jpk) , STAT=ierr(10) )
ALLOCATE( epico(A2D(0),jpk) , epicom(A2D(0),jpk) , STAT=ierr(10) )
!* Size of phytoplankton cells
ALLOCATE( sizep(jpi,jpj,jpk), sizepa(jpi,jpj,jpk), STAT=ierr(11) )
ALLOCATE( sizep(A2D(0),jpk), sizepa(A2D(0),jpk), STAT=ierr(11) )
ENDIF
!
sms_pisces_alloc = MAXVAL( ierr )
......
src/TOP/PISCES/trcice_pisces.F90
View file @ c72255b2
......@@ -19,6 +19,8 @@ MODULE trcice_pisces
PUBLIC trc_ice_ini_pisces ! called by trcini.F90 module
!! * Substitutions
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
!! $Id: trcice_pisces.F90 10794 2019-03-22 09:25:28Z cetlod $
......@@ -283,15 +285,15 @@ CONTAINS
ENDIF
!
DO jn = jp_pcs0, jp_pcs1
IF( cn_trc_o(jn) == 'GL ' ) trc_o(:,:,jn) = zpisc(jn,1) ! Global case
IF( cn_trc_o(jn) == 'GL ' ) trc_o(A2D(0),jn) = zpisc(jn,1) ! Global case
IF( cn_trc_o(jn) == 'AA ' ) THEN
WHERE( gphit(:,:) >= 0._wp ) ; trc_o(:,:,jn) = zpisc(jn,2) ; END WHERE ! Arctic
WHERE( gphit(:,:) < 0._wp ) ; trc_o(:,:,jn) = zpisc(jn,3) ; END WHERE ! Antarctic
WHERE( gphit(A2D(0)) >= 0._wp ) ; trc_o(A2D(0),jn) = zpisc(jn,2) ; END WHERE ! Arctic
WHERE( gphit(A2D(0)) < 0._wp ) ; trc_o(A2D(0),jn) = zpisc(jn,3) ; END WHERE ! Antarctic
ENDIF
IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN ! Baltic Sea particular case for ORCA configurations
WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. &
54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
trc_o(:,:,jn) = zpisc(jn,4)
WHERE( 14._wp <= glamt(A2D(0)) .AND. glamt(A2D(0)) <= 32._wp .AND. &
54._wp <= gphit(A2D(0)) .AND. gphit(A2D(0)) <= 66._wp )
trc_o(A2D(0),jn) = zpisc(jn,4)
END WHERE
ENDIF
ENDDO
......@@ -321,16 +323,16 @@ CONTAINS
DO jn = jp_pcs0, jp_pcs1
!-- Everywhere but in the Baltic
IF ( trc_ice_ratio(jn) >= -1._wp ) THEN ! no prescribed conc. ; typically everything but iron)
trc_i(:,:,jn) = zratio(jn,1) * trc_o(:,:,jn)
trc_i(A2D(0),jn) = zratio(jn,1) * trc_o(A2D(0),jn)
ELSE ! prescribed concentration
trc_i(:,:,jn) = trc_ice_prescr(jn)
trc_i(A2D(0),jn) = trc_ice_prescr(jn)
ENDIF
!-- Baltic
IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN
IF ( trc_ice_ratio(jn) >= - 1._wp ) THEN ! no prescribed conc. ; typically everything but iron)
WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. &
54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
trc_i(:,:,jn) = zratio(jn,2) * trc_o(:,:,jn)
WHERE( 14._wp <= glamt(A2D(0)) .AND. glamt(A2D(0)) <= 32._wp .AND. &
54._wp <= gphit(A2D(0)) .AND. gphit(A2D(0)) <= 66._wp )
trc_i(A2D(0),jn) = zratio(jn,2) * trc_o(A2D(0),jn)
END WHERE
ENDIF
ENDIF
......
src/TOP/PISCES/trcwri_pisces.F90
View file @ c72255b2
......@@ -38,7 +38,7 @@ CONTAINS
CHARACTER (len=20) :: cltra
REAL(wp) :: zfact
INTEGER :: ji, jj, jk, jn
REAL(wp), DIMENSION(jpi,jpj) :: zdic, zo2min, zdepo2min
REAL(wp), DIMENSION(A2D(0)) :: zdic, zo2min, zdepo2min
!!---------------------------------------------------------------------
! write the tracer concentrations in the file
......@@ -60,15 +60,19 @@ CONTAINS
IF( iom_use( "INTDIC" ) ) THEN ! DIC content in kg/m2
zdic(:,:) = 0.
DO jk = 1, jpkm1
zdic(:,:) = zdic(:,:) + tr(:,:,jk,jpdic,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) * 12.
DO_2D( 0, 0, 0, 0 )
zdic(ji,jj) = zdic(ji,jj) + tr(ji,jj,jk,jpdic,Kmm) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * 12.
END_2D
ENDDO
CALL iom_put( 'INTDIC', zdic )
CALL iom_put( 'INTDIC', zdic )
ENDIF
!
IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN ! Oxygen minimum concentration and depth
zo2min (:,:) = tr(:,:,1,jpoxy,Kmm) * tmask(:,:,1)
zdepo2min(:,:) = gdepw(:,:,1,Kmm) * tmask(:,:,1)
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 )
IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN ! Oxygen minimum concentration and depth
DO_2D( 0, 0, 0, 0 )
zo2min (ji,jj) = tr(ji,jj,1,jpoxy,Kmm) * tmask(ji,jj,1)
zdepo2min(ji,jj) = gdepw(ji,jj,1,Kmm) * tmask(ji,jj,1)
END_2D
DO_3D( 0, 0, 0, 0, 2, jpkm1 )
IF( tmask(ji,jj,jk) == 1 ) then
IF( tr(ji,jj,jk,jpoxy,Kmm) < zo2min(ji,jj) ) then
zo2min (ji,jj) = tr(ji,jj,jk,jpoxy,Kmm)
......
src/TOP/TRP/trcadv.F90
View file @ c72255b2
......@@ -123,19 +123,19 @@ CONTAINS
!
IF( ln_wave .AND. ln_sdw ) THEN
DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) ! eulerian transport + Stokes Drift
zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * ( zptu(ji,jj,jk) + usd(ji,jj,jk) )
zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * ( zptv(ji,jj,jk) + vsd(ji,jj,jk) )
zuu(ji,jj,jk) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * ( zptu(ji,jj,jk) + usd(ji,jj,jk) )
zvv(ji,jj,jk) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * ( zptv(ji,jj,jk) + vsd(ji,jj,jk) )
END_3D
DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
zww(ji,jj,jk) = e1e2t(ji,jj) * ( zptw(ji,jj,jk) + wsd(ji,jj,jk) )
zww(ji,jj,jk) = e1e2t(ji,jj) * ( zptw(ji,jj,jk) + wsd(ji,jj,jk) )
END_3D
ELSE
DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * zptu(ji,jj,jk) ! eulerian transport
zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * zptv(ji,jj,jk)
zuu(ji,jj,jk) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * zptu(ji,jj,jk) ! eulerian transport
zvv(ji,jj,jk) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * zptv(ji,jj,jk)
END_3D
DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
zww(ji,jj,jk) = e1e2t(ji,jj) * zptw(ji,jj,jk)
zww(ji,jj,jk) = e1e2t(ji,jj) * zptw(ji,jj,jk)
END_3D
ENDIF
!
......
src/TOP/TRP/trcdmp.F90
View file @ c72255b2
......@@ -57,7 +57,7 @@ CONTAINS
!!----------------------------------------------------------------------
!! *** ROUTINE trc_dmp_alloc ***
!!----------------------------------------------------------------------
ALLOCATE( restotr(jpi,jpj,jpk) , STAT=trc_dmp_alloc )
ALLOCATE( restotr(A2D(0),jpk) , STAT=trc_dmp_alloc )
!
IF( trc_dmp_alloc /= 0 ) CALL ctl_warn('trc_dmp_alloc: failed to allocate array')
!
......@@ -329,11 +329,11 @@ CONTAINS
! convert the position in local domain indices
! --------------------------------------------
DO jc = 1, npncts
nctsi1(jc) = mi0( nctsi1(jc) )
nctsj1(jc) = mj0( nctsj1(jc) )
nctsi1(jc) = mi0( nctsi1(jc), nn_hls )
nctsj1(jc) = mj0( nctsj1(jc), nn_hls )
!
nctsi2(jc) = mi1( nctsi2(jc) )
nctsj2(jc) = mj1( nctsj2(jc) )
nctsi2(jc) = mi1( nctsi2(jc), nn_hls )
nctsj2(jc) = mj1( nctsj2(jc), nn_hls )
END DO
!
ENDIF
......
src/TOP/TRP/trcsbc.F90
View file @ c72255b2
......@@ -115,14 +115,14 @@ CONTAINS
CASE ( -1 ) ! ! No tracers in sea ice ( trc_i = 0 )
!
DO jn = 1, jptra
DO_2D( 0, 0, 0, 1 )
DO_2D( 0, 0, 0, 0 )
sbc_trc(ji,jj,jn) = 0._wp
END_2D
END DO
!
IF( ln_linssh ) THEN !* linear free surface
DO jn = 1, jptra
DO_2D( 0, 0, 0, 1 )
DO_2D( 0, 0, 0, 0 )
sbc_trc(ji,jj,jn) = sbc_trc(ji,jj,jn) + r1_rho0 * emp(ji,jj) * ptr(ji,jj,1,jn,Kmm) !==>> add concentration/dilution effect due to constant volume cell
END_2D
END DO
......@@ -131,14 +131,14 @@ CONTAINS
CASE ( 0 ) ! Same concentration in sea ice and in the ocean ( trc_i = ptr(...,Kmm) )
!
DO jn = 1, jptra
DO_2D( 0, 0, 0, 1 )
DO_2D( 0, 0, 0, 0 )
sbc_trc(ji,jj,jn) = - fmmflx(ji,jj) * r1_rho0 * ptr(ji,jj,1,jn,Kmm)
END_2D
END DO
!
IF( ln_linssh ) THEN !* linear free surface
DO jn = 1, jptra
DO_2D( 0, 0, 0, 1 )
DO_2D( 0, 0, 0, 0 )
sbc_trc(ji,jj,jn) = sbc_trc(ji,jj,jn) + r1_rho0 * emp(ji,jj) * ptr(ji,jj,1,jn,Kmm) !==>> add concentration/dilution effect due to constant volume cell
END_2D
END DO
......@@ -147,21 +147,21 @@ CONTAINS
CASE ( 1 ) ! Specific treatment of sea ice fluxes with an imposed concentration in sea ice
!
DO jn = 1, jptra
DO_2D( 0, 0, 0, 1 )
DO_2D( 0, 0, 0, 0 )
sbc_trc(ji,jj,jn) = - fmmflx(ji,jj) * r1_rho0 * trc_i(ji,jj,jn)
END_2D
END DO
!
IF( ln_linssh ) THEN !* linear free surface
DO jn = 1, jptra
DO_2D( 0, 0, 0, 1 )
DO_2D( 0, 0, 0, 0 )
sbc_trc(ji,jj,jn) = sbc_trc(ji,jj,jn) + r1_rho0 * emp(ji,jj) * ptr(ji,jj,1,jn,Kmm) !==>> add concentration/dilution effect due to constant volume cell
END_2D
END DO
ENDIF
!
DO jn = 1, jptra
DO_2D( 0, 0, 0, 1 )
DO_2D( 0, 0, 0, 0 )
zse3t = rDt_trc / e3t(ji,jj,1,Kmm)
zdtra = ptr(ji,jj,1,jn,Kmm) + sbc_trc(ji,jj,jn) * zse3t
IF( zdtra < 0. ) sbc_trc(ji,jj,jn) = MAX( zdtra, -ptr(ji,jj,1,jn,Kmm) / zse3t ) ! avoid negative concentration that can occurs if trc_i > ptr
......@@ -176,7 +176,7 @@ CONTAINS
!
IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) ! save trends
!
DO_2D( 0, 0, 0, 1 )
DO_2D( 0, 0, 0, 0 )
zse3t = zfact / e3t(ji,jj,1,Kmm)
ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t
END_2D
......@@ -295,7 +295,7 @@ CONTAINS
CASE ( 0 ) ! Same concentration in sea ice and in the ocean fmm contribution to concentration/dilution effect has to be removed
!
DO jn = 1, jptra
DO_2D( 0, 0, 0, 1 )
DO_2D( 0, 0, 0, 0 )
z1_rho0_e3t = r1_rho0 / e3t(ji,jj,1,Kmm)
ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + ( emp(ji,jj) - fmmflx(ji,jj) ) * r1_rho0 * ptr(ji,jj,1,jn,Kmm)
END_2D
......@@ -331,7 +331,7 @@ CONTAINS
CASE ( 0 ) ! Same concentration in sea ice and in the ocean : correct concentration/dilution effect due to "freezing - melting"
!
DO jn = 1, jptra
DO_2D( 0, 0, 0, 1 )
DO_2D( 0, 0, 0, 0 )
z1_rho0_e3t = r1_rho0 / e3t(ji,jj,1,Kmm)
ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) - fmmflx(ji,jj) * r1_rho0 * ptr(ji,jj,1,jn,Kmm)
END_2D
......
src/TOP/TRP/trcsink.F90
View file @ c72255b2
......@@ -50,12 +50,12 @@ CONTAINS
INTEGER , INTENT(in) :: Kbb, Kmm
INTEGER , INTENT(in) :: jp_tra ! tracer index index
REAL(wp), INTENT(in) :: rsfact ! time step duration
REAL(wp), INTENT(in) , DIMENSION(jpi,jpj,jpk) :: pwsink
REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: psinkflx
REAL(wp), INTENT(in) , DIMENSION(A2D(0),jpk) :: pwsink
REAL(wp), INTENT(inout), DIMENSION(A2D(0),jpk) :: psinkflx
INTEGER :: ji, jj, jk
INTEGER, DIMENSION(jpi, jpj) :: iiter
INTEGER, DIMENSION(A2D(0)) :: iiter
REAL(wp) :: zfact, zwsmax, zmax
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwsink
REAL(wp), DIMENSION(A2D(0),jpk) :: zwsink
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('trc_sink')
......@@ -73,7 +73,7 @@ CONTAINS
IF( nitermax == 1 ) THEN
iiter(:,:) = 1
ELSE
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
iiter(ji,jj) = 1
DO jk = 1, jpkm1
IF( tmask(ji,jj,jk) == 1.0 ) THEN
......@@ -85,7 +85,7 @@ CONTAINS
iiter(:,:) = MIN( iiter(:,:), nitermax )
ENDIF
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
IF( tmask(ji,jj,jk) == 1.0 ) THEN
zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact
zwsink(ji,jj,jk) = MIN( pwsink(ji,jj,jk), zwsmax * REAL( iiter(ji,jj), wp ) )
......@@ -121,23 +121,25 @@ CONTAINS
INTEGER, INTENT(in ) :: Kbb, Kmm ! time level indices
INTEGER, INTENT(in ) :: jp_tra ! tracer index index
REAL(wp), INTENT(in ) :: rsfact ! duration of time step
INTEGER, INTENT(in ), DIMENSION(jpi,jpj) :: kiter ! number of iterations for time-splitting
REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pwsink ! sinking speed
REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: psinkflx ! sinking fluxe
INTEGER, INTENT(in ), DIMENSION(A2D(0)) :: kiter ! number of iterations for time-splitting
REAL(wp), INTENT(in ), DIMENSION(A2D(0),jpk) :: pwsink ! sinking speed
REAL(wp), INTENT(inout), DIMENSION(A2D(0),jpk) :: psinkflx ! sinking fluxe
!
INTEGER :: ji, jj, jk, jn, jt
REAL(wp) :: zigma,zew,zign, zflx, zstep
REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztraz, zakz, zwsink2, ztrb, psinking
REAL(wp), DIMENSION(A2D(0),jpk) :: ztraz, zakz, zwsink2, ztrb, psinking
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('trc_sink2')
!
DO jk = 1, jpkm1
zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1)
END DO
zwsink2(:,:,1) = 0.e0
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zwsink2(ji,jj,jk+1) = -pwsink(ji,jj,jk) / rday * tmask(ji,jj,jk+1)
END_3D
DO_2D( 0, 0, 0, 0 )
zwsink2(ji,jj,1) = 0.e0
END_2D
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
! Vertical advective flux
zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2.
DO jt = 1, kiter(ji,jj)
......
src/TOP/trc.F90
View file @ c72255b2
......@@ -158,19 +158,19 @@ CONTAINS
!!-------------------------------------------------------------------
ierr(:) = 0
!
ALLOCATE( tr(jpi,jpj,jpk,jptra,jpt) , &
& trc_i(jpi,jpj,jptra) , trc_o(jpi,jpj,jptra) , &
& gtru (jpi,jpj,jptra) , gtrv (jpi,jpj,jptra) , &
& gtrui(jpi,jpj,jptra) , gtrvi(jpi,jpj,jptra) , &
& trc_ice_ratio(jptra) , trc_ice_prescr(jptra) , cn_trc_o(jptra) , &
& neln(jpi,jpj) , heup(jpi,jpj) , heup_01(jpi,jpj) , &
& etot(jpi,jpj,jpk) , etot_ndcy(jpi,jpj,jpk) , &
& sbc_trc_b(jpi,jpj,jptra), sbc_trc(jpi,jpj,jptra) , &
& cvol(jpi,jpj,jpk) , trai(jptra) , &
& ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , &
& ln_trc_ini(jptra) , &
& ln_trc_sbc(jptra) , ln_trc_cbc(jptra) , ln_trc_obc(jptra) , &
& ln_trc_ais(jptra) , &
ALLOCATE( tr(jpi,jpj,jpk,jptra,jpt) , &
& gtru (jpi,jpj,jptra) , gtrv (jpi,jpj,jptra) , &
& gtrui(jpi,jpj,jptra) , gtrvi(jpi,jpj,jptra) , &
& trc_i(A2D(0),jptra) , trc_o(A2D(0),jptra) , &
& trc_ice_ratio(jptra) , trc_ice_prescr(jptra) , cn_trc_o(jptra) , &
& neln(A2D(0)) , heup(A2D(0)) , heup_01(A2D(0)) , &
& etot(A2D(0),jpk) , etot_ndcy(A2D(0),jpk) , &
& sbc_trc_b(A2D(0),jptra), sbc_trc(A2D(0),jptra) , &
& cvol(jpi,jpj,jpk) , trai(jptra) , &
& ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , &
& ln_trc_ini(jptra) , &
& ln_trc_sbc(jptra) , ln_trc_cbc(jptra) , ln_trc_obc(jptra) , &
& ln_trc_ais(jptra) , &
& STAT = ierr(1) )
!
IF( ln_bdy ) ALLOCATE( trcdta_bdy(jptra, jp_bdy) , STAT = ierr(2) )
......
src/TOP/trcais.F90
View file @ c72255b2
......@@ -169,7 +169,7 @@ CONTAINS
DO jn = 1, jptra
IF( ln_trc_ais(jn) ) THEN
jl = n_trc_indais(jn)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
zfact = 1. / e3t(ji,jj,1,Kmm)
ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + fwficb(ji,jj) * r1_rho0 * ptr(ji,jj,1,jn,Kmm) * zfact
END_2D
......@@ -181,7 +181,7 @@ CONTAINS
DO jn = 1, jptra
IF( ln_trc_ais(jn) ) THEN
jl = n_trc_indais(jn)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
IF( ln_isfpar_mlt ) THEN
zcalv = fwfisf_par(ji,jj) * r1_rho0 / rhisf_tbl_par(ji,jj)
ikt = misfkt_par(ji,jj)
......@@ -213,7 +213,7 @@ CONTAINS
DO jn = 1, jptra
IF( ln_trc_ais(jn) ) THEN
jl = n_trc_indais(jn)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
DO jk = 1, icblev
zcalv = fwficb(ji,jj) * r1_rho0
ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + rf_trafac(jl) * zcalv / gdepw(ji,jj,icblev+1,Kmm)
......@@ -228,7 +228,7 @@ CONTAINS
DO jn = 1, jptra
IF( ln_trc_ais(jn) ) THEN
jl = n_trc_indais(jn)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
IF( ln_isfpar_mlt ) THEN
zcalv = - fwfisf_par(ji,jj) * r1_rho0 / rhisf_tbl_par(ji,jj)
ikt = misfkt_par(ji,jj)
......