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 branches/UKMO/2014_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/UKMO/2014_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90 @ 5728

Last change on this file since 5728 was 4347, checked in by flavoni, 10 years ago

remove obsolete option for freshwater budget for global ocean configurations in free surface and forced mode
  • Property svn:keywords set to Id
File size: 7.8 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   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   sbc_fwb      : freshwater budget for global ocean configurations
14   !!                  in free surface and 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 phycst          ! physical constants
20   USE sbcrnf          ! ocean runoffs
21   USE sbcssr          ! SS damping terms
22   USE in_out_manager  ! I/O manager
23   USE lib_mpp         ! distribued memory computing library
24   USE wrk_nemo        ! work arrays
25   USE timing          ! Timing
26   USE lbclnk          ! ocean lateral boundary conditions
27   USE lib_fortran
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC   sbc_fwb    ! routine called by step
33
34   REAL(wp) ::   a_fwb_b   ! annual domain averaged freshwater budget
35   REAL(wp) ::   a_fwb     ! for 2 year before (_b) and before year.
36   REAL(wp) ::   fwfold    ! fwfold to be suppressed
37   REAL(wp) ::   area      ! global mean ocean surface (interior domain)
38
39   !! * Substitutions
40#  include "domzgr_substitute.h90"
41#  include "vectopt_loop_substitute.h90"
42   !!----------------------------------------------------------------------
43   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
44   !! $Id$
45   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
46   !!----------------------------------------------------------------------
47CONTAINS
48
49   SUBROUTINE sbc_fwb( kt, kn_fwb, kn_fsbc )
50      !!---------------------------------------------------------------------
51      !!                  ***  ROUTINE sbc_fwb  ***
52      !!
53      !! ** Purpose :   Control the mean sea surface drift
54      !!
55      !! ** Method  :   several ways  depending on kn_fwb
56      !!                =0 no control
57      !!                =1 global mean of emp set to zero at each nn_fsbc time step
58      !!                =2 annual global mean corrected from previous year
59      !! Note: if sea ice is embedded it is taken into account when computing the budget
60      !!----------------------------------------------------------------------
61      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
62      INTEGER, INTENT( in ) ::   kn_fsbc  !
63      INTEGER, INTENT( in ) ::   kn_fwb   ! ocean time-step index
64      !
65      INTEGER  ::   inum, ikty, iyear     ! local integers
66      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp                ! local scalars
67      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread, zcoef          !   -      -
68      REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_neg, ztmsk_pos, z_wgt ! 2D workspaces
69      REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_tospread, zerp_cor    !   -      -
70      !!----------------------------------------------------------------------
71      !
72      IF( nn_timing == 1 )  CALL timing_start('sbc_fwb')
73      !
74      CALL wrk_alloc( jpi,jpj, ztmsk_neg, ztmsk_pos, ztmsk_tospread, z_wgt, zerp_cor )
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         ENDIF
84         !
85         area = glob_sum( e1e2t(:,:) )           ! interior global domain surface
86         !
87#if ! defined key_lim2 &&  ! defined key_lim3 && ! defined key_cice
88         snwice_mass_b(:,:) = 0.e0               ! no sea-ice model is being used : no snow+ice mass
89         snwice_mass  (:,:) = 0.e0
90#endif
91         !
92      ENDIF
93     
94
95      SELECT CASE ( kn_fwb )
96      !
97      CASE ( 1 )                             !==  global mean fwf set to zero  ==!
98         !
99         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
100            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) -  snwice_fmass(:,:) ) ) / area   ! sum over the global domain
101            zcoef = z_fwf * rcp
102            emp(:,:) = emp(:,:) - z_fwf 
103            qns(:,:) = qns(:,:) + zcoef * sst_m(:,:)  ! account for change to the heat budget due to fw correction
104         ENDIF
105         !
106      CASE ( 2 )                             !==  fwf budget adjusted from the previous year  ==!
107         !
108         IF( kt == nit000 ) THEN                      ! initialisation
109            !                                         ! Read the corrective factor on precipitations (fwfold)
110            CALL ctl_opn( inum, 'EMPave_old.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
111            READ ( inum, "(24X,I8,2ES24.16)" ) iyear, a_fwb_b, a_fwb
112            CLOSE( inum )
113            fwfold = a_fwb                            ! current year freshwater budget correction
114            !                                         ! estimate from the previous year budget
115            IF(lwp)WRITE(numout,*)
116            IF(lwp)WRITE(numout,*)'sbc_fwb : year = ',iyear  , ' freshwater budget correction = ', fwfold
117            IF(lwp)WRITE(numout,*)'          year = ',iyear-1, ' freshwater budget read       = ', a_fwb
118            IF(lwp)WRITE(numout,*)'          year = ',iyear-2, ' freshwater budget read       = ', a_fwb_b
119         ENDIF   
120         !                                         ! Update fwfold if new year start
121         ikty = 365 * 86400 / rdttra(1)    !!bug  use of 365 days leap year or 360d year !!!!!!!
122         IF( MOD( kt, ikty ) == 0 ) THEN
123            a_fwb_b = a_fwb                           ! mean sea level taking into account the ice+snow
124                                                      ! sum over the global domain
125            a_fwb   = glob_sum( e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rau0 ) )
126            a_fwb   = a_fwb * 1.e+3 / ( area * rday * 365. )     ! convert in Kg/m3/s = mm/s
127!!gm        !                                                      !!bug 365d year
128            fwfold =  a_fwb                           ! current year freshwater budget correction
129            !                                         ! estimate from the previous year budget
130         ENDIF
131         !
132         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN         ! correct the freshwater fluxes
133            zcoef = fwfold * rcp
134            emp(:,:) = emp(:,:) + fwfold
135            qns(:,:) = qns(:,:) - zcoef * sst_m(:,:)  ! account for change to the heat budget due to fw correction
136         ENDIF
137         !
138         IF( kt == nitend .AND. lwp ) THEN            ! save fwfold value in a file
139            CALL ctl_opn( inum, 'EMPave.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
140            WRITE( inum, "(24X,I8,2ES24.16)" ) nyear, a_fwb_b, a_fwb
141            CLOSE( inum )
142         ENDIF
143         !
144      CASE DEFAULT                           !==  you should never be there  ==!
145         CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1 or 2' )
146         !
147      END SELECT
148      !
149      CALL wrk_dealloc( jpi,jpj, ztmsk_neg, ztmsk_pos, ztmsk_tospread, z_wgt, zerp_cor )
150      !
151      IF( nn_timing == 1 )  CALL timing_stop('sbc_fwb')
152      !
153   END SUBROUTINE sbc_fwb
154
155   !!======================================================================
156END MODULE sbcfwb
Note: See TracBrowser for help on using the repository browser.