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_r6501_GO6_package_trunk/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/UKMO/dev_r6501_GO6_package_trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 9247

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

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

Download in other formats: