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

Context Navigation

source: branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 6710

Last change on this file since 6710 was 6710, checked in by clem, 8 years ago
correct a bug in coupled mode in case calving is activated
Property svn:keywords set to `Id`
File size: 125.2 KB

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

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

Download in other formats: