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/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

Context Navigation

source: branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90 @ 4726

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

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

Download in other formats: