diff --git a/src/OCE/DIA/diaar5.F90 b/src/OCE/DIA/diaar5.F90
index 4e9a4f45715b0425caa5b339e812067968a6d995..584783f9b402c44528cf46c6f3e59728890643ef 100644
--- a/src/OCE/DIA/diaar5.F90
+++ b/src/OCE/DIA/diaar5.F90
@@ -28,6 +28,10 @@ MODULE diaar5
IMPLICIT NONE
PRIVATE
+ INTERFACE dia_ar5_hst
+ MODULE PROCEDURE dia_ar5_hst_2d, dia_ar5_hst_3d
+ END INTERFACE
+
PUBLIC dia_ar5 ! routine called in step.F90 module
PUBLIC dia_ar5_init
PUBLIC dia_ar5_alloc ! routine called in nemogcm.F90 module
@@ -367,49 +371,102 @@ CONTAINS
END SUBROUTINE dia_ar5
- SUBROUTINE dia_ar5_hst( ktra, cptr, puflx, pvflx )
+ SUBROUTINE dia_ar5_hst_2d( ktra, cptr, puflx, pvflx, ldfin )
+ !!
+ INTEGER, INTENT(in) :: ktra ! tracer index
+ CHARACTER(len=3), INTENT(in) :: cptr ! transport type 'adv'/'ldf'
+ REAL(wp), DIMENSION(:,:), INTENT(in) :: puflx, pvflx ! 2D u/v-flux of advection/diffusion
+ LOGICAL, INTENT(in) :: ldfin ! last call or not?
+ !!
+ CALL dia_ar5_hst_t( ktra, cptr, puflx2d=puflx, pvflx2d=pvflx, ktuvflx=lbnd_ij(puflx), ldfin=ldfin )
+ END SUBROUTINE dia_ar5_hst_2d
+
+
+ SUBROUTINE dia_ar5_hst_3d( ktra, cptr, puflx, pvflx )
+ !!
+ INTEGER, INTENT(in) :: ktra ! tracer index
+ CHARACTER(len=3), INTENT(in) :: cptr ! transport type 'adv'/'ldf'
+ REAL(wp), DIMENSION(:,:,:), INTENT(in) :: puflx, pvflx ! 3D u/v-flux of advection/diffusion
+ !!
+ CALL dia_ar5_hst_t( ktra, cptr, puflx3d=puflx, pvflx3d=pvflx, ktuvflx=lbnd_ij(puflx), ldfin=.TRUE. )
+ END SUBROUTINE dia_ar5_hst_3d
+
+
+ SUBROUTINE dia_ar5_hst_t( ktra, cptr, puflx2d, pvflx2d, puflx3d, pvflx3d, ktuvflx, ldfin )
!!----------------------------------------------------------------------
!! *** ROUTINE dia_ar5_hst ***
!!----------------------------------------------------------------------
!! Wrapper for heat transport calculations
!! Called from all advection and/or diffusion routines
!!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: ktra ! tracer index
- CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf'
- REAL(wp), DIMENSION(T2D(nn_hls),jpk) , INTENT(in) :: puflx ! u-flux of advection/diffusion
- REAL(wp), DIMENSION(T2D(nn_hls),jpk) , INTENT(in) :: pvflx ! v-flux of advection/diffusion
+ INTEGER, DIMENSION(2), INTENT(in) :: ktuvflx
+ INTEGER, INTENT(in) :: ktra ! tracer index
+ CHARACTER(len=3), INTENT(in) :: cptr ! transport type 'adv'/'ldf'
+ LOGICAL, INTENT(in) :: ldfin ! are diagnostics ready for XIOS?
+ REAL(wp), DIMENSION(AB2D(ktuvflx)), INTENT(in), OPTIONAL :: puflx2d, pvflx2d ! 2D u/v-flux of advection/diffusion
+ REAL(wp), DIMENSION(AB2D(ktuvflx),JPK), INTENT(in), OPTIONAL :: puflx3d, pvflx3d ! 3D " "
!
- INTEGER :: ji, jj, jk
- REAL(wp), DIMENSION(T2D(0)) :: z2d
+ INTEGER :: ji, jj, jk
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE :: zuflx, zvflx
!!----------------------------------------------------------------------
- z2d(:,:) = 0._wp
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk)
- END_3D
-
- IF( cptr == 'adv' ) THEN
- IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * z2d(:,:) ) ! advective heat transport in i-direction
- IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rho0 * z2d(:,:) ) ! advective salt transport in i-direction
- ELSE IF( cptr == 'ldf' ) THEN
- IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rho0_rcp * z2d(:,:) ) ! diffusive heat transport in i-direction
- IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rho0 * z2d(:,:) ) ! diffusive salt transport in i-direction
+ ! Flux in i-direction
+ IF( .NOT. ALLOCATED(zuflx) ) THEN
+ ALLOCATE( zuflx(T2D(0)) )
+ zuflx(:,:) = 0._wp
ENDIF
- !
- z2d(:,:) = 0._wp
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk)
- END_3D
-
- IF( cptr == 'adv' ) THEN
- IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * z2d(:,:) ) ! advective heat transport in j-direction
- IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rho0 * z2d(:,:) ) ! advective salt transport in j-direction
- ELSE IF( cptr == 'ldf' ) THEN
- IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rho0_rcp * z2d(:,:) ) ! diffusive heat transport in j-direction
- IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rho0 * z2d(:,:) ) ! diffusive salt transport in j-direction
+
+ IF( PRESENT(puflx2d) ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ zuflx(ji,jj) = zuflx(ji,jj) + puflx2d(ji,jj)
+ END_2D
+ ELSE IF( PRESENT(puflx3d) ) THEN
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ zuflx(ji,jj) = zuflx(ji,jj) + puflx3d(ji,jj,jk)
+ END_3D
+ ENDIF
+
+ IF( ldfin ) THEN
+ IF( cptr == 'adv' ) THEN
+ IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * zuflx(:,:) ) ! advective heat transport
+ IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rho0 * zuflx(:,:) ) ! advective salt transport
+ ELSE IF( cptr == 'ldf' ) THEN
+ IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rho0_rcp * zuflx(:,:) ) ! diffusive heat transport
+ IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rho0 * zuflx(:,:) ) ! diffusive salt transport
+ ENDIF
+
+ DEALLOCATE( zuflx )
+ ENDIF
+
+ ! Flux in j-direction
+ IF( .NOT. ALLOCATED(zvflx) ) THEN
+ ALLOCATE( zvflx(T2D(0)) )
+ zvflx(:,:) = 0._wp
+ ENDIF
+
+ IF( PRESENT(pvflx2d) ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ zvflx(ji,jj) = zvflx(ji,jj) + pvflx2d(ji,jj)
+ END_2D
+ ELSE IF( PRESENT(pvflx3d) ) THEN
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ zvflx(ji,jj) = zvflx(ji,jj) + pvflx3d(ji,jj,jk)
+ END_3D
+ ENDIF
+
+ IF( ldfin ) THEN
+ IF( cptr == 'adv' ) THEN
+ IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * zvflx(:,:) ) ! advective heat transport
+ IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rho0 * zvflx(:,:) ) ! advective salt transport
+ ELSE IF( cptr == 'ldf' ) THEN
+ IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rho0_rcp * zvflx(:,:) ) ! diffusive heat transport
+ IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rho0 * zvflx(:,:) ) ! diffusive salt transport
+ ENDIF
+
+ DEALLOCATE( zvflx )
ENDIF
- END SUBROUTINE dia_ar5_hst
+ END SUBROUTINE dia_ar5_hst_t
SUBROUTINE dia_ar5_init
diff --git a/src/OCE/DIA/diaptr.F90 b/src/OCE/DIA/diaptr.F90
index d8991121c15300db1a00c37bec7f2552ea1f8925..7b062ed269fa14d368be867079e7fc9e5570c524 100644
--- a/src/OCE/DIA/diaptr.F90
+++ b/src/OCE/DIA/diaptr.F90
@@ -33,19 +33,24 @@ MODULE diaptr
PRIVATE
INTERFACE ptr_sum
- MODULE PROCEDURE ptr_sum_3d, ptr_sum_2d
+ MODULE PROCEDURE ptr_sum_2d, ptr_sum_3d
+ END INTERFACE
+ INTERFACE ptr_mpp_sum
+ MODULE PROCEDURE ptr_mpp_sum_2d, ptr_mpp_sum_3d, ptr_mpp_sum_4d
END INTERFACE
-
INTERFACE ptr_sj
- MODULE PROCEDURE ptr_sj_3d, ptr_sj_2d
+ MODULE PROCEDURE ptr_sj_2d, ptr_sj_3d
+ END INTERFACE
+ INTERFACE dia_ptr_hst
+ MODULE PROCEDURE dia_ptr_hst_2d, dia_ptr_hst_3d
END INTERFACE
PUBLIC dia_ptr ! call in step module
PUBLIC dia_ptr_init ! call in stprk3 module
PUBLIC dia_ptr_hst ! called from tra_ldf/tra_adv routines
- REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_adv, hstr_ldf, hstr_eiv !: Heat/Salt TRansports(adv, diff, Bolus.)
- REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_ove, hstr_btr, hstr_vtr !: heat Salt TRansports(overturn, baro, merional)
+ REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_adv, hstr_ldf, hstr_eiv !: Heat/salt transports(adv, diff, bolus.)
+ REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_vtr !: Heat/salt transports(meridional)
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: pvtr_int, pzon_int !: Other zonal integrals
LOGICAL, PUBLIC :: l_diaptr !: tracers trend flag
@@ -123,12 +128,14 @@ CONTAINS
REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: zt_jk, zs_jk ! i-mean T and S, j-Stream-Function
REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: z4d1, z4d2
- REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: z3dtr
+ REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: z3dtr, zstr
!!----------------------------------------------------------------------
!
ALLOCATE( z3dtr(A2D(0),nbasin) )
IF( PRESENT( pvtr ) ) THEN
+ IF( lk_mpp ) CALL ptr_mpp_sum( pvtr_int(:,:,:,:) ) ! Call MPI sum
+
IF( iom_use( 'zomsf' ) ) THEN ! effective MSF
ALLOCATE( z4d1(A2D(0),jpk,nbasin) )
!
@@ -147,7 +154,7 @@ CONTAINS
ENDIF
IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN
ALLOCATE( sjk( A1Dj(0),jpk,nbasin), r1_sjk(A1Dj(0),jpk,nbasin), v_msf(A1Dj(0),jpk,nbasin), &
- & zt_jk(A1Dj(0),jpk,nbasin), zs_jk( A1Dj(0),jpk,nbasin) )
+ & zt_jk(A1Dj(0),jpk,nbasin), zs_jk( A1Dj(0),jpk,nbasin), zstr(A1Dj(0),nbasin,jpts) )
!
DO jn = 1, nbasin
sjk(:,:,jn) = pvtr_int(:,:,jn,jp_msk)
@@ -161,31 +168,31 @@ CONTAINS
v_msf(jj,jk,jn) = pvtr_int(jj,jk,jn,jp_vtr)
END DO
END DO
- hstr_ove(:,jn,jp_tem) = SUM( v_msf(:,:,jn)*zt_jk(:,:,jn), 2 )
- hstr_ove(:,jn,jp_sal) = SUM( v_msf(:,:,jn)*zs_jk(:,:,jn), 2 )
+ zstr(:,jn,jp_tem) = SUM( v_msf(:,:,jn)*zt_jk(:,:,jn), 2 )
+ zstr(:,jn,jp_sal) = SUM( v_msf(:,:,jn)*zs_jk(:,:,jn), 2 )
!
ENDDO
DO jn = 1, nbasin
- z3dtr(Nis0,:,jn) = hstr_ove(:,jn,jp_tem) * rc_pwatt ! (conversion in PW)
+ z3dtr(Nis0,:,jn) = zstr(:,jn,jp_tem) * rc_pwatt ! (conversion in PW)
DO ji = Nis0+1, Nie0
z3dtr(ji,:,jn) = z3dtr(Nis0,:,jn)
ENDDO
ENDDO
CALL iom_put( 'sophtove', z3dtr )
DO jn = 1, nbasin
- z3dtr(Nis0,:,jn) = hstr_ove(:,jn,jp_sal) * rc_ggram ! (conversion in Gg)
+ z3dtr(Nis0,:,jn) = zstr(:,jn,jp_sal) * rc_ggram ! (conversion in Gg)
DO ji = Nis0+1, Nie0
z3dtr(ji,:,jn) = z3dtr(Nis0,:,jn)
ENDDO
ENDDO
CALL iom_put( 'sopstove', z3dtr )
!
- DEALLOCATE( sjk, r1_sjk, v_msf, zt_jk, zs_jk )
+ DEALLOCATE( sjk, r1_sjk, v_msf, zt_jk, zs_jk, zstr )
ENDIF
IF( iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN
! Calculate barotropic heat and salt transport here
- ALLOCATE( sjk(A1Dj(0),1,nbasin), r1_sjk(A1Dj(0),1,nbasin) )
+ ALLOCATE( sjk(A1Dj(0),1,nbasin), r1_sjk(A1Dj(0),1,nbasin), zstr(A1Dj(0),nbasin,jpts) )
!
DO jn = 1, nbasin
sjk(:,1,jn) = SUM( pvtr_int(:,:,jn,jp_msk), 2 )
@@ -195,32 +202,38 @@ CONTAINS
zvsum(:) = SUM( pvtr_int(:,:,jn,jp_vtr), 2 )
ztsum(:) = SUM( pvtr_int(:,:,jn,jp_tem), 2 )
zssum(:) = SUM( pvtr_int(:,:,jn,jp_sal), 2 )
- hstr_btr(:,jn,jp_tem) = zvsum(:) * ztsum(:) * r1_sjk(:,1,jn)
- hstr_btr(:,jn,jp_sal) = zvsum(:) * zssum(:) * r1_sjk(:,1,jn)
+ zstr(:,jn,jp_tem) = zvsum(:) * ztsum(:) * r1_sjk(:,1,jn)
+ zstr(:,jn,jp_sal) = zvsum(:) * zssum(:) * r1_sjk(:,1,jn)
!
ENDDO
DO jn = 1, nbasin
- z3dtr(Nis0,:,jn) = hstr_btr(:,jn,jp_tem) * rc_pwatt ! (conversion in PW)
+ z3dtr(Nis0,:,jn) = zstr(:,jn,jp_tem) * rc_pwatt ! (conversion in PW)
DO ji = Nis0+1, Nie0
z3dtr(ji,:,jn) = z3dtr(Nis0,:,jn)
ENDDO
ENDDO
CALL iom_put( 'sophtbtr', z3dtr )
DO jn = 1, nbasin
- z3dtr(Nis0,:,jn) = hstr_btr(:,jn,jp_sal) * rc_ggram ! (conversion in Gg)
+ z3dtr(Nis0,:,jn) = zstr(:,jn,jp_sal) * rc_ggram ! (conversion in Gg)
DO ji = Nis0+1, Nie0
z3dtr(ji,:,jn) = z3dtr(Nis0,:,jn)
ENDDO
ENDDO
CALL iom_put( 'sopstbtr', z3dtr )
!
- DEALLOCATE( sjk, r1_sjk )
+ DEALLOCATE( sjk, r1_sjk, zstr )
ENDIF
!
- hstr_ove(:,:,:) = 0._wp ! Zero before next timestep
- hstr_btr(:,:,:) = 0._wp
pvtr_int(:,:,:,:) = 0._wp
ELSE
+ IF( lk_mpp ) THEN ! Call MPI sum
+ CALL ptr_mpp_sum( hstr_adv(:,:,:) )
+ CALL ptr_mpp_sum( hstr_ldf(:,:,:) )
+ CALL ptr_mpp_sum( hstr_eiv(:,:,:) )
+ CALL ptr_mpp_sum( hstr_vtr(:,:,:) )
+ CALL ptr_mpp_sum( pzon_int(:,:,:,:) )
+ ENDIF
+
IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' ) ) THEN ! i-mean i-k-surface
ALLOCATE( z4d1(A2D(0),jpk,nbasin), z4d2(A2D(0),jpk,nbasin) )
!
@@ -527,8 +540,6 @@ CONTAINS
hstr_adv(:,:,:) = 0._wp
hstr_ldf(:,:,:) = 0._wp
hstr_eiv(:,:,:) = 0._wp
- hstr_ove(:,:,:) = 0._wp
- hstr_btr(:,:,:) = 0._wp !
hstr_vtr(:,:,:) = 0._wp !
pvtr_int(:,:,:,:) = 0._wp
pzon_int(:,:,:,:) = 0._wp
@@ -540,33 +551,51 @@ CONTAINS
END SUBROUTINE dia_ptr_init
- SUBROUTINE dia_ptr_hst( ktra, cptr, pvflx )
+ SUBROUTINE dia_ptr_hst_2d( ktra, cptr, pvflx )
+ !!
+ INTEGER, INTENT(in) :: ktra ! tracer index
+ CHARACTER(len=3), INTENT(in) :: cptr ! transport type 'adv'/'ldf'/'eiv'
+ REAL(wp), DIMENSION(:,:), INTENT(in) :: pvflx ! 2D input array of advection/diffusion
+ !!
+ CALL dia_ptr_hst_t( ktra, cptr, pvflx2d=pvflx(:,:), ktvflx=lbnd_ij(pvflx) )
+ END SUBROUTINE dia_ptr_hst_2d
+
+
+ SUBROUTINE dia_ptr_hst_3d( ktra, cptr, pvflx )
!!
INTEGER, INTENT(in) :: ktra ! tracer index
CHARACTER(len=3), INTENT(in) :: cptr ! transport type 'adv'/'ldf'/'eiv'
REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pvflx ! 3D input array of advection/diffusion
!!
- CALL dia_ptr_hst_t( ktra, cptr, pvflx(:,:,:), lbnd_ij(pvflx) )
- END SUBROUTINE dia_ptr_hst
+ CALL dia_ptr_hst_t( ktra, cptr, pvflx3d=pvflx(:,:,:), ktvflx=lbnd_ij(pvflx) )
+ END SUBROUTINE dia_ptr_hst_3d
- SUBROUTINE dia_ptr_hst_t( ktra, cptr, pvflx, ktvflx )
+ SUBROUTINE dia_ptr_hst_t( ktra, cptr, pvflx2d, pvflx3d, ktvflx )
!!----------------------------------------------------------------------
!! *** ROUTINE dia_ptr_hst ***
!!----------------------------------------------------------------------
!! Wrapper for heat and salt transport calculations to calculate them for each basin
!! Called from all advection and/or diffusion routines
!!----------------------------------------------------------------------
- INTEGER, DIMENSION(2), INTENT(in) :: ktvflx
- INTEGER, INTENT(in) :: ktra ! tracer index
- CHARACTER(len=3), INTENT(in) :: cptr ! transport type 'adv'/'ldf'/'eiv'
- REAL(wp), DIMENSION(AB2D(ktvflx),JPK), INTENT(in) :: pvflx ! 3D input array of advection/diffusion
- REAL(wp), DIMENSION(T1Dj(0),nbasin) :: zsj !
- INTEGER :: jn !
-
- DO jn = 1, nbasin
- zsj(:,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) )
- ENDDO
+ INTEGER, DIMENSION(2), INTENT(in) :: ktvflx
+ INTEGER, INTENT(in) :: ktra ! tracer index
+ CHARACTER(len=3), INTENT(in) :: cptr ! transport type 'adv'/'ldf'/'eiv'
+ REAL(wp), DIMENSION(AB2D(ktvflx)), INTENT(in), OPTIONAL :: pvflx2d ! 2D input array of advection/diffusion
+ REAL(wp), DIMENSION(AB2D(ktvflx),JPK), INTENT(in), OPTIONAL :: pvflx3d ! 3D input array of advection/diffusion
+ !!
+ REAL(wp), DIMENSION(T1Dj(0),nbasin) :: zsj !
+ INTEGER :: jn !
+ !!----------------------------------------------------------------------
+ IF( PRESENT(pvflx2d) ) THEN
+ DO jn = 1, nbasin
+ zsj(:,jn) = ptr_sj( pvflx2d(:,:), btmsk(:,:,jn) )
+ END DO
+ ELSE IF( PRESENT(pvflx3d) ) THEN
+ DO jn = 1, nbasin
+ zsj(:,jn) = ptr_sj( pvflx3d(:,:,:), btmsk(:,:,jn) )
+ END DO
+ ENDIF
!
IF( cptr == 'adv' ) THEN
IF( ktra == jp_tem ) CALL ptr_sum( hstr_adv(:,:,jp_tem), zsj(:,:) )
@@ -592,36 +621,18 @@ CONTAINS
!! ** Purpose : Add two 2D arrays with (j,nbasin) dimensions
!!
!! ** Method : - phstr = phstr + pva
- !! - Call mpp_sum if the final tile
!!
!! ** Action : phstr
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(A1Dj(0),nbasin), INTENT(inout) :: phstr !
REAL(wp), DIMENSION(T1Dj(0),nbasin), INTENT(in ) :: pva !
INTEGER :: jj, jn
-#if ! defined key_mpi_off
- INTEGER, DIMENSION(1) :: ish1d
- INTEGER, DIMENSION(2) :: ish2d
- REAL(wp), DIMENSION(:), ALLOCATABLE :: zwork
-#endif
-
+ !!----------------------------------------------------------------------
DO jn = 1, nbasin
DO_1Dj( 0, 0 )
phstr(jj,jn) = phstr(jj,jn) + pva(jj,jn)
END_1D
END DO
-
-#if ! defined key_mpi_off
- IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only for the last tile
- ALLOCATE( zwork(Nj_0*nbasin) )
- ish1d(1) = Nj_0*nbasin
- ish2d(1) = Nj_0 ; ish2d(2) = nbasin
- zwork(:) = RESHAPE( phstr(:,:), ish1d )
- CALL mpp_sum( 'diaptr', zwork, ish1d(1), ncomm_znl )
- phstr(:,:) = RESHAPE( zwork, ish2d )
- DEALLOCATE( zwork )
- ENDIF
-#endif
END SUBROUTINE ptr_sum_2d
@@ -632,19 +643,13 @@ CONTAINS
!! ** Purpose : Add two 3D arrays with (j,k,nbasin) dimensions
!!
!! ** Method : - phstr = phstr + pva
- !! - Call mpp_sum if the final tile
!!
!! ** Action : phstr
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(A1Dj(0),jpk,nbasin), INTENT(inout) :: phstr !
REAL(wp), DIMENSION(T1Dj(0),jpk,nbasin), INTENT(in ) :: pva !
INTEGER :: jj, jk, jn
-#if ! defined key_mpi_off
- INTEGER, DIMENSION(1) :: ish1d
- INTEGER, DIMENSION(3) :: ish3d
- REAL(wp), DIMENSION(:), ALLOCATABLE :: zwork
-#endif
-
+ !!----------------------------------------------------------------------
DO jn = 1, nbasin
DO jk = 1, jpk
DO_1Dj( 0, 0 )
@@ -652,19 +657,70 @@ CONTAINS
END_1D
END DO
END DO
+ END SUBROUTINE ptr_sum_3d
+
+ SUBROUTINE ptr_mpp_sum_2d( phstr )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE ptr_mpp_sum_2d ***
+ !!----------------------------------------------------------------------
+ !! ** Purpose : Call mpp_sum for 2D flux array
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(:,:), INTENT(inout) :: phstr !
+ INTEGER :: isize
+ REAL(wp), DIMENSION(:), ALLOCATABLE :: zwork
+ !!----------------------------------------------------------------------
#if ! defined key_mpi_off
- IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only for the last tile
- ALLOCATE( zwork(Nj_0*jpk*nbasin) )
- ish1d(1) = Nj_0*jpk*nbasin
- ish3d(1) = Nj_0 ; ish3d(2) = jpk ; ish3d(3) = nbasin
- zwork(:) = RESHAPE( phstr(:,:,:), ish1d )
- CALL mpp_sum( 'diaptr', zwork, ish1d(1), ncomm_znl )
- phstr(:,:,:) = RESHAPE( zwork, ish3d )
- DEALLOCATE( zwork )
- ENDIF
+ isize = SIZE(phstr)
+ ALLOCATE( zwork(isize) )
+ zwork(:) = RESHAPE( phstr(:,:), (/ isize /) )
+ CALL mpp_sum( 'diaptr', zwork, isize, ncomm_znl )
+ phstr(:,:) = RESHAPE( zwork, SHAPE(phstr) )
+ DEALLOCATE( zwork )
#endif
- END SUBROUTINE ptr_sum_3d
+ END SUBROUTINE ptr_mpp_sum_2d
+
+
+ SUBROUTINE ptr_mpp_sum_3d( phstr )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE ptr_mpp_sum_3d ***
+ !!----------------------------------------------------------------------
+ !! ** Purpose : Call mpp_sum for 3D flux array
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phstr !
+ INTEGER :: isize
+ REAL(wp), DIMENSION(:), ALLOCATABLE :: zwork
+ !!----------------------------------------------------------------------
+#if ! defined key_mpi_off
+ isize = SIZE(phstr)
+ ALLOCATE( zwork(isize) )
+ zwork(:) = RESHAPE( phstr(:,:,:), (/ isize /) )
+ CALL mpp_sum( 'diaptr', zwork, isize, ncomm_znl )
+ phstr(:,:,:) = RESHAPE( zwork, SHAPE(phstr) )
+ DEALLOCATE( zwork )
+#endif
+ END SUBROUTINE ptr_mpp_sum_3d
+
+
+ SUBROUTINE ptr_mpp_sum_4d( phstr )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE ptr_mpp_sum_4d ***
+ !!----------------------------------------------------------------------
+ !! ** Purpose : Call mpp_sum for 4D flux array
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: phstr !
+ INTEGER :: isize
+ REAL(wp), DIMENSION(:), ALLOCATABLE :: zwork
+ !!----------------------------------------------------------------------
+#if ! defined key_mpi_off
+ isize = SIZE(phstr)
+ ALLOCATE( zwork(isize) )
+ zwork(:) = RESHAPE( phstr(:,:,:,:), (/ isize /) )
+ CALL mpp_sum( 'diaptr', zwork, isize, ncomm_znl )
+ phstr(:,:,:,:) = RESHAPE( zwork, SHAPE(phstr) )
+ DEALLOCATE( zwork )
+#endif
+ END SUBROUTINE ptr_mpp_sum_4d
FUNCTION dia_ptr_alloc()
@@ -681,7 +737,6 @@ CONTAINS
IF( .NOT. ALLOCATED( btmsk ) ) THEN
ALLOCATE( btmsk(A2D(nn_hls),nbasin) , btmsk34(A2D(nn_hls),nbasin) , &
& hstr_adv(A1Dj(0),nbasin,jpts), hstr_eiv(A1Dj(0),nbasin,jpts), &
- & hstr_ove(A1Dj(0),nbasin,jpts), hstr_btr(A1Dj(0),nbasin,jpts), &
& hstr_ldf(A1Dj(0),nbasin,jpts), hstr_vtr(A1Dj(0),nbasin,jpts), STAT=ierr(1) )
!
ALLOCATE( pvtr_int(A1Dj(0),jpk,nbasin,jpts+2), &
diff --git a/src/OCE/TRA/traadv_cen.F90 b/src/OCE/TRA/traadv_cen.F90
index e55956f238555c0064a98f900bbaaf70af40f822..3262e2226ee000b42dd4f89f5c78fb05d07e50b1 100644
--- a/src/OCE/TRA/traadv_cen.F90
+++ b/src/OCE/TRA/traadv_cen.F90
@@ -110,7 +110,7 @@ CONTAINS
!!st limitation : does not take into acccount iceshelf specificity
!! in case of linssh
CASE( 2 ) !* 2nd order centered
- DO jk = 1, jpkm1
+ DO jk = 1, jpkm1
!
DO_2D( 1, 0, 1, 0 ) ! Horizontal fluxes at layer jk
zft_u(ji,jj) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) )
@@ -122,6 +122,10 @@ CONTAINS
& + ( zft_v(ji,jj) - zft_v(ji ,jj-1) ) ) * r1_e1e2t(ji,jj) &
& / e3t(ji,jj,jk,Kmm)
END_2D
+ ! ! "Poleward" heat and salt transports
+ IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zft_v(:,:) )
+ ! ! heat and salt transport
+ IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', zft_u(:,:), zft_v(:,:), ldfin=(jk == jpkm1) )
END DO
!
CASE( 4 ) !* 4th order centered
@@ -147,6 +151,10 @@ CONTAINS
& + ( zft_v(ji,jj) - zft_v(ji ,jj-1) ) ) * r1_e1e2t(ji,jj) &
& / e3t(ji,jj,jk,Kmm)
END_2D
+ ! ! "Poleward" heat and salt transports
+ IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zft_v(:,:) )
+ ! ! heat and salt transport
+ IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', zft_u(:,:), zft_v(:,:), ldfin=(jk == jpkm1) )
END DO
!
CASE DEFAULT
@@ -216,10 +224,6 @@ CONTAINS
!! CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) )
!! CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) )
!! ENDIF
-!! ! ! "Poleward" heat and salt transports
-!! IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
-!! ! ! heat and salt transport
-!! IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) )
!
END DO
!
diff --git a/src/OCE/TRA/traadv_mus.F90 b/src/OCE/TRA/traadv_mus.F90
index f49d6fae47c2a58e31c040c75558f97d95481236..29455647d3e69fe206fe7a3cfc561676980066e8 100644
--- a/src/OCE/TRA/traadv_mus.F90
+++ b/src/OCE/TRA/traadv_mus.F90
@@ -174,8 +174,12 @@ CONTAINS
& + ( zwy(ji,jj) - zwy(ji ,jj-1) ) ) &
& * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
END_2D
+ ! ! "Poleward" heat and salt transports
+ IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:) )
+ ! ! heat transport
+ IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', zwx(:,:), zwy(:,:), ldfin=(jk == jpkm1) )
END DO
-!!gm + !!st to be done with the whole rewritting of trd
+!!gm + !!st to be done with the whole rewritting of trd
!! trd routine arguments MUST be changed adding jk and zwx, zwy in 2D
!!
!! ! ! trend diagnostics
@@ -183,10 +187,6 @@ CONTAINS
!! CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jk, jptra_xad, zwx(:,:), pU, pt(:,:,:,jn,Kbb) )
!! CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jk, jptra_yad, zwy(:,:), pV, pt(:,:,:,jn,Kbb) )
!! END IF
-!! ! ! "Poleward" heat and salt transports
-!! IF( l_ptr ) CALL dia_ptr_hst( jn, jk, 'adv', zwy(:,:) )
-!! ! ! heat transport
-!! IF( l_hst ) CALL dia_ar5_hst( jn, jk, 'adv', zwx(:,:), zwy(:,:) )
!
! !* Vertical advective fluxes
!
diff --git a/src/OCE/TRA/traldf_iso.F90 b/src/OCE/TRA/traldf_iso.F90
index 20e8f67dc5009dc4feec88bd78505610648ea64e..80d5665d74162009e2ffee81c5a43675830c25c0 100644
--- a/src/OCE/TRA/traldf_iso.F90
+++ b/src/OCE/TRA/traldf_iso.F90
@@ -53,7 +53,7 @@ CONTAINS
SUBROUTINE traldf_iso_lap( kt, Kbb, Kmm, pt, Krhs, ld_ptr, ld_hst )
!!----------------------------------------------------------------------
- !! *** ROUTINE traldf_iso_iso ***
+ !! *** ROUTINE traldf_iso_lap ***
!!
!! —— nn_hls =2 or more ——
!!
@@ -105,6 +105,8 @@ CONTAINS
INTEGER :: itra ! number of tracers
INTEGER :: ik, ikp1, iis ! swap indices
!
+ LOGICAL :: ll_ptr, ll_hst
+ !
REAL(wp) :: zmsku, zahu_w ! local scalars
REAL(wp) :: zmskv, zahv_w ! - -
REAL(wp) :: zfw_kp1 ! - -
@@ -116,12 +118,10 @@ CONTAINS
REAL(wp), DIMENSION(T2D(1),0:1) :: zdkt ! INNER + 1 domain at level jk and jk+1
REAL(wp), DIMENSION(T2D(1) ) :: zfu , zfv ! INNER + 1 domain
REAL(wp), DIMENSION(T2D(0) ) :: zfw ! INNER domain
- !
-!!gm ld_ptr,ld_hst: require changes in the dia_ptr/dia_ar5 <<<=== comment for the moment
-! REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zdia_i , zdia_j ! used for some diagnostics
-!!!gm end
- REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdia_i , zdia_j ! used for some diagnostics
!!----------------------------------------------------------------------
+ ll_ptr = .FALSE. ; ll_hst = .FALSE.
+ IF( PRESENT(ld_ptr) ) ll_ptr = ld_ptr
+ IF( PRESENT(ld_hst) ) ll_hst = ld_hst
!
!!gm OPTIMIZATION : This part does not depends on tracer ===>>> put in a routine
!! possibility of moving it in tra_ldf routine (shared between TRA and TRC at least in RK3 case).
@@ -134,28 +134,10 @@ CONTAINS
!
CALL traldf_iso_a33( Kmm, ah_wslp2, akz ) ! calculate a33 element (ah_wslp2 and akz)
!
-!!gm ld_ptr,ld_hst: require changes in the dia_ptr/dia_ar5 <<<=== comment for the moment
-! IF( ld_ptr .OR. ld_hst ) THEN
-! ALLOCATE( zdia_i(A2D(0)) , zdia_j(A2D(0)) )
-! ENDIF
- IF( PRESENT(ld_ptr) .OR. PRESENT(ld_hst) ) THEN
- IF( ld_ptr .OR. ld_hst ) THEN
- ALLOCATE( zdia_i(T2D(0),jpk) , zdia_j(T2D(0),jpk) )
- zdia_i(:,:,jpk) = 0._wp ; zdia_j(:,:,jpk) = 0._wp
- ENDIF
- ENDIF
-!!gm end
- !
itra = SIZE( pt, dim = 4 ) ! number of tracers
!
DO jn = 1, itra !== tracer loop ==!
!
-!!gm ld_ptr,ld_hst: require changes in the dia_ptr/dia_ar5 <<<=== comment for the moment
-! IF( ld_ptr .OR. ld_hst ) THEN
-! zdia_i(:,:) = 0._wp ; zdia_j(:,:) = 0._wp
-! ENDIF
-!!gm end
-
DO jk = 1, jpkm1 != ij slab =!
!
! !* iso-neutral laplacian applied on pt over the INNER domain
@@ -168,29 +150,14 @@ CONTAINS
# undef iso_lap
# undef INN
# undef pt_in
-!!gm ld_ptr,ld_hst:
-! IF( ld_ptr .OR. ld_hst ) THEN ! vertically cumulated fluxes (minus sign by convention in the output)
-! zdia_i(:,:) = zdia_i(:,:) - zfu(A2D(0))
-! zdia_j(:,:) = zdia_j(:,:) - zfv(A2D(0))
-! ENDIF
- IF( PRESENT(ld_ptr) .OR. PRESENT(ld_hst) ) THEN ! store fluxes for diagnostics (minus sign by convention in the output)
- IF( ld_ptr .OR. ld_hst ) THEN
- zdia_i(:,:,jk) = - zfu(T2D(0))
- zdia_j(:,:,jk) = - zfv(T2D(0))
- ENDIF
- ENDIF
-!!gm end
!
+ !
+ ! != "Poleward" & 2D-integrated diffusive heat and salt transports =!
+ ! Note sign is reversed to give down-gradient diffusive transports
+ IF( ll_ptr ) CALL dia_ptr_hst( jn, 'ldf', -zfv(:,:) )
+ IF( ll_hst ) CALL dia_ar5_hst( jn, 'ldf', -zfu(:,:), -zfv(:,:), ldfin=(jk == jpkm1) )
END DO != end ij slab =!
!
- ! != "Poleward" diffusive heat or salt transports =!
- IF( PRESENT(ld_ptr) ) THEN
- IF( ld_ptr) CALL dia_ptr_hst( jn, 'ldf' , zdia_j )
- ENDIF
- IF( PRESENT(ld_hst) ) THEN
- IF( ld_hst) CALL dia_ar5_hst( jn, 'ldf', zdia_i, zdia_j )
- ENDIF
- !
END DO !== end tracer loop ==!
!
END SUBROUTINE traldf_iso_lap
@@ -198,7 +165,7 @@ CONTAINS
SUBROUTINE traldf_iso_blp( kt, Kbb, Kmm, pt, Krhs, ld_ptr, ld_hst )
!!----------------------------------------------------------------------
- !! *** ROUTINE tra_ldf_iso_blp ***
+ !! *** ROUTINE traldf_iso_blp ***
!!
!! —— nn_hls =2 or more ——
!!
@@ -212,6 +179,8 @@ CONTAINS
INTEGER :: itra ! number of tracers
INTEGER :: ik, ikp1, iis ! swap indices
!
+ LOGICAL :: ll_ptr, ll_hst
+ !
REAL(wp) :: zmsku, zahu_w ! local scalars
REAL(wp) :: zmskv, zahv_w ! - -
REAL(wp) :: zfw_kp1 ! - -
@@ -224,36 +193,16 @@ CONTAINS
REAL(wp), DIMENSION(T2D(2) ) :: zfu , zfv ! INNER + 2 domain
REAL(wp), DIMENSION(T2D(1) ) :: zfw ! INNER + 1 domain
REAL(wp), DIMENSION(T2D(1),jpkm1) :: zlap ! INNER + 1 doamin (3D laplacian at t-point)
- !
-!!gm ld_ptr,ld_hst: require changes in the dia_ptr/dia_ar5 <<<=== comment for the moment
-! REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zdia_i , zdia_j ! used for some diagnostics
-!!!gm end
- REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdia_i , zdia_j ! used for some diagnostics
!!----------------------------------------------------------------------
+ ll_ptr = .FALSE. ; ll_hst = .FALSE.
+ IF( PRESENT(ld_ptr) ) ll_ptr = ld_ptr
+ IF( PRESENT(ld_hst) ) ll_hst = ld_hst
!
CALL traldf_iso_a33( Kmm, ah_wslp2, akz ) ! calculate a33 element (ah_wslp2 and akz)
!
itra = SIZE( pt, dim = 4 ) ! number of tracers
!
-!!gm ld_ptr,ld_hst: require changes in the dia_ptr/dia_ar5 <<<=== comment for the moment
-! IF( ld_ptr .OR. ld_hst ) THEN
-! ALLOCATE( zdia_i(A2D(0)) , zdia_j(A2D(0)) )
-! ENDIF
- IF( PRESENT(ld_ptr) .OR. PRESENT(ld_hst) ) THEN
- IF( ld_ptr .OR. ld_hst ) THEN
- ALLOCATE( zdia_i(T2D(0),jpk) , zdia_j(T2D(0),jpk) )
- zdia_i(:,:,jpk) = 0._wp ; zdia_j(:,:,jpk) = 0._wp
- ENDIF
- ENDIF
-!!gm end
- !
DO jn = 1, itra !== tracer loop ==!
- ! !
-!!gm ld_ptr,ld_hst: require changes in the dia_ptr/dia_ar5 <<<=== comment for the moment
-! IF( ld_ptr .OR. ld_hst ) THEN
-! zdia_i(:,:) = 0._wp ; zdia_j(:,:) = 0._wp
-! ENDIF
-!!gm end
!
DO jk = 1, jpkm1 != ij slab =!
!
@@ -286,29 +235,12 @@ CONTAINS
# undef INN
# undef pt_in
!
-!!gm ld_ptr,ld_hst:
-! IF( ld_ptr .OR. ld_hst ) THEN ! vertically cumulated fluxes (minus sign by convention in the output)
-! zdia_i(:,:) = zdia_i(:,:) - zfu(A2D(0))
-! zdia_j(:,:) = zdia_j(:,:) - zfv(A2D(0))
-! ENDIF
- IF( PRESENT(ld_ptr) .OR. PRESENT(ld_hst) ) THEN
- IF( ld_ptr .OR. ld_hst ) THEN ! store fluxes for diagnostics (minus sign by convention in the output)
- zdia_i(:,:,jk) = - zfu(T2D(0))
- zdia_j(:,:,jk) = - zfv(T2D(0))
- ENDIF
- ENDIF
-!!gm end
- !
+ ! != "Poleward" & 2D-integrated diffusive heat and salt transports =!
+ ! Note sign is reversed to give down-gradient diffusive transports
+ IF( ll_ptr ) CALL dia_ptr_hst( jn, 'ldf', -zfv(:,:) )
+ IF( ll_hst ) CALL dia_ar5_hst( jn, 'ldf', -zfu(:,:), -zfv(:,:), ldfin=(jk == jpkm1) )
END DO != end ij slab =!
!
- ! != "Poleward" diffusive heat or salt transports =!
- IF( PRESENT(ld_ptr) ) THEN
- IF( ld_ptr ) CALL dia_ptr_hst( jn, 'ldf' , zdia_j )
- ENDIF
- IF( PRESENT(ld_hst) ) THEN
- IF( ld_hst ) CALL dia_ar5_hst( jn, 'ldf', zdia_i, zdia_j )
- ENDIF
- !
END DO !== end tracer loop ==!
!
END SUBROUTINE traldf_iso_blp
@@ -360,12 +292,6 @@ CONTAINS
& + ( ahtu(ji-1,jj,jk-1) + ahtu(ji ,jj,jk) ) ) * zmsku
zahv_w = ( ( ahtv(ji,jj ,jk-1) + ahtv(ji,jj-1,jk) ) &
& + ( ahtv(ji,jj-1,jk-1) + ahtv(ji,jj ,jk) ) ) * zmskv
-!!st need to do something for dia...
-!!st ! ! "Poleward" diffusive heat or salt transports (T-S case only)
-!!st ! note sign is reversed to give down-gradient diffusive transports )
-!!st IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', -zftv(A2D(0),:) )
-!!st ! ! Diffusive heat transports
-!!st IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', -zftu(:,:,:), -zftv(:,:,:) )
!
pah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk) &
& + zahv_w * wslpj(ji,jj,jk) * wslpj(ji,jj,jk)
diff --git a/src/OCE/TRA/traldf_lev.F90 b/src/OCE/TRA/traldf_lev.F90
index 3bbfa0190d9671137bcad17ed5288012fe501b39..089207b0704b9d3dd25289ad9e90d345029abb4b 100644
--- a/src/OCE/TRA/traldf_lev.F90
+++ b/src/OCE/TRA/traldf_lev.F90
@@ -67,26 +67,14 @@ CONTAINS
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
INTEGER :: itra ! number of tracers
- REAL(wp) :: zaheeu, zaheev ! local scalar
+ REAL(wp) :: zaheeu, zaheev ! local scalar
+ LOGICAL :: ll_ptr, ll_hst
+ !
REAL(wp), DIMENSION(T2D(1)) :: zfu, zfv
-!!gm ld_ptr,ld_hst: require changes in the dia_ptr/dia_ar5 <<<=== comment for the moment
-! REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zdia_i , zdia_j ! used for some diagnostics
-!!!gm end
- REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdia_i , zdia_j
!!----------------------------------------------------------------------
- !
-!!gm ld_ptr,ld_hst: require changes in the dia_ptr/dia_ar5 <<<=== comment for the moment
-! and to be duplicated in traldf_lev_blp (2nd pass only)
-! IF( ld_ptr .OR. ld_hst ) THEN
-! ALLOCATE( zdia_i(A2D(0)) , zdia_j(A2D(0)) )
-! ENDIF
- !!gm end
- IF( PRESENT(ld_ptr) .OR. PRESENT(ld_hst) ) THEN
- IF( ld_ptr .OR. ld_hst ) THEN
- ALLOCATE( zdia_i(T2D(0),jpk) , zdia_j(T2D(0),jpk) )
- zdia_i(:,:,jpk) = 0._wp ; zdia_j(:,:,jpk) = 0._wp
- ENDIF
- ENDIF
+ ll_ptr = .FALSE. ; ll_hst = .FALSE.
+ IF( PRESENT(ld_ptr) ) ll_ptr = ld_ptr
+ IF( PRESENT(ld_hst) ) ll_hst = ld_hst
!
itra = SIZE( pt, dim=4 ) ! number of tracers
!
@@ -110,29 +98,12 @@ CONTAINS
& * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
END_2D
!
-!!gm ld_ptr,ld_hst:
-! IF( ld_ptr .OR. ld_hst ) THEN ! vertically cumulated fluxes (minus sign by convention in the output)
-! zdia_i(:,:) = zdia_i(:,:) - zfu(A2D(0))
-! zdia_j(:,:) = zdia_j(:,:) - zfv(A2D(0))
-! ENDIF
- !!gm end
- IF( PRESENT(ld_ptr) .OR. PRESENT(ld_hst) ) THEN
- IF( ld_ptr .OR. ld_hst ) THEN ! store fluxes for diagnostics (minus sign by convention in the output)
- zdia_i(:,:,jk) = - zfu(T2D(0))
- zdia_j(:,:,jk) = - zfv(T2D(0))
- ENDIF
- ENDIF
- !
+ ! != "Poleward" & 2D-integrated diffusive heat and salt transports =!
+ ! Note sign is reversed to give down-gradient diffusive transports
+ IF( ll_ptr ) CALL dia_ptr_hst( jn, 'ldf', -zfv(:,:) )
+ IF( ll_hst ) CALL dia_ar5_hst( jn, 'ldf', -zfu(:,:), -zfv(:,:), ldfin=(jk == jpkm1) )
END DO ! end horizontal slab
!
- ! !== "Poleward" diffusive heat or salt transports ==!
- IF( PRESENT(ld_ptr) ) THEN
- IF( ld_ptr ) CALL dia_ptr_hst( jn, 'ldf' , zdia_j )
- ENDIF
- IF( PRESENT(ld_hst) ) THEN
- IF( ld_hst ) CALL dia_ar5_hst( jn, 'ldf', zdia_i, zdia_j )
- ENDIF
- !
! ! ==================
END DO ! end of tracer loop
! ! ==================
@@ -163,24 +134,15 @@ CONTAINS
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
INTEGER :: itra ! number of tracers
+ LOGICAL :: ll_ptr, ll_hst
REAL(wp), DIMENSION(T2D(2)) :: zaheeu, zfu
REAL(wp), DIMENSION(T2D(2)) :: zaheev, zfv
REAL(wp), DIMENSION(T2D(1)) :: zlap ! laplacian at t-point
-!!gm ld_ptr,ld_hst: require changes in the dia_ptr/dia_ar5 <<<=== comment for the moment
-! REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zdia_i , zdia_j ! used for some diagnostics
-!!!gm end
- REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdia_i , zdia_j
!!---------------------------------------------------------------------
!
-!!gm ld_ptr,ld_hst: require changes in the dia_ptr/dia_ar5 <<<=== comment for the moment
-! IF( ld_ptr .OR. ld_hst ) THEN
-! ALLOCATE( zdia_i(A2D(0)) , zdia_j(A2D(0)) )
-! ENDIF
- IF( ld_ptr .OR. ld_hst ) THEN
- ALLOCATE( zdia_i(T2D(0),jpk) , zdia_j(T2D(0),jpk) )
- zdia_i(:,:,jpk) = 0._wp ; zdia_j(:,:,jpk) = 0._wp
- ENDIF
-!!gm end
+ ll_ptr = .FALSE. ; ll_hst = .FALSE.
+ IF( PRESENT(ld_ptr) ) ll_ptr = ld_ptr
+ IF( PRESENT(ld_hst) ) ll_hst = ld_hst
!
itra = SIZE( pt, dim=4 ) ! number of tracers
!
@@ -188,12 +150,6 @@ CONTAINS
DO jn = 1, itra ! tracer loop !
! ! =========== !
!
-!!gm ld_ptr,ld_hst: require changes in the dia_ptr/dia_ar5 <<<=== comment for the moment
-! IF( ld_ptr .OR. ld_hst ) THEN
-! zdia_i(:,:) = 0._wp ; zdia_j(:,:) = 0._wp
-! ENDIF
-!!gm end
- !
DO jk = 1, jpkm1 ! horizontal slab
!
DO_2D( 2, 1, 2, 1 )
@@ -224,24 +180,12 @@ CONTAINS
& * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
END_2D
!
-!!gm ld_ptr,ld_hst:
-! IF( ld_ptr .OR. ld_hst ) THEN ! vertically cumulated fluxes (minus sign by convention in the output)
-! zdia_i(:,:) = zdia_i(:,:) - zfu(A2D(0))
-! zdia_j(:,:) = zdia_j(:,:) - zfv(A2D(0))
-! ENDIF
-!!gm end
- IF( ld_ptr .OR. ld_hst ) THEN ! vertically cumulated fluxes (minus sign by convention in the output)
- zdia_i(:,:,jk) = - zfu(T2D(0))
- zdia_j(:,:,jk) = - zfv(T2D(0))
- ENDIF
- !
+ ! != "Poleward" & 2D-integrated diffusive heat and salt transports =!
+ ! Note sign is reversed to give down-gradient diffusive transports
+ IF( ll_ptr ) CALL dia_ptr_hst( jn, 'ldf', -zfv(:,:) )
+ IF( ll_hst ) CALL dia_ar5_hst( jn, 'ldf', -zfu(:,:), -zfv(:,:), ldfin=(jk == jpkm1) )
END DO ! end horizontal slab
!
- ! !== "Poleward" diffusive heat or salt transports ==!
- ! !== "Poleward" diffusive heat or salt transports ==!
- IF( ld_ptr ) CALL dia_ptr_hst( jn, 'ldf' , zdia_j )
- IF( ld_hst ) CALL dia_ar5_hst( jn, 'ldf', zdia_i, zdia_j )
- !
! ! ==================
END DO ! end of tracer loop
! ! ==================