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.
sbcfwb.F90 in NEMO/trunk/src/OCE/SBC – NEMO

source: NEMO/trunk/src/OCE/SBC/sbcfwb.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.
  • Property svn:keywords set to Id
File size: 12.2 KB
Line 
1MODULE sbcfwb
2   !!======================================================================
3   !!                       ***  MODULE  sbcfwb  ***
4   !! Ocean fluxes   : domain averaged freshwater budget
5   !!======================================================================
6   !! History :  OPA  ! 2001-02  (E. Durand)  Original code
7   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
8   !!            3.0  ! 2006-08  (G. Madec)  Surface module
9   !!            3.2  ! 2009-07  (C. Talandier) emp mean s spread over erp area
10   !!            3.6  ! 2014-11  (P. Mathiot  ) add ice shelf melting
11   !!----------------------------------------------------------------------
12
13   !!----------------------------------------------------------------------
14   !!   sbc_fwb       : freshwater budget for global ocean configurations (free surface & forced mode)
15   !!----------------------------------------------------------------------
16   USE oce            ! ocean dynamics and tracers
17   USE dom_oce        ! ocean space and time domain
18   USE sbc_oce        ! surface ocean boundary condition
19   USE isf_oce , ONLY : fwfisf_cav, fwfisf_par                    ! ice shelf melting contribution
20   USE sbc_ice , ONLY : snwice_mass, snwice_mass_b, snwice_fmass
21   USE phycst         ! physical constants
22   USE sbcrnf         ! ocean runoffs
23   USE sbcssr         ! Sea-Surface damping terms
24   !
25   USE in_out_manager ! I/O manager
26   USE lib_mpp        ! distribued memory computing library
27   USE timing         ! Timing
28   USE lbclnk         ! ocean lateral boundary conditions
29   USE lib_fortran    !
30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC   sbc_fwb    ! routine called by step
35
36   REAL(wp) ::   a_fwb_b   ! annual domain averaged freshwater budget
37   REAL(wp) ::   a_fwb     ! for 2 year before (_b) and before year.
38   REAL(wp) ::   fwfold    ! fwfold to be suppressed
39   REAL(wp) ::   area      ! global mean ocean surface (interior domain)
40
41   !!----------------------------------------------------------------------
42   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
43   !! $Id$
44   !! Software governed by the CeCILL license (see ./LICENSE)
45   !!----------------------------------------------------------------------
46CONTAINS
47
48   SUBROUTINE sbc_fwb( kt, kn_fwb, kn_fsbc, Kmm )
49      !!---------------------------------------------------------------------
50      !!                  ***  ROUTINE sbc_fwb  ***
51      !!
52      !! ** Purpose :   Control the mean sea surface drift
53      !!
54      !! ** Method  :   several ways  depending on kn_fwb
55      !!                =0 no control
56      !!                =1 global mean of emp set to zero at each nn_fsbc time step
57      !!                =2 annual global mean corrected from previous year
58      !!                =3 global mean of emp set to zero at each nn_fsbc time step
59      !!                   & spread out over erp area depending its sign
60      !! Note: if sea ice is embedded it is taken into account when computing the budget
61      !!----------------------------------------------------------------------
62      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
63      INTEGER, INTENT( in ) ::   kn_fsbc  !
64      INTEGER, INTENT( in ) ::   kn_fwb   ! ocean time-step index
65      INTEGER, INTENT( in ) ::   Kmm      ! ocean time level index
66      !
67      INTEGER  ::   inum, ikty, iyear     ! local integers
68      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp                ! local scalars
69      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread, zcoef          !   -      -
70      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   ztmsk_neg, ztmsk_pos, z_wgt ! 2D workspaces
71      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   ztmsk_tospread, zerp_cor    !   -      -
72      REAL(wp)   ,DIMENSION(1) ::   z_fwfprv 
73      COMPLEX(wp),DIMENSION(1) ::   y_fwfnow 
74      !!----------------------------------------------------------------------
75      !
76      IF( kt == nit000 ) THEN
77         IF(lwp) THEN
78            WRITE(numout,*)
79            WRITE(numout,*) 'sbc_fwb : FreshWater Budget correction'
80            WRITE(numout,*) '~~~~~~~'
81            IF( kn_fwb == 1 )   WRITE(numout,*) '          instantaneously set to zero'
82            IF( kn_fwb == 2 )   WRITE(numout,*) '          adjusted from previous year budget'
83            IF( kn_fwb == 3 )   WRITE(numout,*) '          fwf set to zero and spread out over erp area'
84         ENDIF
85         !
86         IF( kn_fwb == 3 .AND. nn_sssr /= 2 )   CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' )
87         IF( kn_fwb == 3 .AND. ln_isfcav    )   CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 with ln_isfcav = .TRUE. not working, we stop ' )
88         !
89         area = glob_sum( 'sbcfwb', e1e2t(:,:) * tmask(:,:,1))           ! interior global domain surface
90         ! isf cavities are excluded because it can feedback to the melting with generation of inhibition of plumes
91         ! and in case of no melt, it can generate HSSW.
92         !
93#if ! defined key_si3 && ! defined key_cice
94         snwice_mass_b(:,:) = 0.e0               ! no sea-ice model is being used : no snow+ice mass
95         snwice_mass  (:,:) = 0.e0
96#endif
97         !
98      ENDIF
99
100      SELECT CASE ( kn_fwb )
101      !
102      CASE ( 1 )                             !==  global mean fwf set to zero  ==!
103         !
104         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
105            y_fwfnow(1) = local_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) - snwice_fmass(:,:) ) )
106            CALL mpp_delay_sum( 'sbcfwb', 'fwb', y_fwfnow(:), z_fwfprv(:), kt == nitend - nn_fsbc + 1 )
107            z_fwfprv(1) = z_fwfprv(1) / area
108            zcoef = z_fwfprv(1) * rcp
109            emp(:,:) = emp(:,:) - z_fwfprv(1)        * tmask(:,:,1)
110            qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
111         ENDIF
112         !
113      CASE ( 2 )                             !==  fwf budget adjusted from the previous year  ==!
114         !
115         IF( kt == nit000 ) THEN                      ! initialisation
116            !                                         ! Read the corrective factor on precipitations (fwfold)
117            CALL ctl_opn( inum, 'EMPave_old.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
118            READ ( inum, "(24X,I8,2ES24.16)" ) iyear, a_fwb_b, a_fwb
119            CLOSE( inum )
120            fwfold = a_fwb                            ! current year freshwater budget correction
121            !                                         ! estimate from the previous year budget
122            IF(lwp)WRITE(numout,*)
123            IF(lwp)WRITE(numout,*)'sbc_fwb : year = ',iyear  , ' freshwater budget correction = ', fwfold
124            IF(lwp)WRITE(numout,*)'          year = ',iyear-1, ' freshwater budget read       = ', a_fwb
125            IF(lwp)WRITE(numout,*)'          year = ',iyear-2, ' freshwater budget read       = ', a_fwb_b
126         ENDIF   
127         !                                         ! Update fwfold if new year start
128         ikty = 365 * 86400 / rdt                  !!bug  use of 365 days leap year or 360d year !!!!!!!
129         IF( MOD( kt, ikty ) == 0 ) THEN
130            a_fwb_b = a_fwb                           ! mean sea level taking into account the ice+snow
131                                                      ! sum over the global domain
132            a_fwb   = glob_sum( 'sbcfwb', e1e2t(:,:) * ( ssh(:,:,Kmm) + snwice_mass(:,:) * r1_rau0 ) )
133            a_fwb   = a_fwb * 1.e+3 / ( area * rday * 365. )     ! convert in Kg/m3/s = mm/s
134!!gm        !                                                      !!bug 365d year
135            fwfold =  a_fwb                           ! current year freshwater budget correction
136            !                                         ! estimate from the previous year budget
137         ENDIF
138         !
139         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN         ! correct the freshwater fluxes
140            zcoef = fwfold * rcp
141            emp(:,:) = emp(:,:) + fwfold             * tmask(:,:,1)
142            qns(:,:) = qns(:,:) - zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
143         ENDIF
144         !
145         IF( kt == nitend .AND. lwm ) THEN            ! save fwfold value in a file (only one required)
146            CALL ctl_opn( inum, 'EMPave.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
147            WRITE( inum, "(24X,I8,2ES24.16)" ) nyear, a_fwb_b, a_fwb
148            CLOSE( inum )
149         ENDIF
150         !
151      CASE ( 3 )                             !==  global fwf set to zero and spread out over erp area  ==!
152         !
153         ALLOCATE( ztmsk_neg(jpi,jpj) , ztmsk_pos(jpi,jpj) , ztmsk_tospread(jpi,jpj) , z_wgt(jpi,jpj) , zerp_cor(jpi,jpj) )
154         !
155         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
156            ztmsk_pos(:,:) = tmask_i(:,:)                      ! Select <0 and >0 area of erp
157            WHERE( erp < 0._wp )   ztmsk_pos = 0._wp
158            ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:)
159            !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges)
160            z_fwf     = glob_sum( 'sbcfwb', e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) - snwice_fmass(:,:) ) ) / area
161            !           
162            IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation
163               zsurf_pos = glob_sum( 'sbcfwb', e1e2t(:,:)*ztmsk_pos(:,:) )
164               zsurf_tospread      = zsurf_pos
165               ztmsk_tospread(:,:) = ztmsk_pos(:,:)
166            ELSE                             ! spread out over <0 erp area to increase precipitation
167               zsurf_neg = glob_sum( 'sbcfwb', e1e2t(:,:)*ztmsk_neg(:,:) )  ! Area filled by <0 and >0 erp
168               zsurf_tospread      = zsurf_neg
169               ztmsk_tospread(:,:) = ztmsk_neg(:,:)
170            ENDIF
171            !
172            zsum_fwf   = glob_sum( 'sbcfwb', e1e2t(:,:) * z_fwf )         ! fwf global mean over <0 or >0 erp area
173!!gm :  zsum_fwf   = z_fwf * area   ???  it is right?  I think so....
174            z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall )
175            !                                                  ! weight to respect erp field 2D structure
176            zsum_erp   = glob_sum( 'sbcfwb', ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) )
177            z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall )
178            !                                                  ! final correction term to apply
179            zerp_cor(:,:) = -1. * z_fwf_nsrf * zsurf_tospread * z_wgt(:,:)
180            !
181!!gm   ===>>>>  lbc_lnk should be useless as all the computation is done over the whole domain !
182            CALL lbc_lnk( 'sbcfwb', zerp_cor, 'T', 1. )
183            !
184            emp(:,:) = emp(:,:) + zerp_cor(:,:)
185            qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:)  ! account for change to the heat budget due to fw correction
186            erp(:,:) = erp(:,:) + zerp_cor(:,:)
187            !
188            IF( nprint == 1 .AND. lwp ) THEN                   ! control print
189               IF( z_fwf < 0._wp ) THEN
190                  WRITE(numout,*)'   z_fwf < 0'
191                  WRITE(numout,*)'   SUM(erp+)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
192               ELSE
193                  WRITE(numout,*)'   z_fwf >= 0'
194                  WRITE(numout,*)'   SUM(erp-)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
195               ENDIF
196               WRITE(numout,*)'   SUM(empG)     = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv'
197               WRITE(numout,*)'   z_fwf         = ', z_fwf      ,' Kg/m2/s'
198               WRITE(numout,*)'   z_fwf_nsrf    = ', z_fwf_nsrf ,' Kg/m2/s'
199               WRITE(numout,*)'   MIN(zerp_cor) = ', MINVAL(zerp_cor) 
200               WRITE(numout,*)'   MAX(zerp_cor) = ', MAXVAL(zerp_cor) 
201            ENDIF
202         ENDIF
203         DEALLOCATE( ztmsk_neg , ztmsk_pos , ztmsk_tospread , z_wgt , zerp_cor )
204         !
205      CASE DEFAULT                           !==  you should never be there  ==!
206         CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1, 2 or 3' )
207         !
208      END SELECT
209      !
210   END SUBROUTINE sbc_fwb
211
212   !!======================================================================
213END MODULE sbcfwb
Note: See TracBrowser for help on using the repository browser.