Context Navigation

sbcmod.F90 @ 8044

Last change on this file since 8044 was 7993, checked in by frrh, 7 years ago

Merge in missing revisions 6428:2477 inclusive and 6482 from nemo_v3_6_STABLE
branch. In ptic, this includes the fix for restartability of runoff fields in coupled
models. Evolution of coupled models will therefor be affected.

These changes donot affect evolution of the current stand-alone NEMO-CICE GO6
standard configuration.

Work and testing documented in Met Office GMED ticket 320.

File size: 31.5 KB

Rev	Line
[888]	1	MODULE sbcmod
	2	!!======================================================================
	3	!! * MODULE sbcmod *
	4	!! Surface module : provide to the ocean its surface boundary condition
	5	!!======================================================================
[2528]	6	!! History : 3.0 ! 2006-07 (G. Madec) Original code
	7	!! 3.1 ! 2008-08 (S. Masson, A. Caubel, E. Maisonnave, G. Madec) coupled interface
	8	!! 3.3 ! 2010-04 (M. Leclair, G. Madec) Forcing averaged over 2 time steps
	9	!! 3.3 ! 2010-10 (S. Masson) add diurnal cycle
	10	!! 3.3 ! 2010-09 (D. Storkey) add ice boundary conditions (BDY)
	11	!! - ! 2010-11 (G. Madec) ice-ocean stress always computed at each ocean time-step
	12	!! - ! 2010-10 (J. Chanut, C. Bricaud, G. Madec) add the surface pressure forcing
[3294]	13	!! 3.4 ! 2011-11 (C. Harris) CICE added as an option
[3625]	14	!! 3.5 ! 2012-11 (A. Coward, G. Madec) Rethink of heat, mass and salt surface fluxes
[5120]	15	!! 3.6 ! 2014-11 (P. Mathiot, C. Harris) add ice shelves melting
[888]	16	!!----------------------------------------------------------------------
	17
	18	!!----------------------------------------------------------------------
	19	!! sbc_init : read namsbc namelist
[1037]	20	!! sbc : surface ocean momentum, heat and freshwater boundary conditions
[888]	21	!!----------------------------------------------------------------------
[2528]	22	USE oce ! ocean dynamics and tracers
	23	USE dom_oce ! ocean space and time domain
	24	USE phycst ! physical constants
	25	USE sbc_oce ! Surface boundary condition: ocean fields
[5385]	26	USE trc_oce ! shared ocean-passive tracers variables
[2528]	27	USE sbc_ice ! Surface boundary condition: ice fields
	28	USE sbcdcy ! surface boundary condition: diurnal cycle
	29	USE sbcssm ! surface boundary condition: sea-surface mean variables
	30	USE sbcapr ! surface boundary condition: atmospheric pressure
	31	USE sbcana ! surface boundary condition: analytical formulation
	32	USE sbcflx ! surface boundary condition: flux formulation
	33	USE sbcblk_clio ! surface boundary condition: bulk formulation : CLIO
	34	USE sbcblk_core ! surface boundary condition: bulk formulation : CORE
[3294]	35	USE sbcblk_mfs ! surface boundary condition: bulk formulation : MFS
[2528]	36	USE sbcice_if ! surface boundary condition: ice-if sea-ice model
	37	USE sbcice_lim ! surface boundary condition: LIM 3.0 sea-ice model
	38	USE sbcice_lim_2 ! surface boundary condition: LIM 2.0 sea-ice model
[3294]	39	USE sbcice_cice ! surface boundary condition: CICE sea-ice model
[2528]	40	USE sbccpl ! surface boundary condition: coupled florulation
[5407]	41	USE cpl_oasis3 ! OASIS routines for coupling
[2528]	42	USE sbcssr ! surface boundary condition: sea surface restoring
	43	USE sbcrnf ! surface boundary condition: runoffs
[4990]	44	USE sbcisf ! surface boundary condition: ice shelf
[2528]	45	USE sbcfwb ! surface boundary condition: freshwater budget
	46	USE closea ! closed sea
[3609]	47	USE icbstp ! Icebergs!
[888]	48
[2528]	49	USE prtctl ! Print control (prt_ctl routine)
	50	USE iom ! IOM library
	51	USE in_out_manager ! I/O manager
[2715]	52	USE lib_mpp ! MPP library
[3294]	53	USE timing ! Timing
	54	USE sbcwave ! Wave module
[5501]	55	USE bdy_par ! Require lk_bdy
[888]	56
	57	IMPLICIT NONE
	58	PRIVATE
	59
	60	PUBLIC sbc ! routine called by step.F90
[1725]	61	PUBLIC sbc_init ! routine called by opa.F90
[888]	62
	63	INTEGER :: nsbc ! type of surface boundary condition (deduced from namsbc informations)
	64
	65	!! * Substitutions
	66	# include "domzgr_substitute.h90"
	67	!!----------------------------------------------------------------------
[2715]	68	!! NEMO/OPA 4.0 , NEMO-consortium (2011)
[1146]	69	!! $Id$
[2715]	70	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[888]	71	!!----------------------------------------------------------------------
	72	CONTAINS
	73
	74	SUBROUTINE sbc_init
	75	!!---------------------------------------------------------------------
	76	!! * ROUTINE sbc_init *
	77	!!
	78	!! ** Purpose : Initialisation of the ocean surface boundary computation
	79	!!
	80	!! ** Method : Read the namsbc namelist and set derived parameters
[3607]	81	!! Call init routines for all other SBC modules that have one
[888]	82	!!
	83	!! ** Action : - read namsbc parameters
	84	!! - nsbc: type of sbc
	85	!!----------------------------------------------------------------------
[2715]	86	INTEGER :: icpt ! local integer
[1037]	87	!!
[5407]	88	NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx, ln_blk_clio, ln_blk_core, ln_mixcpl, &
	89	& ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc , ln_rnf , &
	90	& ln_ssr , nn_isf , nn_fwb, ln_cdgw , ln_wave , ln_sdw , &
	91	& nn_lsm , nn_limflx , nn_components, ln_cpl
[4147]	92	INTEGER :: ios
[5407]	93	INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3, jpm
	94	LOGICAL :: ll_purecpl
[1037]	95	!!----------------------------------------------------------------------
[888]	96
	97	IF(lwp) THEN
	98	WRITE(numout,*)
	99	WRITE(numout,*) 'sbc_init : surface boundary condition setting'
	100	WRITE(numout,*) '~~~~~~~~ '
	101	ENDIF
	102
[4147]	103	REWIND( numnam_ref ) ! Namelist namsbc in reference namelist : Surface boundary
	104	READ ( numnam_ref, namsbc, IOSTAT = ios, ERR = 901)
	105	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in reference namelist', lwp )
[888]	106
[4147]	107	REWIND( numnam_cfg ) ! Namelist namsbc in configuration namelist : Parameters of the run
	108	READ ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 )
	109	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp )
[4624]	110	IF(lwm) WRITE ( numond, namsbc )
[4147]	111
[2528]	112	! ! overwrite namelist parameter using CPP key information
	113	IF( Agrif_Root() ) THEN ! AGRIF zoom
	114	IF( lk_lim2 ) nn_ice = 2
	115	IF( lk_lim3 ) nn_ice = 3
[3294]	116	IF( lk_cice ) nn_ice = 4
[1242]	117	ENDIF
[2528]	118	IF( cp_cfg == 'gyre' ) THEN ! GYRE configuration
[888]	119	ln_ana = .TRUE.
	120	nn_ice = 0
	121	ENDIF
[5407]	122
[2528]	123	IF(lwp) THEN ! Control print
[1218]	124	WRITE(numout,*) ' Namelist namsbc (partly overwritten with CPP key setting)'
[888]	125	WRITE(numout,*) ' frequency update of sbc (and ice) nn_fsbc = ', nn_fsbc
	126	WRITE(numout,*) ' Type of sbc : '
	127	WRITE(numout,*) ' analytical formulation ln_ana = ', ln_ana
	128	WRITE(numout,*) ' flux formulation ln_flx = ', ln_flx
	129	WRITE(numout,*) ' CLIO bulk formulation ln_blk_clio = ', ln_blk_clio
[3294]	130	WRITE(numout,*) ' CORE bulk formulation ln_blk_core = ', ln_blk_core
	131	WRITE(numout,*) ' MFS bulk formulation ln_blk_mfs = ', ln_blk_mfs
[5407]	132	WRITE(numout,*) ' ocean-atmosphere coupled formulation ln_cpl = ', ln_cpl
	133	WRITE(numout,*) ' forced-coupled mixed formulation ln_mixcpl = ', ln_mixcpl
	134	WRITE(numout,*) ' OASIS coupling (with atm or sas) lk_oasis = ', lk_oasis
	135	WRITE(numout,*) ' components of your executable nn_components = ', nn_components
[4990]	136	WRITE(numout,*) ' Multicategory heat flux formulation (LIM3) nn_limflx = ', nn_limflx
[888]	137	WRITE(numout,*) ' Misc. options of sbc : '
[2528]	138	WRITE(numout,*) ' Patm gradient added in ocean & ice Eqs. ln_apr_dyn = ', ln_apr_dyn
[1037]	139	WRITE(numout,*) ' ice management in the sbc (=0/1/2/3) nn_ice = ', nn_ice
[3625]	140	WRITE(numout,*) ' ice-ocean embedded/levitating (=0/1/2) nn_ice_embd = ', nn_ice_embd
[888]	141	WRITE(numout,*) ' daily mean to diurnal cycle qsr ln_dm2dc = ', ln_dm2dc
	142	WRITE(numout,*) ' runoff / runoff mouths ln_rnf = ', ln_rnf
[4990]	143	WRITE(numout,*) ' iceshelf formulation nn_isf = ', nn_isf
[888]	144	WRITE(numout,*) ' Sea Surface Restoring on SST and/or SSS ln_ssr = ', ln_ssr
	145	WRITE(numout,*) ' FreshWater Budget control (=0/1/2) nn_fwb = ', nn_fwb
[1601]	146	WRITE(numout,*) ' closed sea (=0/1) (set in namdom) nn_closea = ', nn_closea
[4230]	147	WRITE(numout,*) ' n. of iterations if land-sea-mask applied nn_lsm = ', nn_lsm
[888]	148	ENDIF
	149
[4990]	150	! LIM3 Multi-category heat flux formulation
	151	SELECT CASE ( nn_limflx)
	152	CASE ( -1 )
	153	IF(lwp) WRITE(numout,*) ' Use of per-category fluxes (nn_limflx = -1) '
	154	CASE ( 0 )
	155	IF(lwp) WRITE(numout,*) ' Average per-category fluxes (nn_limflx = 0) '
	156	CASE ( 1 )
	157	IF(lwp) WRITE(numout,*) ' Average then redistribute per-category fluxes (nn_limflx = 1) '
	158	CASE ( 2 )
	159	IF(lwp) WRITE(numout,*) ' Redistribute a single flux over categories (nn_limflx = 2) '
[4161]	160	END SELECT
	161	!
[5407]	162	IF ( nn_components /= jp_iam_nemo .AND. .NOT. lk_oasis ) &
	163	& CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' )
	164	IF ( nn_components == jp_iam_opa .AND. ln_cpl ) &
	165	& CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' )
	166	IF ( nn_components == jp_iam_opa .AND. ln_mixcpl ) &
	167	& CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )
	168	IF ( ln_cpl .AND. .NOT. lk_oasis ) &
	169	& CALL ctl_stop( 'STOP', 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' )
	170	IF( ln_mixcpl .AND. .NOT. lk_oasis ) &
	171	& CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires the cpp key key_oasis3' )
	172	IF( ln_mixcpl .AND. .NOT. ln_cpl ) &
	173	& CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires ln_cpl = T' )
	174	IF( ln_mixcpl .AND. nn_components /= jp_iam_nemo ) &
	175	& CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) is not yet working with sas-opa coupling via oasis' )
	176
[2715]	177	! ! allocate sbc arrays
	178	IF( sbc_oce_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' )
	179
[2528]	180	! ! Checks:
[6487]	181	IF( nn_isf .EQ. 0 ) THEN ! variable initialisation if no ice shelf
[4990]	182	IF( sbc_isf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' )
[6487]	183	fwfisf (:,:) = 0.0_wp ; fwfisf_b (:,:) = 0.0_wp
	184	risf_tsc(:,:,:) = 0.0_wp ; risf_tsc_b(:,:,:) = 0.0_wp
	185	rdivisf = 0.0_wp
[4990]	186	END IF
[5407]	187	IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa ) fr_i(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero
[1037]	188
[3625]	189	sfx(:,:) = 0.0_wp ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero)
	190	! only if sea-ice is present
[4148]	191
	192	fmmflx(:,:) = 0.0_wp ! freezing-melting array initialisation
[4822]	193
	194	taum(:,:) = 0.0_wp ! Initialise taum for use in gls in case of reduced restart
[3625]	195
[1218]	196	! ! restartability
[5407]	197	IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) ) &
[3294]	198	& CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' )
[5407]	199	IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. ln_cpl ) ) &
	200	& CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or ln_cpl' )
[3625]	201	IF( nn_ice == 4 .AND. lk_agrif ) &
	202	& CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' )
	203	IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 ) &
[3740]	204	& CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 1 or 2' )
[4990]	205	IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) ) &
	206	& WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3'
[5407]	207	IF( ( nn_ice == 3 ) .AND. ( ln_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) ) &
[4990]	208	& CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' )
[5407]	209	IF( ( nn_ice == 3 ) .AND. ( .NOT. ln_cpl ) .AND. ( nn_limflx == 2 ) ) &
[4990]	210	& CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' )
	211
[2528]	212	IF( ln_dm2dc ) nday_qsr = -1 ! initialisation flag
	213
[5407]	214	IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) .AND. nn_components /= jp_iam_opa ) &
[2528]	215	& CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' )
	216
[3680]	217	IF ( ln_wave ) THEN
	218	!Activated wave module but neither drag nor stokes drift activated
	219	IF ( .NOT.(ln_cdgw .OR. ln_sdw) ) THEN
	220	CALL ctl_warn( 'Ask for wave coupling but nor drag coefficient (ln_cdgw=F) neither stokes drift activated (ln_sdw=F)' )
	221	!drag coefficient read from wave model definable only with mfs bulk formulae and core
	222	ELSEIF (ln_cdgw .AND. .NOT.(ln_blk_mfs .OR. ln_blk_core) ) THEN
	223	CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core')
	224	ENDIF
	225	ELSE
	226	IF ( ln_cdgw .OR. ln_sdw ) &
	227	& CALL ctl_stop('Not Activated Wave Module (ln_wave=F) but &
	228	& asked coupling with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ')
	229	ENDIF
[2528]	230	! ! Choice of the Surface Boudary Condition (set nsbc)
[5407]	231	ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl
	232	!
[888]	233	icpt = 0
[5407]	234	IF( ln_ana ) THEN ; nsbc = jp_ana ; icpt = icpt + 1 ; ENDIF ! analytical formulation
	235	IF( ln_flx ) THEN ; nsbc = jp_flx ; icpt = icpt + 1 ; ENDIF ! flux formulation
	236	IF( ln_blk_clio ) THEN ; nsbc = jp_clio ; icpt = icpt + 1 ; ENDIF ! CLIO bulk formulation
	237	IF( ln_blk_core ) THEN ; nsbc = jp_core ; icpt = icpt + 1 ; ENDIF ! CORE bulk formulation
	238	IF( ln_blk_mfs ) THEN ; nsbc = jp_mfs ; icpt = icpt + 1 ; ENDIF ! MFS bulk formulation
	239	IF( ll_purecpl ) THEN ; nsbc = jp_purecpl ; icpt = icpt + 1 ; ENDIF ! Pure Coupled formulation
	240	IF( cp_cfg == 'gyre') THEN ; nsbc = jp_gyre ; ENDIF ! GYRE analytical formulation
	241	IF( nn_components == jp_iam_opa ) &
	242	& THEN ; nsbc = jp_none ; icpt = icpt + 1 ; ENDIF ! opa coupling via SAS module
	243	IF( lk_esopa ) nsbc = jp_esopa ! esopa test, ALL formulations
[2528]	244	!
[888]	245	IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN
	246	WRITE(numout,*)
	247	WRITE(numout,*) ' E R R O R in setting the sbc, one and only one namelist/CPP key option '
	248	WRITE(numout,*) ' must be choosen. You choose ', icpt, ' option(s)'
	249	WRITE(numout,*) ' We stop'
	250	nstop = nstop + 1
	251	ENDIF
	252	IF(lwp) THEN
	253	WRITE(numout,*)
[5407]	254	IF( nsbc == jp_esopa ) WRITE(numout,*) ' ESOPA test All surface boundary conditions'
	255	IF( nsbc == jp_gyre ) WRITE(numout,*) ' GYRE analytical formulation'
	256	IF( nsbc == jp_ana ) WRITE(numout,*) ' analytical formulation'
	257	IF( nsbc == jp_flx ) WRITE(numout,*) ' flux formulation'
	258	IF( nsbc == jp_clio ) WRITE(numout,*) ' CLIO bulk formulation'
	259	IF( nsbc == jp_core ) WRITE(numout,*) ' CORE bulk formulation'
	260	IF( nsbc == jp_purecpl ) WRITE(numout,*) ' pure coupled formulation'
	261	IF( nsbc == jp_mfs ) WRITE(numout,*) ' MFS Bulk formulation'
	262	IF( nsbc == jp_none ) WRITE(numout,*) ' OPA coupled to SAS via oasis'
	263	IF( ln_mixcpl ) WRITE(numout,*) ' + forced-coupled mixed formulation'
	264	IF( nn_components/= jp_iam_nemo ) &
	265	& WRITE(numout,*) ' + OASIS coupled SAS'
[888]	266	ENDIF
	267	!
[5407]	268	IF( lk_oasis ) CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before: (1) first time step
	269	! ! (2) the use of nn_fsbc
	270
	271	! nn_fsbc initialization if OPA-SAS coupling via OASIS
	272	! sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly
	273	IF ( nn_components /= jp_iam_nemo ) THEN
	274
	275	IF ( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt)
	276	IF ( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt)
	277	!
	278	IF(lwp)THEN
	279	WRITE(numout,*)
	280	WRITE(numout,*)" OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc
	281	WRITE(numout,*)
	282	ENDIF
	283	ENDIF
	284
	285	IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR. &
	286	MOD( nstock , nn_fsbc) /= 0 ) THEN
	287	WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock, &
	288	& ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
	289	CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' )
	290	ENDIF
	291	!
	292	IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 ) &
	293	& CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' )
	294	!
	295	IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) ) < 8 ) ) &
	296	& CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )
	297
[4990]	298	CALL sbc_ssm_init ! Sea-surface mean fields initialisation
[4152]	299	!
[4990]	300	IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialisation
[3764]	301	!
[5431]	302	CALL sbc_rnf_init ! Runof initialisation
[5385]	303	!
[5123]	304	IF( nn_ice == 3 ) CALL sbc_lim_init ! LIM3 initialisation
	305
[4990]	306	IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialisation
[5385]	307
[888]	308	END SUBROUTINE sbc_init
	309
	310
	311	SUBROUTINE sbc( kt )
	312	!!---------------------------------------------------------------------
	313	!! * ROUTINE sbc *
	314	!!
	315	!! ** Purpose : provide at each time-step the ocean surface boundary
	316	!! condition (momentum, heat and freshwater fluxes)
	317	!!
	318	!! ** Method : blah blah to be written ?????????
	319	!! CAUTION : never mask the surface stress field (tke sbc)
	320	!!
[2528]	321	!! ** Action : - set the ocean surface boundary condition at before and now
	322	!! time step, i.e.
[3625]	323	!! utau_b, vtau_b, qns_b, qsr_b, emp_n, sfx_b, qrp_b, erp_b
	324	!! utau , vtau , qns , qsr , emp , sfx , qrp , erp
[1037]	325	!! - updte the ice fraction : fr_i
[888]	326	!!----------------------------------------------------------------------
	327	INTEGER, INTENT(in) :: kt ! ocean time step
	328	!!---------------------------------------------------------------------
[3294]	329	!
	330	IF( nn_timing == 1 ) CALL timing_start('sbc')
	331	!
[2528]	332	! ! ---------------------------------------- !
	333	IF( kt /= nit000 ) THEN ! Swap of forcing fields !
	334	! ! ---------------------------------------- !
	335	utau_b(:,:) = utau(:,:) ! Swap the ocean forcing fields
	336	vtau_b(:,:) = vtau(:,:) ! (except at nit000 where before fields
	337	qns_b (:,:) = qns (:,:) ! are set at the end of the routine)
	338	! The 3D heat content due to qsr forcing is treated in traqsr
	339	! qsr_b (:,:) = qsr (:,:)
[3625]	340	emp_b(:,:) = emp(:,:)
	341	sfx_b(:,:) = sfx(:,:)
[7993]	342	IF ( ln_rnf ) THEN
	343	rnf_b (:,: ) = rnf (:,: )
	344	rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
	345	ENDIF
[2528]	346	ENDIF
	347	! ! ---------------------------------------- !
	348	! ! forcing field computation !
	349	! ! ---------------------------------------- !
[1482]	350	!
[5501]	351	IF ( .NOT. lk_bdy ) then
	352	IF( ln_apr_dyn ) CALL sbc_apr( kt ) ! atmospheric pressure provided at kt+0.5*nn_fsbc
	353	ENDIF
[2528]	354	! (caution called before sbc_ssm)
	355	!
[5407]	356	IF( nn_components /= jp_iam_sas ) CALL sbc_ssm( kt ) ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
	357	! ! averaged over nf_sbc time-step
[888]	358
[3680]	359	IF (ln_wave) CALL sbc_wave( kt )
[2528]	360	!== sbc formulation ==!
	361
	362	SELECT CASE( nsbc ) ! Compute ocean surface boundary condition
[3625]	363	! ! (i.e. utau,vtau, qns, qsr, emp, sfx)
[4990]	364	CASE( jp_gyre ) ; CALL sbc_gyre ( kt ) ! analytical formulation : GYRE configuration
	365	CASE( jp_ana ) ; CALL sbc_ana ( kt ) ! analytical formulation : uniform sbc
	366	CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation
	367	CASE( jp_clio ) ; CALL sbc_blk_clio( kt ) ! bulk formulation : CLIO for the ocean
[5407]	368	CASE( jp_core )
	369	IF( nn_components == jp_iam_sas ) &
	370	& CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: SAS receiving fields from OPA
	371	CALL sbc_blk_core( kt ) ! bulk formulation : CORE for the ocean
	372	! from oce: sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
	373	CASE( jp_purecpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! pure coupled formulation
	374	!
[4990]	375	CASE( jp_mfs ) ; CALL sbc_blk_mfs ( kt ) ! bulk formulation : MFS for the ocean
[5407]	376	CASE( jp_none )
	377	IF( nn_components == jp_iam_opa ) &
	378	CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: OPA receiving fields from SAS
[4990]	379	CASE( jp_esopa )
	380	CALL sbc_ana ( kt ) ! ESOPA, test ALL the formulations
	381	CALL sbc_gyre ( kt ) !
	382	CALL sbc_flx ( kt ) !
	383	CALL sbc_blk_clio( kt ) !
	384	CALL sbc_blk_core( kt ) !
	385	CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) !
[888]	386	END SELECT
	387
[5407]	388	IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! forced-coupled mixed formulation after forcing
	389
	390
[2528]	391	! !== Misc. Options ==!
[888]	392
[3632]	393	SELECT CASE( nn_ice ) ! Update heat and freshwater fluxes over sea-ice areas
	394	CASE( 1 ) ; CALL sbc_ice_if ( kt ) ! Ice-cover climatology ("Ice-if" model)
	395	CASE( 2 ) ; CALL sbc_ice_lim_2( kt, nsbc ) ! LIM-2 ice model
	396	CASE( 3 ) ; CALL sbc_ice_lim ( kt, nsbc ) ! LIM-3 ice model
[4205]	397	CASE( 4 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model
[1037]	398	END SELECT
[888]	399
[3632]	400	IF( ln_icebergs ) CALL icb_stp( kt ) ! compute icebergs
[3609]	401
[4990]	402	IF( nn_isf /= 0 ) CALL sbc_isf( kt ) ! compute iceshelves
	403
[3632]	404	IF( ln_rnf ) CALL sbc_rnf( kt ) ! add runoffs to fresh water fluxes
[1061]	405
[3632]	406	IF( ln_ssr ) CALL sbc_ssr( kt ) ! add SST/SSS damping term
[888]	407
[3632]	408	IF( nn_fwb /= 0 ) CALL sbc_fwb( kt, nn_fwb, nn_fsbc ) ! control the freshwater budget
[888]	409
[3632]	410	IF( nn_closea == 1 ) CALL sbc_clo( kt ) ! treatment of closed sea in the model domain
	411	! ! (update freshwater fluxes)
[2502]	412	!RBbug do not understand why see ticket 667
[5407]	413	!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why.
	414	CALL lbc_lnk( emp, 'T', 1. )
[2502]	415	!
[2528]	416	IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 !
	417	! ! ---------------------------------------- !
	418	IF( ln_rstart .AND. & !* Restart: read in restart file
	419	& iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN
	420	IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields red in the restart file'
	421	CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b ) ! before i-stress (U-point)
	422	CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b ) ! before j-stress (V-point)
	423	CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b ) ! before non solar heat flux (T-point)
	424	! The 3D heat content due to qsr forcing is treated in traqsr
[3625]	425	! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b ) ! before solar heat flux (T-point)
	426	CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b ) ! before freshwater flux (T-point)
	427	! To ensure restart capability with 3.3x/3.4 restart files !! to be removed in v3.6
	428	IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN
	429	CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b ) ! before salt flux (T-point)
	430	ELSE
	431	sfx_b (:,:) = sfx(:,:)
	432	ENDIF
[2528]	433	ELSE !* no restart: set from nit000 values
	434	IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields set to nit000'
	435	utau_b(:,:) = utau(:,:)
	436	vtau_b(:,:) = vtau(:,:)
	437	qns_b (:,:) = qns (:,:)
[3625]	438	emp_b (:,:) = emp(:,:)
	439	sfx_b (:,:) = sfx(:,:)
[2528]	440	ENDIF
	441	ENDIF
	442	! ! ---------------------------------------- !
	443	IF( lrst_oce ) THEN ! Write in the ocean restart file !
	444	! ! ---------------------------------------- !
	445	IF(lwp) WRITE(numout,*)
	446	IF(lwp) WRITE(numout,*) 'sbc : ocean surface forcing fields written in ocean restart file ', &
	447	& 'at it= ', kt,' date= ', ndastp
	448	IF(lwp) WRITE(numout,*) '~~~~'
	449	CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau )
	450	CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau )
	451	CALL iom_rstput( kt, nitrst, numrow, 'qns_b' , qns )
	452	! The 3D heat content due to qsr forcing is treated in traqsr
	453	! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b' , qsr )
	454	CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp )
[5407]	455	CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx )
[2528]	456	ENDIF
	457
	458	! ! ---------------------------------------- !
	459	! ! Outputs and control print !
	460	! ! ---------------------------------------- !
[1482]	461	IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
[6498]	462	CALL iom_put( "empmr" , emp - rnf ) ! upward water flux
	463	CALL iom_put( "empbmr" , emp_b - rnf ) ! before upward water flux ( needed to recalculate the time evolution of ssh in offline )
[3625]	464	CALL iom_put( "saltflx", sfx ) ! downward salt flux
	465	! (includes virtual salt flux beneath ice
	466	! in linear free surface case)
[4148]	467	CALL iom_put( "fmmflx", fmmflx ) ! Freezing-melting water flux
[2561]	468	CALL iom_put( "qt" , qns + qsr ) ! total heat flux
	469	CALL iom_put( "qns" , qns ) ! solar heat flux
	470	CALL iom_put( "qsr" , qsr ) ! solar heat flux
[5407]	471	IF( nn_ice > 0 .OR. nn_components == jp_iam_opa ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction
[4990]	472	CALL iom_put( "taum" , taum ) ! wind stress module
	473	CALL iom_put( "wspd" , wndm ) ! wind speed module over free ocean or leads in presence of sea-ice
[1482]	474	ENDIF
	475	!
	476	CALL iom_put( "utau", utau ) ! i-wind stress (stress can be updated at
	477	CALL iom_put( "vtau", vtau ) ! j-wind stress each time step in sea-ice)
	478	!
[888]	479	IF(ln_ctl) THEN ! print mean trends (used for debugging)
[4990]	480	CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask, ovlap=1 )
	481	CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf), clinfo1=' emp-rnf - : ', mask1=tmask, ovlap=1 )
	482	CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf), clinfo1=' sfx-rnf - : ', mask1=tmask, ovlap=1 )
[3294]	483	CALL prt_ctl(tab2d_1=qns , clinfo1=' qns - : ', mask1=tmask, ovlap=1 )
	484	CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask, ovlap=1 )
	485	CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask - : ', mask1=tmask, ovlap=1, kdim=jpk )
	486	CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' sst - : ', mask1=tmask, ovlap=1, kdim=1 )
	487	CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sss - : ', mask1=tmask, ovlap=1, kdim=1 )
	488	CALL prt_ctl(tab2d_1=utau , clinfo1=' utau - : ', mask1=umask, &
	489	& tab2d_2=vtau , clinfo2=' vtau - : ', mask2=vmask, ovlap=1 )
[888]	490	ENDIF
[3294]	491
	492	IF( kt == nitend ) CALL sbc_final ! Close down surface module if necessary
[888]	493	!
[3294]	494	IF( nn_timing == 1 ) CALL timing_stop('sbc')
	495	!
[888]	496	END SUBROUTINE sbc
	497
[3764]	498
[3294]	499	SUBROUTINE sbc_final
	500	!!---------------------------------------------------------------------
	501	!! * ROUTINE sbc_final *
[3764]	502	!!
	503	!! ** Purpose : Finalize CICE (if used)
[3294]	504	!!---------------------------------------------------------------------
[3764]	505	!
[3294]	506	IF( nn_ice == 4 ) CALL cice_sbc_final
	507	!
	508	END SUBROUTINE sbc_final
	509
[888]	510	!!======================================================================
	511	END MODULE sbcmod

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

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

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90 @ 8044

Download in other formats: