Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

trasbc.F90 @ 8079

Last change on this file since 8079 was 8079, checked in by andmirek, 7 years ago
#1882 a first working version with XIOS writing restart file. Works with MO suite u-am389
File size: 16.3 KB

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

Note: See TracBrowser for help on using the repository browser.

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: branches/UKMO/dev_r7573_xios_write/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90 @ 8079

Download in other formats: