Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

trasbc.F90 @ 9383

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

Download in other formats: