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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

trasbc.F90 in branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

Context Navigation

source: branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90 @ 7469

Last change on this file since 7469 was 6688, checked in by lovato, 8 years ago
#1677 - v3.6_STABLE: Update code for passive tracers data input and restoring
Property svn:keywords set to `Id`
File size: 16.1 KB

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

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

Download in other formats: