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.

sbccpl.F90 in branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 6498

Last change on this file since 6498 was 6498, checked in by timgraham, 8 years ago
Merge head of nemo_v3_6_STABLE into package branch
File size: 141.5 KB

Rev	Line
[888]	1	MODULE sbccpl
	2	!!======================================================================
	3	!! * MODULE sbccpl *
[1218]	4	!! Surface Boundary Condition : momentum, heat and freshwater fluxes in coupled mode
	5	!!======================================================================
[2528]	6	!! History : 2.0 ! 2007-06 (R. Redler, N. Keenlyside, W. Park) Original code split into flxmod & taumod
	7	!! 3.0 ! 2008-02 (G. Madec, C Talandier) surface module
	8	!! 3.1 ! 2009_02 (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface
[3294]	9	!! 3.4 ! 2011_11 (C. Harris) more flexibility + multi-category fields
[888]	10	!!----------------------------------------------------------------------
	11	!!----------------------------------------------------------------------
[1218]	12	!! namsbc_cpl : coupled formulation namlist
	13	!! sbc_cpl_init : initialisation of the coupled exchanges
	14	!! sbc_cpl_rcv : receive fields from the atmosphere over the ocean (ocean only)
	15	!! receive stress from the atmosphere over the ocean (ocean-ice case)
	16	!! sbc_cpl_ice_tau : receive stress from the atmosphere over ice
	17	!! sbc_cpl_ice_flx : receive fluxes from the atmosphere over ice
	18	!! sbc_cpl_snd : send fields to the atmosphere
[888]	19	!!----------------------------------------------------------------------
	20	USE dom_oce ! ocean space and time domain
[1218]	21	USE sbc_oce ! Surface boundary condition: ocean fields
	22	USE sbc_ice ! Surface boundary condition: ice fields
[5407]	23	USE sbcapr
[2528]	24	USE sbcdcy ! surface boundary condition: diurnal cycle
[1860]	25	USE phycst ! physical constants
[1218]	26	#if defined key_lim3
[2528]	27	USE ice ! ice variables
[1218]	28	#endif
[1226]	29	#if defined key_lim2
[1534]	30	USE par_ice_2 ! ice parameters
	31	USE ice_2 ! ice variables
[1226]	32	#endif
[1218]	33	USE cpl_oasis3 ! OASIS3 coupling
	34	USE geo2ocean !
[5407]	35	USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev
[1218]	36	USE albedo !
[888]	37	USE in_out_manager ! I/O manager
[1218]	38	USE iom ! NetCDF library
[888]	39	USE lib_mpp ! distribued memory computing library
[3294]	40	USE wrk_nemo ! work arrays
	41	USE timing ! Timing
[888]	42	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
[5407]	43	USE eosbn2
	44	USE sbcrnf , ONLY : l_rnfcpl
[1534]	45	#if defined key_cpl_carbon_cycle
	46	USE p4zflx, ONLY : oce_co2
	47	#endif
[5407]	48	#if defined key_lim3
	49	USE limthd_dh ! for CALL lim_thd_snwblow
	50	#endif
	51
[1218]	52	IMPLICIT NONE
	53	PRIVATE
[5407]	54
[4990]	55	PUBLIC sbc_cpl_init ! routine called by sbcmod.F90
[2715]	56	PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90
	57	PUBLIC sbc_cpl_snd ! routine called by step.F90
	58	PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim(_2).F90
	59	PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim(_2).F90
[5009]	60	PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90
[2715]	61
[1218]	62	INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 1
	63	INTEGER, PARAMETER :: jpr_oty1 = 2 !
	64	INTEGER, PARAMETER :: jpr_otz1 = 3 !
	65	INTEGER, PARAMETER :: jpr_otx2 = 4 ! 3 atmosphere-ocean stress components on grid 2
	66	INTEGER, PARAMETER :: jpr_oty2 = 5 !
	67	INTEGER, PARAMETER :: jpr_otz2 = 6 !
	68	INTEGER, PARAMETER :: jpr_itx1 = 7 ! 3 atmosphere-ice stress components on grid 1
	69	INTEGER, PARAMETER :: jpr_ity1 = 8 !
	70	INTEGER, PARAMETER :: jpr_itz1 = 9 !
	71	INTEGER, PARAMETER :: jpr_itx2 = 10 ! 3 atmosphere-ice stress components on grid 2
	72	INTEGER, PARAMETER :: jpr_ity2 = 11 !
	73	INTEGER, PARAMETER :: jpr_itz2 = 12 !
	74	INTEGER, PARAMETER :: jpr_qsroce = 13 ! Qsr above the ocean
	75	INTEGER, PARAMETER :: jpr_qsrice = 14 ! Qsr above the ice
[1226]	76	INTEGER, PARAMETER :: jpr_qsrmix = 15
	77	INTEGER, PARAMETER :: jpr_qnsoce = 16 ! Qns above the ocean
	78	INTEGER, PARAMETER :: jpr_qnsice = 17 ! Qns above the ice
	79	INTEGER, PARAMETER :: jpr_qnsmix = 18
	80	INTEGER, PARAMETER :: jpr_rain = 19 ! total liquid precipitation (rain)
	81	INTEGER, PARAMETER :: jpr_snow = 20 ! solid precipitation over the ocean (snow)
	82	INTEGER, PARAMETER :: jpr_tevp = 21 ! total evaporation
	83	INTEGER, PARAMETER :: jpr_ievp = 22 ! solid evaporation (sublimation)
[1232]	84	INTEGER, PARAMETER :: jpr_sbpr = 23 ! sublimation - liquid precipitation - solid precipitation
[1226]	85	INTEGER, PARAMETER :: jpr_semp = 24 ! solid freshwater budget (sublimation - snow)
	86	INTEGER, PARAMETER :: jpr_oemp = 25 ! ocean freshwater budget (evap - precip)
[1696]	87	INTEGER, PARAMETER :: jpr_w10m = 26 ! 10m wind
	88	INTEGER, PARAMETER :: jpr_dqnsdt = 27 ! d(Q non solar)/d(temperature)
	89	INTEGER, PARAMETER :: jpr_rnf = 28 ! runoffs
	90	INTEGER, PARAMETER :: jpr_cal = 29 ! calving
	91	INTEGER, PARAMETER :: jpr_taum = 30 ! wind stress module
	92	INTEGER, PARAMETER :: jpr_co2 = 31
[3294]	93	INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn
	94	INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn
[5407]	95	INTEGER, PARAMETER :: jpr_sflx = 34 ! salt flux
	96	INTEGER, PARAMETER :: jpr_toce = 35 ! ocean temperature
	97	INTEGER, PARAMETER :: jpr_soce = 36 ! ocean salinity
	98	INTEGER, PARAMETER :: jpr_ocx1 = 37 ! ocean current on grid 1
	99	INTEGER, PARAMETER :: jpr_ocy1 = 38 !
	100	INTEGER, PARAMETER :: jpr_ssh = 39 ! sea surface height
	101	INTEGER, PARAMETER :: jpr_fice = 40 ! ice fraction
	102	INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness
	103	INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level
[6488]	104	INTEGER, PARAMETER :: jpr_ts_ice = 43 ! skin temperature of sea-ice (used for melt-ponds)
	105	INTEGER, PARAMETER :: jpr_grnm = 44 ! Greenland ice mass
	106	INTEGER, PARAMETER :: jpr_antm = 45 ! Antarctic ice mass
	107	INTEGER, PARAMETER :: jprcv = 45 ! total number of fields received
[3294]	108
[5407]	109	INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere
[1218]	110	INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature
	111	INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature
	112	INTEGER, PARAMETER :: jps_tmix = 4 ! mixed temperature (ocean+ice)
	113	INTEGER, PARAMETER :: jps_albice = 5 ! ice albedo
	114	INTEGER, PARAMETER :: jps_albmix = 6 ! mixed albedo
	115	INTEGER, PARAMETER :: jps_hice = 7 ! ice thickness
	116	INTEGER, PARAMETER :: jps_hsnw = 8 ! snow thickness
	117	INTEGER, PARAMETER :: jps_ocx1 = 9 ! ocean current on grid 1
	118	INTEGER, PARAMETER :: jps_ocy1 = 10 !
	119	INTEGER, PARAMETER :: jps_ocz1 = 11 !
	120	INTEGER, PARAMETER :: jps_ivx1 = 12 ! ice current on grid 1
	121	INTEGER, PARAMETER :: jps_ivy1 = 13 !
	122	INTEGER, PARAMETER :: jps_ivz1 = 14 !
[1534]	123	INTEGER, PARAMETER :: jps_co2 = 15
[5407]	124	INTEGER, PARAMETER :: jps_soce = 16 ! ocean salinity
	125	INTEGER, PARAMETER :: jps_ssh = 17 ! sea surface height
	126	INTEGER, PARAMETER :: jps_qsroce = 18 ! Qsr above the ocean
	127	INTEGER, PARAMETER :: jps_qnsoce = 19 ! Qns above the ocean
	128	INTEGER, PARAMETER :: jps_oemp = 20 ! ocean freshwater budget (evap - precip)
	129	INTEGER, PARAMETER :: jps_sflx = 21 ! salt flux
	130	INTEGER, PARAMETER :: jps_otx1 = 22 ! 2 atmosphere-ocean stress components on grid 1
	131	INTEGER, PARAMETER :: jps_oty1 = 23 !
	132	INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs
	133	INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module
	134	INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling)
	135	INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl)
	136	INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level
[6488]	137	INTEGER, PARAMETER :: jps_a_p = 29 ! meltpond fraction
	138	INTEGER, PARAMETER :: jps_ht_p = 30 ! meltpond depth (m)
	139	INTEGER, PARAMETER :: jps_kice = 31 ! ice surface layer thermal conductivity
	140	INTEGER, PARAMETER :: jps_sstfrz = 32 ! sea-surface freezing temperature
	141	INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for time-travelling ice coupling)
	142	INTEGER, PARAMETER :: jpsnd = 33 ! total number of fields sended
[3294]	143
[1218]	144	! !! namelist namsbc_cpl
[3294]	145	TYPE :: FLD_C
	146	CHARACTER(len = 32) :: cldes ! desciption of the coupling strategy
	147	CHARACTER(len = 32) :: clcat ! multiple ice categories strategy
	148	CHARACTER(len = 32) :: clvref ! reference of vector ('spherical' or 'cartesian')
	149	CHARACTER(len = 32) :: clvor ! orientation of vector fields ('eastward-northward' or 'local grid')
	150	CHARACTER(len = 32) :: clvgrd ! grids on which is located the vector fields
	151	END TYPE FLD_C
	152	! Send to the atmosphere !
[6488]	153	TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2, sn_snd_cond, sn_snd_mpnd, sn_snd_sstfrz, sn_snd_thick1
	154
[3294]	155	! Received from the atmosphere !
	156	TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf
[6488]	157	TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_ts_ice, sn_rcv_grnm, sn_rcv_antm
[4990]	158	! Other namelist parameters !
	159	INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
	160	LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models
	161	! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
[3294]	162	TYPE :: DYNARR
	163	REAL(wp), POINTER, DIMENSION(:,:,:) :: z3
	164	END TYPE DYNARR
[888]	165
[3294]	166	TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere
	167
[2715]	168	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky)
[888]	169
[2715]	170	INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument
[888]	171
[1218]	172	!! Substitution
[5407]	173	# include "domzgr_substitute.h90"
[1218]	174	# include "vectopt_loop_substitute.h90"
	175	!!----------------------------------------------------------------------
[2528]	176	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
[1226]	177	!! $Id$
[2715]	178	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[1218]	179	!!----------------------------------------------------------------------
[888]	180
[1218]	181	CONTAINS
	182
[2715]	183	INTEGER FUNCTION sbc_cpl_alloc()
	184	!!----------------------------------------------------------------------
	185	!! * FUNCTION sbc_cpl_alloc *
	186	!!----------------------------------------------------------------------
[4990]	187	INTEGER :: ierr(3)
[2715]	188	!!----------------------------------------------------------------------
	189	ierr(:) = 0
	190	!
[3294]	191	ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) )
[4990]	192
	193	#if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice
	194	ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init)
	195	#endif
[5407]	196	ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) )
[2715]	197	!
	198	sbc_cpl_alloc = MAXVAL( ierr )
	199	IF( lk_mpp ) CALL mpp_sum ( sbc_cpl_alloc )
	200	IF( sbc_cpl_alloc > 0 ) CALL ctl_warn('sbc_cpl_alloc: allocation of arrays failed')
	201	!
	202	END FUNCTION sbc_cpl_alloc
	203
	204
[1218]	205	SUBROUTINE sbc_cpl_init( k_ice )
	206	!!----------------------------------------------------------------------
	207	!! * ROUTINE sbc_cpl_init *
	208	!!
[4990]	209	!! ** Purpose : Initialisation of send and received information from
[1218]	210	!! the atmospheric component
	211	!!
	212	!! ** Method : * Read namsbc_cpl namelist
	213	!! * define the receive interface
	214	!! * define the send interface
	215	!! * initialise the OASIS coupler
	216	!!----------------------------------------------------------------------
[5407]	217	INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)
[1218]	218	!!
[2715]	219	INTEGER :: jn ! dummy loop index
[4147]	220	INTEGER :: ios ! Local integer output status for namelist read
[4990]	221	INTEGER :: inum
[3294]	222	REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos
[1218]	223	!!
[6488]	224	NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick , sn_snd_crt , sn_snd_co2, &
	225	& sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1, &
	226	& sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, &
	227	& sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, &
	228	& sn_rcv_co2 , sn_rcv_grnm , sn_rcv_antm , sn_rcv_ts_ice, nn_cplmodel , &
	229	& ln_usecplmask, ln_coupled_iceshelf_fluxes, rn_greenland_calving_fraction, &
	230	& rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance
[1218]	231	!!---------------------------------------------------------------------
[3294]	232	!
	233	IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init')
	234	!
	235	CALL wrk_alloc( jpi,jpj, zacs, zaos )
[888]	236
[1218]	237	! ================================ !
	238	! Namelist informations !
	239	! ================================ !
[888]	240
[4147]	241	REWIND( numnam_ref ) ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling
	242	READ ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901)
	243	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp )
[3294]	244
[4147]	245	REWIND( numnam_cfg ) ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling
	246	READ ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 )
	247	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp )
[4624]	248	IF(lwm) WRITE ( numond, namsbc_cpl )
[888]	249
[1218]	250	IF(lwp) THEN ! control print
	251	WRITE(numout,*)
	252	WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist '
	253	WRITE(numout,*)'~~~~~~~~~~~~'
[5407]	254	ENDIF
	255	IF( lwp .AND. ln_cpl ) THEN ! control print
[3294]	256	WRITE(numout,*)' received fields (mutiple ice categogies)'
	257	WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')'
	258	WRITE(numout,*)' stress module = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')'
	259	WRITE(numout,*)' surface stress = ', TRIM(sn_rcv_tau%cldes ), ' (', TRIM(sn_rcv_tau%clcat ), ')'
	260	WRITE(numout,*)' - referential = ', sn_rcv_tau%clvref
	261	WRITE(numout,*)' - orientation = ', sn_rcv_tau%clvor
	262	WRITE(numout,*)' - mesh = ', sn_rcv_tau%clvgrd
	263	WRITE(numout,*)' non-solar heat flux sensitivity = ', TRIM(sn_rcv_dqnsdt%cldes), ' (', TRIM(sn_rcv_dqnsdt%clcat), ')'
	264	WRITE(numout,*)' solar heat flux = ', TRIM(sn_rcv_qsr%cldes ), ' (', TRIM(sn_rcv_qsr%clcat ), ')'
	265	WRITE(numout,*)' non-solar heat flux = ', TRIM(sn_rcv_qns%cldes ), ' (', TRIM(sn_rcv_qns%clcat ), ')'
	266	WRITE(numout,*)' freshwater budget = ', TRIM(sn_rcv_emp%cldes ), ' (', TRIM(sn_rcv_emp%clcat ), ')'
	267	WRITE(numout,*)' runoffs = ', TRIM(sn_rcv_rnf%cldes ), ' (', TRIM(sn_rcv_rnf%clcat ), ')'
	268	WRITE(numout,*)' calving = ', TRIM(sn_rcv_cal%cldes ), ' (', TRIM(sn_rcv_cal%clcat ), ')'
[6488]	269	WRITE(numout,*)' Greenland ice mass = ', TRIM(sn_rcv_grnm%cldes ), ' (', TRIM(sn_rcv_grnm%clcat ), ')'
	270	WRITE(numout,*)' Antarctica ice mass = ', TRIM(sn_rcv_antm%cldes ), ' (', TRIM(sn_rcv_antm%clcat ), ')'
[3294]	271	WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')'
	272	WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')'
	273	WRITE(numout,*)' sent fields (multiple ice categories)'
	274	WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')'
	275	WRITE(numout,*)' albedo = ', TRIM(sn_snd_alb%cldes ), ' (', TRIM(sn_snd_alb%clcat ), ')'
	276	WRITE(numout,*)' ice/snow thickness = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')'
	277	WRITE(numout,*)' surface current = ', TRIM(sn_snd_crt%cldes ), ' (', TRIM(sn_snd_crt%clcat ), ')'
	278	WRITE(numout,*)' - referential = ', sn_snd_crt%clvref
	279	WRITE(numout,*)' - orientation = ', sn_snd_crt%clvor
	280	WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd
	281	WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')'
[6488]	282	WRITE(numout,*)' ice effective conductivity = ', TRIM(sn_snd_cond%cldes ), ' (', TRIM(sn_snd_cond%clcat ), ')'
	283	WRITE(numout,*)' meltponds fraction & depth = ', TRIM(sn_snd_mpnd%cldes ), ' (', TRIM(sn_snd_mpnd%clcat ), ')'
	284	WRITE(numout,*)' sea surface freezing temp = ', TRIM(sn_snd_sstfrz%cldes ), ' (', TRIM(sn_snd_sstfrz%clcat ), ')'
	285
[4990]	286	WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel
	287	WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask
[6488]	288	WRITE(numout,*)' ln_coupled_iceshelf_fluxes = ', ln_coupled_iceshelf_fluxes
	289	WRITE(numout,*)' rn_greenland_calving_fraction = ', rn_greenland_calving_fraction
	290	WRITE(numout,*)' rn_antarctica_calving_fraction = ', rn_antarctica_calving_fraction
	291	WRITE(numout,*)' rn_iceshelf_fluxes_tolerance = ', rn_iceshelf_fluxes_tolerance
[1218]	292	ENDIF
[888]	293
[3294]	294	! ! allocate sbccpl arrays
[2715]	295	IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )
[1218]	296
	297	! ================================ !
	298	! Define the receive interface !
	299	! ================================ !
[1698]	300	nrcvinfo(:) = OASIS_idle ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress
[888]	301
[1218]	302	! for each field: define the OASIS name (srcv(:)%clname)
	303	! define receive or not from the namelist parameters (srcv(:)%laction)
	304	! define the north fold type of lbc (srcv(:)%nsgn)
[888]	305
[1218]	306	! default definitions of srcv
[3294]	307	srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1
[888]	308
[1218]	309	! ! ------------------------- !
	310	! ! ice and ocean wind stress !
	311	! ! ------------------------- !
	312	! ! Name
	313	srcv(jpr_otx1)%clname = 'O_OTaux1' ! 1st ocean component on grid ONE (T or U)
	314	srcv(jpr_oty1)%clname = 'O_OTauy1' ! 2nd - - - -
	315	srcv(jpr_otz1)%clname = 'O_OTauz1' ! 3rd - - - -
	316	srcv(jpr_otx2)%clname = 'O_OTaux2' ! 1st ocean component on grid TWO (V)
	317	srcv(jpr_oty2)%clname = 'O_OTauy2' ! 2nd - - - -
	318	srcv(jpr_otz2)%clname = 'O_OTauz2' ! 3rd - - - -
	319	!
	320	srcv(jpr_itx1)%clname = 'O_ITaux1' ! 1st ice component on grid ONE (T, F, I or U)
	321	srcv(jpr_ity1)%clname = 'O_ITauy1' ! 2nd - - - -
	322	srcv(jpr_itz1)%clname = 'O_ITauz1' ! 3rd - - - -
	323	srcv(jpr_itx2)%clname = 'O_ITaux2' ! 1st ice component on grid TWO (V)
	324	srcv(jpr_ity2)%clname = 'O_ITauy2' ! 2nd - - - -
	325	srcv(jpr_itz2)%clname = 'O_ITauz2' ! 3rd - - - -
	326	!
[1833]	327	! Vectors: change of sign at north fold ONLY if on the local grid
[3294]	328	IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1.
[1218]	329
	330	! ! Set grid and action
[3294]	331	SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) ) ! 'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V'
[1218]	332	CASE( 'T' )
	333	srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
	334	srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
	335	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
	336	CASE( 'U,V' )
	337	srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
	338	srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
	339	srcv(jpr_itx1:jpr_itz1)%clgrid = 'U' ! ice components given at U-point
	340	srcv(jpr_itx2:jpr_itz2)%clgrid = 'V' ! and V-point
	341	srcv(jpr_otx1:jpr_itz2)%laction = .TRUE. ! receive oce and ice components on both grid 1 & 2
	342	CASE( 'U,V,T' )
	343	srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
	344	srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
	345	srcv(jpr_itx1:jpr_itz1)%clgrid = 'T' ! ice components given at T-point
	346	srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
	347	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
	348	CASE( 'U,V,I' )
	349	srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
	350	srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
	351	srcv(jpr_itx1:jpr_itz1)%clgrid = 'I' ! ice components given at I-point
	352	srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
	353	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
	354	CASE( 'U,V,F' )
	355	srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
	356	srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
	357	srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point
	358	srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
	359	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
	360	CASE( 'T,I' )
	361	srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
	362	srcv(jpr_itx1:jpr_itz1)%clgrid = 'I' ! ice components given at I-point
	363	srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
	364	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
	365	CASE( 'T,F' )
	366	srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
	367	srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point
	368	srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
	369	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
	370	CASE( 'T,U,V' )
	371	srcv(jpr_otx1:jpr_otz1)%clgrid = 'T' ! oce components given at T-point
	372	srcv(jpr_itx1:jpr_itz1)%clgrid = 'U' ! ice components given at U-point
	373	srcv(jpr_itx2:jpr_itz2)%clgrid = 'V' ! and V-point
	374	srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1 only
	375	srcv(jpr_itx1:jpr_itz2)%laction = .TRUE. ! receive ice components on grid 1 & 2
	376	CASE default
[3294]	377	CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' )
[1218]	378	END SELECT
	379	!
[3294]	380	IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' ) & ! spherical: 3rd component not received
[1218]	381	& srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE.
	382	!
[3680]	383	IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) THEN ! already on local grid -> no need of the second grid
	384	srcv(jpr_otx2:jpr_otz2)%laction = .FALSE.
	385	srcv(jpr_itx2:jpr_itz2)%laction = .FALSE.
	386	srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid ! not needed but cleaner...
	387	srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid ! not needed but cleaner...
	388	ENDIF
	389	!
[3294]	390	IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used
[4162]	391	srcv(jpr_itx1:jpr_itz2)%laction = .FALSE. ! ice components not received
[1218]	392	srcv(jpr_itx1)%clgrid = 'U' ! ocean stress used after its transformation
	393	srcv(jpr_ity1)%clgrid = 'V' ! i.e. it is always at U- & V-points for i- & j-comp. resp.
	394	ENDIF
	395
	396	! ! ------------------------- !
	397	! ! freshwater budget ! E-P
	398	! ! ------------------------- !
	399	! we suppose that atmosphere modele do not make the difference between precipiration (liquide or solid)
	400	! over ice of free ocean within the same atmospheric cell.cd
	401	srcv(jpr_rain)%clname = 'OTotRain' ! Rain = liquid precipitation
	402	srcv(jpr_snow)%clname = 'OTotSnow' ! Snow = solid precipitation
	403	srcv(jpr_tevp)%clname = 'OTotEvap' ! total evaporation (over oce + ice sublimation)
[6488]	404	srcv(jpr_ievp)%clname = 'OIceEvp' ! evaporation over ice = sublimation
[1232]	405	srcv(jpr_sbpr)%clname = 'OSubMPre' ! sublimation - liquid precipitation - solid precipitation
	406	srcv(jpr_semp)%clname = 'OISubMSn' ! ice solid water budget = sublimation - solid precipitation
	407	srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip
[3294]	408	SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
[5407]	409	CASE( 'none' ) ! nothing to do
[1218]	410	CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE.
[4162]	411	CASE( 'conservative' )
	412	srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE.
[4393]	413	IF ( k_ice <= 1 ) srcv(jpr_ievp)%laction = .FALSE.
[1232]	414	CASE( 'oce and ice' ) ; srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE.
[3294]	415	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' )
[1218]	416	END SELECT
[6488]	417	!Set the number of categories for coupling of sublimation
	418	IF ( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = jpl
	419	!
[1218]	420	! ! ------------------------- !
	421	! ! Runoffs & Calving !
	422	! ! ------------------------- !
[5407]	423	srcv(jpr_rnf )%clname = 'O_Runoff'
	424	IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN
	425	srcv(jpr_rnf)%laction = .TRUE.
	426	l_rnfcpl = .TRUE. ! -> no need to read runoffs in sbcrnf
	427	ln_rnf = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas
	428	IF(lwp) WRITE(numout,*)
	429	IF(lwp) WRITE(numout,*) ' runoffs received from oasis -> force ln_rnf = ', ln_rnf
	430	ENDIF
	431	!
[3294]	432	srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE.
[6488]	433	srcv(jpr_grnm )%clname = 'OGrnmass' ; IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' ) srcv(jpr_grnm)%laction = .TRUE.
	434	srcv(jpr_antm )%clname = 'OAntmass' ; IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' ) srcv(jpr_antm)%laction = .TRUE.
[888]	435
[6488]	436
[1218]	437	! ! ------------------------- !
	438	! ! non solar radiation ! Qns
	439	! ! ------------------------- !
	440	srcv(jpr_qnsoce)%clname = 'O_QnsOce'
	441	srcv(jpr_qnsice)%clname = 'O_QnsIce'
	442	srcv(jpr_qnsmix)%clname = 'O_QnsMix'
[3294]	443	SELECT CASE( TRIM( sn_rcv_qns%cldes ) )
[5407]	444	CASE( 'none' ) ! nothing to do
[1218]	445	CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE.
	446	CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE.
	447	CASE( 'oce and ice' ) ; srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE.
	448	CASE( 'mixed oce-ice' ) ; srcv( jpr_qnsmix )%laction = .TRUE.
[3294]	449	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' )
[1218]	450	END SELECT
[3294]	451	IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) &
	452	CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' )
[1218]	453	! ! ------------------------- !
	454	! ! solar radiation ! Qsr
	455	! ! ------------------------- !
	456	srcv(jpr_qsroce)%clname = 'O_QsrOce'
	457	srcv(jpr_qsrice)%clname = 'O_QsrIce'
	458	srcv(jpr_qsrmix)%clname = 'O_QsrMix'
[3294]	459	SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )
[5407]	460	CASE( 'none' ) ! nothing to do
[1218]	461	CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE.
	462	CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE.
	463	CASE( 'oce and ice' ) ; srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE.
	464	CASE( 'mixed oce-ice' ) ; srcv( jpr_qsrmix )%laction = .TRUE.
[3294]	465	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' )
[1218]	466	END SELECT
[3294]	467	IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) &
	468	CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' )
[1218]	469	! ! ------------------------- !
	470	! ! non solar sensitivity ! d(Qns)/d(T)
	471	! ! ------------------------- !
	472	srcv(jpr_dqnsdt)%clname = 'O_dQnsdT'
[3294]	473	IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' ) srcv(jpr_dqnsdt)%laction = .TRUE.
[1232]	474	!
[3294]	475	! non solar sensitivity mandatory for LIM ice model
[5407]	476	IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) &
[3294]	477	CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' )
[1232]	478	! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique
[3294]	479	IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) &
	480	CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' )
[1218]	481	! ! ------------------------- !
	482	! ! 10m wind module !
	483	! ! ------------------------- !
[3294]	484	srcv(jpr_w10m)%clname = 'O_Wind10' ; IF( TRIM(sn_rcv_w10m%cldes ) == 'coupled' ) srcv(jpr_w10m)%laction = .TRUE.
[1696]	485	!
	486	! ! ------------------------- !
	487	! ! wind stress module !
	488	! ! ------------------------- !
[3294]	489	srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE.
[1705]	490	lhftau = srcv(jpr_taum)%laction
[1534]	491
	492	! ! ------------------------- !
	493	! ! Atmospheric CO2 !
	494	! ! ------------------------- !
[3294]	495	srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE.
	496	! ! ------------------------- !
	497	! ! topmelt and botmelt !
	498	! ! ------------------------- !
	499	srcv(jpr_topm )%clname = 'OTopMlt'
	500	srcv(jpr_botm )%clname = 'OBotMlt'
	501	IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN
	502	IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN
	503	srcv(jpr_topm:jpr_botm)%nct = jpl
	504	ELSE
	505	CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' )
	506	ENDIF
	507	srcv(jpr_topm:jpr_botm)%laction = .TRUE.
	508	ENDIF
[6488]	509
	510	#if defined key_cice && ! defined key_cice4
	511	! ! ----------------------------- !
	512	! ! sea-ice skin temperature !
	513	! ! used in meltpond scheme !
	514	! ! May be calculated in Atm !
	515	! ! ----------------------------- !
	516	srcv(jpr_ts_ice)%clname = 'OTsfIce'
	517	IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' ) srcv(jpr_ts_ice)%laction = .TRUE.
	518	IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' ) srcv(jpr_ts_ice)%nct = jpl
	519	!TODO: Should there be a consistency check here?
	520	#endif
	521
[5407]	522	! ! ------------------------------- !
	523	! ! OPA-SAS coupling - rcv by opa !
	524	! ! ------------------------------- !
	525	srcv(jpr_sflx)%clname = 'O_SFLX'
	526	srcv(jpr_fice)%clname = 'RIceFrc'
	527	!
	528	IF( nn_components == jp_iam_opa ) THEN ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS)
	529	srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
	530	srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling
	531	srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling
	532	srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE.
	533	srcv(jpr_otx1)%clgrid = 'U' ! oce components given at U-point
	534	srcv(jpr_oty1)%clgrid = 'V' ! and V-point
	535	! Vectors: change of sign at north fold ONLY if on the local grid
	536	srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1.
	537	sn_rcv_tau%clvgrd = 'U,V'
	538	sn_rcv_tau%clvor = 'local grid'
	539	sn_rcv_tau%clvref = 'spherical'
	540	sn_rcv_emp%cldes = 'oce only'
	541	!
	542	IF(lwp) THEN ! control print
	543	WRITE(numout,*)
	544	WRITE(numout,*)' Special conditions for SAS-OPA coupling '
	545	WRITE(numout,*)' OPA component '
	546	WRITE(numout,*)
	547	WRITE(numout,*)' received fields from SAS component '
	548	WRITE(numout,*)' ice cover '
	549	WRITE(numout,*)' oce only EMP '
	550	WRITE(numout,*)' salt flux '
	551	WRITE(numout,*)' mixed oce-ice solar flux '
	552	WRITE(numout,*)' mixed oce-ice non solar flux '
	553	WRITE(numout,*)' wind stress U,V on local grid and sperical coordinates '
	554	WRITE(numout,*)' wind stress module'
	555	WRITE(numout,*)
	556	ENDIF
	557	ENDIF
	558	! ! -------------------------------- !
	559	! ! OPA-SAS coupling - rcv by sas !
	560	! ! -------------------------------- !
	561	srcv(jpr_toce )%clname = 'I_SSTSST'
	562	srcv(jpr_soce )%clname = 'I_SSSal'
	563	srcv(jpr_ocx1 )%clname = 'I_OCurx1'
	564	srcv(jpr_ocy1 )%clname = 'I_OCury1'
	565	srcv(jpr_ssh )%clname = 'I_SSHght'
	566	srcv(jpr_e3t1st)%clname = 'I_E3T1st'
	567	srcv(jpr_fraqsr)%clname = 'I_FraQsr'
	568	!
	569	IF( nn_components == jp_iam_sas ) THEN
	570	IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
	571	IF( .NOT. ln_cpl ) srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling
	572	IF( .NOT. ln_cpl ) srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling
	573	srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE.
	574	srcv( jpr_e3t1st )%laction = lk_vvl
	575	srcv(jpr_ocx1)%clgrid = 'U' ! oce components given at U-point
	576	srcv(jpr_ocy1)%clgrid = 'V' ! and V-point
	577	! Vectors: change of sign at north fold ONLY if on the local grid
	578	srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1.
	579	! Change first letter to couple with atmosphere if already coupled OPA
	580	! this is nedeed as each variable name used in the namcouple must be unique:
	581	! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere
	582	DO jn = 1, jprcv
	583	IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname))
	584	END DO
	585	!
	586	IF(lwp) THEN ! control print
	587	WRITE(numout,*)
	588	WRITE(numout,*)' Special conditions for SAS-OPA coupling '
	589	WRITE(numout,*)' SAS component '
	590	WRITE(numout,*)
	591	IF( .NOT. ln_cpl ) THEN
	592	WRITE(numout,*)' received fields from OPA component '
	593	ELSE
	594	WRITE(numout,*)' Additional received fields from OPA component : '
	595	ENDIF
	596	WRITE(numout,*)' sea surface temperature (Celcius) '
	597	WRITE(numout,*)' sea surface salinity '
	598	WRITE(numout,*)' surface currents '
	599	WRITE(numout,*)' sea surface height '
	600	WRITE(numout,*)' thickness of first ocean T level '
	601	WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level'
	602	WRITE(numout,*)
	603	ENDIF
	604	ENDIF
	605
	606	! =================================================== !
	607	! Allocate all parts of frcv used for received fields !
	608	! =================================================== !
[3294]	609	DO jn = 1, jprcv
	610	IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
	611	END DO
	612	! Allocate taum part of frcv which is used even when not received as coupling field
[4990]	613	IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
[5407]	614	! Allocate w10m part of frcv which is used even when not received as coupling field
	615	IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )
	616	! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field
	617	IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )
	618	IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )
[4162]	619	! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.
	620	IF( k_ice /= 0 ) THEN
[4990]	621	IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )
	622	IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
[4162]	623	END IF
[3294]	624
[1218]	625	! ================================ !
	626	! Define the send interface !
	627	! ================================ !
[3294]	628	! for each field: define the OASIS name (ssnd(:)%clname)
	629	! define send or not from the namelist parameters (ssnd(:)%laction)
	630	! define the north fold type of lbc (ssnd(:)%nsgn)
[1218]	631
	632	! default definitions of nsnd
[3294]	633	ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1
[1218]	634
	635	! ! ------------------------- !
	636	! ! Surface temperature !
	637	! ! ------------------------- !
	638	ssnd(jps_toce)%clname = 'O_SSTSST'
[6488]	639	ssnd(jps_tice)%clname = 'OTepIce'
[1218]	640	ssnd(jps_tmix)%clname = 'O_TepMix'
[3294]	641	SELECT CASE( TRIM( sn_snd_temp%cldes ) )
[5410]	642	CASE( 'none' ) ! nothing to do
	643	CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE.
[6488]	644	CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice')
[3294]	645	ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE.
	646	IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl
[5410]	647	CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE.
[3294]	648	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' )
[1218]	649	END SELECT
[5407]	650
[1218]	651	! ! ------------------------- !
	652	! ! Albedo !
	653	! ! ------------------------- !
	654	ssnd(jps_albice)%clname = 'O_AlbIce'
	655	ssnd(jps_albmix)%clname = 'O_AlbMix'
[3294]	656	SELECT CASE( TRIM( sn_snd_alb%cldes ) )
[5410]	657	CASE( 'none' ) ! nothing to do
	658	CASE( 'ice' , 'weighted ice' ) ; ssnd(jps_albice)%laction = .TRUE.
	659	CASE( 'mixed oce-ice' ) ; ssnd(jps_albmix)%laction = .TRUE.
[3294]	660	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' )
[1218]	661	END SELECT
[1232]	662	!
	663	! Need to calculate oceanic albedo if
	664	! 1. sending mixed oce-ice albedo or
	665	! 2. receiving mixed oce-ice solar radiation
[3294]	666	IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN
[1308]	667	CALL albedo_oce( zaos, zacs )
	668	! Due to lack of information on nebulosity : mean clear/overcast sky
	669	albedo_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5
[1232]	670	ENDIF
	671
[1218]	672	! ! ------------------------- !
[6488]	673	! ! Ice fraction & Thickness
[1218]	674	! ! ------------------------- !
[3294]	675	ssnd(jps_fice)%clname = 'OIceFrc'
	676	ssnd(jps_hice)%clname = 'OIceTck'
	677	ssnd(jps_hsnw)%clname = 'OSnwTck'
[6488]	678	ssnd(jps_a_p)%clname = 'OPndFrc'
	679	ssnd(jps_ht_p)%clname = 'OPndTck'
	680	ssnd(jps_fice1)%clname = 'OIceFrd'
[3294]	681	IF( k_ice /= 0 ) THEN
	682	ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case)
[6488]	683	ssnd(jps_fice1)%laction = .TRUE. ! First-order regridded ice concentration, to be used
	684	! in producing atmos-to-ice fluxes
[3294]	685	! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now
	686	IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl
[6488]	687	IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = jpl
[3294]	688	ENDIF
[5407]	689
[3294]	690	SELECT CASE ( TRIM( sn_snd_thick%cldes ) )
[3680]	691	CASE( 'none' ) ! nothing to do
	692	CASE( 'ice and snow' )
[3294]	693	ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
	694	IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
	695	ssnd(jps_hice:jps_hsnw)%nct = jpl
	696	ENDIF
	697	CASE ( 'weighted ice and snow' )
	698	ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
	699	IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = jpl
	700	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' )
	701	END SELECT
	702
[1218]	703	! ! ------------------------- !
[6488]	704	! ! Ice Meltponds !
	705	! ! ------------------------- !
	706	#if defined key_cice && ! defined key_cice4
	707	! Meltponds only CICE5
	708	ssnd(jps_a_p)%clname = 'OPndFrc'
	709	ssnd(jps_ht_p)%clname = 'OPndTck'
	710	SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) )
	711	CASE ( 'none' )
	712	ssnd(jps_a_p)%laction = .FALSE.
	713	ssnd(jps_ht_p)%laction = .FALSE.
	714	CASE ( 'ice only' )
	715	ssnd(jps_a_p)%laction = .TRUE.
	716	ssnd(jps_ht_p)%laction = .TRUE.
	717	IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN
	718	ssnd(jps_a_p)%nct = jpl
	719	ssnd(jps_ht_p)%nct = jpl
	720	ELSE
	721	IF ( jpl > 1 ) THEN
	722	CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' )
	723	ENDIF
	724	ENDIF
	725	CASE ( 'weighted ice' )
	726	ssnd(jps_a_p)%laction = .TRUE.
	727	ssnd(jps_ht_p)%laction = .TRUE.
	728	IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN
	729	ssnd(jps_a_p)%nct = jpl
	730	ssnd(jps_ht_p)%nct = jpl
	731	ENDIF
	732	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes' )
	733	END SELECT
	734	#else
	735	IF( TRIM( sn_snd_mpnd%cldes /= 'none' ) THEN
	736	CALL ctl_stop('Meltponds can only be used with CICEv5')
	737	ENDIF
	738	#endif
	739
	740	! ! ------------------------- !
[1218]	741	! ! Surface current !
	742	! ! ------------------------- !
	743	! ocean currents ! ice velocities
	744	ssnd(jps_ocx1)%clname = 'O_OCurx1' ; ssnd(jps_ivx1)%clname = 'O_IVelx1'
	745	ssnd(jps_ocy1)%clname = 'O_OCury1' ; ssnd(jps_ivy1)%clname = 'O_IVely1'
	746	ssnd(jps_ocz1)%clname = 'O_OCurz1' ; ssnd(jps_ivz1)%clname = 'O_IVelz1'
	747	!
[2090]	748	ssnd(jps_ocx1:jps_ivz1)%nsgn = -1. ! vectors: change of the sign at the north fold
[1218]	749
[3294]	750	IF( sn_snd_crt%clvgrd == 'U,V' ) THEN
	751	ssnd(jps_ocx1)%clgrid = 'U' ; ssnd(jps_ocy1)%clgrid = 'V'
	752	ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN
	753	CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' )
	754	ssnd(jps_ocx1:jps_ivz1)%clgrid = 'T' ! all oce and ice components on the same unique grid
	755	ENDIF
[1226]	756	ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE. ! default: all are send
[3294]	757	IF( TRIM( sn_snd_crt%clvref ) == 'spherical' ) ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE.
	758	IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) ssnd(jps_ocx1:jps_ivz1)%nsgn = 1.
	759	SELECT CASE( TRIM( sn_snd_crt%cldes ) )
[1226]	760	CASE( 'none' ) ; ssnd(jps_ocx1:jps_ivz1)%laction = .FALSE.
	761	CASE( 'oce only' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
[1218]	762	CASE( 'weighted oce and ice' ) ! nothing to do
[1226]	763	CASE( 'mixed oce-ice' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
[3294]	764	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crt%cldes' )
[1218]	765	END SELECT
	766
[1534]	767	! ! ------------------------- !
	768	! ! CO2 flux !
	769	! ! ------------------------- !
[3294]	770	ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE.
[6488]	771	!
	772
	773	! ! ------------------------- !
	774	! ! Sea surface freezing temp !
	775	! ! ------------------------- !
	776	ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' ) ssnd(jps_sstfrz)%laction = .TRUE.
	777	!
	778	! ! ------------------------- !
	779	! ! Ice conductivity !
	780	! ! ------------------------- !
	781	! Note that ultimately we will move to passing an ocean effective conductivity as well so there
	782	! will be some changes to the parts of the code which currently relate only to ice conductivity
	783	ssnd(jps_kice )%clname = 'OIceKn'
	784	SELECT CASE ( TRIM( sn_snd_cond%cldes ) )
	785	CASE ( 'none' )
	786	ssnd(jps_kice)%laction = .FALSE.
	787	CASE ( 'ice only' )
	788	ssnd(jps_kice)%laction = .TRUE.
	789	IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN
	790	ssnd(jps_kice)%nct = jpl
	791	ELSE
	792	IF ( jpl > 1 ) THEN
	793	CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' )
	794	ENDIF
	795	ENDIF
	796	CASE ( 'weighted ice' )
	797	ssnd(jps_kice)%laction = .TRUE.
	798	IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = jpl
	799	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes' )
	800	END SELECT
	801	!
	802
[5407]	803
	804	! ! ------------------------------- !
	805	! ! OPA-SAS coupling - snd by opa !
	806	! ! ------------------------------- !
	807	ssnd(jps_ssh )%clname = 'O_SSHght'
	808	ssnd(jps_soce )%clname = 'O_SSSal'
	809	ssnd(jps_e3t1st)%clname = 'O_E3T1st'
	810	ssnd(jps_fraqsr)%clname = 'O_FraQsr'
[1534]	811	!
[5407]	812	IF( nn_components == jp_iam_opa ) THEN
	813	ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
	814	ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE.
	815	ssnd( jps_e3t1st )%laction = lk_vvl
	816	! vector definition: not used but cleaner...
	817	ssnd(jps_ocx1)%clgrid = 'U' ! oce components given at U-point
	818	ssnd(jps_ocy1)%clgrid = 'V' ! and V-point
	819	sn_snd_crt%clvgrd = 'U,V'
	820	sn_snd_crt%clvor = 'local grid'
	821	sn_snd_crt%clvref = 'spherical'
	822	!
	823	IF(lwp) THEN ! control print
	824	WRITE(numout,*)
	825	WRITE(numout,*)' sent fields to SAS component '
	826	WRITE(numout,*)' sea surface temperature (T before, Celcius) '
	827	WRITE(numout,*)' sea surface salinity '
	828	WRITE(numout,*)' surface currents U,V on local grid and spherical coordinates'
	829	WRITE(numout,*)' sea surface height '
	830	WRITE(numout,*)' thickness of first ocean T level '
	831	WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level'
	832	WRITE(numout,*)
	833	ENDIF
	834	ENDIF
	835	! ! ------------------------------- !
	836	! ! OPA-SAS coupling - snd by sas !
	837	! ! ------------------------------- !
	838	ssnd(jps_sflx )%clname = 'I_SFLX'
	839	ssnd(jps_fice2 )%clname = 'IIceFrc'
	840	ssnd(jps_qsroce)%clname = 'I_QsrOce'
	841	ssnd(jps_qnsoce)%clname = 'I_QnsOce'
	842	ssnd(jps_oemp )%clname = 'IOEvaMPr'
	843	ssnd(jps_otx1 )%clname = 'I_OTaux1'
	844	ssnd(jps_oty1 )%clname = 'I_OTauy1'
	845	ssnd(jps_rnf )%clname = 'I_Runoff'
	846	ssnd(jps_taum )%clname = 'I_TauMod'
	847	!
	848	IF( nn_components == jp_iam_sas ) THEN
	849	IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
	850	ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE.
	851	!
	852	! Change first letter to couple with atmosphere if already coupled with sea_ice
	853	! this is nedeed as each variable name used in the namcouple must be unique:
	854	! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere
	855	DO jn = 1, jpsnd
	856	IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname))
	857	END DO
	858	!
	859	IF(lwp) THEN ! control print
	860	WRITE(numout,*)
	861	IF( .NOT. ln_cpl ) THEN
	862	WRITE(numout,*)' sent fields to OPA component '
	863	ELSE
	864	WRITE(numout,*)' Additional sent fields to OPA component : '
	865	ENDIF
	866	WRITE(numout,*)' ice cover '
	867	WRITE(numout,*)' oce only EMP '
	868	WRITE(numout,*)' salt flux '
	869	WRITE(numout,*)' mixed oce-ice solar flux '
	870	WRITE(numout,*)' mixed oce-ice non solar flux '
	871	WRITE(numout,*)' wind stress U,V components'
	872	WRITE(numout,*)' wind stress module'
	873	ENDIF
	874	ENDIF
	875
	876	!
[1218]	877	! ================================ !
	878	! initialisation of the coupler !
	879	! ================================ !
[1226]	880
[5407]	881	CALL cpl_define(jprcv, jpsnd, nn_cplmodel)
	882
[4990]	883	IF (ln_usecplmask) THEN
	884	xcplmask(:,:,:) = 0.
	885	CALL iom_open( 'cplmask', inum )
	886	CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel), &
	887	& kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) )
	888	CALL iom_close( inum )
	889	ELSE
	890	xcplmask(:,:,:) = 1.
	891	ENDIF
[5407]	892	xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 )
[1218]	893	!
[5486]	894	ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' )
[5407]	895	IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 ) &
[2528]	896	& CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
[5407]	897	ncpl_qsr_freq = 86400 / ncpl_qsr_freq
[2528]	898
[6488]	899	IF( ln_coupled_iceshelf_fluxes ) THEN
	900	! Crude masks to separate the Antarctic and Greenland icesheets. Obviously something
	901	! more complicated could be done if required.
	902	greenland_icesheet_mask = 0.0
	903	WHERE( gphit >= 0.0 ) greenland_icesheet_mask = 1.0
	904	antarctica_icesheet_mask = 0.0
	905	WHERE( gphit < 0.0 ) antarctica_icesheet_mask = 1.0
	906
	907	! initialise other variables
	908	greenland_icesheet_mass_array(:,:) = 0.0
	909	antarctica_icesheet_mass_array(:,:) = 0.0
	910
	911	IF( .not. ln_rstart ) THEN
	912	greenland_icesheet_mass = 0.0
	913	greenland_icesheet_mass_rate_of_change = 0.0
	914	greenland_icesheet_timelapsed = 0.0
	915	antarctica_icesheet_mass = 0.0
	916	antarctica_icesheet_mass_rate_of_change = 0.0
	917	antarctica_icesheet_timelapsed = 0.0
	918	ENDIF
	919
	920	ENDIF
	921
[3294]	922	CALL wrk_dealloc( jpi,jpj, zacs, zaos )
[2715]	923	!
[3294]	924	IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_init')
	925	!
[1218]	926	END SUBROUTINE sbc_cpl_init
	927
	928
	929	SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )
	930	!!----------------------------------------------------------------------
	931	!! * ROUTINE sbc_cpl_rcv *
[888]	932	!!
[1218]	933	!! ** Purpose : provide the stress over the ocean and, if no sea-ice,
	934	!! provide the ocean heat and freshwater fluxes.
[888]	935	!!
[1218]	936	!! ** Method : - Receive all the atmospheric fields (stored in frcv array). called at each time step.
	937	!! OASIS controls if there is something do receive or not. nrcvinfo contains the info
	938	!! to know if the field was really received or not
[888]	939	!!
[1218]	940	!! --> If ocean stress was really received:
[888]	941	!!
[1218]	942	!! - transform the received ocean stress vector from the received
	943	!! referential and grid into an atmosphere-ocean stress in
	944	!! the (i,j) ocean referencial and at the ocean velocity point.
	945	!! The received stress are :
	946	!! - defined by 3 components (if cartesian coordinate)
	947	!! or by 2 components (if spherical)
	948	!! - oriented along geographical coordinate (if eastward-northward)
	949	!! or along the local grid coordinate (if local grid)
	950	!! - given at U- and V-point, resp. if received on 2 grids
	951	!! or at T-point if received on 1 grid
	952	!! Therefore and if necessary, they are successively
	953	!! processed in order to obtain them
	954	!! first as 2 components on the sphere
	955	!! second as 2 components oriented along the local grid
	956	!! third as 2 components on the U,V grid
[888]	957	!!
[1218]	958	!! -->
[888]	959	!!
[1218]	960	!! - In 'ocean only' case, non solar and solar ocean heat fluxes
	961	!! and total ocean freshwater fluxes
	962	!!
	963	!! ** Method : receive all fields from the atmosphere and transform
	964	!! them into ocean surface boundary condition fields
	965	!!
	966	!! ** Action : update utau, vtau ocean stress at U,V grid
[4990]	967	!! taum wind stress module at T-point
	968	!! wndm wind speed module at T-point over free ocean or leads in presence of sea-ice
[3625]	969	!! qns non solar heat fluxes including emp heat content (ocean only case)
	970	!! and the latent heat flux of solid precip. melting
	971	!! qsr solar ocean heat fluxes (ocean only case)
	972	!! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case)
[888]	973	!!----------------------------------------------------------------------
[5407]	974	INTEGER, INTENT(in) :: kt ! ocean model time step index
	975	INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation
	976	INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)
	977
[888]	978	!!
[5407]	979	LOGICAL :: llnewtx, llnewtau ! update wind stress components and module??
[6488]	980	INTEGER :: ji, jj, jl, jn ! dummy loop indices
[1218]	981	INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000)
	982	REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars
[6488]	983	REAL(wp) :: zgreenland_icesheet_mass_in, zantarctica_icesheet_mass_in
	984	REAL(wp) :: zgreenland_icesheet_mass_b, zantarctica_icesheet_mass_b
	985	REAL(wp) :: zmask_sum, zepsilon
[1226]	986	REAL(wp) :: zcoef ! temporary scalar
[1695]	987	REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3
	988	REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient
	989	REAL(wp) :: zzx, zzy ! temporary variables
[5407]	990	REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr
[1218]	991	!!----------------------------------------------------------------------
[3294]	992	!
	993	IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv')
	994	!
[5407]	995	CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )
	996	!
	997	IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0)
	998	!
	999	! ! ======================================================= !
	1000	! ! Receive all the atmos. fields (including ice information)
	1001	! ! ======================================================= !
	1002	isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges
	1003	DO jn = 1, jprcv ! received fields sent by the atmosphere
	1004	IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )
[1218]	1005	END DO
[888]	1006
[1218]	1007	! ! ========================= !
[1696]	1008	IF( srcv(jpr_otx1)%laction ) THEN ! ocean stress components !
[1218]	1009	! ! ========================= !
[3294]	1010	! define frcv(jpr_otx1)%z3(:,:,1) and frcv(jpr_oty1)%z3(:,:,1): stress at U/V point along model grid
[1218]	1011	! => need to be done only when we receive the field
[1698]	1012	IF( nrcvinfo(jpr_otx1) == OASIS_Rcv ) THEN
[1218]	1013	!
[3294]	1014	IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere
[1218]	1015	! ! (cartesian to spherical -> 3 to 2 components)
	1016	!
[3294]	1017	CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1), &
[1218]	1018	& srcv(jpr_otx1)%clgrid, ztx, zty )
[3294]	1019	frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid
	1020	frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid
[1218]	1021	!
	1022	IF( srcv(jpr_otx2)%laction ) THEN
[3294]	1023	CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1), &
[1218]	1024	& srcv(jpr_otx2)%clgrid, ztx, zty )
[3294]	1025	frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid
	1026	frcv(jpr_oty2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid
[1218]	1027	ENDIF
	1028	!
	1029	ENDIF
	1030	!
[3294]	1031	IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid
[1218]	1032	! ! (geographical to local grid -> rotate the components)
[3294]	1033	CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )
[1218]	1034	IF( srcv(jpr_otx2)%laction ) THEN
[3294]	1035	CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )
	1036	ELSE
	1037	CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )
[1218]	1038	ENDIF
[3632]	1039	frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid
[3294]	1040	frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid
[1218]	1041	ENDIF
	1042	!
	1043	IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN
	1044	DO jj = 2, jpjm1 ! T ==> (U,V)
	1045	DO ji = fs_2, fs_jpim1 ! vector opt.
[3294]	1046	frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) )
	1047	frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) )
[1218]	1048	END DO
	1049	END DO
[3294]	1050	CALL lbc_lnk( frcv(jpr_otx1)%z3(:,:,1), 'U', -1. ) ; CALL lbc_lnk( frcv(jpr_oty1)%z3(:,:,1), 'V', -1. )
[1218]	1051	ENDIF
[1696]	1052	llnewtx = .TRUE.
	1053	ELSE
	1054	llnewtx = .FALSE.
[1218]	1055	ENDIF
	1056	! ! ========================= !
	1057	ELSE ! No dynamical coupling !
	1058	! ! ========================= !
[3294]	1059	frcv(jpr_otx1)%z3(:,:,1) = 0.e0 ! here simply set to zero
	1060	frcv(jpr_oty1)%z3(:,:,1) = 0.e0 ! an external read in a file can be added instead
[1696]	1061	llnewtx = .TRUE.
[1218]	1062	!
	1063	ENDIF
[1696]	1064	! ! ========================= !
	1065	! ! wind stress module ! (taum)
	1066	! ! ========================= !
	1067	!
	1068	IF( .NOT. srcv(jpr_taum)%laction ) THEN ! compute wind stress module from its components if not received
	1069	! => need to be done only when otx1 was changed
	1070	IF( llnewtx ) THEN
[1695]	1071	!CDIR NOVERRCHK
[1696]	1072	DO jj = 2, jpjm1
[1695]	1073	!CDIR NOVERRCHK
[1696]	1074	DO ji = fs_2, fs_jpim1 ! vect. opt.
[3294]	1075	zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
	1076	zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)
	1077	frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
[1696]	1078	END DO
[1695]	1079	END DO
[3294]	1080	CALL lbc_lnk( frcv(jpr_taum)%z3(:,:,1), 'T', 1. )
[1696]	1081	llnewtau = .TRUE.
	1082	ELSE
	1083	llnewtau = .FALSE.
	1084	ENDIF
	1085	ELSE
[1706]	1086	llnewtau = nrcvinfo(jpr_taum) == OASIS_Rcv
[1726]	1087	! Stress module can be negative when received (interpolation problem)
	1088	IF( llnewtau ) THEN
[3625]	1089	frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) )
[1726]	1090	ENDIF
[1696]	1091	ENDIF
[5407]	1092	!
[1696]	1093	! ! ========================= !
	1094	! ! 10 m wind speed ! (wndm)
	1095	! ! ========================= !
	1096	!
	1097	IF( .NOT. srcv(jpr_w10m)%laction ) THEN ! compute wind spreed from wind stress module if not received
	1098	! => need to be done only when taumod was changed
	1099	IF( llnewtau ) THEN
[1695]	1100	zcoef = 1. / ( zrhoa * zcdrag )
[1697]	1101	!CDIR NOVERRCHK
[1695]	1102	DO jj = 1, jpj
[1697]	1103	!CDIR NOVERRCHK
[1695]	1104	DO ji = 1, jpi
[5407]	1105	frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
[1695]	1106	END DO
	1107	END DO
	1108	ENDIF
[1696]	1109	ENDIF
	1110
[3294]	1111	! u(v)tau and taum will be modified by ice model
[1696]	1112	! -> need to be reset before each call of the ice/fsbc
	1113	IF( MOD( kt-1, k_fsbc ) == 0 ) THEN
	1114	!
[5407]	1115	IF( ln_mixcpl ) THEN
	1116	utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:)
	1117	vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:)
	1118	taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:)
	1119	wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:)
	1120	ELSE
	1121	utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)
	1122	vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)
	1123	taum(:,:) = frcv(jpr_taum)%z3(:,:,1)
	1124	wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)
	1125	ENDIF
[1705]	1126	CALL iom_put( "taum_oce", taum ) ! output wind stress module
[1695]	1127	!
[1218]	1128	ENDIF
[3294]	1129
	1130	#if defined key_cpl_carbon_cycle
[5407]	1131	! ! ================== !
	1132	! ! atmosph. CO2 (ppm) !
	1133	! ! ================== !
[3294]	1134	IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1)
	1135	#endif
	1136
[6488]	1137	#if defined key_cice && ! defined key_cice4
	1138	! ! Sea ice surface skin temp:
	1139	IF( srcv(jpr_ts_ice)%laction ) THEN
	1140	DO jl = 1, jpl
	1141	DO jj = 1, jpj
	1142	DO ji = 1, jpi
	1143	IF (frcv(jpr_ts_ice)%z3(ji,jj,jl) > 0.0) THEN
	1144	tsfc_ice(ji,jj,jl) = 0.0
	1145	ELSE IF (frcv(jpr_ts_ice)%z3(ji,jj,jl) < -60.0) THEN
	1146	tsfc_ice(ji,jj,jl) = -60.0
	1147	ELSE
	1148	tsfc_ice(ji,jj,jl) = frcv(jpr_ts_ice)%z3(ji,jj,jl)
	1149	ENDIF
	1150	END DO
	1151	END DO
	1152	END DO
	1153	ENDIF
	1154	#endif
	1155
[5407]	1156	! Fields received by SAS when OASIS coupling
	1157	! (arrays no more filled at sbcssm stage)
	1158	! ! ================== !
	1159	! ! SSS !
	1160	! ! ================== !
	1161	IF( srcv(jpr_soce)%laction ) THEN ! received by sas in case of opa <-> sas coupling
	1162	sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1)
	1163	CALL iom_put( 'sss_m', sss_m )
	1164	ENDIF
	1165	!
	1166	! ! ================== !
	1167	! ! SST !
	1168	! ! ================== !
	1169	IF( srcv(jpr_toce)%laction ) THEN ! received by sas in case of opa <-> sas coupling
	1170	sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1)
	1171	IF( srcv(jpr_soce)%laction .AND. ln_useCT ) THEN ! make sure that sst_m is the potential temperature
	1172	sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) )
	1173	ENDIF
	1174	ENDIF
	1175	! ! ================== !
	1176	! ! SSH !
	1177	! ! ================== !
	1178	IF( srcv(jpr_ssh )%laction ) THEN ! received by sas in case of opa <-> sas coupling
	1179	ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1)
	1180	CALL iom_put( 'ssh_m', ssh_m )
	1181	ENDIF
	1182	! ! ================== !
	1183	! ! surface currents !
	1184	! ! ================== !
	1185	IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling
	1186	ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1)
	1187	ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau
[6487]	1188	un (:,:,1) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling
[5407]	1189	CALL iom_put( 'ssu_m', ssu_m )
	1190	ENDIF
	1191	IF( srcv(jpr_ocy1)%laction ) THEN
	1192	ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
	1193	vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau
[6487]	1194	vn (:,:,1) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling
[5407]	1195	CALL iom_put( 'ssv_m', ssv_m )
	1196	ENDIF
	1197	! ! ======================== !
	1198	! ! first T level thickness !
	1199	! ! ======================== !
	1200	IF( srcv(jpr_e3t1st )%laction ) THEN ! received by sas in case of opa <-> sas coupling
	1201	e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1)
	1202	CALL iom_put( 'e3t_m', e3t_m(:,:) )
	1203	ENDIF
	1204	! ! ================================ !
	1205	! ! fraction of solar net radiation !
	1206	! ! ================================ !
	1207	IF( srcv(jpr_fraqsr)%laction ) THEN ! received by sas in case of opa <-> sas coupling
	1208	frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1)
	1209	CALL iom_put( 'frq_m', frq_m )
	1210	ENDIF
	1211
[1218]	1212	! ! ========================= !
[5407]	1213	IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN ! heat & freshwater fluxes ! (Ocean only case)
[1218]	1214	! ! ========================= !
	1215	!
[3625]	1216	! ! total freshwater fluxes over the ocean (emp)
[5407]	1217	IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN
	1218	SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation
	1219	CASE( 'conservative' )
	1220	zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
	1221	CASE( 'oce only', 'oce and ice' )
	1222	zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
	1223	CASE default
	1224	CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
	1225	END SELECT
	1226	ELSE
	1227	zemp(:,:) = 0._wp
	1228	ENDIF
[1218]	1229	!
	1230	! ! runoffs and calving (added in emp)
[5407]	1231	IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
	1232	IF( srcv(jpr_cal)%laction ) zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1)
	1233
	1234	IF( ln_mixcpl ) THEN ; emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
	1235	ELSE ; emp(:,:) = zemp(:,:)
	1236	ENDIF
[1218]	1237	!
[3625]	1238	! ! non solar heat flux over the ocean (qns)
[5407]	1239	IF( srcv(jpr_qnsoce)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
	1240	ELSE IF( srcv(jpr_qnsmix)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
	1241	ELSE ; zqns(:,:) = 0._wp
	1242	END IF
[4990]	1243	! update qns over the free ocean with:
[5407]	1244	IF( nn_components /= jp_iam_opa ) THEN
	1245	zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST)
	1246	IF( srcv(jpr_snow )%laction ) THEN
	1247	zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean
	1248	ENDIF
[3625]	1249	ENDIF
[5407]	1250	IF( ln_mixcpl ) THEN ; qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:)
	1251	ELSE ; qns(:,:) = zqns(:,:)
	1252	ENDIF
[3625]	1253
	1254	! ! solar flux over the ocean (qsr)
[5407]	1255	IF ( srcv(jpr_qsroce)%laction ) THEN ; zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
	1256	ELSE IF( srcv(jpr_qsrmix)%laction ) then ; zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
	1257	ELSE ; zqsr(:,:) = 0._wp
	1258	ENDIF
	1259	IF( ln_dm2dc .AND. ln_cpl ) zqsr(:,:) = sbc_dcy( zqsr ) ! modify qsr to include the diurnal cycle
	1260	IF( ln_mixcpl ) THEN ; qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:)
	1261	ELSE ; qsr(:,:) = zqsr(:,:)
	1262	ENDIF
[3625]	1263	!
[5407]	1264	! salt flux over the ocean (received by opa in case of opa <-> sas coupling)
	1265	IF( srcv(jpr_sflx )%laction ) sfx(:,:) = frcv(jpr_sflx )%z3(:,:,1)
	1266	! Ice cover (received by opa in case of opa <-> sas coupling)
	1267	IF( srcv(jpr_fice )%laction ) fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1)
	1268	!
	1269
[1218]	1270	ENDIF
[6488]	1271
	1272	! ! land ice masses : Greenland
	1273	zepsilon = rn_iceshelf_fluxes_tolerance
	1274
	1275	IF( srcv(jpr_grnm)%laction ) THEN
	1276	greenland_icesheet_mass_array(:,:) = frcv(jpr_grnm)%z3(:,:,1)
	1277	! take average over ocean points of input array to avoid cumulative error over time
	1278	zgreenland_icesheet_mass_in = SUM( greenland_icesheet_mass_array(:,:) * tmask(:,:,1) )
	1279	IF(lk_mpp) CALL mpp_sum( zgreenland_icesheet_mass_in )
	1280	zmask_sum = SUM( tmask(:,:,1) )
	1281	IF(lk_mpp) CALL mpp_sum( zmask_sum )
	1282	zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum
	1283	greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt
	1284	IF( ABS( zgreenland_icesheet_mass_in - greenland_icesheet_mass ) > zepsilon ) THEN
	1285	zgreenland_icesheet_mass_b = greenland_icesheet_mass
	1286
	1287	! Only update the mass if it has increased
	1288	IF ( (zgreenland_icesheet_mass_in - greenland_icesheet_mass) > 0.0 ) THEN
	1289	greenland_icesheet_mass = zgreenland_icesheet_mass_in
	1290	ENDIF
	1291
	1292	IF( zgreenland_icesheet_mass_b /= 0.0 ) &
	1293	& greenland_icesheet_mass_rate_of_change = ( greenland_icesheet_mass - zgreenland_icesheet_mass_b ) / greenland_icesheet_timelapsed
	1294	greenland_icesheet_timelapsed = 0.0_wp
	1295	ENDIF
	1296	IF(lwp) WRITE(numout,*) 'Greenland icesheet mass (kg) read in is ', zgreenland_icesheet_mass_in
	1297	IF(lwp) WRITE(numout,*) 'Greenland icesheet mass (kg) used is ', greenland_icesheet_mass
	1298	IF(lwp) WRITE(numout,*) 'Greenland icesheet mass rate of change (kg/s) is ', greenland_icesheet_mass_rate_of_change
	1299	IF(lwp) WRITE(numout,*) 'Greenland icesheet seconds lapsed since last change is ', greenland_icesheet_timelapsed
	1300	ENDIF
	1301
	1302	! ! land ice masses : Antarctica
	1303	IF( srcv(jpr_antm)%laction ) THEN
	1304	antarctica_icesheet_mass_array(:,:) = frcv(jpr_antm)%z3(:,:,1)
	1305	! take average over ocean points of input array to avoid cumulative error from rounding errors over time
	1306	zantarctica_icesheet_mass_in = SUM( antarctica_icesheet_mass_array(:,:) * tmask(:,:,1) )
	1307	IF(lk_mpp) CALL mpp_sum( zantarctica_icesheet_mass_in )
	1308	zmask_sum = SUM( tmask(:,:,1) )
	1309	IF(lk_mpp) CALL mpp_sum( zmask_sum )
	1310	zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum
	1311	antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt
	1312	IF( ABS( zantarctica_icesheet_mass_in - antarctica_icesheet_mass ) > zepsilon ) THEN
	1313	zantarctica_icesheet_mass_b = antarctica_icesheet_mass
	1314
	1315	! Only update the mass if it has increased
	1316	IF ( (zantarctica_icesheet_mass_in - antarctica_icesheet_mass) > 0.0 ) THEN
	1317	antarctica_icesheet_mass = zantarctica_icesheet_mass_in
	1318	END IF
	1319
	1320	IF( zantarctica_icesheet_mass_b /= 0.0 ) &
	1321	& antarctica_icesheet_mass_rate_of_change = ( antarctica_icesheet_mass - zantarctica_icesheet_mass_b ) / antarctica_icesheet_timelapsed
	1322	antarctica_icesheet_timelapsed = 0.0_wp
	1323	ENDIF
	1324	IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass (kg) read in is ', zantarctica_icesheet_mass_in
	1325	IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass (kg) used is ', antarctica_icesheet_mass
	1326	IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass rate of change (kg/s) is ', antarctica_icesheet_mass_rate_of_change
	1327	IF(lwp) WRITE(numout,*) 'Antarctica icesheet seconds lapsed since last change is ', antarctica_icesheet_timelapsed
	1328	ENDIF
	1329
[1218]	1330	!
[5407]	1331	CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )
[2715]	1332	!
[3294]	1333	IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv')
	1334	!
[1218]	1335	END SUBROUTINE sbc_cpl_rcv
	1336
	1337
	1338	SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )
	1339	!!----------------------------------------------------------------------
	1340	!! * ROUTINE sbc_cpl_ice_tau *
	1341	!!
	1342	!! ** Purpose : provide the stress over sea-ice in coupled mode
	1343	!!
	1344	!! ** Method : transform the received stress from the atmosphere into
	1345	!! an atmosphere-ice stress in the (i,j) ocean referencial
[2528]	1346	!! and at the velocity point of the sea-ice model (cp_ice_msh):
[1218]	1347	!! 'C'-grid : i- (j-) components given at U- (V-) point
[2528]	1348	!! 'I'-grid : B-grid lower-left corner: both components given at I-point
[1218]	1349	!!
	1350	!! The received stress are :
	1351	!! - defined by 3 components (if cartesian coordinate)
	1352	!! or by 2 components (if spherical)
	1353	!! - oriented along geographical coordinate (if eastward-northward)
	1354	!! or along the local grid coordinate (if local grid)
	1355	!! - given at U- and V-point, resp. if received on 2 grids
	1356	!! or at a same point (T or I) if received on 1 grid
	1357	!! Therefore and if necessary, they are successively
	1358	!! processed in order to obtain them
	1359	!! first as 2 components on the sphere
	1360	!! second as 2 components oriented along the local grid
[2528]	1361	!! third as 2 components on the cp_ice_msh point
[1218]	1362	!!
[4148]	1363	!! Except in 'oce and ice' case, only one vector stress field
[1218]	1364	!! is received. It has already been processed in sbc_cpl_rcv
	1365	!! so that it is now defined as (i,j) components given at U-
[4148]	1366	!! and V-points, respectively. Therefore, only the third
[2528]	1367	!! transformation is done and only if the ice-grid is a 'I'-grid.
[1218]	1368	!!
[2528]	1369	!! ** Action : return ptau_i, ptau_j, the stress over the ice at cp_ice_msh point
[1218]	1370	!!----------------------------------------------------------------------
[2715]	1371	REAL(wp), INTENT(out), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2]
	1372	REAL(wp), INTENT(out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid)
	1373	!!
[1218]	1374	INTEGER :: ji, jj ! dummy loop indices
	1375	INTEGER :: itx ! index of taux over ice
[3294]	1376	REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty
[1218]	1377	!!----------------------------------------------------------------------
[3294]	1378	!
	1379	IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_tau')
	1380	!
	1381	CALL wrk_alloc( jpi,jpj, ztx, zty )
[1218]	1382
[4990]	1383	IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1
[1218]	1384	ELSE ; itx = jpr_otx1
	1385	ENDIF
	1386
	1387	! do something only if we just received the stress from atmosphere
[1698]	1388	IF( nrcvinfo(itx) == OASIS_Rcv ) THEN
[1218]	1389
[4990]	1390	! ! ======================= !
	1391	IF( srcv(jpr_itx1)%laction ) THEN ! ice stress received !
	1392	! ! ======================= !
[1218]	1393	!
[3294]	1394	IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere
[1218]	1395	! ! (cartesian to spherical -> 3 to 2 components)
[3294]	1396	CALL geo2oce( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1), &
[1218]	1397	& srcv(jpr_itx1)%clgrid, ztx, zty )
[3294]	1398	frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid
	1399	frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid
[1218]	1400	!
	1401	IF( srcv(jpr_itx2)%laction ) THEN
[3294]	1402	CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1), &
[1218]	1403	& srcv(jpr_itx2)%clgrid, ztx, zty )
[3294]	1404	frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid
	1405	frcv(jpr_ity2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid
[1218]	1406	ENDIF
	1407	!
[888]	1408	ENDIF
[1218]	1409	!
[3294]	1410	IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid
[1218]	1411	! ! (geographical to local grid -> rotate the components)
[3294]	1412	CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )
[1218]	1413	IF( srcv(jpr_itx2)%laction ) THEN
[3294]	1414	CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )
[1218]	1415	ELSE
[3294]	1416	CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty )
[1218]	1417	ENDIF
[3632]	1418	frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid
[3294]	1419	frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid
[1218]	1420	ENDIF
	1421	! ! ======================= !
	1422	ELSE ! use ocean stress !
	1423	! ! ======================= !
[3294]	1424	frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1)
	1425	frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1)
[1218]	1426	!
	1427	ENDIF
	1428	! ! ======================= !
	1429	! ! put on ice grid !
	1430	! ! ======================= !
	1431	!
	1432	! j+1 j -----V---F
[2528]	1433	! ice stress on ice velocity point (cp_ice_msh) ! \|
[1467]	1434	! (C-grid ==>(U,V) or B-grid ==> I or F) j \| T U
[1218]	1435	! \| \|
	1436	! j j-1 -I-------\|
	1437	! (for I) \| \|
	1438	! i-1 i i
	1439	! i i+1 (for I)
[2528]	1440	SELECT CASE ( cp_ice_msh )
[1218]	1441	!
[1467]	1442	CASE( 'I' ) ! B-grid ==> I
[1218]	1443	SELECT CASE ( srcv(jpr_itx1)%clgrid )
	1444	CASE( 'U' )
	1445	DO jj = 2, jpjm1 ! (U,V) ==> I
[1694]	1446	DO ji = 2, jpim1 ! NO vector opt.
[3294]	1447	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji-1,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )
	1448	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )
[1218]	1449	END DO
	1450	END DO
	1451	CASE( 'F' )
	1452	DO jj = 2, jpjm1 ! F ==> I
[1694]	1453	DO ji = 2, jpim1 ! NO vector opt.
[3294]	1454	p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji-1,jj-1,1)
	1455	p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji-1,jj-1,1)
[1218]	1456	END DO
	1457	END DO
	1458	CASE( 'T' )
	1459	DO jj = 2, jpjm1 ! T ==> I
[1694]	1460	DO ji = 2, jpim1 ! NO vector opt.
[3294]	1461	p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj ,1) &
	1462	& + frcv(jpr_itx1)%z3(ji,jj-1,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )
	1463	p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) &
	1464	& + frcv(jpr_oty1)%z3(ji,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )
[1218]	1465	END DO
	1466	END DO
	1467	CASE( 'I' )
[3294]	1468	p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! I ==> I
	1469	p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
[1218]	1470	END SELECT
	1471	IF( srcv(jpr_itx1)%clgrid /= 'I' ) THEN
	1472	CALL lbc_lnk( p_taui, 'I', -1. ) ; CALL lbc_lnk( p_tauj, 'I', -1. )
	1473	ENDIF
	1474	!
[1467]	1475	CASE( 'F' ) ! B-grid ==> F
	1476	SELECT CASE ( srcv(jpr_itx1)%clgrid )
	1477	CASE( 'U' )
	1478	DO jj = 2, jpjm1 ! (U,V) ==> F
	1479	DO ji = fs_2, fs_jpim1 ! vector opt.
[3294]	1480	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj+1,1) )
	1481	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) )
[1467]	1482	END DO
	1483	END DO
	1484	CASE( 'I' )
	1485	DO jj = 2, jpjm1 ! I ==> F
[1694]	1486	DO ji = 2, jpim1 ! NO vector opt.
[3294]	1487	p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji+1,jj+1,1)
	1488	p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji+1,jj+1,1)
[1467]	1489	END DO
	1490	END DO
	1491	CASE( 'T' )
	1492	DO jj = 2, jpjm1 ! T ==> F
[1694]	1493	DO ji = 2, jpim1 ! NO vector opt.
[3294]	1494	p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) &
	1495	& + frcv(jpr_itx1)%z3(ji,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj+1,1) )
	1496	p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) &
	1497	& + frcv(jpr_ity1)%z3(ji,jj+1,1) + frcv(jpr_ity1)%z3(ji+1,jj+1,1) )
[1467]	1498	END DO
	1499	END DO
	1500	CASE( 'F' )
[3294]	1501	p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! F ==> F
	1502	p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
[1467]	1503	END SELECT
	1504	IF( srcv(jpr_itx1)%clgrid /= 'F' ) THEN
	1505	CALL lbc_lnk( p_taui, 'F', -1. ) ; CALL lbc_lnk( p_tauj, 'F', -1. )
	1506	ENDIF
	1507	!
[1218]	1508	CASE( 'C' ) ! C-grid ==> U,V
	1509	SELECT CASE ( srcv(jpr_itx1)%clgrid )
	1510	CASE( 'U' )
[3294]	1511	p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! (U,V) ==> (U,V)
	1512	p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
[1218]	1513	CASE( 'F' )
	1514	DO jj = 2, jpjm1 ! F ==> (U,V)
	1515	DO ji = fs_2, fs_jpim1 ! vector opt.
[3294]	1516	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj-1,1) )
	1517	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(jj,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) )
[1218]	1518	END DO
	1519	END DO
	1520	CASE( 'T' )
	1521	DO jj = 2, jpjm1 ! T ==> (U,V)
	1522	DO ji = fs_2, fs_jpim1 ! vector opt.
[3294]	1523	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
	1524	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
[1218]	1525	END DO
	1526	END DO
	1527	CASE( 'I' )
	1528	DO jj = 2, jpjm1 ! I ==> (U,V)
[1694]	1529	DO ji = 2, jpim1 ! NO vector opt.
[3294]	1530	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) )
	1531	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji ,jj+1,1) )
[1218]	1532	END DO
	1533	END DO
	1534	END SELECT
	1535	IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN
	1536	CALL lbc_lnk( p_taui, 'U', -1. ) ; CALL lbc_lnk( p_tauj, 'V', -1. )
	1537	ENDIF
	1538	END SELECT
	1539
	1540	ENDIF
	1541	!
[3294]	1542	CALL wrk_dealloc( jpi,jpj, ztx, zty )
[2715]	1543	!
[3294]	1544	IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_tau')
	1545	!
[1218]	1546	END SUBROUTINE sbc_cpl_ice_tau
	1547
	1548
[5407]	1549	SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist )
[1218]	1550	!!----------------------------------------------------------------------
[3294]	1551	!! * ROUTINE sbc_cpl_ice_flx *
[1218]	1552	!!
	1553	!! ** Purpose : provide the heat and freshwater fluxes of the
	1554	!! ocean-ice system.
	1555	!!
	1556	!! ** Method : transform the fields received from the atmosphere into
	1557	!! surface heat and fresh water boundary condition for the
	1558	!! ice-ocean system. The following fields are provided:
	1559	!! * total non solar, solar and freshwater fluxes (qns_tot,
	1560	!! qsr_tot and emp_tot) (total means weighted ice-ocean flux)
	1561	!! NB: emp_tot include runoffs and calving.
	1562	!! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where
	1563	!! emp_ice = sublimation - solid precipitation as liquid
	1564	!! precipitation are re-routed directly to the ocean and
	1565	!! runoffs and calving directly enter the ocean.
	1566	!! * solid precipitation (sprecip), used to add to qns_tot
	1567	!! the heat lost associated to melting solid precipitation
	1568	!! over the ocean fraction.
	1569	!! ===>> CAUTION here this changes the net heat flux received from
	1570	!! the atmosphere
	1571	!!
	1572	!! - the fluxes have been separated from the stress as
	1573	!! (a) they are updated at each ice time step compare to
	1574	!! an update at each coupled time step for the stress, and
	1575	!! (b) the conservative computation of the fluxes over the
	1576	!! sea-ice area requires the knowledge of the ice fraction
	1577	!! after the ice advection and before the ice thermodynamics,
	1578	!! so that the stress is updated before the ice dynamics
	1579	!! while the fluxes are updated after it.
	1580	!!
	1581	!! ** Action : update at each nf_ice time step:
[3294]	1582	!! qns_tot, qsr_tot non-solar and solar total heat fluxes
	1583	!! qns_ice, qsr_ice non-solar and solar heat fluxes over the ice
	1584	!! emp_tot total evaporation - precipitation(liquid and solid) (-runoff)(-calving)
	1585	!! emp_ice ice sublimation - solid precipitation over the ice
	1586	!! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice
[1226]	1587	!! sprecip solid precipitation over the ocean
[1218]	1588	!!----------------------------------------------------------------------
[3294]	1589	REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1]
[1468]	1590	! optional arguments, used only in 'mixed oce-ice' case
[5407]	1591	REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo
	1592	REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius]
	1593	REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin]
[3294]	1594	!
[5407]	1595	INTEGER :: jl ! dummy loop index
[6498]	1596	REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk, zsnw
	1597	REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice
	1598	REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice
	1599	REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice
[1218]	1600	!!----------------------------------------------------------------------
[3294]	1601	!
	1602	IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx')
	1603	!
[6498]	1604	CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw )
	1605	CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice )
	1606	CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )
	1607	CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )
[2715]	1608
[5407]	1609	IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0)
[3294]	1610	zicefr(:,:) = 1.- p_frld(:,:)
[3625]	1611	zcptn(:,:) = rcp * sst_m(:,:)
[888]	1612	!
[1218]	1613	! ! ========================= !
	1614	! ! freshwater budget ! (emp)
	1615	! ! ========================= !
[888]	1616	!
[5407]	1617	! ! total Precipitation - total Evaporation (emp_tot)
	1618	! ! solid precipitation - sublimation (emp_ice)
	1619	! ! solid Precipitation (sprecip)
	1620	! ! liquid + solid Precipitation (tprecip)
[3294]	1621	SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
[1218]	1622	CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
[5407]	1623	zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here
	1624	ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here
[6488]	1625	zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)
	1626	#if defined key_cice
	1627	IF ( TRIM(sn_rcv_emp%clcat) == 'yes' ) THEN
	1628	! zemp_ice is the sum of frcv(jpr_ievp)%z3(:,:,1) over all layers - snow
	1629	zemp_ice(:,:) = - frcv(jpr_snow)%z3(:,:,1)
	1630	DO jl=1,jpl
	1631	zemp_ice(:,: ) = zemp_ice(:,:) + frcv(jpr_ievp)%z3(:,:,jl)
	1632	ENDDO
	1633	! latent heat coupled for each category in CICE
	1634	qla_ice(:,:,1:jpl) = - frcv(jpr_ievp)%z3(:,:,1:jpl) * lsub
	1635	ELSE
	1636	! If CICE has multicategories it still expects coupling fields for
	1637	! each even if we treat as a single field
	1638	! The latent heat flux is split between the ice categories according
	1639	! to the fraction of the ice in each category
	1640	zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)
	1641	WHERE ( zicefr(:,:) /= 0._wp )
	1642	ztmp(:,:) = 1./zicefr(:,:)
	1643	ELSEWHERE
	1644	ztmp(:,:) = 0.e0
	1645	END WHERE
	1646	DO jl=1,jpl
	1647	qla_ice(:,:,jl) = - a_i(:,:,jl) * ztmp(:,:) * frcv(jpr_ievp)%z3(:,:,1) * lsub
	1648	END DO
	1649	WHERE ( zicefr(:,:) == 0._wp ) qla_ice(:,:,1) = -frcv(jpr_ievp)%z3(:,:,1) * lsub
	1650	ENDIF
	1651	#else
[5407]	1652	zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)
[6488]	1653	#endif
[4990]	1654	CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation
	1655	IF( iom_use('hflx_rain_cea') ) &
	1656	CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip.
	1657	IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) &
	1658	ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)
	1659	IF( iom_use('evap_ao_cea' ) ) &
	1660	CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average)
	1661	IF( iom_use('hflx_evap_cea') ) &
	1662	CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) ) ! heat flux from from evap (cell average)
[3294]	1663	CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
[5407]	1664	zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
	1665	zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1)
	1666	zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1)
	1667	ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:)
[1218]	1668	END SELECT
[3294]	1669
[6498]	1670	#if defined key_lim3
	1671	! zsnw = snow percentage over ice after wind blowing
	1672	zsnw(:,:) = 0._wp
	1673	CALL lim_thd_snwblow( p_frld, zsnw )
	1674
	1675	! --- evaporation (kg/m2/s) --- !
	1676	zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1)
	1677	! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0
	1678	! therefore, sublimation is not redistributed over the ice categories in case no subgrid scale fluxes are provided by atm.
	1679	zdevap_ice(:,:) = 0._wp
	1680
	1681	! --- evaporation minus precipitation corrected for the effect of wind blowing on snow --- !
	1682	zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) - zsprecip * (1._wp - zsnw)
	1683	zemp_ice(:,:) = zemp_ice(:,:) + zsprecip * (1._wp - zsnw)
	1684
	1685	! Sublimation over sea-ice (cell average)
	1686	IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) )
	1687	! runoffs and calving (put in emp_tot)
[5407]	1688	IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
[1756]	1689	IF( srcv(jpr_cal)%laction ) THEN
[5407]	1690	zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
[5363]	1691	CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) )
[1756]	1692	ENDIF
[888]	1693
[5407]	1694	IF( ln_mixcpl ) THEN
	1695	emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
	1696	emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
[6498]	1697	emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:)
[5407]	1698	sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
	1699	tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
[6498]	1700	DO jl=1,jpl
	1701	evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:) * zmsk(:,:)
	1702	devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:)
	1703	ENDDO
[5407]	1704	ELSE
[6498]	1705	emp_tot(:,:) = zemp_tot(:,:)
	1706	emp_ice(:,:) = zemp_ice(:,:)
	1707	emp_oce(:,:) = zemp_oce(:,:)
	1708	sprecip(:,:) = zsprecip(:,:)
	1709	tprecip(:,:) = ztprecip(:,:)
	1710	DO jl=1,jpl
	1711	evap_ice (:,:,jl) = zevap_ice (:,:)
	1712	devap_ice(:,:,jl) = zdevap_ice(:,:)
	1713	ENDDO
	1714	ENDIF
	1715
	1716	CALL iom_put( 'snowpre' , sprecip ) ! Snow
	1717	IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw ) ) ! Snow over ice-free ocean (cell average)
	1718	IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zsnw ) ! Snow over sea-ice (cell average)
	1719	#else
	1720	! Sublimation over sea-ice (cell average)
	1721	IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )
	1722	! runoffs and calving (put in emp_tot)
	1723	IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
	1724	IF( srcv(jpr_cal)%laction ) THEN
	1725	zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
	1726	CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) )
	1727	ENDIF
	1728
	1729	IF( ln_mixcpl ) THEN
	1730	emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
	1731	emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
	1732	sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
	1733	tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
	1734	ELSE
[5407]	1735	emp_tot(:,:) = zemp_tot(:,:)
	1736	emp_ice(:,:) = zemp_ice(:,:)
	1737	sprecip(:,:) = zsprecip(:,:)
	1738	tprecip(:,:) = ztprecip(:,:)
	1739	ENDIF
	1740
	1741	CALL iom_put( 'snowpre' , sprecip ) ! Snow
	1742	IF( iom_use('snow_ao_cea') ) &
	1743	CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average)
	1744	IF( iom_use('snow_ai_cea') ) &
	1745	CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average)
[6498]	1746	#endif
[5407]	1747
[1218]	1748	! ! ========================= !
[3294]	1749	SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns)
[1218]	1750	! ! ========================= !
[3294]	1751	CASE( 'oce only' ) ! the required field is directly provided
[5407]	1752	zqns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1)
[1218]	1753	CASE( 'conservative' ) ! the required fields are directly provided
[5407]	1754	zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)
[3294]	1755	IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
[5407]	1756	zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
[3294]	1757	ELSE
	1758	! Set all category values equal for the moment
	1759	DO jl=1,jpl
[5407]	1760	zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
[3294]	1761	ENDDO
	1762	ENDIF
[1218]	1763	CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes
[5407]	1764	zqns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
[3294]	1765	IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
	1766	DO jl=1,jpl
[5407]	1767	zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)
	1768	zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
[3294]	1769	ENDDO
	1770	ELSE
[5146]	1771	qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
[3294]	1772	DO jl=1,jpl
[5407]	1773	zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
	1774	zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
[3294]	1775	ENDDO
	1776	ENDIF
[1218]	1777	CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations
[3294]	1778	! NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED
[5407]	1779	zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)
	1780	zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) &
[3294]	1781	& + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) &
	1782	& + pist(:,:,1) * zicefr(:,:) ) )
[1218]	1783	END SELECT
	1784	!!gm
[5407]	1785	!! currently it is taken into account in leads budget but not in the zqns_tot, and thus not in
[1218]	1786	!! the flux that enter the ocean....
	1787	!! moreover 1 - it is not diagnose anywhere....
	1788	!! 2 - it is unclear for me whether this heat lost is taken into account in the atmosphere or not...
	1789	!!
	1790	!! similar job should be done for snow and precipitation temperature
[1860]	1791	!
	1792	IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting
[3294]	1793	ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting
[5407]	1794	zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:)
[4990]	1795	IF( iom_use('hflx_cal_cea') ) &
	1796	CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving
[1742]	1797	ENDIF
[1218]	1798
[5407]	1799	ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus
	1800	IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average)
	1801
[6498]	1802	#if defined key_lim3
[5407]	1803	! --- evaporation --- !
	1804	zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean
	1805
	1806	! --- non solar flux over ocean --- !
	1807	! note: p_frld cannot be = 0 since we limit the ice concentration to amax
	1808	zqns_oce = 0._wp
	1809	WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:)
	1810
[6498]	1811	! --- heat flux associated with emp (W/m2) --- !
[5407]	1812	zqemp_oce(:,:) = - zevap(:,:) * p_frld(:,:) * zcptn(:,:) & ! evap
	1813	& + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip
	1814	& + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean
[6498]	1815	! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap
	1816	! & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice
	1817	zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice (only)
	1818	! qevap_ice=0 since we consider Tice=0°C
	1819
[5407]	1820	! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
	1821	zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus )
	1822
[6498]	1823	! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- !
	1824	DO jl = 1, jpl
	1825	zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0°C
	1826	END DO
[5407]	1827
[6498]	1828	! --- total non solar flux (including evap/precip) --- !
	1829	zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:)
	1830
[5407]	1831	! --- in case both coupled/forced are active, we must mix values --- !
	1832	IF( ln_mixcpl ) THEN
	1833	qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
	1834	qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:)
	1835	DO jl=1,jpl
[6498]	1836	qns_ice (:,:,jl) = qns_ice (:,:,jl) * xcplmask(:,:,0) + zqns_ice (:,:,jl)* zmsk(:,:)
	1837	qevap_ice(:,:,jl) = qevap_ice(:,:,jl) * xcplmask(:,:,0) + zqevap_ice(:,:,jl)* zmsk(:,:)
[5407]	1838	ENDDO
	1839	qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:)
	1840	qemp_oce (:,:) = qemp_oce(:,:) * xcplmask(:,:,0) + zqemp_oce(:,:)* zmsk(:,:)
[6498]	1841	qemp_ice (:,:) = qemp_ice(:,:) * xcplmask(:,:,0) + zqemp_ice(:,:)* zmsk(:,:)
[5407]	1842	ELSE
	1843	qns_tot (:,: ) = zqns_tot (:,: )
	1844	qns_oce (:,: ) = zqns_oce (:,: )
	1845	qns_ice (:,:,:) = zqns_ice (:,:,:)
[6498]	1846	qevap_ice(:,:,:) = zqevap_ice(:,:,:)
	1847	qprec_ice(:,: ) = zqprec_ice(:,: )
	1848	qemp_oce (:,: ) = zqemp_oce (:,: )
	1849	qemp_ice (:,: ) = zqemp_ice (:,: )
[5407]	1850	ENDIF
	1851	#else
	1852	! clem: this formulation is certainly wrong... but better than it was...
	1853	zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with:
	1854	& - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting
	1855	& - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST)
	1856	& - zemp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:)
	1857
	1858	IF( ln_mixcpl ) THEN
	1859	qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk
	1860	qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
	1861	DO jl=1,jpl
	1862	qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:)
	1863	ENDDO
	1864	ELSE
	1865	qns_tot(:,: ) = zqns_tot(:,: )
	1866	qns_ice(:,:,:) = zqns_ice(:,:,:)
	1867	ENDIF
	1868	#endif
	1869
[1218]	1870	! ! ========================= !
[3294]	1871	SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr)
[1218]	1872	! ! ========================= !
[3294]	1873	CASE( 'oce only' )
[5407]	1874	zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
[1218]	1875	CASE( 'conservative' )
[5407]	1876	zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
[3294]	1877	IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
[5407]	1878	zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
[3294]	1879	ELSE
	1880	! Set all category values equal for the moment
	1881	DO jl=1,jpl
[5407]	1882	zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
[3294]	1883	ENDDO
	1884	ENDIF
[5407]	1885	zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
	1886	zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
[1218]	1887	CASE( 'oce and ice' )
[5407]	1888	zqsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
[3294]	1889	IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
	1890	DO jl=1,jpl
[5407]	1891	zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)
	1892	zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
[3294]	1893	ENDDO
	1894	ELSE
[5146]	1895	qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
[3294]	1896	DO jl=1,jpl
[5407]	1897	zqsr_tot(:,: ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
	1898	zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
[3294]	1899	ENDDO
	1900	ENDIF
[1218]	1901	CASE( 'mixed oce-ice' )
[5407]	1902	zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
[3294]	1903	! NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED
[1232]	1904	! Create solar heat flux over ice using incoming solar heat flux and albedos
	1905	! ( see OASIS3 user guide, 5th edition, p39 )
[5407]	1906	zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) &
[3294]	1907	& / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) &
	1908	& + palbi (:,:,1) * zicefr(:,:) ) )
[1218]	1909	END SELECT
[5407]	1910	IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle
	1911	zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) )
[3294]	1912	DO jl=1,jpl
[5407]	1913	zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) )
[3294]	1914	ENDDO
[2528]	1915	ENDIF
[1218]	1916
[5486]	1917	#if defined key_lim3
	1918	! --- solar flux over ocean --- !
	1919	! note: p_frld cannot be = 0 since we limit the ice concentration to amax
	1920	zqsr_oce = 0._wp
	1921	WHERE( p_frld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:)
	1922
	1923	IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:)
	1924	ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF
	1925	#endif
	1926
[5407]	1927	IF( ln_mixcpl ) THEN
	1928	qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk
	1929	qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:)
	1930	DO jl=1,jpl
	1931	qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:)
	1932	ENDDO
	1933	ELSE
	1934	qsr_tot(:,: ) = zqsr_tot(:,: )
	1935	qsr_ice(:,:,:) = zqsr_ice(:,:,:)
	1936	ENDIF
	1937
[4990]	1938	! ! ========================= !
	1939	SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt !
	1940	! ! ========================= !
[1226]	1941	CASE ('coupled')
[3294]	1942	IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
[5407]	1943	zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
[3294]	1944	ELSE
	1945	! Set all category values equal for the moment
	1946	DO jl=1,jpl
[5407]	1947	zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
[3294]	1948	ENDDO
	1949	ENDIF
[1226]	1950	END SELECT
[5407]	1951
	1952	IF( ln_mixcpl ) THEN
	1953	DO jl=1,jpl
	1954	dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)
	1955	ENDDO
	1956	ELSE
	1957	dqns_ice(:,:,:) = zdqns_ice(:,:,:)
	1958	ENDIF
	1959
[4990]	1960	! ! ========================= !
	1961	SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt !
	1962	! ! ========================= !
[3294]	1963	CASE ('coupled')
	1964	topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:)
	1965	botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:)
	1966	END SELECT
	1967
[4990]	1968	! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 )
	1969	! Used for LIM2 and LIM3
[4162]	1970	! Coupled case: since cloud cover is not received from atmosphere
[4990]	1971	! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81)
	1972	fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
	1973	fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
[4162]	1974
[6498]	1975	CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw )
	1976	CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice )
	1977	CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )
	1978	CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )
[2715]	1979	!
[3294]	1980	IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx')
	1981	!
[1226]	1982	END SUBROUTINE sbc_cpl_ice_flx
[1218]	1983
	1984
	1985	SUBROUTINE sbc_cpl_snd( kt )
	1986	!!----------------------------------------------------------------------
	1987	!! * ROUTINE sbc_cpl_snd *
	1988	!!
	1989	!! ** Purpose : provide the ocean-ice informations to the atmosphere
	1990	!!
[4990]	1991	!! ** Method : send to the atmosphere through a call to cpl_snd
[1218]	1992	!! all the needed fields (as defined in sbc_cpl_init)
	1993	!!----------------------------------------------------------------------
	1994	INTEGER, INTENT(in) :: kt
[2715]	1995	!
[3294]	1996	INTEGER :: ji, jj, jl ! dummy loop indices
[2715]	1997	INTEGER :: isec, info ! local integer
[5407]	1998	REAL(wp) :: zumax, zvmax
[3294]	1999	REAL(wp), POINTER, DIMENSION(:,:) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
	2000	REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp3, ztmp4
[1218]	2001	!!----------------------------------------------------------------------
[3294]	2002	!
	2003	IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_snd')
	2004	!
	2005	CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
	2006	CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 )
[888]	2007
[1218]	2008	isec = ( kt - nit000 ) * NINT(rdttra(1)) ! date of exchanges
[888]	2009
[1218]	2010	zfr_l(:,:) = 1.- fr_i(:,:)
	2011	! ! ------------------------- !
	2012	! ! Surface temperature ! in Kelvin
	2013	! ! ------------------------- !
[3680]	2014	IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
[5407]	2015
	2016	IF ( nn_components == jp_iam_opa ) THEN
	2017	ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part
	2018	ELSE
	2019	! we must send the surface potential temperature
	2020	IF( ln_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
	2021	ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem)
	2022	ENDIF
	2023	!
	2024	SELECT CASE( sn_snd_temp%cldes)
	2025	CASE( 'oce only' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0
[5410]	2026	CASE( 'oce and ice' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0
	2027	SELECT CASE( sn_snd_temp%clcat )
	2028	CASE( 'yes' )
	2029	ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl)
	2030	CASE( 'no' )
	2031	WHERE( SUM( a_i, dim=3 ) /= 0. )
	2032	ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 )
	2033	ELSEWHERE
[6487]	2034	ztmp3(:,:,1) = rt0
[5410]	2035	END WHERE
	2036	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
	2037	END SELECT
[5407]	2038	CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)
	2039	SELECT CASE( sn_snd_temp%clcat )
	2040	CASE( 'yes' )
	2041	ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
	2042	CASE( 'no' )
	2043	ztmp3(:,:,:) = 0.0
	2044	DO jl=1,jpl
	2045	ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
	2046	ENDDO
	2047	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
	2048	END SELECT
[6488]	2049	CASE( 'oce and weighted ice' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0
	2050	SELECT CASE( sn_snd_temp%clcat )
	2051	CASE( 'yes' )
	2052	ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
	2053	CASE( 'no' )
	2054	ztmp3(:,:,:) = 0.0
	2055	DO jl=1,jpl
	2056	ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
	2057	ENDDO
	2058	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
	2059	END SELECT
[5407]	2060	CASE( 'mixed oce-ice' )
	2061	ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)
[3680]	2062	DO jl=1,jpl
[5407]	2063	ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
[3680]	2064	ENDDO
[5407]	2065	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
[3680]	2066	END SELECT
[5407]	2067	ENDIF
[4990]	2068	IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
	2069	IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info )
	2070	IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
[3680]	2071	ENDIF
[1218]	2072	! ! ------------------------- !
	2073	! ! Albedo !
	2074	! ! ------------------------- !
	2075	IF( ssnd(jps_albice)%laction ) THEN ! ice
[6487]	2076	SELECT CASE( sn_snd_alb%cldes )
	2077	CASE( 'ice' )
	2078	SELECT CASE( sn_snd_alb%clcat )
	2079	CASE( 'yes' )
	2080	ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
	2081	CASE( 'no' )
	2082	WHERE( SUM( a_i, dim=3 ) /= 0. )
	2083	ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 )
	2084	ELSEWHERE
	2085	ztmp1(:,:) = albedo_oce_mix(:,:)
	2086	END WHERE
	2087	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' )
	2088	END SELECT
	2089	CASE( 'weighted ice' ) ;
	2090	SELECT CASE( sn_snd_alb%clcat )
	2091	CASE( 'yes' )
	2092	ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
	2093	CASE( 'no' )
	2094	WHERE( fr_i (:,:) > 0. )
	2095	ztmp1(:,:) = SUM ( alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 )
	2096	ELSEWHERE
	2097	ztmp1(:,:) = 0.
	2098	END WHERE
	2099	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' )
	2100	END SELECT
	2101	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' )
[5410]	2102	END SELECT
[6487]	2103
	2104	SELECT CASE( sn_snd_alb%clcat )
	2105	CASE( 'yes' )
	2106	CALL cpl_snd( jps_albice, isec, ztmp3, info ) !-> MV this has never been checked in coupled mode
	2107	CASE( 'no' )
	2108	CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
	2109	END SELECT
[888]	2110	ENDIF
[6487]	2111
[1218]	2112	IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean
[3294]	2113	ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:)
	2114	DO jl=1,jpl
	2115	ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl)
	2116	ENDDO
[4990]	2117	CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
[1218]	2118	ENDIF
	2119	! ! ------------------------- !
	2120	! ! Ice fraction & Thickness !
	2121	! ! ------------------------- !
[5407]	2122	! Send ice fraction field to atmosphere
[3680]	2123	IF( ssnd(jps_fice)%laction ) THEN
	2124	SELECT CASE( sn_snd_thick%clcat )
	2125	CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl)
	2126	CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(:,: )
	2127	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
	2128	END SELECT
[5407]	2129	IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info )
[3680]	2130	ENDIF
[5407]	2131
[6488]	2132	! Send ice fraction field (first order interpolation), for weighting UM fluxes to be passed to NEMO
	2133	IF (ssnd(jps_fice1)%laction) THEN
	2134	SELECT CASE (sn_snd_thick1%clcat)
	2135	CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl)
	2136	CASE( 'no' ) ; ztmp3(:,:,1) = fr_i(:,:)
	2137	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' )
	2138	END SELECT
	2139	CALL cpl_snd (jps_fice1, isec, ztmp3, info)
	2140	ENDIF
	2141
[5407]	2142	! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling)
	2143	IF( ssnd(jps_fice2)%laction ) THEN
	2144	ztmp3(:,:,1) = fr_i(:,:)
	2145	IF( ssnd(jps_fice2)%laction ) CALL cpl_snd( jps_fice2, isec, ztmp3, info )
	2146	ENDIF
[3294]	2147
	2148	! Send ice and snow thickness field
[3680]	2149	IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN
	2150	SELECT CASE( sn_snd_thick%cldes)
	2151	CASE( 'none' ) ! nothing to do
	2152	CASE( 'weighted ice and snow' )
	2153	SELECT CASE( sn_snd_thick%clcat )
	2154	CASE( 'yes' )
	2155	ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) * a_i(:,:,1:jpl)
	2156	ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) * a_i(:,:,1:jpl)
	2157	CASE( 'no' )
	2158	ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0
	2159	DO jl=1,jpl
	2160	ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl)
	2161	ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl)
	2162	ENDDO
	2163	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
	2164	END SELECT
	2165	CASE( 'ice and snow' )
[5410]	2166	SELECT CASE( sn_snd_thick%clcat )
	2167	CASE( 'yes' )
	2168	ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl)
	2169	ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl)
	2170	CASE( 'no' )
	2171	WHERE( SUM( a_i, dim=3 ) /= 0. )
	2172	ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 )
	2173	ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 )
	2174	ELSEWHERE
	2175	ztmp3(:,:,1) = 0.
	2176	ztmp4(:,:,1) = 0.
	2177	END WHERE
	2178	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
	2179	END SELECT
[3680]	2180	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' )
[3294]	2181	END SELECT
[4990]	2182	IF( ssnd(jps_hice)%laction ) CALL cpl_snd( jps_hice, isec, ztmp3, info )
	2183	IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info )
[3680]	2184	ENDIF
[1218]	2185	!
[6488]	2186	! Send meltpond fields
	2187	IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN
	2188	SELECT CASE( sn_snd_mpnd%cldes)
	2189	CASE( 'weighted ice' )
	2190	SELECT CASE( sn_snd_mpnd%clcat )
	2191	CASE( 'yes' )
	2192	ztmp3(:,:,1:jpl) = a_p(:,:,1:jpl) * a_i(:,:,1:jpl)
	2193	ztmp4(:,:,1:jpl) = ht_p(:,:,1:jpl) * a_i(:,:,1:jpl)
	2194	CASE( 'no' )
	2195	ztmp3(:,:,:) = 0.0
	2196	ztmp4(:,:,:) = 0.0
	2197	DO jl=1,jpl
	2198	ztmp3(:,:,1) = ztmp3(:,:,1) + a_p(:,:,jpl) * a_i(:,:,jpl)
	2199	ztmp4(:,:,1) = ztmp4(:,:,1) + ht_p(:,:,jpl) * a_i(:,:,jpl)
	2200	ENDDO
	2201	CASE default ; CALL ctl_stop( 'sbc_cpl_mpd: wrong definition of sn_snd_mpnd%clcat' )
	2202	END SELECT
	2203	CASE( 'ice only' )
	2204	ztmp3(:,:,1:jpl) = a_p(:,:,1:jpl)
	2205	ztmp4(:,:,1:jpl) = ht_p(:,:,1:jpl)
	2206	END SELECT
	2207	IF( ssnd(jps_a_p)%laction ) CALL cpl_snd( jps_a_p, isec, ztmp3, info )
	2208	IF( ssnd(jps_ht_p)%laction ) CALL cpl_snd( jps_ht_p, isec, ztmp4, info )
	2209	!
	2210	! Send ice effective conductivity
	2211	SELECT CASE( sn_snd_cond%cldes)
	2212	CASE( 'weighted ice' )
	2213	SELECT CASE( sn_snd_cond%clcat )
	2214	CASE( 'yes' )
	2215	ztmp3(:,:,1:jpl) = kn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
	2216	CASE( 'no' )
	2217	ztmp3(:,:,:) = 0.0
	2218	DO jl=1,jpl
	2219	ztmp3(:,:,1) = ztmp3(:,:,1) + kn_ice(:,:,jl) * a_i(:,:,jl)
	2220	ENDDO
	2221	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' )
	2222	END SELECT
	2223	CASE( 'ice only' )
	2224	ztmp3(:,:,1:jpl) = kn_ice(:,:,1:jpl)
	2225	END SELECT
	2226	IF( ssnd(jps_kice)%laction ) CALL cpl_snd( jps_kice, isec, ztmp3, info )
	2227	ENDIF
	2228	!
	2229	!
[1534]	2230	#if defined key_cpl_carbon_cycle
[1218]	2231	! ! ------------------------- !
[1534]	2232	! ! CO2 flux from PISCES !
	2233	! ! ------------------------- !
[4990]	2234	IF( ssnd(jps_co2)%laction ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )
[1534]	2235	!
	2236	#endif
[3294]	2237	! ! ------------------------- !
[1218]	2238	IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current !
	2239	! ! ------------------------- !
[1467]	2240	!
	2241	! j+1 j -----V---F
[1694]	2242	! surface velocity always sent from T point ! \|
[1467]	2243	! j \| T U
	2244	! \| \|
	2245	! j j-1 -I-------\|
	2246	! (for I) \| \|
	2247	! i-1 i i
	2248	! i i+1 (for I)
[5407]	2249	IF( nn_components == jp_iam_opa ) THEN
	2250	zotx1(:,:) = un(:,:,1)
	2251	zoty1(:,:) = vn(:,:,1)
	2252	ELSE
	2253	SELECT CASE( TRIM( sn_snd_crt%cldes ) )
	2254	CASE( 'oce only' ) ! C-grid ==> T
[1218]	2255	DO jj = 2, jpjm1
	2256	DO ji = fs_2, fs_jpim1 ! vector opt.
[5407]	2257	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) )
	2258	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) )
[1218]	2259	END DO
	2260	END DO
[5407]	2261	CASE( 'weighted oce and ice' )
	2262	SELECT CASE ( cp_ice_msh )
	2263	CASE( 'C' ) ! Ocean and Ice on C-grid ==> T
	2264	DO jj = 2, jpjm1
	2265	DO ji = fs_2, fs_jpim1 ! vector opt.
	2266	zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj)
	2267	zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj)
	2268	zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
	2269	zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
	2270	END DO
[1218]	2271	END DO
[5407]	2272	CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T
	2273	DO jj = 2, jpjm1
	2274	DO ji = 2, jpim1 ! NO vector opt.
	2275	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj)
	2276	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj)
	2277	zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) &
	2278	& + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
	2279	zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) &
	2280	& + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
	2281	END DO
[1467]	2282	END DO
[5407]	2283	CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T
	2284	DO jj = 2, jpjm1
	2285	DO ji = 2, jpim1 ! NO vector opt.
	2286	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj)
	2287	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj)
	2288	zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) &
	2289	& + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
	2290	zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) &
	2291	& + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
	2292	END DO
[1308]	2293	END DO
[5407]	2294	END SELECT
	2295	CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. )
	2296	CASE( 'mixed oce-ice' )
	2297	SELECT CASE ( cp_ice_msh )
	2298	CASE( 'C' ) ! Ocean and Ice on C-grid ==> T
	2299	DO jj = 2, jpjm1
	2300	DO ji = fs_2, fs_jpim1 ! vector opt.
	2301	zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) &
	2302	& + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
	2303	zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) &
	2304	& + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
	2305	END DO
[1218]	2306	END DO
[5407]	2307	CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T
	2308	DO jj = 2, jpjm1
	2309	DO ji = 2, jpim1 ! NO vector opt.
	2310	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) &
	2311	& + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) &
	2312	& + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
	2313	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) &
	2314	& + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) &
	2315	& + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
	2316	END DO
[1467]	2317	END DO
[5407]	2318	CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T
	2319	DO jj = 2, jpjm1
	2320	DO ji = 2, jpim1 ! NO vector opt.
	2321	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) &
	2322	& + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) &
	2323	& + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
	2324	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) &
	2325	& + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) &
	2326	& + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
	2327	END DO
	2328	END DO
	2329	END SELECT
[1467]	2330	END SELECT
[5407]	2331	CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. )
	2332	!
	2333	ENDIF
[888]	2334	!
[1218]	2335	!
[3294]	2336	IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components
[1218]	2337	! ! Ocean component
	2338	CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component
	2339	CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
	2340	zotx1(:,:) = ztmp1(:,:) ! overwrite the components
	2341	zoty1(:,:) = ztmp2(:,:)
	2342	IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component
	2343	CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component
	2344	CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
	2345	zitx1(:,:) = ztmp1(:,:) ! overwrite the components
	2346	zity1(:,:) = ztmp2(:,:)
	2347	ENDIF
	2348	ENDIF
	2349	!
	2350	! spherical coordinates to cartesian -> 2 components to 3 components
[3294]	2351	IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN
[1218]	2352	ztmp1(:,:) = zotx1(:,:) ! ocean currents
	2353	ztmp2(:,:) = zoty1(:,:)
[1226]	2354	CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
[1218]	2355	!
	2356	IF( ssnd(jps_ivx1)%laction ) THEN ! ice velocities
	2357	ztmp1(:,:) = zitx1(:,:)
	2358	ztmp1(:,:) = zity1(:,:)
[1226]	2359	CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
[1218]	2360	ENDIF
	2361	ENDIF
	2362	!
[4990]	2363	IF( ssnd(jps_ocx1)%laction ) CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid
	2364	IF( ssnd(jps_ocy1)%laction ) CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid
	2365	IF( ssnd(jps_ocz1)%laction ) CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid
[1218]	2366	!
[4990]	2367	IF( ssnd(jps_ivx1)%laction ) CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid
	2368	IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid
	2369	IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid
[1534]	2370	!
[888]	2371	ENDIF
[2715]	2372	!
[5407]	2373	!
	2374	! Fields sent by OPA to SAS when doing OPA<->SAS coupling
	2375	! ! SSH
	2376	IF( ssnd(jps_ssh )%laction ) THEN
	2377	! ! removed inverse barometer ssh when Patm
	2378	! forcing is used (for sea-ice dynamics)
	2379	IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
	2380	ELSE ; ztmp1(:,:) = sshn(:,:)
	2381	ENDIF
	2382	CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info )
	2383
	2384	ENDIF
	2385	! ! SSS
	2386	IF( ssnd(jps_soce )%laction ) THEN
	2387	CALL cpl_snd( jps_soce , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info )
	2388	ENDIF
	2389	! ! first T level thickness
	2390	IF( ssnd(jps_e3t1st )%laction ) THEN
	2391	CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1) , (/jpi,jpj,1/) ), info )
	2392	ENDIF
	2393	! ! Qsr fraction
	2394	IF( ssnd(jps_fraqsr)%laction ) THEN
	2395	CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info )
	2396	ENDIF
	2397	!
	2398	! Fields sent by SAS to OPA when OASIS coupling
	2399	! ! Solar heat flux
	2400	IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info )
	2401	IF( ssnd(jps_qnsoce)%laction ) CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info )
	2402	IF( ssnd(jps_oemp )%laction ) CALL cpl_snd( jps_oemp , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info )
	2403	IF( ssnd(jps_sflx )%laction ) CALL cpl_snd( jps_sflx , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info )
	2404	IF( ssnd(jps_otx1 )%laction ) CALL cpl_snd( jps_otx1 , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info )
	2405	IF( ssnd(jps_oty1 )%laction ) CALL cpl_snd( jps_oty1 , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info )
	2406	IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info )
	2407	IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info )
[6488]	2408
	2409	ztmp1(:,:) = sstfrz(:,:) + rt0
	2410	IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
	2411	!
[3294]	2412	CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
	2413	CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )
[2715]	2414	!
[3294]	2415	IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_snd')
	2416	!
[1226]	2417	END SUBROUTINE sbc_cpl_snd
[1218]	2418
[888]	2419	!!======================================================================
	2420	END MODULE sbccpl

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

Download in other formats: