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.
trasbc.F90 in NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA – NEMO

source: NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/trasbc.F90 @ 10023

Last change on this file since 10023 was 10023, checked in by gm, 6 years ago

#1911 (ENHANCE-04): RK3 branch - step II.2 bug correction in dynnxt + domvvl_RK3 creation
  • Property svn:keywords set to Id
File size: 14.0 KB
Line 
1MODULE trasbc
2   !!==============================================================================
3   !!                       ***  MODULE  trasbc  ***
4   !! Ocean active tracers:  surface boundary condition
5   !!==============================================================================
6   !! History :  OPA  !  1998-10  (G. Madec, G. Roullet, M. Imbard)  Original code
7   !!            8.2  !  2001-02  (D. Ludicone)  sea ice and free surface
8   !!  NEMO      1.0  !  2002-06  (G. Madec)  F90: Free form and module
9   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
10   !!             -   !  2010-09  (C. Ethe, G. Madec) Merge TRA-TRC
11   !!            3.6  !  2014-11  (P. Mathiot) isf melting forcing
12   !!----------------------------------------------------------------------
13
14   !!----------------------------------------------------------------------
15   !!   tra_sbc       : update the tracer trend at ocean surface
16   !!----------------------------------------------------------------------
17   USE oce            ! ocean dynamics and active tracers
18   USE sbc_oce        ! surface boundary condition: ocean
19   USE dom_oce        ! ocean space domain variables
20   USE phycst         ! physical constant
21   USE eosbn2         ! Equation Of State
22   USE sbcmod         ! ln_rnf 
23   USE sbcrnf         ! River runoff 
24   USE sbcisf         ! Ice shelf   
25   USE iscplini       ! Ice sheet coupling
26   USE traqsr         ! solar radiation penetration
27   USE trd_oce        ! trends: ocean variables
28   USE trdtra         ! trends manager: tracers
29   USE wet_dry,  ONLY : ll_wd, rn_wdmin1, r_rn_wdmin1   ! Wetting and drying
30#if defined key_asminc   
31   USE asminc         ! Assimilation increment
32#endif
33   !
34   USE in_out_manager ! I/O manager
35   USE prtctl         ! Print control
36   USE iom            ! xIOS server
37   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
38   USE timing         ! Timing
39
40   IMPLICIT NONE
41   PRIVATE
42
43   PUBLIC   tra_sbc   ! routine called by step.F90
44
45   !! * Substitutions
46#  include "vectopt_loop_substitute.h90"
47   !!----------------------------------------------------------------------
48   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
49   !! $Id$
50   !! Software governed by the CeCILL licence     (./LICENSE)
51   !!----------------------------------------------------------------------
52CONTAINS
53
54   SUBROUTINE tra_sbc ( kt )
55      !!----------------------------------------------------------------------
56      !!                  ***  ROUTINE tra_sbc  ***
57      !!                   
58      !! ** Purpose :   Compute the tracer surface boundary condition trend of
59      !!      (flux through the interface, concentration/dilution effect)
60      !!      and add it to the general trend of tracer equations.
61      !!
62      !! ** Method :   The (air+ice)-sea flux has two components:
63      !!      (1) Fext, external forcing (i.e. flux through the (air+ice)-sea interface);
64      !!      (2) Fwe , tracer carried with the water that is exchanged with air+ice.
65      !!               The input forcing fields (emp, rnf, sfx, isf) contain Fext+Fwe,
66      !!             they are simply added to the tracer trend (tsa).
67      !!               In linear free surface case (ln_linssh=T), the volume of the
68      !!             ocean does not change with the water exchanges at the (air+ice)-sea
69      !!             interface. Therefore another term has to be added, to mimic the
70      !!             concentration/dilution effect associated with water exchanges.
71      !!
72      !! ** Action  : - Update tsa with the surface boundary condition trend
73      !!              - send trends to trdtra module for further diagnostics(l_trdtra=T)
74      !!----------------------------------------------------------------------
75      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
76      !
77      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 
78      INTEGER  ::   ikt, ikb                    ! local integers
79      REAL(wp) ::   zfact, z1_e3t, zdep, ztim   ! local scalar
80      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrd   ! 4D workspace
81      !!----------------------------------------------------------------------
82      !
83      IF( ln_timing )   CALL timing_start('tra_sbc')
84      !
85      IF( kt == nit000 ) THEN
86         IF(lwp) WRITE(numout,*)
87         IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition'
88         IF(lwp) WRITE(numout,*) '~~~~~~~ '
89      ENDIF
90      !
91      IF( l_trdtra ) THEN                    !* Save input tsa trends
92         ALLOCATE( ztrd(jpi,jpj,jpk,jpts) ) 
93         ztrd(:,:,:,:) = tsa(:,:,:,:)
94      ENDIF
95      !
96!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist)
97      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration
98         qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns
99         qsr(:,:) = 0._wp                    ! qsr set to zero
100      ENDIF
101
102      !----------------------------------------
103      !        EMP, SFX and QNS effects
104      !----------------------------------------
105      !                             !==  Set before sbc tracer content fields  ==!
106      IF( kt == nit000 ) THEN             !* 1st time-step
107         IF( ln_rstart .AND.    &               ! Restart: read in restart file
108              & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN
109            IF(lwp) WRITE(numout,*) '          nit000-1 sbc tracer content field read in the restart file'
110            zfact = 0.5_wp
111            sbc_tsc(:,:,:) = 0._wp
112            CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem), ldxios = lrxios )   ! before heat content sbc trend
113            CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal), ldxios = lrxios )   ! before salt content sbc trend
114         ELSE                                   ! No restart or restart not found: Euler forward time stepping
115            zfact = 1._wp
116            sbc_tsc(:,:,:) = 0._wp
117            sbc_tsc_b(:,:,:) = 0._wp
118         ENDIF
119      ELSE                                !* other time-steps: swap of forcing fields
120         zfact = 0.5_wp
121         sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:)
122      ENDIF
123      !                             !==  Now sbc tracer content fields  ==!
124      !
125      IF ( ll_wd ) THEN                   !* WAD case:  If near WAD point limit the flux for now
126         DO jj = 2, jpj
127            DO ji = fs_2, fs_jpim1   ! vector opt.
128               IF     ( ssh(ji,jj,Nnn) + ht_0(ji,jj) >  2._wp * rn_wdmin1 ) THEN
129                  sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj)   ! non solar heat flux
130               ELSEIF ( ssh(ji,jj,Nnn) + ht_0(ji,jj) >  rn_wdmin1 ) THEN
131                  sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) &
132                     &                  * tanh ( 5._wp * ( ( ssh(ji,jj,Nnn) + ht_0(ji,jj) - rn_wdmin1 ) * r_rn_wdmin1 ) )
133               ELSE
134                  sbc_tsc(ji,jj,jp_tem) = 0._wp
135               ENDIF
136               sbc_tsc(ji,jj,jp_sal) = r1_rho0     * sfx(ji,jj)   ! salt flux due to freezing/melting
137            END DO
138         END DO
139      ELSE                                !* standard case
140         DO jj = 2, jpj
141            DO ji = fs_2, fs_jpim1   ! vector opt.
142               sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj)   ! non solar heat flux
143               sbc_tsc(ji,jj,jp_sal) = r1_rho0     * sfx(ji,jj)   ! salt flux due to freezing/melting
144            END DO
145         END DO
146      ENDIF
147      !
148      IF( ln_linssh ) THEN                !* linear free surface 
149         DO jj = 2, jpj                         !==>> add concentration/dilution effect due to constant volume cell
150            DO ji = fs_2, fs_jpim1   ! vector opt.
151               sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * tsn(ji,jj,1,jp_tem)
152               sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * tsn(ji,jj,1,jp_sal)
153            END DO
154         END DO                                 !==>> output c./d. term
155         IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) )
156         IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) )
157      ENDIF
158      !
159      DO jn = 1, jpts               !==  update tracer trend  ==!
160         DO jj = 2, jpj
161            DO ji = fs_2, fs_jpim1   ! vector opt. 
162               tsa(ji,jj,1,jn) = tsa(ji,jj,1,jn) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) / e3t_n(ji,jj,1)
163            END DO
164         END DO
165      END DO
166      !                 
167      IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==!
168         IF( lwxios ) CALL iom_swap(      cwxios_context          )
169         CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem), ldxios = lwxios )
170         CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal), ldxios = lwxios )
171         IF( lwxios ) CALL iom_swap(      cxios_context          )
172      ENDIF
173      !
174      !----------------------------------------
175      !       Ice Shelf effects (ISF)
176      !     tbl treated as in Losh (2008) JGR
177      !----------------------------------------
178      !
179!!gm BUG ?   Why no differences between non-linear and linear free surface ?
180!!gm         probably taken into account in r1_hisf_tbl : to be verified
181      IF( ln_isf ) THEN
182         zfact = 0.5_wp
183         DO jj = 2, jpj
184            DO ji = fs_2, fs_jpim1
185               !
186               ikt = misfkt(ji,jj)
187               ikb = misfkb(ji,jj)
188               !
189               ! level fully include in the ice shelf boundary layer
190               ! sign - because fwf sign of evapo (rnf sign of precip)
191               DO jk = ikt, ikb - 1
192               ! compute trend
193                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)                                                &
194                     &           + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) )             &
195                     &           * r1_hisf_tbl(ji,jj)
196               END DO
197   
198               ! level partially include in ice shelf boundary layer
199               ! compute trend
200               tsa(ji,jj,ikb,jp_tem) = tsa(ji,jj,ikb,jp_tem)                                                 &
201                  &              + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) )             &
202                  &              * r1_hisf_tbl(ji,jj) * ralpha(ji,jj)
203
204            END DO
205         END DO
206      END IF
207      !
208      !----------------------------------------
209      !        River Runoff effects
210      !----------------------------------------
211      !
212      IF( ln_rnf ) THEN         ! input of heat and salt due to river runoff
213         zfact = 0.5_wp
214         DO jj = 2, jpj 
215            DO ji = fs_2, fs_jpim1
216               IF( rnf(ji,jj) /= 0._wp ) THEN
217                  zdep = zfact / h_rnf(ji,jj)
218                  DO jk = 1, nk_rnf(ji,jj)
219                                        tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)                                 &
220                                           &                 +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
221                     IF( ln_rnf_sal )   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)                                 &
222                                           &                 +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 
223                  END DO
224               ENDIF
225            END DO 
226         END DO 
227      ENDIF
228
229      IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*tsn(:,:,1,jp_tem) )   ! runoff term on sst
230      IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*tsn(:,:,1,jp_sal) )   ! runoff term on sss
231
232#if defined key_asminc
233      !
234      !----------------------------------------
235      !        Assmilation effects
236      !----------------------------------------
237      !
238      IF( ln_sshinc ) THEN         ! input of heat and salt due to assimilation
239          !
240         IF( ln_linssh ) THEN
241            DO jj = 2, jpj 
242               DO ji = fs_2, fs_jpim1
243                  ztim = ssh_iau(ji,jj) / e3t_n(ji,jj,1)
244                  tsa(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) + tsn(ji,jj,1,jp_tem) * ztim
245                  tsa(ji,jj,1,jp_sal) = tsa(ji,jj,1,jp_sal) + tsn(ji,jj,1,jp_sal) * ztim
246               END DO
247            END DO
248         ELSE
249            DO jj = 2, jpj 
250               DO ji = fs_2, fs_jpim1
251                  ztim = ssh_iau(ji,jj) / ( ht_n(ji,jj) + 1. - ssmask(ji, jj) )
252                  tsa(ji,jj,:,jp_tem) = tsa(ji,jj,:,jp_tem) + tsn(ji,jj,:,jp_tem) * ztim
253                  tsa(ji,jj,:,jp_sal) = tsa(ji,jj,:,jp_sal) + tsn(ji,jj,:,jp_sal) * ztim
254               END DO 
255            END DO 
256         ENDIF
257         !
258      ENDIF
259      !
260#endif
261      !
262      !----------------------------------------
263      !        Ice Sheet coupling imbalance correction to have conservation
264      !----------------------------------------
265      !
266      IF( ln_iscpl .AND. ln_hsb) THEN         ! input of heat and salt due to river runoff
267         DO jk = 1,jpk
268            DO jj = 2, jpj 
269               DO ji = fs_2, fs_jpim1
270                  zdep = 1._wp / e3t_n(ji,jj,jk) 
271                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - htsc_iscpl(ji,jj,jk,jp_tem) * zdep
272                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - htsc_iscpl(ji,jj,jk,jp_sal) * zdep 
273               END DO 
274            END DO 
275         END DO
276      ENDIF
277
278      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
279         ztrd(:,:,:,:) = tsa(:,:,:,:) - ztrd(:,:,:,:)
280         CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrd(:,:,:,jp_tem) )
281         CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrd(:,:,:,jp_sal) )
282         DEALLOCATE( ztrd ) 
283      ENDIF
284      !
285      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' sbc  - Ta: ', mask1=tmask,   &
286         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
287      !
288      IF( ln_timing )   CALL timing_stop('tra_sbc')
289      !
290   END SUBROUTINE tra_sbc
291
292   !!======================================================================
293END MODULE trasbc
Note: See TracBrowser for help on using the repository browser.