source: NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/TRA/trasbc.F90 @ 11395

Last change on this file since 11395 was 11395, checked in by mathiot, 2 years ago

ENHANCE-02_ISF_nemo : Initial commit isf simplification (add ISF directory, moved isf routine in and split isf cavity and isf parametrisation, …) (ticket #2142)

  • Property svn:keywords set to Id
File size: 10.9 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 traqsr         ! solar radiation penetration
25   USE trd_oce        ! trends: ocean variables
26   USE trdtra         ! trends manager: tracers
27#if defined key_asminc   
28   USE asminc         ! Assimilation increment
29#endif
30   !
31   USE in_out_manager ! I/O manager
32   USE prtctl         ! Print control
33   USE iom            ! xIOS server
34   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
35   USE timing         ! Timing
36
37   IMPLICIT NONE
38   PRIVATE
39
40   PUBLIC   tra_sbc   ! routine called by step.F90
41
42   !! * Substitutions
43#  include "vectopt_loop_substitute.h90"
44   !!----------------------------------------------------------------------
45   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
46   !! $Id$
47   !! Software governed by the CeCILL license (see ./LICENSE)
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 :   The (air+ice)-sea flux has two components:
60      !!      (1) Fext, external forcing (i.e. flux through the (air+ice)-sea interface);
61      !!      (2) Fwe , tracer carried with the water that is exchanged with air+ice.
62      !!               The input forcing fields (emp, rnf, sfx, isf) contain Fext+Fwe,
63      !!             they are simply added to the tracer trend (tsa).
64      !!               In linear free surface case (ln_linssh=T), the volume of the
65      !!             ocean does not change with the water exchanges at the (air+ice)-sea
66      !!             interface. Therefore another term has to be added, to mimic the
67      !!             concentration/dilution effect associated with water exchanges.
68      !!
69      !! ** Action  : - Update tsa with the surface boundary condition trend
70      !!              - send trends to trdtra module for further diagnostics(l_trdtra=T)
71      !!----------------------------------------------------------------------
72      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
73      !
74      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 
75      INTEGER  ::   ikt, ikb                    ! local integers
76      REAL(wp) ::   zfact, z1_e3t, zdep, ztim   ! local scalar
77      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdt, ztrds
78      !!----------------------------------------------------------------------
79      !
80      IF( ln_timing )   CALL timing_start('tra_sbc')
81      !
82      IF( kt == nit000 ) THEN
83         IF(lwp) WRITE(numout,*)
84         IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition'
85         IF(lwp) WRITE(numout,*) '~~~~~~~ '
86      ENDIF
87      !
88      IF( l_trdtra ) THEN                    !* Save ta and sa trends
89         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
90         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
91         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
92      ENDIF
93      !
94!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist)
95      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration
96         qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns
97         qsr(:,:) = 0._wp                     ! qsr set to zero
98      ENDIF
99
100      !----------------------------------------
101      !        EMP, SFX and QNS effects
102      !----------------------------------------
103      !                             !==  Set before sbc tracer content fields  ==!
104      IF( kt == nit000 ) THEN             !* 1st time-step
105         IF( ln_rstart .AND.    &               ! Restart: read in restart file
106              & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN
107            IF(lwp) WRITE(numout,*) '          nit000-1 sbc tracer content field read in the restart file'
108            zfact = 0.5_wp
109            sbc_tsc(:,:,:) = 0._wp
110            CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem), ldxios = lrxios )   ! before heat content sbc trend
111            CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal), ldxios = lrxios )   ! before salt content sbc trend
112         ELSE                                   ! No restart or restart not found: Euler forward time stepping
113            zfact = 1._wp
114            sbc_tsc(:,:,:) = 0._wp
115            sbc_tsc_b(:,:,:) = 0._wp
116         ENDIF
117      ELSE                                !* other time-steps: swap of forcing fields
118         zfact = 0.5_wp
119         sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:)
120      ENDIF
121      !                             !==  Now sbc tracer content fields  ==!
122      DO jj = 2, jpj
123         DO ji = fs_2, fs_jpim1   ! vector opt.
124            sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)   ! non solar heat flux
125            sbc_tsc(ji,jj,jp_sal) = r1_rau0     * sfx(ji,jj)   ! salt flux due to freezing/melting
126         END DO
127      END DO
128      IF( ln_linssh ) THEN                !* linear free surface 
129         DO jj = 2, jpj                         !==>> add concentration/dilution effect due to constant volume cell
130            DO ji = fs_2, fs_jpim1   ! vector opt.
131               sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rau0 * emp(ji,jj) * tsn(ji,jj,1,jp_tem)
132               sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rau0 * emp(ji,jj) * tsn(ji,jj,1,jp_sal)
133            END DO
134         END DO                                 !==>> output c./d. term
135         IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) )
136         IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) )
137      ENDIF
138      !
139      DO jn = 1, jpts               !==  update tracer trend  ==!
140         DO jj = 2, jpj
141            DO ji = fs_2, fs_jpim1   ! vector opt. 
142               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)
143            END DO
144         END DO
145      END DO
146      !                 
147      IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==!
148         IF( lwxios ) CALL iom_swap(      cwxios_context          )
149         CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem), ldxios = lwxios )
150         CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal), ldxios = lwxios )
151         IF( lwxios ) CALL iom_swap(      cxios_context          )
152      ENDIF
153      !
154      !----------------------------------------
155      !        River Runoff effects
156      !----------------------------------------
157      !
158      IF( ln_rnf ) THEN         ! input of heat and salt due to river runoff
159         zfact = 0.5_wp
160         DO jj = 2, jpj 
161            DO ji = fs_2, fs_jpim1
162               IF( rnf(ji,jj) /= 0._wp ) THEN
163                  zdep = zfact / h_rnf(ji,jj)
164                  DO jk = 1, nk_rnf(ji,jj)
165                                        tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)                                 &
166                                           &                 +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
167                     IF( ln_rnf_sal )   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)                                 &
168                                           &                 +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 
169                  END DO
170               ENDIF
171            END DO 
172         END DO 
173      ENDIF
174
175      IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*tsn(:,:,1,jp_tem) )   ! runoff term on sst
176      IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*tsn(:,:,1,jp_sal) )   ! runoff term on sss
177
178#if defined key_asminc
179      !
180      !----------------------------------------
181      !        Assmilation effects
182      !----------------------------------------
183      !
184      IF( ln_sshinc ) THEN         ! input of heat and salt due to assimilation
185          !
186         IF( ln_linssh ) THEN
187            DO jj = 2, jpj 
188               DO ji = fs_2, fs_jpim1
189                  ztim = ssh_iau(ji,jj) / e3t_n(ji,jj,1)
190                  tsa(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) + tsn(ji,jj,1,jp_tem) * ztim
191                  tsa(ji,jj,1,jp_sal) = tsa(ji,jj,1,jp_sal) + tsn(ji,jj,1,jp_sal) * ztim
192               END DO
193            END DO
194         ELSE
195            DO jj = 2, jpj 
196               DO ji = fs_2, fs_jpim1
197                  ztim = ssh_iau(ji,jj) / ( ht_n(ji,jj) + 1. - ssmask(ji, jj) )
198                  tsa(ji,jj,:,jp_tem) = tsa(ji,jj,:,jp_tem) + tsn(ji,jj,:,jp_tem) * ztim
199                  tsa(ji,jj,:,jp_sal) = tsa(ji,jj,:,jp_sal) + tsn(ji,jj,:,jp_sal) * ztim
200               END DO 
201            END DO 
202         ENDIF
203         !
204      ENDIF
205      !
206#endif
207      !
208      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
209         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
210         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
211         CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt )
212         CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds )
213         DEALLOCATE( ztrdt , ztrds ) 
214      ENDIF
215      !
216      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' sbc  - Ta: ', mask1=tmask,   &
217         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
218      !
219      IF( ln_timing )   CALL timing_stop('tra_sbc')
220      !
221   END SUBROUTINE tra_sbc
222
223   !!======================================================================
224END MODULE trasbc
Note: See TracBrowser for help on using the repository browser.