New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
#2051 (Implementation of fresh water budget control for AGRIF configurations (here nn_fwb = 3 only)) – NEMO

Opened 6 years ago

Last modified 3 years ago

#2051 assigned Defect

Implementation of fresh water budget control for AGRIF configurations (here nn_fwb = 3 only)

Reported by: fschwarzkopf Owned by: jchanut
Priority: low Milestone: Unscheduled
Component: AGRIF Version: trunk
Severity: minor Keywords: AGRIF fwb
Cc: fschwarzkopf

Description

Context

In AGRIF configurations (TWO-WAY), fresh water budget control does not work correctly:

If nn_fwb /= 0 in host and nn_fwb = 0 in nest
--> corrections applied to the host within the nested region are "reversed" by AGRIF-update.
If nn_fwb /= 0 in host and nn_fwb /= 0 in nest
--> for nest, fwb from nest itself is used for correction instead of global budget.

Both versions do not correctly close the fresh water budget.

Proposal

Idea: Correct fwb in nest based on global budget.

Changes in sbcmod.F90:
Apply fwb correction in nest at every host-nn_fsbc-time-step coinciding with Agrif_Update-time-step.
NO consistency-check implemented yet. (in test case: host: nn_fsbc = 6; nest: rhot = nn_fsbc = nn_cln_update = 3)

Changes in sbcfwb.F90:
Transfer global budget from host to nest.
Apply portion of budget correction to nest depending on erp-fraction (relative to global erp) done in nest.

These changes (marked by FUS) seem to technically work (the correct numbers are transferred from the host to the nest and used by the nest at the correct timing), however, closing the budget still fails.

  • sbcmod.F90

     
    5454   USE sbcwave          ! Wave module 
    5555   USE bdy_par          ! Require lk_bdy 
    5656 
     57   USE agrif_oce        ! FUS: get nbcline and nbclineupdate for fwb-call timing 
     58   USE agrif_util       ! FUS: get Agrif_Parent*  for fwb-call timing 
     59 
    5760   IMPLICIT NONE 
    5861   PRIVATE 
    5962 
     
    411414 
    412415      IF( ln_ssr         )   CALL sbc_ssr( kt )                   ! add SST/SSS damping term 
    413416 
     417! FUS: start control fwb timing in AGRIF case - here for nn_fwb=3 only 
     418#if defined key_agrif                   
     419 
     420      IF( nn_fwb    /= 0  .AND. nn_fwb /= 3 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget 
     421 
     422      IF( nn_fwb == 3 ) THEN 
     423         IF(Agrif_Root()) THEN 
     424           CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget 
     425         ELSE 
     426!FUS: do fwb correction in nest at nn_fsbc in host and Update time-step (make sure, nn_fsbc (nest and host) and nn_cln_update choice is suitable - NO consistency-check implemented yet) 
     427           IF ( MOD(nbcline,nbclineupdate) == 0 .AND. MOD( Agrif_Parent_Nb_Step()-1, Agrif_Parent(nn_fsbc) ) == 0  ) THEN 
     428             CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget 
     429           ENDIF 
     430         ENDIF 
     431      ENDIF 
     432#else 
    414433      IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget 
     434#endif 
     435! FUS: end control fwb timing in AGRIF case - here for nn_fwb=3 only 
    415436 
    416437      IF( nn_closea == 1 )   CALL sbc_clo( kt )                   ! treatment of closed sea in the model domain 
    417438      !                                                           ! (update freshwater fluxes) 
  • sbcfwb.F90

     
    2727   USE timing          ! Timing 
    2828   USE lbclnk          ! ocean lateral boundary conditions 
    2929   USE lib_fortran 
    30  
     30   USE Agrif_Util      ! FUS: get Agrif_Parent 
     31   USE agrif_types     ! FUS: needed for POINTER to Agrif_Parent (?) 
    3132   IMPLICIT NONE 
    3233   PRIVATE 
    3334 
     
    3738   REAL(wp) ::   a_fwb     ! for 2 year before (_b) and before year. 
    3839   REAL(wp) ::   fwfold    ! fwfold to be suppressed 
    3940   REAL(wp) ::   area      ! global mean ocean surface (interior domain) 
    40  
     41   REAL(wp),PUBLIC ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp, zsurf_tospread  ! FUS: variables transfered from the parent to child via Agrif_Parent need to be PUBLIC! 
     42                                                                              ! FUS: variable names are still in local nomenclature - adjustments needed 
    4143   !! * Substitutions 
    4244#  include "domzgr_substitute.h90" 
    4345#  include "vectopt_loop_substitute.h90" 
     
    6769      INTEGER, INTENT( in ) ::   kn_fwb   ! ocean time-step index 
    6870      ! 
    6971      INTEGER  ::   inum, ikty, iyear     ! local integers 
    70       REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp                ! local scalars 
    71       REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread, zcoef          !   -      - 
     72!      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp                ! local scalars ! FUS: now defined public 
     73!      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread, zcoef          !   -      -    ! FUS: zsurf_tospread now defined public 
     74      REAL(wp) ::   zsurf_neg, zsurf_pos, zcoef                          !   -      -    ! FUS: zsurf_tospread now defined public 
    7275      REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_neg, ztmsk_pos, z_wgt ! 2D workspaces 
    7376      REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_tospread, zerp_cor    !   -      - 
     77! FUS: define pointer for parent-variables transfered through Agrif_Parent 
     78#if defined key_agrif 
     79      REAL(wp),POINTER :: parent_z_fwf, parent_z_fwf_nsrf, parent_zsum_erp, parent_zsum_fwf, parent_zsurf_tospread 
     80#endif 
     81 
    7482      !!---------------------------------------------------------------------- 
    7583      ! 
    7684      IF( nn_timing == 1 )  CALL timing_start('sbc_fwb') 
     
    160168            ! 
    161169            zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) )  ! Area filled by <0 and >0 erp 
    162170            zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) ) 
     171 
     172! FUS: differentiate between host and nest in AGRIF case 
     173#if defined key_agrif 
     174IF ( Agrif_Root() ) THEN 
     175#endif 
     176 
    163177            !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges) 
    164178            z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area 
    165179            !            
     
    171185                ztmsk_tospread(:,:) = ztmsk_neg(:,:) 
    172186            ENDIF 
    173187            ! 
    174             zsum_fwf   = glob_sum( e1e2t(:,:) * z_fwf )         ! fwf global mean over <0 or >0 erp area 
     188            zsum_fwf   = glob_sum( e1e2t(:,:) * z_fwf )         ! fwf global mean over <0 or >0 erp area ! FUS: this is erp-independent global mean! 
    175189!!gm :  zsum_fwf   = z_fwf * area   ???  it is right?  I think so.... 
    176             z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall ) 
     190            z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall )       ! FUS: is this necessary? could use zsum_fwf for zerp_cor instead 
    177191            !                                                  ! weight to respect erp field 2D structure 
    178192            zsum_erp   = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) ) 
    179193            z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) 
     
    187201            qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:)  ! account for change to the heat budget due to fw correction 
    188202            erp(:,:) = erp(:,:) + zerp_cor(:,:) 
    189203            ! 
     204 
     205! FUS: differentiate between host and nest in AGRIF case 
     206#if defined key_agrif 
     207ELSE                                                          ! FUS: start special treatment for nest 
     208       parent_z_fwf             => Agrif_Parent(z_fwf)                 ! FUS: add pointer to Parent value 
     209       parent_zsum_fwf          => Agrif_Parent(zsum_fwf)               ! FUS: add pointer to Parent value - might replace parent_z_fwf_nsrf and parent_zsurf_tospread 
     210       parent_z_fwf_nsrf        => Agrif_Parent(z_fwf_nsrf)             ! FUS: add pointer to Parent value 
     211       parent_zsum_erp          => Agrif_Parent(zsum_erp)               ! FUS: add pointer to Parent value 
     212       parent_zsurf_tospread          => Agrif_Parent(zsurf_tospread)   ! FUS: add pointer to Parent value 
     213 
     214            IF( parent_z_fwf < 0._wp ) THEN         ! FUS: keep fwf-sign from parent (nest might differ) 
     215                zsurf_tospread      = zsurf_pos 
     216                ztmsk_tospread(:,:) = ztmsk_pos(:,:) 
     217            ELSE                                    
     218                zsurf_tospread      = zsurf_neg 
     219                ztmsk_tospread(:,:) = ztmsk_neg(:,:) 
     220            ENDIF 
     221 
     222            !                                                  ! weight to respect erp field 2D structure 
     223            !                                                 ! FUS: scale by zsum_erp in parent 
     224            z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( parent_zsum_erp + rsmall ) 
     225            !                                                  ! final correction term to apply 
     226            !                                                 ! FUS: spread parent_zsum_fwf = parent_z_fwf_nsrf * parent_zsurf_tospread 
     227            zerp_cor(:,:) = -1. * parent_z_fwf_nsrf * parent_zsurf_tospread *  z_wgt(:,:) 
     228            ! 
     229            CALL lbc_lnk( zerp_cor, 'T', 1. ) 
     230            ! 
     231            emp(:,:) = emp(:,:) + zerp_cor(:,:) 
     232            qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:)  ! account for change to the heat budget due to fw correction 
     233            erp(:,:) = erp(:,:) + zerp_cor(:,:) 
     234            ! 
     235ENDIF                                                          ! FUS: end special treatment for nest 
     236#endif 
     237 
    190238            IF( nprint == 1 .AND. lwp ) THEN                   ! control print 
     239 
     240! FUS: nest specific prints 
     241#if defined key_agrif 
     242IF ( Agrif_Root()) THEN 
    191243               IF( z_fwf < 0._wp ) THEN 
    192244                  WRITE(numout,*)'   z_fwf < 0' 
    193245                  WRITE(numout,*)'   SUM(erp+)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv' 
     
    198250               WRITE(numout,*)'   SUM(empG)     = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv' 
    199251               WRITE(numout,*)'   z_fwf         = ', z_fwf      ,' Kg/m2/s' 
    200252               WRITE(numout,*)'   z_fwf_nsrf    = ', z_fwf_nsrf ,' Kg/m2/s' 
    201                WRITE(numout,*)'   MIN(zerp_cor) = ', MINVAL(zerp_cor) 
    202                WRITE(numout,*)'   MAX(zerp_cor) = ', MAXVAL(zerp_cor) 
     253ELSE 
     254               IF( parent_z_fwf < 0._wp ) THEN 
     255                  WRITE(numout,*)'   z_fwf < 0' 
     256                  WRITE(numout,*)'   SUM(erp+)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv' 
     257               ELSE 
     258                  WRITE(numout,*)'   z_fwf >= 0' 
     259                  WRITE(numout,*)'   SUM(erp-)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv' 
     260               ENDIF 
     261               WRITE(numout,*)'   SUM(empG)     = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv' 
     262               WRITE(numout,*)'   z_fwf         = ', z_fwf      ,' Kg/m2/s' 
     263               WRITE(numout,*)'   z_fwf_nsrf    = ', z_fwf_nsrf ,' Kg/m2/s' 
     264               WRITE(numout,*)'   parent_z_fwf_nsrf        = ', parent_z_fwf_nsrf ,' Kg/m2/s' 
     265               WRITE(numout,*)'   parent_zsurf_tospread          = ', parent_zsurf_tospread ,' Kg/m2/s' 
     266               WRITE(numout,*)'   parent_zsum_fwf        = ', parent_zsum_fwf ,' Kg/m2/s' 
     267               WRITE(numout,*)'   parent_z_fwf_nsrf * parent_zsurf_tospread should be parent_zsum_fwf = ', parent_z_fwf_nsrf * parent_zsurf_tospread 
     268               WRITE(numout,*)'   parent_zsum_erp          = ', parent_zsum_erp ,' Kg/m2/s' 
     269ENDIF 
     270#else 
     271               IF( z_fwf < 0._wp ) THEN 
     272                  WRITE(numout,*)'   z_fwf < 0' 
     273                  WRITE(numout,*)'   SUM(erp+)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv' 
     274               ELSE 
     275                  WRITE(numout,*)'   z_fwf >= 0' 
     276                  WRITE(numout,*)'   SUM(erp-)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv' 
     277               ENDIF 
     278               WRITE(numout,*)'   SUM(empG)     = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv' 
     279               WRITE(numout,*)'   z_fwf         = ', z_fwf      ,' Kg/m2/s' 
     280               WRITE(numout,*)'   z_fwf_nsrf    = ', z_fwf_nsrf ,' Kg/m2/s' 
     281               WRITE(numout,*)'   MIN(zerp_cor) = ', MINVAL(zerp_cor)  ! FUS: in mpp-case, this is not the expected value glob_min fails 
     282               WRITE(numout,*)'   MAX(zerp_cor) = ', MAXVAL(zerp_cor)   ! FUS: in mpp-case, this is not the expected value glob_max fails 
     283#endif 
    203284            ENDIF 
    204285         ENDIF 
    205286         ! 

Commit History (0)

(No commits)

Change History (6)

comment:1 Changed 6 years ago by fschwarzkopf

  • Type changed from Enhancement to Defect

comment:2 Changed 6 years ago by nicolasmartin

  • Owner set to jchanut
  • Status changed from new to assigned

comment:3 in reply to: ↑ description Changed 6 years ago by jchanut

  • Component changed from OPA to AGRIF

Hi Fransziska,

That's a tricky one... simply because the global freshwater budget (at current time step) can not be known prior the fine grid integration. Anyways, as you did, the right way to proceed is to consider the freshwater budget on the parent grid only and to use the AGRIF_parent() function to get the correction.
This said, one way to do it could be to allow for a one step lag in the correction computation (i.e. compute the correction based on emp_b, rnf_b, etc...). In addition, one has to compute the time integrated freshwater fluxes (during successive fine grid time steps) on the fine grid and feed this back to the parent grid (which means updating emp_b(:,:), rnf_b(:,:), etc... on the coarse grid). This way, the right global freshwater budget on the coarse grid can be computed during the next time step. 

Jérôme

Replying to fschwarzkopf:

Context

In AGRIF configurations (TWO-WAY), fresh water budget control does not work correctly:

If nn_fwb /= 0 in host and nn_fwb = 0 in nest
--> corrections applied to the host within the nested region are "reversed" by AGRIF-update.
If nn_fwb /= 0 in host and nn_fwb /= 0 in nest
--> for nest, fwb from nest itself is used for correction instead of global budget.

Both versions do not correctly close the fresh water budget.

Proposal

Idea: Correct fwb in nest based on global budget.

Changes in sbcmod.F90:
Apply fwb correction in nest at every host-nn_fsbc-time-step coinciding with Agrif_Update-time-step.
NO consistency-check implemented yet. (in test case: host: nn_fsbc = 6; nest: rhot = nn_fsbc = nn_cln_update = 3)

Changes in sbcfwb.F90:
Transfer global budget from host to nest.
Apply portion of budget correction to nest depending on erp-fraction (relative to global erp) done in nest.

These changes (marked by FUS) seem to technically work (the correct numbers are transferred from the host to the nest and used by the nest at the correct timing), however, closing the budget still fails.

Index: sbcmod.F90
===================================================================
--- sbcmod.F90  (revision 9356)
+++ sbcmod.F90  (working copy)
@@ -54,6 +54,9 @@
USE sbcwave          ! Wave module
USE bdy_par          ! Require lk_bdy

+   USE agrif_oce        ! FUS: get nbcline and nbclineupdate for fwb-call timing
+   USE agrif_util       ! FUS: get Agrif_Parent*  for fwb-call timing
+
IMPLICIT NONE
PRIVATE

@@ -411,7 +414,25 @@

IF( ln_ssr         )   CALL sbc_ssr( kt )                   ! add SST/SSS damping term

+! FUS: start control fwb timing in AGRIF case - here for nn_fwb=3 only
+#if defined key_agrif                  
+
+      IF( nn_fwb    /= 0  .AND. nn_fwb /= 3 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget
+
+      IF( nn_fwb == 3 ) THEN
+         IF(Agrif_Root()) THEN
+           CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget
+         ELSE
+!FUS: do fwb correction in nest at nn_fsbc in host and Update time-step (make sure, nn_fsbc (nest and host) and nn_cln_update choice is suitable - NO consistency-check implemented yet)
+           IF ( MOD(nbcline,nbclineupdate) == 0 .AND. MOD( Agrif_Parent_Nb_Step()-1, Agrif_Parent(nn_fsbc) ) == 0  ) THEN
+             CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget
+           ENDIF
+         ENDIF
+      ENDIF
+#else
IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget
+#endif
+! FUS: end control fwb timing in AGRIF case - here for nn_fwb=3 only

IF( nn_closea == 1 )   CALL sbc_clo( kt )                   ! treatment of closed sea in the model domain
!                                                           ! (update freshwater fluxes)
Index: sbcfwb.F90
===================================================================
--- sbcfwb.F90  (revision 9356)
+++ sbcfwb.F90  (working copy)
@@ -27,7 +27,8 @@
USE timing          ! Timing
USE lbclnk          ! ocean lateral boundary conditions
USE lib_fortran
-
+   USE Agrif_Util      ! FUS: get Agrif_Parent
+   USE agrif_types     ! FUS: needed for POINTER to Agrif_Parent (?)
IMPLICIT NONE
PRIVATE

@@ -37,7 +38,8 @@
REAL(wp) ::   a_fwb     ! for 2 year before (_b) and before year.
REAL(wp) ::   fwfold    ! fwfold to be suppressed
REAL(wp) ::   area      ! global mean ocean surface (interior domain)
-
+   REAL(wp),PUBLIC ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp, zsurf_tospread  ! FUS: variables transfered from the parent to child via Agrif_Parent need to be PUBLIC!
+                                                                              ! FUS: variable names are still in local nomenclature - adjustments needed
!! * Substitutions
#  include "domzgr_substitute.h90"
#  include "vectopt_loop_substitute.h90"
@@ -67,10 +69,16 @@
INTEGER, INTENT( in ) ::   kn_fwb   ! ocean time-step index
!
INTEGER  ::   inum, ikty, iyear     ! local integers
-      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp                ! local scalars
-      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread, zcoef          !   -      -
+!      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp                ! local scalars ! FUS: now defined public
+!      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread, zcoef          !   -      -    ! FUS: zsurf_tospread now defined public
+      REAL(wp) ::   zsurf_neg, zsurf_pos, zcoef                          !   -      -    ! FUS: zsurf_tospread now defined public
REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_neg, ztmsk_pos, z_wgt ! 2D workspaces
REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_tospread, zerp_cor    !   -      -
+! FUS: define pointer for parent-variables transfered through Agrif_Parent
+#if defined key_agrif
+      REAL(wp),POINTER :: parent_z_fwf, parent_z_fwf_nsrf, parent_zsum_erp, parent_zsum_fwf, parent_zsurf_tospread
+#endif
+
!!----------------------------------------------------------------------
!
IF( nn_timing == 1 )  CALL timing_start('sbc_fwb')
@@ -160,6 +168,12 @@
!
zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) )  ! Area filled by <0 and >0 erp
zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) )
+
+! FUS: differentiate between host and nest in AGRIF case
+#if defined key_agrif
+IF ( Agrif_Root() ) THEN
+#endif
+
!                                                  ! fwf global mean (excluding ocean to ice/snow exchanges)
z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area
!           
@@ -171,9 +185,9 @@
ztmsk_tospread(:,:) = ztmsk_neg(:,:)
ENDIF
!
-            zsum_fwf   = glob_sum( e1e2t(:,:) * z_fwf )         ! fwf global mean over <0 or >0 erp area
+            zsum_fwf   = glob_sum( e1e2t(:,:) * z_fwf )         ! fwf global mean over <0 or >0 erp area ! FUS: this is erp-independent global mean!
!!gm :  zsum_fwf   = z_fwf * area   ???  it is right?  I think so....
-            z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall )
+            z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall )       ! FUS: is this necessary? could use zsum_fwf for zerp_cor instead
!                                                  ! weight to respect erp field 2D structure
zsum_erp   = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) )
z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall )
@@ -187,7 +201,45 @@
qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:)  ! account for change to the heat budget due to fw correction
erp(:,:) = erp(:,:) + zerp_cor(:,:)
!
+
+! FUS: differentiate between host and nest in AGRIF case
+#if defined key_agrif
+ELSE                                                          ! FUS: start special treatment for nest
+       parent_z_fwf             => Agrif_Parent(z_fwf)                 ! FUS: add pointer to Parent value
+       parent_zsum_fwf          => Agrif_Parent(zsum_fwf)               ! FUS: add pointer to Parent value - might replace parent_z_fwf_nsrf and parent_zsurf_tospread
+       parent_z_fwf_nsrf        => Agrif_Parent(z_fwf_nsrf)             ! FUS: add pointer to Parent value
+       parent_zsum_erp          => Agrif_Parent(zsum_erp)               ! FUS: add pointer to Parent value
+       parent_zsurf_tospread          => Agrif_Parent(zsurf_tospread)   ! FUS: add pointer to Parent value
+
+            IF( parent_z_fwf < 0._wp ) THEN         ! FUS: keep fwf-sign from parent (nest might differ)
+                zsurf_tospread      = zsurf_pos
+                ztmsk_tospread(:,:) = ztmsk_pos(:,:)
+            ELSE                                   
+                zsurf_tospread      = zsurf_neg
+                ztmsk_tospread(:,:) = ztmsk_neg(:,:)
+            ENDIF
+
+            !                                                  ! weight to respect erp field 2D structure
+            !                                                 ! FUS: scale by zsum_erp in parent
+            z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( parent_zsum_erp + rsmall )
+            !                                                  ! final correction term to apply
+            !                                                 ! FUS: spread parent_zsum_fwf = parent_z_fwf_nsrf * parent_zsurf_tospread
+            zerp_cor(:,:) = -1. * parent_z_fwf_nsrf * parent_zsurf_tospread *  z_wgt(:,:)
+            !
+            CALL lbc_lnk( zerp_cor, 'T', 1. )
+            !
+            emp(:,:) = emp(:,:) + zerp_cor(:,:)
+            qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:)  ! account for change to the heat budget due to fw correction
+            erp(:,:) = erp(:,:) + zerp_cor(:,:)
+            !
+ENDIF                                                          ! FUS: end special treatment for nest
+#endif
+
IF( nprint == 1 .AND. lwp ) THEN                   ! control print
+
+! FUS: nest specific prints
+#if defined key_agrif
+IF ( Agrif_Root()) THEN
IF( z_fwf < 0._wp ) THEN
WRITE(numout,*)'   z_fwf < 0'
WRITE(numout,*)'   SUM(erp+)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
@@ -198,8 +250,37 @@
WRITE(numout,*)'   SUM(empG)     = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv'
WRITE(numout,*)'   z_fwf         = ', z_fwf      ,' Kg/m2/s'
WRITE(numout,*)'   z_fwf_nsrf    = ', z_fwf_nsrf ,' Kg/m2/s'
-               WRITE(numout,*)'   MIN(zerp_cor) = ', MINVAL(zerp_cor)
-               WRITE(numout,*)'   MAX(zerp_cor) = ', MAXVAL(zerp_cor)
+ELSE
+               IF( parent_z_fwf < 0._wp ) THEN
+                  WRITE(numout,*)'   z_fwf < 0'
+                  WRITE(numout,*)'   SUM(erp+)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
+               ELSE
+                  WRITE(numout,*)'   z_fwf >= 0'
+                  WRITE(numout,*)'   SUM(erp-)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
+               ENDIF
+               WRITE(numout,*)'   SUM(empG)     = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv'
+               WRITE(numout,*)'   z_fwf         = ', z_fwf      ,' Kg/m2/s'
+               WRITE(numout,*)'   z_fwf_nsrf    = ', z_fwf_nsrf ,' Kg/m2/s'
+               WRITE(numout,*)'   parent_z_fwf_nsrf        = ', parent_z_fwf_nsrf ,' Kg/m2/s'
+               WRITE(numout,*)'   parent_zsurf_tospread          = ', parent_zsurf_tospread ,' Kg/m2/s'
+               WRITE(numout,*)'   parent_zsum_fwf        = ', parent_zsum_fwf ,' Kg/m2/s'
+               WRITE(numout,*)'   parent_z_fwf_nsrf * parent_zsurf_tospread should be parent_zsum_fwf = ', parent_z_fwf_nsrf * parent_zsurf_tospread
+               WRITE(numout,*)'   parent_zsum_erp          = ', parent_zsum_erp ,' Kg/m2/s'
+ENDIF
+#else
+               IF( z_fwf < 0._wp ) THEN
+                  WRITE(numout,*)'   z_fwf < 0'
+                  WRITE(numout,*)'   SUM(erp+)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
+               ELSE
+                  WRITE(numout,*)'   z_fwf >= 0'
+                  WRITE(numout,*)'   SUM(erp-)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
+               ENDIF
+               WRITE(numout,*)'   SUM(empG)     = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv'
+               WRITE(numout,*)'   z_fwf         = ', z_fwf      ,' Kg/m2/s'
+               WRITE(numout,*)'   z_fwf_nsrf    = ', z_fwf_nsrf ,' Kg/m2/s'
+               WRITE(numout,*)'   MIN(zerp_cor) = ', MINVAL(zerp_cor)  ! FUS: in mpp-case, this is not the expected value glob_min fails
+               WRITE(numout,*)'   MAX(zerp_cor) = ', MAXVAL(zerp_cor)   ! FUS: in mpp-case, this is not the expected value glob_max fails
+#endif
ENDIF
ENDIF
!

comment:4 Changed 5 years ago by jchanut

  • Version changed from v3.6 to trunk

comment:5 Changed 4 years ago by smasson

  • Milestone set to 2020 WP

comment:6 Changed 3 years ago by jchanut

  • Milestone changed from 2020 WP to Unscheduled
Note: See TracTickets for help on using tickets.