source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/TRA/trasbc.F90 @ 11099

Last change on this file since 11099 was 11099, checked in by davestorkey, 18 months ago

dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap : Updates and bug fixes. This version still doesn't pass all SETTE tests.

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