Context Navigation

sbcmod.F90 @ 11101

Last change on this file since 11101 was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.

File size: 32.2 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,*) '~~~~~~~~ '
[11101]	101	IF(lflush) CALL flush(numout)
[888]	102	ENDIF
	103
[4147]	104	REWIND( numnam_ref ) ! Namelist namsbc in reference namelist : Surface boundary
	105	READ ( numnam_ref, namsbc, IOSTAT = ios, ERR = 901)
	106	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in reference namelist', lwp )
[888]	107
[4147]	108	REWIND( numnam_cfg ) ! Namelist namsbc in configuration namelist : Parameters of the run
	109	READ ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 )
	110	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp )
[11101]	111	IF(lwm .AND. nprint > 2) WRITE ( numond, namsbc )
[4147]	112
[2528]	113	! ! overwrite namelist parameter using CPP key information
	114	IF( Agrif_Root() ) THEN ! AGRIF zoom
	115	IF( lk_lim2 ) nn_ice = 2
	116	IF( lk_lim3 ) nn_ice = 3
[3294]	117	IF( lk_cice ) nn_ice = 4
[1242]	118	ENDIF
[2528]	119	IF( cp_cfg == 'gyre' ) THEN ! GYRE configuration
[888]	120	ln_ana = .TRUE.
	121	nn_ice = 0
	122	ENDIF
[5407]	123
[2528]	124	IF(lwp) THEN ! Control print
[1218]	125	WRITE(numout,*) ' Namelist namsbc (partly overwritten with CPP key setting)'
[888]	126	WRITE(numout,*) ' frequency update of sbc (and ice) nn_fsbc = ', nn_fsbc
	127	WRITE(numout,*) ' Type of sbc : '
	128	WRITE(numout,*) ' analytical formulation ln_ana = ', ln_ana
	129	WRITE(numout,*) ' flux formulation ln_flx = ', ln_flx
	130	WRITE(numout,*) ' CLIO bulk formulation ln_blk_clio = ', ln_blk_clio
[3294]	131	WRITE(numout,*) ' CORE bulk formulation ln_blk_core = ', ln_blk_core
	132	WRITE(numout,*) ' MFS bulk formulation ln_blk_mfs = ', ln_blk_mfs
[5407]	133	WRITE(numout,*) ' ocean-atmosphere coupled formulation ln_cpl = ', ln_cpl
	134	WRITE(numout,*) ' forced-coupled mixed formulation ln_mixcpl = ', ln_mixcpl
	135	WRITE(numout,*) ' OASIS coupling (with atm or sas) lk_oasis = ', lk_oasis
	136	WRITE(numout,*) ' components of your executable nn_components = ', nn_components
[4990]	137	WRITE(numout,*) ' Multicategory heat flux formulation (LIM3) nn_limflx = ', nn_limflx
[888]	138	WRITE(numout,*) ' Misc. options of sbc : '
[2528]	139	WRITE(numout,*) ' Patm gradient added in ocean & ice Eqs. ln_apr_dyn = ', ln_apr_dyn
[1037]	140	WRITE(numout,*) ' ice management in the sbc (=0/1/2/3) nn_ice = ', nn_ice
[3625]	141	WRITE(numout,*) ' ice-ocean embedded/levitating (=0/1/2) nn_ice_embd = ', nn_ice_embd
[888]	142	WRITE(numout,*) ' daily mean to diurnal cycle qsr ln_dm2dc = ', ln_dm2dc
	143	WRITE(numout,*) ' runoff / runoff mouths ln_rnf = ', ln_rnf
[4990]	144	WRITE(numout,*) ' iceshelf formulation nn_isf = ', nn_isf
[888]	145	WRITE(numout,*) ' Sea Surface Restoring on SST and/or SSS ln_ssr = ', ln_ssr
	146	WRITE(numout,*) ' FreshWater Budget control (=0/1/2) nn_fwb = ', nn_fwb
[1601]	147	WRITE(numout,*) ' closed sea (=0/1) (set in namdom) nn_closea = ', nn_closea
[4230]	148	WRITE(numout,*) ' n. of iterations if land-sea-mask applied nn_lsm = ', nn_lsm
[888]	149	ENDIF
	150
[4990]	151	! LIM3 Multi-category heat flux formulation
	152	SELECT CASE ( nn_limflx)
	153	CASE ( -1 )
	154	IF(lwp) WRITE(numout,*) ' Use of per-category fluxes (nn_limflx = -1) '
	155	CASE ( 0 )
	156	IF(lwp) WRITE(numout,*) ' Average per-category fluxes (nn_limflx = 0) '
	157	CASE ( 1 )
	158	IF(lwp) WRITE(numout,*) ' Average then redistribute per-category fluxes (nn_limflx = 1) '
	159	CASE ( 2 )
	160	IF(lwp) WRITE(numout,*) ' Redistribute a single flux over categories (nn_limflx = 2) '
[4161]	161	END SELECT
	162	!
[11101]	163	IF(lwp .AND. lflush) CALL flush(numout)
	164	!
[5407]	165	IF ( nn_components /= jp_iam_nemo .AND. .NOT. lk_oasis ) &
	166	& CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' )
	167	IF ( nn_components == jp_iam_opa .AND. ln_cpl ) &
	168	& CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' )
	169	IF ( nn_components == jp_iam_opa .AND. ln_mixcpl ) &
	170	& CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )
	171	IF ( ln_cpl .AND. .NOT. lk_oasis ) &
	172	& CALL ctl_stop( 'STOP', 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' )
	173	IF( ln_mixcpl .AND. .NOT. lk_oasis ) &
	174	& CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires the cpp key key_oasis3' )
	175	IF( ln_mixcpl .AND. .NOT. ln_cpl ) &
	176	& CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires ln_cpl = T' )
	177	IF( ln_mixcpl .AND. nn_components /= jp_iam_nemo ) &
	178	& CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) is not yet working with sas-opa coupling via oasis' )
	179
[2715]	180	! ! allocate sbc arrays
	181	IF( sbc_oce_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' )
	182
[2528]	183	! ! Checks:
[6487]	184	IF( nn_isf .EQ. 0 ) THEN ! variable initialisation if no ice shelf
[4990]	185	IF( sbc_isf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' )
[6487]	186	fwfisf (:,:) = 0.0_wp ; fwfisf_b (:,:) = 0.0_wp
	187	risf_tsc(:,:,:) = 0.0_wp ; risf_tsc_b(:,:,:) = 0.0_wp
	188	rdivisf = 0.0_wp
[4990]	189	END IF
[5407]	190	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]	191
[3625]	192	sfx(:,:) = 0.0_wp ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero)
	193	! only if sea-ice is present
[4148]	194
	195	fmmflx(:,:) = 0.0_wp ! freezing-melting array initialisation
[4822]	196
	197	taum(:,:) = 0.0_wp ! Initialise taum for use in gls in case of reduced restart
[3625]	198
[1218]	199	! ! restartability
[5407]	200	IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) ) &
[3294]	201	& CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' )
[5407]	202	IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. ln_cpl ) ) &
	203	& CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or ln_cpl' )
[3625]	204	IF( nn_ice == 4 .AND. lk_agrif ) &
	205	& CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' )
	206	IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 ) &
[3740]	207	& CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 1 or 2' )
[4990]	208	IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) ) &
	209	& WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3'
[5407]	210	IF( ( nn_ice == 3 ) .AND. ( ln_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) ) &
[4990]	211	& CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' )
[5407]	212	IF( ( nn_ice == 3 ) .AND. ( .NOT. ln_cpl ) .AND. ( nn_limflx == 2 ) ) &
[4990]	213	& CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' )
	214
[2528]	215	IF( ln_dm2dc ) nday_qsr = -1 ! initialisation flag
	216
[5407]	217	IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) .AND. nn_components /= jp_iam_opa ) &
[2528]	218	& CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' )
	219
[3680]	220	IF ( ln_wave ) THEN
	221	!Activated wave module but neither drag nor stokes drift activated
	222	IF ( .NOT.(ln_cdgw .OR. ln_sdw) ) THEN
	223	CALL ctl_warn( 'Ask for wave coupling but nor drag coefficient (ln_cdgw=F) neither stokes drift activated (ln_sdw=F)' )
	224	!drag coefficient read from wave model definable only with mfs bulk formulae and core
	225	ELSEIF (ln_cdgw .AND. .NOT.(ln_blk_mfs .OR. ln_blk_core) ) THEN
	226	CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core')
	227	ENDIF
	228	ELSE
	229	IF ( ln_cdgw .OR. ln_sdw ) &
	230	& CALL ctl_stop('Not Activated Wave Module (ln_wave=F) but &
	231	& asked coupling with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ')
	232	ENDIF
[2528]	233	! ! Choice of the Surface Boudary Condition (set nsbc)
[5407]	234	ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl
	235	!
[888]	236	icpt = 0
[5407]	237	IF( ln_ana ) THEN ; nsbc = jp_ana ; icpt = icpt + 1 ; ENDIF ! analytical formulation
	238	IF( ln_flx ) THEN ; nsbc = jp_flx ; icpt = icpt + 1 ; ENDIF ! flux formulation
	239	IF( ln_blk_clio ) THEN ; nsbc = jp_clio ; icpt = icpt + 1 ; ENDIF ! CLIO bulk formulation
	240	IF( ln_blk_core ) THEN ; nsbc = jp_core ; icpt = icpt + 1 ; ENDIF ! CORE bulk formulation
	241	IF( ln_blk_mfs ) THEN ; nsbc = jp_mfs ; icpt = icpt + 1 ; ENDIF ! MFS bulk formulation
	242	IF( ll_purecpl ) THEN ; nsbc = jp_purecpl ; icpt = icpt + 1 ; ENDIF ! Pure Coupled formulation
	243	IF( cp_cfg == 'gyre') THEN ; nsbc = jp_gyre ; ENDIF ! GYRE analytical formulation
	244	IF( nn_components == jp_iam_opa ) &
	245	& THEN ; nsbc = jp_none ; icpt = icpt + 1 ; ENDIF ! opa coupling via SAS module
	246	IF( lk_esopa ) nsbc = jp_esopa ! esopa test, ALL formulations
[2528]	247	!
[888]	248	IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN
	249	WRITE(numout,*)
	250	WRITE(numout,*) ' E R R O R in setting the sbc, one and only one namelist/CPP key option '
	251	WRITE(numout,*) ' must be choosen. You choose ', icpt, ' option(s)'
	252	WRITE(numout,*) ' We stop'
	253	nstop = nstop + 1
	254	ENDIF
	255	IF(lwp) THEN
	256	WRITE(numout,*)
[5407]	257	IF( nsbc == jp_esopa ) WRITE(numout,*) ' ESOPA test All surface boundary conditions'
	258	IF( nsbc == jp_gyre ) WRITE(numout,*) ' GYRE analytical formulation'
	259	IF( nsbc == jp_ana ) WRITE(numout,*) ' analytical formulation'
	260	IF( nsbc == jp_flx ) WRITE(numout,*) ' flux formulation'
	261	IF( nsbc == jp_clio ) WRITE(numout,*) ' CLIO bulk formulation'
	262	IF( nsbc == jp_core ) WRITE(numout,*) ' CORE bulk formulation'
	263	IF( nsbc == jp_purecpl ) WRITE(numout,*) ' pure coupled formulation'
	264	IF( nsbc == jp_mfs ) WRITE(numout,*) ' MFS Bulk formulation'
	265	IF( nsbc == jp_none ) WRITE(numout,*) ' OPA coupled to SAS via oasis'
	266	IF( ln_mixcpl ) WRITE(numout,*) ' + forced-coupled mixed formulation'
	267	IF( nn_components/= jp_iam_nemo ) &
	268	& WRITE(numout,*) ' + OASIS coupled SAS'
[11101]	269	IF(lflush) CALL flush(numout)
[888]	270	ENDIF
	271	!
[8280]	272	IF( lk_oasis ) THEN
	273	IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )
	274	CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before: (1) first time step
	275	! (2) the use of nn_fsbc
	276	ENDIF
[5407]	277
	278	! nn_fsbc initialization if OPA-SAS coupling via OASIS
	279	! sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly
	280	IF ( nn_components /= jp_iam_nemo ) THEN
	281
	282	IF ( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt)
	283	IF ( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt)
	284	!
	285	IF(lwp)THEN
	286	WRITE(numout,*)
	287	WRITE(numout,*)" OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc
	288	WRITE(numout,*)
[11101]	289	IF(lflush) CALL flush(numout)
[5407]	290	ENDIF
	291	ENDIF
	292
	293	IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR. &
	294	MOD( nstock , nn_fsbc) /= 0 ) THEN
	295	WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock, &
	296	& ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
	297	CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' )
	298	ENDIF
	299	!
	300	IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 ) &
	301	& CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' )
	302	!
	303	IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) ) < 8 ) ) &
	304	& CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )
	305
[4990]	306	CALL sbc_ssm_init ! Sea-surface mean fields initialisation
[4152]	307	!
[4990]	308	IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialisation
[3764]	309	!
[5431]	310	CALL sbc_rnf_init ! Runof initialisation
[5385]	311	!
[5123]	312	IF( nn_ice == 3 ) CALL sbc_lim_init ! LIM3 initialisation
	313
[4990]	314	IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialisation
[5385]	315
[888]	316	END SUBROUTINE sbc_init
	317
	318
	319	SUBROUTINE sbc( kt )
	320	!!---------------------------------------------------------------------
	321	!! * ROUTINE sbc *
	322	!!
	323	!! ** Purpose : provide at each time-step the ocean surface boundary
	324	!! condition (momentum, heat and freshwater fluxes)
	325	!!
	326	!! ** Method : blah blah to be written ?????????
	327	!! CAUTION : never mask the surface stress field (tke sbc)
	328	!!
[2528]	329	!! ** Action : - set the ocean surface boundary condition at before and now
	330	!! time step, i.e.
[3625]	331	!! utau_b, vtau_b, qns_b, qsr_b, emp_n, sfx_b, qrp_b, erp_b
	332	!! utau , vtau , qns , qsr , emp , sfx , qrp , erp
[1037]	333	!! - updte the ice fraction : fr_i
[888]	334	!!----------------------------------------------------------------------
	335	INTEGER, INTENT(in) :: kt ! ocean time step
	336	!!---------------------------------------------------------------------
[3294]	337	!
	338	IF( nn_timing == 1 ) CALL timing_start('sbc')
	339	!
[2528]	340	! ! ---------------------------------------- !
	341	IF( kt /= nit000 ) THEN ! Swap of forcing fields !
	342	! ! ---------------------------------------- !
	343	utau_b(:,:) = utau(:,:) ! Swap the ocean forcing fields
	344	vtau_b(:,:) = vtau(:,:) ! (except at nit000 where before fields
	345	qns_b (:,:) = qns (:,:) ! are set at the end of the routine)
	346	! The 3D heat content due to qsr forcing is treated in traqsr
	347	! qsr_b (:,:) = qsr (:,:)
[3625]	348	emp_b(:,:) = emp(:,:)
	349	sfx_b(:,:) = sfx(:,:)
[7993]	350	IF ( ln_rnf ) THEN
	351	rnf_b (:,: ) = rnf (:,: )
	352	rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
	353	ENDIF
[2528]	354	ENDIF
	355	! ! ---------------------------------------- !
	356	! ! forcing field computation !
	357	! ! ---------------------------------------- !
[1482]	358	!
[5501]	359	IF ( .NOT. lk_bdy ) then
	360	IF( ln_apr_dyn ) CALL sbc_apr( kt ) ! atmospheric pressure provided at kt+0.5*nn_fsbc
	361	ENDIF
[2528]	362	! (caution called before sbc_ssm)
	363	!
[5407]	364	IF( nn_components /= jp_iam_sas ) CALL sbc_ssm( kt ) ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
	365	! ! averaged over nf_sbc time-step
[888]	366
[3680]	367	IF (ln_wave) CALL sbc_wave( kt )
[2528]	368	!== sbc formulation ==!
	369
	370	SELECT CASE( nsbc ) ! Compute ocean surface boundary condition
[3625]	371	! ! (i.e. utau,vtau, qns, qsr, emp, sfx)
[4990]	372	CASE( jp_gyre ) ; CALL sbc_gyre ( kt ) ! analytical formulation : GYRE configuration
	373	CASE( jp_ana ) ; CALL sbc_ana ( kt ) ! analytical formulation : uniform sbc
	374	CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation
	375	CASE( jp_clio ) ; CALL sbc_blk_clio( kt ) ! bulk formulation : CLIO for the ocean
[5407]	376	CASE( jp_core )
	377	IF( nn_components == jp_iam_sas ) &
	378	& CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: SAS receiving fields from OPA
	379	CALL sbc_blk_core( kt ) ! bulk formulation : CORE for the ocean
	380	! from oce: sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
	381	CASE( jp_purecpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! pure coupled formulation
	382	!
[4990]	383	CASE( jp_mfs ) ; CALL sbc_blk_mfs ( kt ) ! bulk formulation : MFS for the ocean
[5407]	384	CASE( jp_none )
	385	IF( nn_components == jp_iam_opa ) &
	386	CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: OPA receiving fields from SAS
[4990]	387	CASE( jp_esopa )
	388	CALL sbc_ana ( kt ) ! ESOPA, test ALL the formulations
	389	CALL sbc_gyre ( kt ) !
	390	CALL sbc_flx ( kt ) !
	391	CALL sbc_blk_clio( kt ) !
	392	CALL sbc_blk_core( kt ) !
	393	CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) !
[888]	394	END SELECT
	395
[5407]	396	IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! forced-coupled mixed formulation after forcing
	397
	398
[2528]	399	! !== Misc. Options ==!
[888]	400
[3632]	401	SELECT CASE( nn_ice ) ! Update heat and freshwater fluxes over sea-ice areas
	402	CASE( 1 ) ; CALL sbc_ice_if ( kt ) ! Ice-cover climatology ("Ice-if" model)
	403	CASE( 2 ) ; CALL sbc_ice_lim_2( kt, nsbc ) ! LIM-2 ice model
	404	CASE( 3 ) ; CALL sbc_ice_lim ( kt, nsbc ) ! LIM-3 ice model
[4205]	405	CASE( 4 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model
[1037]	406	END SELECT
[888]	407
[3632]	408	IF( ln_icebergs ) CALL icb_stp( kt ) ! compute icebergs
[3609]	409
[4990]	410	IF( nn_isf /= 0 ) CALL sbc_isf( kt ) ! compute iceshelves
	411
[3632]	412	IF( ln_rnf ) CALL sbc_rnf( kt ) ! add runoffs to fresh water fluxes
[1061]	413
[3632]	414	IF( ln_ssr ) CALL sbc_ssr( kt ) ! add SST/SSS damping term
[888]	415
[3632]	416	IF( nn_fwb /= 0 ) CALL sbc_fwb( kt, nn_fwb, nn_fsbc ) ! control the freshwater budget
[888]	417
[3632]	418	IF( nn_closea == 1 ) CALL sbc_clo( kt ) ! treatment of closed sea in the model domain
	419	! ! (update freshwater fluxes)
[2502]	420	!RBbug do not understand why see ticket 667
[5407]	421	!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why.
	422	CALL lbc_lnk( emp, 'T', 1. )
[2502]	423	!
[2528]	424	IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 !
	425	! ! ---------------------------------------- !
	426	IF( ln_rstart .AND. & !* Restart: read in restart file
	427	& iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN
[11101]	428	IF(lwp .AND. nprint > 0) THEN
	429	WRITE(numout,*) ' nit000-1 surface forcing fields red in the restart file'
	430	IF(lflush) CALL flush(numout)
	431	ENDIF
[9321]	432	IF(nn_timing == 2) CALL timing_start('iom_rstget')
[2528]	433	CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b ) ! before i-stress (U-point)
	434	CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b ) ! before j-stress (V-point)
	435	CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b ) ! before non solar heat flux (T-point)
	436	! The 3D heat content due to qsr forcing is treated in traqsr
[3625]	437	! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b ) ! before solar heat flux (T-point)
	438	CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b ) ! before freshwater flux (T-point)
	439	! To ensure restart capability with 3.3x/3.4 restart files !! to be removed in v3.6
	440	IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN
	441	CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b ) ! before salt flux (T-point)
	442	ELSE
	443	sfx_b (:,:) = sfx(:,:)
	444	ENDIF
[9321]	445	IF(nn_timing == 2) CALL timing_stop('iom_rstget')
[2528]	446	ELSE !* no restart: set from nit000 values
	447	IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields set to nit000'
	448	utau_b(:,:) = utau(:,:)
	449	vtau_b(:,:) = vtau(:,:)
	450	qns_b (:,:) = qns (:,:)
[3625]	451	emp_b (:,:) = emp(:,:)
	452	sfx_b (:,:) = sfx(:,:)
[2528]	453	ENDIF
	454	ENDIF
	455	! ! ---------------------------------------- !
	456	IF( lrst_oce ) THEN ! Write in the ocean restart file !
	457	! ! ---------------------------------------- !
[11101]	458	IF(lwp .AND. nprint > 0) THEN
	459	WRITE(numout,*)
	460	WRITE(numout,*) 'sbc : ocean surface forcing fields written in ocean restart file ', &
[2528]	461	& 'at it= ', kt,' date= ', ndastp
[11101]	462	WRITE(numout,*) '~~~~'
	463	IF(lflush) CALL flush(numout)
	464	ENDIF
[9321]	465	IF(nn_timing == 2) CALL timing_start('iom_rstput')
[2528]	466	CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau )
	467	CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau )
	468	CALL iom_rstput( kt, nitrst, numrow, 'qns_b' , qns )
	469	! The 3D heat content due to qsr forcing is treated in traqsr
	470	! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b' , qsr )
	471	CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp )
[5407]	472	CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx )
[9321]	473	IF(nn_timing == 2) CALL timing_stop('iom_rstput')
[2528]	474	ENDIF
	475
	476	! ! ---------------------------------------- !
	477	! ! Outputs and control print !
	478	! ! ---------------------------------------- !
[1482]	479	IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
[6498]	480	CALL iom_put( "empmr" , emp - rnf ) ! upward water flux
	481	CALL iom_put( "empbmr" , emp_b - rnf ) ! before upward water flux ( needed to recalculate the time evolution of ssh in offline )
[3625]	482	CALL iom_put( "saltflx", sfx ) ! downward salt flux
	483	! (includes virtual salt flux beneath ice
	484	! in linear free surface case)
[4148]	485	CALL iom_put( "fmmflx", fmmflx ) ! Freezing-melting water flux
[2561]	486	CALL iom_put( "qt" , qns + qsr ) ! total heat flux
	487	CALL iom_put( "qns" , qns ) ! solar heat flux
	488	CALL iom_put( "qsr" , qsr ) ! solar heat flux
[5407]	489	IF( nn_ice > 0 .OR. nn_components == jp_iam_opa ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction
[4990]	490	CALL iom_put( "taum" , taum ) ! wind stress module
	491	CALL iom_put( "wspd" , wndm ) ! wind speed module over free ocean or leads in presence of sea-ice
[1482]	492	ENDIF
	493	!
	494	CALL iom_put( "utau", utau ) ! i-wind stress (stress can be updated at
	495	CALL iom_put( "vtau", vtau ) ! j-wind stress each time step in sea-ice)
	496	!
[888]	497	IF(ln_ctl) THEN ! print mean trends (used for debugging)
[4990]	498	CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask, ovlap=1 )
	499	CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf), clinfo1=' emp-rnf - : ', mask1=tmask, ovlap=1 )
	500	CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf), clinfo1=' sfx-rnf - : ', mask1=tmask, ovlap=1 )
[3294]	501	CALL prt_ctl(tab2d_1=qns , clinfo1=' qns - : ', mask1=tmask, ovlap=1 )
	502	CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask, ovlap=1 )
	503	CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask - : ', mask1=tmask, ovlap=1, kdim=jpk )
	504	CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' sst - : ', mask1=tmask, ovlap=1, kdim=1 )
	505	CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sss - : ', mask1=tmask, ovlap=1, kdim=1 )
	506	CALL prt_ctl(tab2d_1=utau , clinfo1=' utau - : ', mask1=umask, &
	507	& tab2d_2=vtau , clinfo2=' vtau - : ', mask2=vmask, ovlap=1 )
[888]	508	ENDIF
[3294]	509
	510	IF( kt == nitend ) CALL sbc_final ! Close down surface module if necessary
[888]	511	!
[3294]	512	IF( nn_timing == 1 ) CALL timing_stop('sbc')
	513	!
[888]	514	END SUBROUTINE sbc
	515
[3764]	516
[3294]	517	SUBROUTINE sbc_final
	518	!!---------------------------------------------------------------------
	519	!! * ROUTINE sbc_final *
[3764]	520	!!
	521	!! ** Purpose : Finalize CICE (if used)
[3294]	522	!!---------------------------------------------------------------------
[3764]	523	!
[3294]	524	IF( nn_ice == 4 ) CALL cice_sbc_final
	525	!
	526	END SUBROUTINE sbc_final
	527
[888]	528	!!======================================================================
	529	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 @ 11101

Download in other formats: