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/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA – NEMO

Context Navigation

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/trasbc.F90 @ 10985

Last change on this file since 10985 was 10985, checked in by acc, 5 years ago
2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : interface changes to tra and trc routines for design compliance and consistency. Fully SETTE tested (non-AGRIF, only)
Property svn:keywords set to `Id`
File size: 13.6 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	!!----------------------------------------------------------------------
[6140]	15	!! tra_sbc : update the tracer trend at ocean surface
[3]	16	!!----------------------------------------------------------------------
[6140]	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 eosbn2 ! Equation Of State
	22	USE sbcmod ! ln_rnf
	23	USE sbcrnf ! River runoff
	24	USE sbcisf ! Ice shelf
	25	USE iscplini ! Ice sheet coupling
	26	USE traqsr ! solar radiation penetration
	27	USE trd_oce ! trends: ocean variables
	28	USE trdtra ! trends manager: tracers
[9023]	29	#if defined key_asminc
	30	USE asminc ! Assimilation increment
	31	#endif
[4990]	32	!
[6140]	33	USE in_out_manager ! I/O manager
	34	USE prtctl ! Print control
	35	USE iom ! xIOS server
	36	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
	37	USE timing ! Timing
[3]	38
	39	IMPLICIT NONE
	40	PRIVATE
	41
[6140]	42	PUBLIC tra_sbc ! routine called by step.F90
[3]	43
	44	!! * Substitutions
	45	# include "vectopt_loop_substitute.h90"
	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
[10985]	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.
	64	!! The input forcing fields (emp, rnf, sfx, isf) contain Fext+Fwe,
[10954]	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	!!
[10954]	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	!!----------------------------------------------------------------------
[10985]	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 equation
[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) )
[10985]	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
	109	IF( ln_rstart .AND. & ! Restart: read in restart file
[2528]	110	& iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN
[6140]	111	IF(lwp) WRITE(numout,*) ' nit000-1 sbc tracer content field read in the restart file'
[4990]	112	zfact = 0.5_wp
[7753]	113	sbc_tsc(:,:,:) = 0._wp
[9367]	114	CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem), ldxios = lrxios ) ! before heat content sbc trend
	115	CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal), ldxios = lrxios ) ! before salt content sbc trend
[6140]	116	ELSE ! No restart or restart not found: Euler forward time stepping
[4990]	117	zfact = 1._wp
[7753]	118	sbc_tsc(:,:,:) = 0._wp
	119	sbc_tsc_b(:,:,:) = 0._wp
[2528]	120	ENDIF
[6140]	121	ELSE !* other time-steps: swap of forcing fields
[4990]	122	zfact = 0.5_wp
[7753]	123	sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:)
[2528]	124	ENDIF
[6140]	125	! !== Now sbc tracer content fields ==!
	126	DO jj = 2, jpj
	127	DO ji = fs_2, fs_jpim1 ! vector opt.
[10499]	128	sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj) ! non solar heat flux
[6140]	129	sbc_tsc(ji,jj,jp_sal) = r1_rau0 * sfx(ji,jj) ! salt flux due to freezing/melting
[3]	130	END DO
[6140]	131	END DO
	132	IF( ln_linssh ) THEN !* linear free surface
	133	DO jj = 2, jpj !==>> add concentration/dilution effect due to constant volume cell
[2528]	134	DO ji = fs_2, fs_jpim1 ! vector opt.
[10985]	135	sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rau0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm)
	136	sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rau0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm)
[2528]	137	END DO
[6140]	138	END DO !==>> output c./d. term
[10985]	139	IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) )
	140	IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) )
[2528]	141	ENDIF
[6140]	142	!
	143	DO jn = 1, jpts !== update tracer trend ==!
[2528]	144	DO jj = 2, jpj
[6140]	145	DO ji = fs_2, fs_jpim1 ! vector opt.
[10985]	146	pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) / e3t(ji,jj,1,Kmm)
[2528]	147	END DO
	148	END DO
[3]	149	END DO
[6140]	150	!
	151	IF( lrst_oce ) THEN !== write sbc_tsc in the ocean restart file ==!
[9367]	152	IF( lwxios ) CALL iom_swap( cwxios_context )
	153	CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem), ldxios = lwxios )
	154	CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal), ldxios = lwxios )
	155	IF( lwxios ) CALL iom_swap( cxios_context )
[2528]	156	ENDIF
	157	!
	158	!----------------------------------------
[4990]	159	! Ice Shelf effects (ISF)
	160	! tbl treated as in Losh (2008) JGR
	161	!----------------------------------------
	162	!
[6140]	163	!!gm BUG ? Why no differences between non-linear and linear free surface ?
	164	!!gm probably taken into account in r1_hisf_tbl : to be verified
	165	IF( ln_isf ) THEN
	166	zfact = 0.5_wp
[4990]	167	DO jj = 2, jpj
	168	DO ji = fs_2, fs_jpim1
[6140]	169	!
[4990]	170	ikt = misfkt(ji,jj)
	171	ikb = misfkb(ji,jj)
[6140]	172	!
[4990]	173	! level fully include in the ice shelf boundary layer
	174	! sign - because fwf sign of evapo (rnf sign of precip)
	175	DO jk = ikt, ikb - 1
	176	! compute trend
[10985]	177	pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) &
	178	& + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) ) &
	179	& * r1_hisf_tbl(ji,jj)
[4990]	180	END DO
	181
	182	! level partially include in ice shelf boundary layer
	183	! compute trend
[10985]	184	pts(ji,jj,ikb,jp_tem,Krhs) = pts(ji,jj,ikb,jp_tem,Krhs) &
	185	& + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) ) &
	186	& * r1_hisf_tbl(ji,jj) * ralpha(ji,jj)
[6140]	187
[4990]	188	END DO
	189	END DO
	190	END IF
	191	!
	192	!----------------------------------------
[2528]	193	! River Runoff effects
	194	!----------------------------------------
	195	!
[3764]	196	IF( ln_rnf ) THEN ! input of heat and salt due to river runoff
	197	zfact = 0.5_wp
[2528]	198	DO jj = 2, jpj
	199	DO ji = fs_2, fs_jpim1
[3764]	200	IF( rnf(ji,jj) /= 0._wp ) THEN
	201	zdep = zfact / h_rnf(ji,jj)
[2528]	202	DO jk = 1, nk_rnf(ji,jj)
[10985]	203	pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) &
	204	& + ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
	205	IF( ln_rnf_sal ) pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) &
	206	& + ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep
[2715]	207	END DO
[2528]	208	ENDIF
[2715]	209	END DO
	210	END DO
[3764]	211	ENDIF
[6472]	212
[10985]	213	IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) ) ! runoff term on sst
	214	IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) ) ! runoff term on sss
[6472]	215
[9023]	216	#if defined key_asminc
[6140]	217	!
	218	!----------------------------------------
[9023]	219	! Assmilation effects
	220	!----------------------------------------
	221	!
	222	IF( ln_sshinc ) THEN ! input of heat and salt due to assimilation
	223	!
	224	IF( ln_linssh ) THEN
	225	DO jj = 2, jpj
	226	DO ji = fs_2, fs_jpim1
[10954]	227	ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm)
[10985]	228	pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + pts(ji,jj,1,jp_tem,Kmm) * ztim
	229	pts(ji,jj,1,jp_sal,Krhs) = pts(ji,jj,1,jp_sal,Krhs) + pts(ji,jj,1,jp_sal,Kmm) * ztim
[9023]	230	END DO
	231	END DO
	232	ELSE
	233	DO jj = 2, jpj
	234	DO ji = fs_2, fs_jpim1
	235	ztim = ssh_iau(ji,jj) / ( ht_n(ji,jj) + 1. - ssmask(ji, jj) )
[10985]	236	pts(ji,jj,:,jp_tem,Krhs) = pts(ji,jj,:,jp_tem,Krhs) + pts(ji,jj,:,jp_tem,Kmm) * ztim
	237	pts(ji,jj,:,jp_sal,Krhs) = pts(ji,jj,:,jp_sal,Krhs) + pts(ji,jj,:,jp_sal,Kmm) * ztim
[9023]	238	END DO
	239	END DO
	240	ENDIF
	241	!
	242	ENDIF
	243	!
	244	#endif
	245	!
	246	!----------------------------------------
[6140]	247	! Ice Sheet coupling imbalance correction to have conservation
	248	!----------------------------------------
	249	!
	250	IF( ln_iscpl .AND. ln_hsb) THEN ! input of heat and salt due to river runoff
	251	DO jk = 1,jpk
	252	DO jj = 2, jpj
	253	DO ji = fs_2, fs_jpim1
[10954]	254	zdep = 1._wp / e3t(ji,jj,jk,Kmm)
[10985]	255	pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) - htsc_iscpl(ji,jj,jk,jp_tem) * zdep
	256	pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) - htsc_iscpl(ji,jj,jk,jp_sal) * zdep
[6140]	257	END DO
	258	END DO
	259	END DO
	260	ENDIF
	261
	262	IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics
[10985]	263	ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
	264	ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
[10946]	265	CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt )
	266	CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds )
[9019]	267	DEALLOCATE( ztrdt , ztrds )
[216]	268	ENDIF
[503]	269	!
[10985]	270	IF(ln_ctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' sbc - Ta: ', mask1=tmask, &
	271	& tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[503]	272	!
[9019]	273	IF( ln_timing ) CALL timing_stop('tra_sbc')
[3294]	274	!
[3]	275	END SUBROUTINE tra_sbc
	276
	277	!!======================================================================
	278	END MODULE trasbc

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

Download in other formats: