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 NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/TRA – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/TRA/trasbc.F90 @ 13998

Last change on this file since 13998 was 13998, checked in by techene, 3 years ago
branch updated with trunk 13787
Property svn:keywords set to `Id`
File size: 11.2 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
[12377]	12	!! 4.1 ! 2019-09 (P. Mathiot) isf moved in traisf
[3]	13	!!----------------------------------------------------------------------
[503]	14
	15	!!----------------------------------------------------------------------
[6140]	16	!! tra_sbc : update the tracer trend at ocean surface
[3]	17	!!----------------------------------------------------------------------
[6140]	18	USE oce ! ocean dynamics and active tracers
	19	USE sbc_oce ! surface boundary condition: ocean
	20	USE dom_oce ! ocean space domain variables
	21	USE phycst ! physical constant
	22	USE eosbn2 ! Equation Of State
	23	USE sbcmod ! ln_rnf
	24	USE sbcrnf ! River runoff
	25	USE traqsr ! solar radiation penetration
	26	USE trd_oce ! trends: ocean variables
	27	USE trdtra ! trends manager: tracers
[9023]	28	#if defined key_asminc
	29	USE asminc ! Assimilation increment
	30	#endif
[4990]	31	!
[6140]	32	USE in_out_manager ! I/O manager
	33	USE prtctl ! Print control
	34	USE iom ! xIOS server
	35	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
	36	USE timing ! Timing
[3]	37
	38	IMPLICIT NONE
	39	PRIVATE
	40
[6140]	41	PUBLIC tra_sbc ! routine called by step.F90
[3]	42
	43	!! * Substitutions
[12377]	44	# include "do_loop_substitute.h90"
[13237]	45	# include "domzgr_substitute.h90"
[3]	46	!!----------------------------------------------------------------------
[9598]	47	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
[888]	48	!! $Id$
[10068]	49	!! Software governed by the CeCILL license (see ./LICENSE)
[3]	50	!!----------------------------------------------------------------------
	51	CONTAINS
	52
[12377]	53	SUBROUTINE tra_sbc ( kt, Kmm, pts, Krhs )
[3]	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	!!
[6140]	61	!! ** Method : The (air+ice)-sea flux has two components:
	62	!! (1) Fext, external forcing (i.e. flux through the (air+ice)-sea interface);
	63	!! (2) Fwe , tracer carried with the water that is exchanged with air+ice.
[12377]	64	!! The input forcing fields (emp, rnf, sfx) contain Fext+Fwe,
	65	!! they are simply added to the tracer trend (ts(Krhs)).
[6140]	66	!! In linear free surface case (ln_linssh=T), the volume of the
	67	!! ocean does not change with the water exchanges at the (air+ice)-sea
	68	!! interface. Therefore another term has to be added, to mimic the
	69	!! concentration/dilution effect associated with water exchanges.
[664]	70	!!
[12377]	71	!! ** Action : - Update ts(Krhs) with the surface boundary condition trend
[6140]	72	!! - send trends to trdtra module for further diagnostics(l_trdtra=T)
[503]	73	!!----------------------------------------------------------------------
[13895]	74	INTEGER, INTENT(in ) :: kt ! ocean time-step index
	75	INTEGER, INTENT(in ) :: Kmm, Krhs ! time level indices
	76	REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer Eq.
[6140]	77	!
[9023]	78	INTEGER :: ji, jj, jk, jn ! dummy loop indices
	79	INTEGER :: ikt, ikb ! local integers
	80	REAL(wp) :: zfact, z1_e3t, zdep, ztim ! local scalar
[9019]	81	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds
[3]	82	!!----------------------------------------------------------------------
[3294]	83	!
[9019]	84	IF( ln_timing ) CALL timing_start('tra_sbc')
[3294]	85	!
[3]	86	IF( kt == nit000 ) THEN
	87	IF(lwp) WRITE(numout,*)
	88	IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition'
	89	IF(lwp) WRITE(numout,*) '~~~~~~~ '
	90	ENDIF
[6140]	91	!
[4990]	92	IF( l_trdtra ) THEN !* Save ta and sa trends
[9019]	93	ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )
[12377]	94	ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
	95	ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
[216]	96	ENDIF
[6140]	97	!
	98	!!gm This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist)
[2528]	99	IF( .NOT.ln_traqsr ) THEN ! no solar radiation penetration
[7753]	100	qns(:,:) = qns(:,:) + qsr(:,:) ! total heat flux in qns
	101	qsr(:,:) = 0._wp ! qsr set to zero
[2528]	102	ENDIF
[3]	103
[2528]	104	!----------------------------------------
[4990]	105	! EMP, SFX and QNS effects
[2528]	106	!----------------------------------------
[6140]	107	! !== Set before sbc tracer content fields ==!
	108	IF( kt == nit000 ) THEN !* 1st time-step
[13895]	109	IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN ! Restart: read in restart file
[6140]	110	IF(lwp) WRITE(numout,*) ' nit000-1 sbc tracer content field read in the restart file'
[4990]	111	zfact = 0.5_wp
[13895]	112	sbc_tsc(:,:,:) = 0._wp ! CAUTION: here only the halos should be set to 0 due to rst_put
[13286]	113	CALL iom_get( numror, jpdom_auto, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem), ldxios = lrxios ) ! before heat content sbc trend
	114	CALL iom_get( numror, jpdom_auto, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal), ldxios = lrxios ) ! before salt content sbc trend
[13895]	115	ELSE ! No restart or restart not found: Euler forward time stepping
[4990]	116	zfact = 1._wp
[13895]	117	sbc_tsc (:,:,:) = 0._wp ! CAUTION: here only the halos of sbc_tsc should be set to 0
[7753]	118	sbc_tsc_b(:,:,:) = 0._wp
[2528]	119	ENDIF
[6140]	120	ELSE !* other time-steps: swap of forcing fields
[4990]	121	zfact = 0.5_wp
[7753]	122	sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:)
[2528]	123	ENDIF
[6140]	124	! !== Now sbc tracer content fields ==!
[13895]	125	DO_2D( 0, 0, 0, 0 )
[12489]	126	sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) ! non solar heat flux
	127	sbc_tsc(ji,jj,jp_sal) = r1_rho0 * sfx(ji,jj) ! salt flux due to freezing/melting
[12377]	128	END_2D
[6140]	129	IF( ln_linssh ) THEN !* linear free surface
[13998]	130	DO_2D( 0, 1, 0, 0 ) !==>> add concentration/dilution effect due to constant volume cell
[12489]	131	sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm)
	132	sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm)
[13998]	133	END_2D !==>> output c./d. term
[12377]	134	IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) )
	135	IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) )
[2528]	136	ENDIF
[6140]	137	!
	138	DO jn = 1, jpts !== update tracer trend ==!
[13895]	139	DO_2D( 0, 0, 0, 0 )
[13237]	140	pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) &
	141	& / e3t(ji,jj,1,Kmm)
[12377]	142	END_2D
[3]	143	END DO
[6140]	144	!
	145	IF( lrst_oce ) THEN !== write sbc_tsc in the ocean restart file ==!
[9367]	146	IF( lwxios ) CALL iom_swap( cwxios_context )
	147	CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem), ldxios = lwxios )
	148	CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal), ldxios = lwxios )
	149	IF( lwxios ) CALL iom_swap( cxios_context )
[2528]	150	ENDIF
	151	!
	152	!----------------------------------------
	153	! River Runoff effects
	154	!----------------------------------------
	155	!
[3764]	156	IF( ln_rnf ) THEN ! input of heat and salt due to river runoff
	157	zfact = 0.5_wp
[13895]	158	DO_2D( 0, 0, 0, 0 )
[12377]	159	IF( rnf(ji,jj) /= 0._wp ) THEN
	160	zdep = zfact / h_rnf(ji,jj)
	161	DO jk = 1, nk_rnf(ji,jj)
	162	pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) &
	163	& + ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
	164	IF( ln_rnf_sal ) pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) &
	165	& + ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep
	166	END DO
	167	ENDIF
	168	END_2D
[3764]	169	ENDIF
[6472]	170
[12377]	171	IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) ) ! runoff term on sst
	172	IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) ) ! runoff term on sss
[6472]	173
[9023]	174	#if defined key_asminc
[6140]	175	!
	176	!----------------------------------------
[9023]	177	! Assmilation effects
	178	!----------------------------------------
	179	!
	180	IF( ln_sshinc ) THEN ! input of heat and salt due to assimilation
	181	!
	182	IF( ln_linssh ) THEN
[13895]	183	DO_2D( 0, 0, 0, 0 )
[12377]	184	ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm)
	185	pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + pts(ji,jj,1,jp_tem,Kmm) * ztim
	186	pts(ji,jj,1,jp_sal,Krhs) = pts(ji,jj,1,jp_sal,Krhs) + pts(ji,jj,1,jp_sal,Kmm) * ztim
	187	END_2D
[9023]	188	ELSE
[13895]	189	DO_2D( 0, 0, 0, 0 )
[12377]	190	ztim = ssh_iau(ji,jj) / ( ht(ji,jj) + 1. - ssmask(ji, jj) )
	191	pts(ji,jj,:,jp_tem,Krhs) = pts(ji,jj,:,jp_tem,Krhs) + pts(ji,jj,:,jp_tem,Kmm) * ztim
	192	pts(ji,jj,:,jp_sal,Krhs) = pts(ji,jj,:,jp_sal,Krhs) + pts(ji,jj,:,jp_sal,Kmm) * ztim
	193	END_2D
[9023]	194	ENDIF
	195	!
	196	ENDIF
	197	!
	198	#endif
	199	!
[6140]	200	IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics
[12377]	201	ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
	202	ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
	203	CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt )
	204	CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds )
[9019]	205	DEALLOCATE( ztrdt , ztrds )
[216]	206	ENDIF
[503]	207	!
[12377]	208	IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' sbc - Ta: ', mask1=tmask, &
	209	& tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[503]	210	!
[9019]	211	IF( ln_timing ) CALL timing_stop('tra_sbc')
[3294]	212	!
[3]	213	END SUBROUTINE tra_sbc
	214
	215	!!======================================================================
	216	END MODULE trasbc

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

Download in other formats: