Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

trasbc.F90 @ 15127

Last change on this file since 15127 was 15127, checked in by cetlod, 3 years ago
dev_PISCO : merge with trunk@15119
Property svn:keywords set to `Id`
File size: 11.5 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
[14072]	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
[14072]	23	USE sbcmod ! ln_rnf
	24	USE sbcrnf ! River runoff
[6140]	25	USE traqsr ! solar radiation penetration
	26	USE trd_oce ! trends: ocean variables
[14072]	27	USE trdtra ! trends manager: tracers
	28	#if defined key_asminc
[9023]	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 *
[14072]	56	!!
[3]	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	!!
[14072]	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	!!
[14072]	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	!!----------------------------------------------------------------------
[14053]	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	!
[13982]	78	INTEGER :: ji, jj, jk, jn ! dummy loop indices
[15127]	79	INTEGER :: ikt, ikb ! local integers
[13982]	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	!
[15127]	86	IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
[13982]	87	IF( kt == nit000 ) THEN
	88	IF(lwp) WRITE(numout,*)
	89	IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition'
	90	IF(lwp) WRITE(numout,*) '~~~~~~~ '
	91	ENDIF
[3]	92	ENDIF
[6140]	93	!
[4990]	94	IF( l_trdtra ) THEN !* Save ta and sa trends
[13982]	95	ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) )
[12377]	96	ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
	97	ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
[216]	98	ENDIF
[6140]	99	!
	100	!!gm This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist)
[2528]	101	IF( .NOT.ln_traqsr ) THEN ! no solar radiation penetration
[15127]	102	DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
[13982]	103	qns(ji,jj) = qns(ji,jj) + qsr(ji,jj) ! total heat flux in qns
	104	qsr(ji,jj) = 0._wp ! qsr set to zero
	105	END_2D
[2528]	106	ENDIF
[3]	107
[2528]	108	!----------------------------------------
[4990]	109	! EMP, SFX and QNS effects
[2528]	110	!----------------------------------------
[6140]	111	! !== Set before sbc tracer content fields ==!
	112	IF( kt == nit000 ) THEN !* 1st time-step
[14053]	113	IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN ! Restart: read in restart file
[4990]	114	zfact = 0.5_wp
[15127]	115	IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
[13982]	116	IF(lwp) WRITE(numout,*) ' nit000-1 sbc tracer content field read in the restart file'
	117	sbc_tsc(:,:,:) = 0._wp
	118	CALL iom_get( numror, jpdom_auto, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) ) ! before heat content sbc trend
	119	CALL iom_get( numror, jpdom_auto, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) ) ! before salt content sbc trend
	120	ENDIF
[14053]	121	ELSE ! No restart or restart not found: Euler forward time stepping
[4990]	122	zfact = 1._wp
[15127]	123	DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
[13982]	124	sbc_tsc(ji,jj,:) = 0._wp
	125	sbc_tsc_b(ji,jj,:) = 0._wp
	126	END_2D
[2528]	127	ENDIF
[6140]	128	ELSE !* other time-steps: swap of forcing fields
[4990]	129	zfact = 0.5_wp
[15127]	130	DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
[13982]	131	sbc_tsc_b(ji,jj,:) = sbc_tsc(ji,jj,:)
	132	END_2D
[2528]	133	ENDIF
[6140]	134	! !== Now sbc tracer content fields ==!
[15127]	135	DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
[12489]	136	sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) ! non solar heat flux
	137	sbc_tsc(ji,jj,jp_sal) = r1_rho0 * sfx(ji,jj) ! salt flux due to freezing/melting
[12377]	138	END_2D
[14072]	139	IF( ln_linssh ) THEN !* linear free surface
[15127]	140	DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) !==>> add concentration/dilution effect due to constant volume cell
[12489]	141	sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm)
	142	sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm)
[13497]	143	END_2D !==>> output c./d. term
[15127]	144	IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) )
	145	IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) )
[2528]	146	ENDIF
[6140]	147	!
	148	DO jn = 1, jpts !== update tracer trend ==!
[13982]	149	DO_2D( 0, 0, 0, 0 )
[13237]	150	pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) &
	151	& / e3t(ji,jj,1,Kmm)
[12377]	152	END_2D
[3]	153	END DO
[14072]	154	!
[15127]	155	IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile
[13982]	156	IF( lrst_oce ) THEN !== write sbc_tsc in the ocean restart file ==!
	157	CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) )
	158	CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) )
	159	ENDIF
[2528]	160	ENDIF
	161	!
	162	!----------------------------------------
	163	! River Runoff effects
	164	!----------------------------------------
	165	!
[14072]	166	IF( ln_rnf ) THEN ! input of heat and salt due to river runoff
[3764]	167	zfact = 0.5_wp
[13982]	168	DO_2D( 0, 0, 0, 0 )
[12377]	169	IF( rnf(ji,jj) /= 0._wp ) THEN
	170	zdep = zfact / h_rnf(ji,jj)
	171	DO jk = 1, nk_rnf(ji,jj)
	172	pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) &
	173	& + ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
	174	IF( ln_rnf_sal ) pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) &
[14072]	175	& + ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep
[12377]	176	END DO
	177	ENDIF
	178	END_2D
[3764]	179	ENDIF
[6472]	180
[15127]	181	IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) ) ! runoff term on sst
	182	IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) ) ! runoff term on sss
[6472]	183
[9023]	184	#if defined key_asminc
[6140]	185	!
	186	!----------------------------------------
[9023]	187	! Assmilation effects
	188	!----------------------------------------
	189	!
	190	IF( ln_sshinc ) THEN ! input of heat and salt due to assimilation
	191	!
[14072]	192	IF( ln_linssh ) THEN
[13982]	193	DO_2D( 0, 0, 0, 0 )
[12377]	194	ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm)
	195	pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + pts(ji,jj,1,jp_tem,Kmm) * ztim
	196	pts(ji,jj,1,jp_sal,Krhs) = pts(ji,jj,1,jp_sal,Krhs) + pts(ji,jj,1,jp_sal,Kmm) * ztim
	197	END_2D
[9023]	198	ELSE
[13982]	199	DO_2D( 0, 0, 0, 0 )
[12377]	200	ztim = ssh_iau(ji,jj) / ( ht(ji,jj) + 1. - ssmask(ji, jj) )
	201	pts(ji,jj,:,jp_tem,Krhs) = pts(ji,jj,:,jp_tem,Krhs) + pts(ji,jj,:,jp_tem,Kmm) * ztim
	202	pts(ji,jj,:,jp_sal,Krhs) = pts(ji,jj,:,jp_sal,Krhs) + pts(ji,jj,:,jp_sal,Kmm) * ztim
	203	END_2D
[9023]	204	ENDIF
	205	!
	206	ENDIF
	207	!
	208	#endif
	209	!
[6140]	210	IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics
[12377]	211	ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
	212	ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
	213	CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt )
	214	CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds )
[13982]	215	DEALLOCATE( ztrdt , ztrds )
[216]	216	ENDIF
[503]	217	!
[12377]	218	IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' sbc - Ta: ', mask1=tmask, &
	219	& tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
[503]	220	!
[9019]	221	IF( ln_timing ) CALL timing_stop('tra_sbc')
[3294]	222	!
[3]	223	END SUBROUTINE tra_sbc
	224
	225	!!======================================================================
	226	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: NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/OCE/TRA/trasbc.F90 @ 15127

Download in other formats: