source: branches/UKMO/dev_r7750_GO6_package_oasis_timers/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90 @ 9252

Last change on this file since 9252 was 9252, checked in by andmirek, 3 years ago

#1978 timers for nn_timing 3

File size: 16.1 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 sbcmod          ! ln_rnf 
22   USE sbcrnf          ! River runoff 
23   USE sbcisf          ! Ice shelf   
24   USE traqsr          ! solar radiation penetration
25   USE trd_oce         ! trends: ocean variables
26   USE trdtra          ! trends manager: tracers
27   !
28   USE in_out_manager  ! I/O manager
29   USE prtctl          ! Print control
30   USE iom
31   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
32   USE wrk_nemo        ! Memory Allocation
33   USE timing          ! Timing
34   USE eosbn2
35
36   IMPLICIT NONE
37   PRIVATE
38
39   PUBLIC   tra_sbc    ! routine called by step.F90
40
41   !! * Substitutions
42#  include "domzgr_substitute.h90"
43#  include "vectopt_loop_substitute.h90"
44   !!----------------------------------------------------------------------
45   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
46   !! $Id$
47   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
48   !!----------------------------------------------------------------------
49CONTAINS
50
51   SUBROUTINE tra_sbc ( kt )
52      !!----------------------------------------------------------------------
53      !!                  ***  ROUTINE tra_sbc  ***
54      !!                   
55      !! ** Purpose :   Compute the tracer surface boundary condition trend of
56      !!      (flux through the interface, concentration/dilution effect)
57      !!      and add it to the general trend of tracer equations.
58      !!
59      !! ** Method :
60      !!      Following Roullet and Madec (2000), the air-sea flux can be divided
61      !!      into three effects: (1) Fext, external forcing;
62      !!      (2) Fwi, concentration/dilution effect due to water exchanged
63      !!         at the surface by evaporation, precipitations and runoff (E-P-R);
64      !!      (3) Fwe, tracer carried with the water that is exchanged.
65      !!            - salinity    : salt flux only due to freezing/melting
66      !!            sa = sa +  sfx / rau0 / e3t  for k=1
67      !!
68      !!      Fext, flux through the air-sea interface for temperature and salt:
69      !!            - temperature : heat flux q (w/m2). If penetrative solar
70      !!         radiation q is only the non solar part of the heat flux, the
71      !!         solar part is added in traqsr.F routine.
72      !!            ta = ta + q /(rau0 rcp e3t)  for k=1
73      !!            - salinity    : no salt flux
74      !!
75      !!      The formulation for Fwb and Fwi vary according to the free
76      !!      surface formulation (linear or variable volume).
77      !!      * Linear free surface
78      !!            The surface freshwater flux modifies the ocean volume
79      !!         and thus the concentration of a tracer and the temperature.
80      !!         First order of the effect of surface freshwater exchange
81      !!         for salinity, it can be neglected on temperature (especially
82      !!         as the temperature of precipitations and runoffs is usually
83      !!         unknown).
84      !!            - temperature : we assume that the temperature of both
85      !!         precipitations and runoffs is equal to the SST, thus there
86      !!         is no additional flux since in this case, the concentration
87      !!         dilution effect is balanced by the net heat flux associated
88      !!         to the freshwater exchange (Fwe+Fwi=0):
89      !!            (Tp P - Te E) + SST (P-E) = 0 when Tp=Te=SST
90      !!            - salinity    : evaporation, precipitation and runoff
91      !!         water has a zero salinity  but there is a salt flux due to
92      !!         freezing/melting, thus:
93      !!            sa = sa + emp * sn / rau0 / e3t   for k=1
94      !!                    + sfx    / rau0 / e3t
95      !!         where emp, the surface freshwater budget (evaporation minus
96      !!         precipitation minus runoff) given in kg/m2/s is divided
97      !!         by rau0 (density of sea water) to obtain m/s.   
98      !!         Note: even though Fwe does not appear explicitly for
99      !!         temperature in this routine, the heat carried by the water
100      !!         exchanged through the surface is part of the total heat flux
101      !!         forcing and must be taken into account in the global heat
102      !!         balance).
103      !!      * nonlinear free surface (variable volume, lk_vvl)
104      !!         contrary to the linear free surface case, Fwi is properly
105      !!         taken into account by using the true layer thicknesses to       
106      !!         calculate tracer content and advection. There is no need to
107      !!         deal with it in this routine.
108      !!           - temperature: Fwe=SST (P-E+R) is added to Fext.
109      !!           - salinity:  Fwe = 0, there is no surface flux of salt.
110      !!
111      !! ** Action  : - Update the 1st level of (ta,sa) with the trend associated
112      !!                with the tracer surface boundary condition
113      !!              - send trends to trdtra module (l_trdtra=T)
114      !!----------------------------------------------------------------------
115      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
116      !!
117      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices 
118      INTEGER  ::   ikt, ikb 
119      INTEGER  ::   nk_isf
120      REAL(wp) ::   zfact, z1_e3t, zdep
121      REAL(wp) ::   zalpha, zhk
122      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
123      !!----------------------------------------------------------------------
124      !
125      IF( nn_timing == 1 )  CALL timing_start('tra_sbc')
126      !
127      IF( kt == nit000 ) THEN
128         IF(lwp) WRITE(numout,*)
129         IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition'
130         IF(lwp) WRITE(numout,*) '~~~~~~~ '
131      ENDIF
132
133      IF( l_trdtra ) THEN                    !* Save ta and sa trends
134         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
135         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
136         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
137      ENDIF
138
139!!gm      IF( .NOT.ln_traqsr )   qsr(:,:) = 0.e0   ! no solar radiation penetration
140      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration
141         qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns
142         qsr(:,:) = 0.e0                     ! qsr set to zero
143      ENDIF
144
145      !----------------------------------------
146      !        EMP, SFX and QNS effects
147      !----------------------------------------
148      !                                          Set before sbc tracer content fields
149      !                                          ************************************
150      IF( kt == nit000 ) THEN                      ! Set the forcing field at nit000 - 1
151         !                                         ! -----------------------------------
152         IF( ln_rstart .AND.    &                     ! Restart: read in restart file
153              & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN
154            IF(lwp) WRITE(numout,*) '          nit000-1 surface tracer content forcing fields red in the restart file'
155            zfact = 0.5_wp
156            CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) )   ! before heat content sbc trend
157            CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) )   ! before salt content sbc trend
158         ELSE                                         ! No restart or restart not found: Euler forward time stepping
159            zfact = 1._wp
160            sbc_tsc(:,:,:) = 0._wp
161            sbc_tsc_b(:,:,:) = 0._wp
162         ENDIF
163      ELSE                                         ! Swap of forcing fields
164         !                                         ! ----------------------
165         zfact = 0.5_wp
166         sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:)
167      ENDIF
168      !                                          Compute now sbc tracer content fields
169      !                                          *************************************
170
171                                                   ! Concentration dilution effect on (t,s) due to 
172                                                   ! evaporation, precipitation and qns, but not river runoff
173                                               
174      IF( lk_vvl ) THEN                            ! Variable Volume case  ==>> heat content of mass flux is in qns
175         DO jj = 1, jpj
176            DO ji = 1, jpi 
177               sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)                              ! non solar heat flux
178               sbc_tsc(ji,jj,jp_sal) = r1_rau0     * sfx(ji,jj)                              ! salt flux due to freezing/melting
179            END DO
180         END DO
181      ELSE                                         ! Constant Volume case ==>> Concentration dilution effect
182         DO jj = 2, jpj
183            DO ji = fs_2, fs_jpim1   ! vector opt.
184               ! temperature : heat flux
185               sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)                          &   ! non solar heat flux
186                  &                  + r1_rau0     * emp(ji,jj)  * tsn(ji,jj,1,jp_tem)       ! concent./dilut. effect
187               ! salinity    : salt flux + concent./dilut. effect (both in sfx)
188               sbc_tsc(ji,jj,jp_sal) = r1_rau0  * (  sfx(ji,jj)                          &   ! salt flux (freezing/melting)
189                  &                                + emp(ji,jj) * tsn(ji,jj,1,jp_sal) )      ! concent./dilut. effect
190            END DO
191         END DO
192         IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) )   ! c/d term on sst
193         IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) )   ! c/d term on sss
194      ENDIF
195      ! Concentration dilution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff 
196      DO jn = 1, jpts
197         DO jj = 2, jpj
198            DO ji = fs_2, fs_jpim1   ! vector opt.
199               z1_e3t = zfact / fse3t(ji,jj,1)
200               tsa(ji,jj,1,jn) = tsa(ji,jj,1,jn) + ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) * z1_e3t
201            END DO
202         END DO
203      END DO
204      !                                          Write in the ocean restart file
205      !                                          *******************************
206      IF( lrst_oce ) THEN
207         IF(lwp) WRITE(numout,*)
208         IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in ocean restart file ',   &
209            &                    'at it= ', kt,' date= ', ndastp
210         IF(lwp) WRITE(numout,*) '~~~~'
211         IF(nn_timing == 3)  CALL timing_start('rst_put')
212         CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) )
213         CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) )
214         IF(nn_timing == 3)  CALL timing_stop('rst_put')
215      ENDIF
216      !
217      !
218      !----------------------------------------
219      !       Ice Shelf effects (ISF)
220      !     tbl treated as in Losh (2008) JGR
221      !----------------------------------------
222      !
223      IF( nn_isf > 0 ) THEN
224         zfact = 0.5e0
225         DO jj = 2, jpj
226            DO ji = fs_2, fs_jpim1
227         
228               ikt = misfkt(ji,jj)
229               ikb = misfkb(ji,jj)
230   
231               ! level fully include in the ice shelf boundary layer
232               ! if isfdiv, we have to remove heat flux due to inflow at 0oC (as in rnf when you add rnf at sst)
233               ! sign - because fwf sign of evapo (rnf sign of precip)
234               DO jk = ikt, ikb - 1
235               ! compute tfreez for the temperature correction (we add water at freezing temperature)
236               ! compute trend
237                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)                                          &
238                     &           + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)) * r1_hisf_tbl(ji,jj)
239                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)                                          &
240                     &           + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) * r1_hisf_tbl(ji,jj)
241               END DO
242   
243               ! level partially include in ice shelf boundary layer
244               ! compute tfreez for the temperature correction (we add water at freezing temperature)
245               ! compute trend
246               tsa(ji,jj,ikb,jp_tem) = tsa(ji,jj,ikb,jp_tem)                                           &
247                  &              + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj)
248               tsa(ji,jj,ikb,jp_sal) = tsa(ji,jj,ikb,jp_sal)                                           &
249                  &              + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) 
250            END DO
251         END DO
252         IF( lrst_oce ) THEN
253            IF(lwp) WRITE(numout,*)
254            IF(lwp) WRITE(numout,*) 'sbc : isf surface tracer content forcing fields written in ocean restart file ',   &
255               &                    'at it= ', kt,' date= ', ndastp
256            IF(lwp) WRITE(numout,*) '~~~~'
257            IF(nn_timing == 3)  CALL timing_start('rst_put')
258            CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:)          )
259            CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem) )
260            CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal) )
261            IF(nn_timing == 3)  CALL timing_stop('rst_put')
262         ENDIF
263      END IF
264      !
265      !----------------------------------------
266      !        River Runoff effects
267      !----------------------------------------
268      !
269      IF( ln_rnf ) THEN         ! input of heat and salt due to river runoff
270         zfact = 0.5_wp
271         DO jj = 2, jpj 
272            DO ji = fs_2, fs_jpim1
273               IF( rnf(ji,jj) /= 0._wp ) THEN
274                  zdep = zfact / h_rnf(ji,jj)
275                  DO jk = 1, nk_rnf(ji,jj)
276                                        tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
277                                          &               +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
278                     IF( ln_rnf_sal )   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
279                                          &               +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 
280                  END DO
281               ENDIF
282            END DO 
283         END DO 
284      ENDIF
285 
286      IF( l_trdtra )   THEN                      ! send trends for further diagnostics
287         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
288         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
289         CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt )
290         CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds )
291         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
292      ENDIF
293      !
294      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' sbc  - Ta: ', mask1=tmask,   &
295         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
296      !
297      IF( nn_timing == 1 )  CALL timing_stop('tra_sbc')
298      !
299   END SUBROUTINE tra_sbc
300
301   !!======================================================================
302END MODULE trasbc
Note: See TracBrowser for help on using the repository browser.