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

Context Navigation

source: branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 10392

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

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

Download in other formats: