source: branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90 @ 4726

Last change on this file since 4726 was 4726, checked in by mathiot, 6 years ago

ISF branch: change name of 2 variables (icedep ⇒ risfdep and lmask ⇒ ssmask), cosmetic changes and add ldfslp key

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