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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

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

Context Navigation

source: branches/UKMO/dev_r5518_new_runoff_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 9242

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

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

Download in other formats: