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/trunk/src/OCE/TRA – NEMO

source: NEMO/trunk/src/OCE/TRA/trasbc.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: 10.8 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   !!            4.1  !  2019-09  (P. Mathiot) isf moved in traisf
13   !!----------------------------------------------------------------------
14
15   !!----------------------------------------------------------------------
16   !!   tra_sbc       : update the tracer trend at ocean surface
17   !!----------------------------------------------------------------------
18   USE oce            ! ocean dynamics and active tracers
19   USE sbc_oce        ! surface boundary condition: ocean
20   USE dom_oce        ! ocean space domain variables
21   USE phycst         ! physical constant
22   USE eosbn2         ! Equation Of State
23   USE sbcmod         ! ln_rnf 
24   USE sbcrnf         ! River runoff 
25   USE traqsr         ! solar radiation penetration
26   USE trd_oce        ! trends: ocean variables
27   USE trdtra         ! trends manager: tracers
28#if defined key_asminc   
29   USE asminc         ! Assimilation increment
30#endif
31   !
32   USE in_out_manager ! I/O manager
33   USE prtctl         ! Print control
34   USE iom            ! xIOS server
35   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
36   USE timing         ! Timing
37
38   IMPLICIT NONE
39   PRIVATE
40
41   PUBLIC   tra_sbc   ! routine called by step.F90
42
43   !! * Substitutions
44#  include "do_loop_substitute.h90"
45   !!----------------------------------------------------------------------
46   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
47   !! $Id$
48   !! Software governed by the CeCILL license (see ./LICENSE)
49   !!----------------------------------------------------------------------
50CONTAINS
51
52   SUBROUTINE tra_sbc ( kt, Kmm, pts, Krhs )
53      !!----------------------------------------------------------------------
54      !!                  ***  ROUTINE tra_sbc  ***
55      !!                   
56      !! ** Purpose :   Compute the tracer surface boundary condition trend of
57      !!      (flux through the interface, concentration/dilution effect)
58      !!      and add it to the general trend of tracer equations.
59      !!
60      !! ** Method :   The (air+ice)-sea flux has two components:
61      !!      (1) Fext, external forcing (i.e. flux through the (air+ice)-sea interface);
62      !!      (2) Fwe , tracer carried with the water that is exchanged with air+ice.
63      !!               The input forcing fields (emp, rnf, sfx) contain Fext+Fwe,
64      !!             they are simply added to the tracer trend (ts(Krhs)).
65      !!               In linear free surface case (ln_linssh=T), the volume of the
66      !!             ocean does not change with the water exchanges at the (air+ice)-sea
67      !!             interface. Therefore another term has to be added, to mimic the
68      !!             concentration/dilution effect associated with water exchanges.
69      !!
70      !! ** Action  : - Update ts(Krhs) with the surface boundary condition trend
71      !!              - send trends to trdtra module for further diagnostics(l_trdtra=T)
72      !!----------------------------------------------------------------------
73      INTEGER,                                   INTENT(in   ) :: kt         ! ocean time-step index
74      INTEGER,                                   INTENT(in   ) :: Kmm, Krhs  ! time level indices
75      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts        ! active tracers and RHS of tracer equation
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), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdt, ztrds
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 ta and sa trends
92         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
93         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
94         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
95      ENDIF
96      !
97!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist)
98      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration
99         qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns
100         qsr(:,:) = 0._wp                     ! qsr set to zero
101      ENDIF
102
103      !----------------------------------------
104      !        EMP, SFX and QNS effects
105      !----------------------------------------
106      !                             !==  Set before sbc tracer content fields  ==!
107      IF( kt == nit000 ) THEN             !* 1st time-step
108         IF( ln_rstart .AND.    &               ! Restart: read in restart file
109              & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN
110            IF(lwp) WRITE(numout,*) '          nit000-1 sbc tracer content field read in the restart file'
111            zfact = 0.5_wp
112            sbc_tsc(:,:,:) = 0._wp
113            CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem), ldxios = lrxios )   ! before heat content sbc trend
114            CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal), ldxios = lrxios )   ! before salt content sbc trend
115         ELSE                                   ! No restart or restart not found: Euler forward time stepping
116            zfact = 1._wp
117            sbc_tsc(:,:,:) = 0._wp
118            sbc_tsc_b(:,:,:) = 0._wp
119         ENDIF
120      ELSE                                !* other time-steps: swap of forcing fields
121         zfact = 0.5_wp
122         sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:)
123      ENDIF
124      !                             !==  Now sbc tracer content fields  ==!
125      DO_2D_01_00
126         sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)   ! non solar heat flux
127         sbc_tsc(ji,jj,jp_sal) = r1_rau0     * sfx(ji,jj)   ! salt flux due to freezing/melting
128      END_2D
129      IF( ln_linssh ) THEN                !* linear free surface 
130         DO_2D_01_00
131            sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rau0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm)
132            sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rau0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm)
133         END_2D
134         IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) )
135         IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) )
136      ENDIF
137      !
138      DO jn = 1, jpts               !==  update tracer trend  ==!
139         DO_2D_01_00
140            pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) / e3t(ji,jj,1,Kmm)
141         END_2D
142      END DO
143      !                 
144      IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==!
145         IF( lwxios ) CALL iom_swap(      cwxios_context          )
146         CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem), ldxios = lwxios )
147         CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal), ldxios = lwxios )
148         IF( lwxios ) CALL iom_swap(      cxios_context          )
149      ENDIF
150      !
151      !----------------------------------------
152      !        River Runoff effects
153      !----------------------------------------
154      !
155      IF( ln_rnf ) THEN         ! input of heat and salt due to river runoff
156         zfact = 0.5_wp
157         DO_2D_01_00
158            IF( rnf(ji,jj) /= 0._wp ) THEN
159               zdep = zfact / h_rnf(ji,jj)
160               DO jk = 1, nk_rnf(ji,jj)
161                                     pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)                                  &
162                                        &                      +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
163                  IF( ln_rnf_sal )   pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)                                  &
164                                        &                      +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 
165               END DO
166            ENDIF
167         END_2D
168      ENDIF
169
170      IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) )   ! runoff term on sst
171      IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) )   ! runoff term on sss
172
173#if defined key_asminc
174      !
175      !----------------------------------------
176      !        Assmilation effects
177      !----------------------------------------
178      !
179      IF( ln_sshinc ) THEN         ! input of heat and salt due to assimilation
180          !
181         IF( ln_linssh ) THEN
182            DO_2D_01_00
183               ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm)
184               pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + pts(ji,jj,1,jp_tem,Kmm) * ztim
185               pts(ji,jj,1,jp_sal,Krhs) = pts(ji,jj,1,jp_sal,Krhs) + pts(ji,jj,1,jp_sal,Kmm) * ztim
186            END_2D
187         ELSE
188            DO_2D_01_00
189               ztim = ssh_iau(ji,jj) / ( ht(ji,jj) + 1. - ssmask(ji, jj) )
190               pts(ji,jj,:,jp_tem,Krhs) = pts(ji,jj,:,jp_tem,Krhs) + pts(ji,jj,:,jp_tem,Kmm) * ztim
191               pts(ji,jj,:,jp_sal,Krhs) = pts(ji,jj,:,jp_sal,Krhs) + pts(ji,jj,:,jp_sal,Kmm) * ztim
192            END_2D
193         ENDIF
194         !
195      ENDIF
196      !
197#endif
198      !
199      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
200         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
201         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
202         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt )
203         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds )
204         DEALLOCATE( ztrdt , ztrds ) 
205      ENDIF
206      !
207      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' sbc  - Ta: ', mask1=tmask,   &
208         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
209      !
210      IF( ln_timing )   CALL timing_stop('tra_sbc')
211      !
212   END SUBROUTINE tra_sbc
213
214   !!======================================================================
215END MODULE trasbc
Note: See TracBrowser for help on using the repository browser.