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

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

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

Context Navigation

source: branches/UKMO/dev_r5107_hadgem3_cplseq/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 5491

Last change on this file since 5491 was 5491, checked in by dancopsey, 9 years ago
Hardwire only two models as nn_cplmodel has not been read in from the namelist yet.
File size: 94.3 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
[2528]	23	USE sbcdcy ! surface boundary condition: diurnal cycle
[1860]	24	USE phycst ! physical constants
[1218]	25	#if defined key_lim3
	26	USE par_ice ! ice parameters
[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 !
[3294]	35	USE oce , ONLY : tsn, un, vn
[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)
[1534]	43	#if defined key_cpl_carbon_cycle
	44	USE p4zflx, ONLY : oce_co2
	45	#endif
[3294]	46	#if defined key_cice
	47	USE ice_domain_size, only: ncat
	48	#endif
[1218]	49	IMPLICIT NONE
	50	PRIVATE
[4990]	51	!EM XIOS-OASIS-MCT compliance
	52	PUBLIC sbc_cpl_init ! routine called by sbcmod.F90
[2715]	53	PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90
	54	PUBLIC sbc_cpl_snd ! routine called by step.F90
	55	PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim(_2).F90
	56	PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim(_2).F90
[5009]	57	PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90
[2715]	58
[1218]	59	INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 1
	60	INTEGER, PARAMETER :: jpr_oty1 = 2 !
	61	INTEGER, PARAMETER :: jpr_otz1 = 3 !
	62	INTEGER, PARAMETER :: jpr_otx2 = 4 ! 3 atmosphere-ocean stress components on grid 2
	63	INTEGER, PARAMETER :: jpr_oty2 = 5 !
	64	INTEGER, PARAMETER :: jpr_otz2 = 6 !
	65	INTEGER, PARAMETER :: jpr_itx1 = 7 ! 3 atmosphere-ice stress components on grid 1
	66	INTEGER, PARAMETER :: jpr_ity1 = 8 !
	67	INTEGER, PARAMETER :: jpr_itz1 = 9 !
	68	INTEGER, PARAMETER :: jpr_itx2 = 10 ! 3 atmosphere-ice stress components on grid 2
	69	INTEGER, PARAMETER :: jpr_ity2 = 11 !
	70	INTEGER, PARAMETER :: jpr_itz2 = 12 !
	71	INTEGER, PARAMETER :: jpr_qsroce = 13 ! Qsr above the ocean
	72	INTEGER, PARAMETER :: jpr_qsrice = 14 ! Qsr above the ice
[1226]	73	INTEGER, PARAMETER :: jpr_qsrmix = 15
	74	INTEGER, PARAMETER :: jpr_qnsoce = 16 ! Qns above the ocean
	75	INTEGER, PARAMETER :: jpr_qnsice = 17 ! Qns above the ice
	76	INTEGER, PARAMETER :: jpr_qnsmix = 18
	77	INTEGER, PARAMETER :: jpr_rain = 19 ! total liquid precipitation (rain)
	78	INTEGER, PARAMETER :: jpr_snow = 20 ! solid precipitation over the ocean (snow)
	79	INTEGER, PARAMETER :: jpr_tevp = 21 ! total evaporation
	80	INTEGER, PARAMETER :: jpr_ievp = 22 ! solid evaporation (sublimation)
[1232]	81	INTEGER, PARAMETER :: jpr_sbpr = 23 ! sublimation - liquid precipitation - solid precipitation
[1226]	82	INTEGER, PARAMETER :: jpr_semp = 24 ! solid freshwater budget (sublimation - snow)
	83	INTEGER, PARAMETER :: jpr_oemp = 25 ! ocean freshwater budget (evap - precip)
[1696]	84	INTEGER, PARAMETER :: jpr_w10m = 26 ! 10m wind
	85	INTEGER, PARAMETER :: jpr_dqnsdt = 27 ! d(Q non solar)/d(temperature)
	86	INTEGER, PARAMETER :: jpr_rnf = 28 ! runoffs
	87	INTEGER, PARAMETER :: jpr_cal = 29 ! calving
	88	INTEGER, PARAMETER :: jpr_taum = 30 ! wind stress module
	89	INTEGER, PARAMETER :: jpr_co2 = 31
[3294]	90	INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn
	91	INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn
	92	INTEGER, PARAMETER :: jprcv = 33 ! total number of fields received
	93
[1218]	94	INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction
	95	INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature
	96	INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature
	97	INTEGER, PARAMETER :: jps_tmix = 4 ! mixed temperature (ocean+ice)
	98	INTEGER, PARAMETER :: jps_albice = 5 ! ice albedo
	99	INTEGER, PARAMETER :: jps_albmix = 6 ! mixed albedo
	100	INTEGER, PARAMETER :: jps_hice = 7 ! ice thickness
	101	INTEGER, PARAMETER :: jps_hsnw = 8 ! snow thickness
	102	INTEGER, PARAMETER :: jps_ocx1 = 9 ! ocean current on grid 1
	103	INTEGER, PARAMETER :: jps_ocy1 = 10 !
	104	INTEGER, PARAMETER :: jps_ocz1 = 11 !
	105	INTEGER, PARAMETER :: jps_ivx1 = 12 ! ice current on grid 1
	106	INTEGER, PARAMETER :: jps_ivy1 = 13 !
	107	INTEGER, PARAMETER :: jps_ivz1 = 14 !
[1534]	108	INTEGER, PARAMETER :: jps_co2 = 15
	109	INTEGER, PARAMETER :: jpsnd = 15 ! total number of fields sended
[3294]	110
[1218]	111	! !! namelist namsbc_cpl
[3294]	112	TYPE :: FLD_C
	113	CHARACTER(len = 32) :: cldes ! desciption of the coupling strategy
	114	CHARACTER(len = 32) :: clcat ! multiple ice categories strategy
	115	CHARACTER(len = 32) :: clvref ! reference of vector ('spherical' or 'cartesian')
	116	CHARACTER(len = 32) :: clvor ! orientation of vector fields ('eastward-northward' or 'local grid')
	117	CHARACTER(len = 32) :: clvgrd ! grids on which is located the vector fields
	118	END TYPE FLD_C
	119	! Send to the atmosphere !
	120	TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2
	121	! Received from the atmosphere !
	122	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
	123	TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2
[4990]	124	! Other namelist parameters !
	125	INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
	126	LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models
	127	! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
[888]	128
[4990]	129	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask
	130
[3294]	131	TYPE :: DYNARR
	132	REAL(wp), POINTER, DIMENSION(:,:,:) :: z3
	133	END TYPE DYNARR
[888]	134
[3294]	135	TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere
	136
[2715]	137	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky)
[888]	138
[2715]	139	INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument
[888]	140
[1218]	141	!! Substitution
	142	# include "vectopt_loop_substitute.h90"
	143	!!----------------------------------------------------------------------
[2528]	144	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
[1226]	145	!! $Id$
[2715]	146	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[1218]	147	!!----------------------------------------------------------------------
[888]	148
[1218]	149	CONTAINS
	150
[2715]	151	INTEGER FUNCTION sbc_cpl_alloc()
	152	!!----------------------------------------------------------------------
	153	!! * FUNCTION sbc_cpl_alloc *
	154	!!----------------------------------------------------------------------
[4990]	155	INTEGER :: ierr(3)
[2715]	156	!!----------------------------------------------------------------------
	157	ierr(:) = 0
	158	!
[3294]	159	ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) )
[4990]	160
	161	#if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice
	162	ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init)
	163	#endif
[5491]	164	!ALLOCATE( xcplmask(jpi,jpj,nn_cplmodel) , STAT=ierr(3) )
	165	! Hardwire only two models as nn_cplmodel has not been read in
	166	! from the namelist yet.
	167	ALLOCATE( xcplmask(jpi,jpj,2) , STAT=ierr(3) )
[2715]	168	!
	169	sbc_cpl_alloc = MAXVAL( ierr )
	170	IF( lk_mpp ) CALL mpp_sum ( sbc_cpl_alloc )
	171	IF( sbc_cpl_alloc > 0 ) CALL ctl_warn('sbc_cpl_alloc: allocation of arrays failed')
	172	!
	173	END FUNCTION sbc_cpl_alloc
	174
	175
[1218]	176	SUBROUTINE sbc_cpl_init( k_ice )
	177	!!----------------------------------------------------------------------
	178	!! * ROUTINE sbc_cpl_init *
	179	!!
[4990]	180	!! ** Purpose : Initialisation of send and received information from
[1218]	181	!! the atmospheric component
	182	!!
	183	!! ** Method : * Read namsbc_cpl namelist
	184	!! * define the receive interface
	185	!! * define the send interface
	186	!! * initialise the OASIS coupler
	187	!!----------------------------------------------------------------------
	188	INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)
	189	!!
[2715]	190	INTEGER :: jn ! dummy loop index
[4147]	191	INTEGER :: ios ! Local integer output status for namelist read
[4990]	192	INTEGER :: inum
[3294]	193	REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos
[1218]	194	!!
[4990]	195	NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, &
	196	& sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, &
	197	& sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, &
	198	& sn_rcv_co2 , nn_cplmodel , ln_usecplmask
[1218]	199	!!---------------------------------------------------------------------
[3294]	200	!
	201	IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init')
	202	!
	203	CALL wrk_alloc( jpi,jpj, zacs, zaos )
[888]	204
[1218]	205	! ================================ !
	206	! Namelist informations !
	207	! ================================ !
[888]	208
[4147]	209	REWIND( numnam_ref ) ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling
	210	READ ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901)
	211	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp )
[3294]	212
[4147]	213	REWIND( numnam_cfg ) ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling
	214	READ ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 )
	215	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp )
[4624]	216	IF(lwm) WRITE ( numond, namsbc_cpl )
[888]	217
[1218]	218	IF(lwp) THEN ! control print
	219	WRITE(numout,*)
	220	WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist '
	221	WRITE(numout,*)'~~~~~~~~~~~~'
[3294]	222	WRITE(numout,*)' received fields (mutiple ice categogies)'
	223	WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')'
	224	WRITE(numout,*)' stress module = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')'
	225	WRITE(numout,*)' surface stress = ', TRIM(sn_rcv_tau%cldes ), ' (', TRIM(sn_rcv_tau%clcat ), ')'
	226	WRITE(numout,*)' - referential = ', sn_rcv_tau%clvref
	227	WRITE(numout,*)' - orientation = ', sn_rcv_tau%clvor
	228	WRITE(numout,*)' - mesh = ', sn_rcv_tau%clvgrd
	229	WRITE(numout,*)' non-solar heat flux sensitivity = ', TRIM(sn_rcv_dqnsdt%cldes), ' (', TRIM(sn_rcv_dqnsdt%clcat), ')'
	230	WRITE(numout,*)' solar heat flux = ', TRIM(sn_rcv_qsr%cldes ), ' (', TRIM(sn_rcv_qsr%clcat ), ')'
	231	WRITE(numout,*)' non-solar heat flux = ', TRIM(sn_rcv_qns%cldes ), ' (', TRIM(sn_rcv_qns%clcat ), ')'
	232	WRITE(numout,*)' freshwater budget = ', TRIM(sn_rcv_emp%cldes ), ' (', TRIM(sn_rcv_emp%clcat ), ')'
	233	WRITE(numout,*)' runoffs = ', TRIM(sn_rcv_rnf%cldes ), ' (', TRIM(sn_rcv_rnf%clcat ), ')'
	234	WRITE(numout,*)' calving = ', TRIM(sn_rcv_cal%cldes ), ' (', TRIM(sn_rcv_cal%clcat ), ')'
	235	WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')'
	236	WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')'
	237	WRITE(numout,*)' sent fields (multiple ice categories)'
	238	WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')'
	239	WRITE(numout,*)' albedo = ', TRIM(sn_snd_alb%cldes ), ' (', TRIM(sn_snd_alb%clcat ), ')'
	240	WRITE(numout,*)' ice/snow thickness = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')'
	241	WRITE(numout,*)' surface current = ', TRIM(sn_snd_crt%cldes ), ' (', TRIM(sn_snd_crt%clcat ), ')'
	242	WRITE(numout,*)' - referential = ', sn_snd_crt%clvref
	243	WRITE(numout,*)' - orientation = ', sn_snd_crt%clvor
	244	WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd
	245	WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')'
[4990]	246	WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel
	247	WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask
[1218]	248	ENDIF
[888]	249
[3294]	250	! ! allocate sbccpl arrays
[5489]	251	!IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )
[1218]	252
	253	! ================================ !
	254	! Define the receive interface !
	255	! ================================ !
[1698]	256	nrcvinfo(:) = OASIS_idle ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress
[888]	257
[1218]	258	! for each field: define the OASIS name (srcv(:)%clname)
	259	! define receive or not from the namelist parameters (srcv(:)%laction)
	260	! define the north fold type of lbc (srcv(:)%nsgn)
[888]	261
[1218]	262	! default definitions of srcv
[3294]	263	srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1
[888]	264
[1218]	265	! ! ------------------------- !
	266	! ! ice and ocean wind stress !
	267	! ! ------------------------- !
	268	! ! Name
	269	srcv(jpr_otx1)%clname = 'O_OTaux1' ! 1st ocean component on grid ONE (T or U)
	270	srcv(jpr_oty1)%clname = 'O_OTauy1' ! 2nd - - - -
	271	srcv(jpr_otz1)%clname = 'O_OTauz1' ! 3rd - - - -
	272	srcv(jpr_otx2)%clname = 'O_OTaux2' ! 1st ocean component on grid TWO (V)
	273	srcv(jpr_oty2)%clname = 'O_OTauy2' ! 2nd - - - -
	274	srcv(jpr_otz2)%clname = 'O_OTauz2' ! 3rd - - - -
	275	!
	276	srcv(jpr_itx1)%clname = 'O_ITaux1' ! 1st ice component on grid ONE (T, F, I or U)
	277	srcv(jpr_ity1)%clname = 'O_ITauy1' ! 2nd - - - -
	278	srcv(jpr_itz1)%clname = 'O_ITauz1' ! 3rd - - - -
	279	srcv(jpr_itx2)%clname = 'O_ITaux2' ! 1st ice component on grid TWO (V)
	280	srcv(jpr_ity2)%clname = 'O_ITauy2' ! 2nd - - - -
	281	srcv(jpr_itz2)%clname = 'O_ITauz2' ! 3rd - - - -
	282	!
[1833]	283	! Vectors: change of sign at north fold ONLY if on the local grid
[3294]	284	IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1.
[1218]	285
	286	! ! Set grid and action
[3294]	287	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]	288	CASE( 'T' )
	289	srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
	290	srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
	291	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
	292	CASE( 'U,V' )
	293	srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
	294	srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
	295	srcv(jpr_itx1:jpr_itz1)%clgrid = 'U' ! ice components given at U-point
	296	srcv(jpr_itx2:jpr_itz2)%clgrid = 'V' ! and V-point
	297	srcv(jpr_otx1:jpr_itz2)%laction = .TRUE. ! receive oce and ice components on both grid 1 & 2
	298	CASE( 'U,V,T' )
	299	srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
	300	srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
	301	srcv(jpr_itx1:jpr_itz1)%clgrid = 'T' ! ice components given at T-point
	302	srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
	303	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
	304	CASE( 'U,V,I' )
	305	srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
	306	srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
	307	srcv(jpr_itx1:jpr_itz1)%clgrid = 'I' ! ice components given at I-point
	308	srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
	309	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
	310	CASE( 'U,V,F' )
	311	srcv(jpr_otx1:jpr_otz1)%clgrid = 'U' ! oce components given at U-point
	312	srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point
	313	srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point
	314	srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2
	315	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only
	316	CASE( 'T,I' )
	317	srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
	318	srcv(jpr_itx1:jpr_itz1)%clgrid = 'I' ! ice components given at I-point
	319	srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
	320	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
	321	CASE( 'T,F' )
	322	srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point
	323	srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point
	324	srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1
	325	srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1
	326	CASE( 'T,U,V' )
	327	srcv(jpr_otx1:jpr_otz1)%clgrid = 'T' ! oce components given at T-point
	328	srcv(jpr_itx1:jpr_itz1)%clgrid = 'U' ! ice components given at U-point
	329	srcv(jpr_itx2:jpr_itz2)%clgrid = 'V' ! and V-point
	330	srcv(jpr_otx1:jpr_otz1)%laction = .TRUE. ! receive oce components on grid 1 only
	331	srcv(jpr_itx1:jpr_itz2)%laction = .TRUE. ! receive ice components on grid 1 & 2
	332	CASE default
[3294]	333	CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' )
[1218]	334	END SELECT
	335	!
[3294]	336	IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' ) & ! spherical: 3rd component not received
[1218]	337	& srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE.
	338	!
[3680]	339	IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) THEN ! already on local grid -> no need of the second grid
	340	srcv(jpr_otx2:jpr_otz2)%laction = .FALSE.
	341	srcv(jpr_itx2:jpr_itz2)%laction = .FALSE.
	342	srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid ! not needed but cleaner...
	343	srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid ! not needed but cleaner...
	344	ENDIF
	345	!
[3294]	346	IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used
[4162]	347	srcv(jpr_itx1:jpr_itz2)%laction = .FALSE. ! ice components not received
[1218]	348	srcv(jpr_itx1)%clgrid = 'U' ! ocean stress used after its transformation
	349	srcv(jpr_ity1)%clgrid = 'V' ! i.e. it is always at U- & V-points for i- & j-comp. resp.
	350	ENDIF
	351
	352	! ! ------------------------- !
	353	! ! freshwater budget ! E-P
	354	! ! ------------------------- !
	355	! we suppose that atmosphere modele do not make the difference between precipiration (liquide or solid)
	356	! over ice of free ocean within the same atmospheric cell.cd
	357	srcv(jpr_rain)%clname = 'OTotRain' ! Rain = liquid precipitation
	358	srcv(jpr_snow)%clname = 'OTotSnow' ! Snow = solid precipitation
	359	srcv(jpr_tevp)%clname = 'OTotEvap' ! total evaporation (over oce + ice sublimation)
	360	srcv(jpr_ievp)%clname = 'OIceEvap' ! evaporation over ice = sublimation
[1232]	361	srcv(jpr_sbpr)%clname = 'OSubMPre' ! sublimation - liquid precipitation - solid precipitation
	362	srcv(jpr_semp)%clname = 'OISubMSn' ! ice solid water budget = sublimation - solid precipitation
	363	srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip
[3294]	364	SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
[1218]	365	CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE.
[4162]	366	CASE( 'conservative' )
	367	srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE.
[4393]	368	IF ( k_ice <= 1 ) srcv(jpr_ievp)%laction = .FALSE.
[1232]	369	CASE( 'oce and ice' ) ; srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE.
[3294]	370	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' )
[1218]	371	END SELECT
[888]	372
[1218]	373	! ! ------------------------- !
	374	! ! Runoffs & Calving !
	375	! ! ------------------------- !
[3294]	376	srcv(jpr_rnf )%clname = 'O_Runoff' ; IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE.
	377	! This isn't right - really just want ln_rnf_emp changed
	378	! IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' ) THEN ; ln_rnf = .TRUE.
	379	! ELSE ; ln_rnf = .FALSE.
	380	! ENDIF
	381	srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE.
[888]	382
[1218]	383	! ! ------------------------- !
	384	! ! non solar radiation ! Qns
	385	! ! ------------------------- !
	386	srcv(jpr_qnsoce)%clname = 'O_QnsOce'
	387	srcv(jpr_qnsice)%clname = 'O_QnsIce'
	388	srcv(jpr_qnsmix)%clname = 'O_QnsMix'
[3294]	389	SELECT CASE( TRIM( sn_rcv_qns%cldes ) )
[1218]	390	CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE.
	391	CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE.
	392	CASE( 'oce and ice' ) ; srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE.
	393	CASE( 'mixed oce-ice' ) ; srcv( jpr_qnsmix )%laction = .TRUE.
[3294]	394	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' )
[1218]	395	END SELECT
[3294]	396	IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) &
	397	CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' )
[1218]	398	! ! ------------------------- !
	399	! ! solar radiation ! Qsr
	400	! ! ------------------------- !
	401	srcv(jpr_qsroce)%clname = 'O_QsrOce'
	402	srcv(jpr_qsrice)%clname = 'O_QsrIce'
	403	srcv(jpr_qsrmix)%clname = 'O_QsrMix'
[3294]	404	SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )
[1218]	405	CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE.
	406	CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE.
	407	CASE( 'oce and ice' ) ; srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE.
	408	CASE( 'mixed oce-ice' ) ; srcv( jpr_qsrmix )%laction = .TRUE.
[3294]	409	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' )
[1218]	410	END SELECT
[3294]	411	IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) &
	412	CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' )
[1218]	413	! ! ------------------------- !
	414	! ! non solar sensitivity ! d(Qns)/d(T)
	415	! ! ------------------------- !
	416	srcv(jpr_dqnsdt)%clname = 'O_dQnsdT'
[3294]	417	IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' ) srcv(jpr_dqnsdt)%laction = .TRUE.
[1232]	418	!
[3294]	419	! non solar sensitivity mandatory for LIM ice model
	420	IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) &
	421	CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' )
[1232]	422	! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique
[3294]	423	IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) &
	424	CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' )
[1218]	425	! ! ------------------------- !
	426	! ! 10m wind module !
	427	! ! ------------------------- !
[3294]	428	srcv(jpr_w10m)%clname = 'O_Wind10' ; IF( TRIM(sn_rcv_w10m%cldes ) == 'coupled' ) srcv(jpr_w10m)%laction = .TRUE.
[1696]	429	!
	430	! ! ------------------------- !
	431	! ! wind stress module !
	432	! ! ------------------------- !
[3294]	433	srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE.
[1705]	434	lhftau = srcv(jpr_taum)%laction
[1534]	435
	436	! ! ------------------------- !
	437	! ! Atmospheric CO2 !
	438	! ! ------------------------- !
[3294]	439	srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE.
	440	! ! ------------------------- !
	441	! ! topmelt and botmelt !
	442	! ! ------------------------- !
	443	srcv(jpr_topm )%clname = 'OTopMlt'
	444	srcv(jpr_botm )%clname = 'OBotMlt'
	445	IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN
	446	IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN
	447	srcv(jpr_topm:jpr_botm)%nct = jpl
	448	ELSE
	449	CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' )
	450	ENDIF
	451	srcv(jpr_topm:jpr_botm)%laction = .TRUE.
	452	ENDIF
	453
	454	! Allocate all parts of frcv used for received fields
	455	DO jn = 1, jprcv
	456	IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
	457	END DO
	458	! Allocate taum part of frcv which is used even when not received as coupling field
[4990]	459	IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
[4162]	460	! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.
	461	IF( k_ice /= 0 ) THEN
[4990]	462	IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )
	463	IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
[4162]	464	END IF
[3294]	465
[1218]	466	! ================================ !
	467	! Define the send interface !
	468	! ================================ !
[3294]	469	! for each field: define the OASIS name (ssnd(:)%clname)
	470	! define send or not from the namelist parameters (ssnd(:)%laction)
	471	! define the north fold type of lbc (ssnd(:)%nsgn)
[1218]	472
	473	! default definitions of nsnd
[3294]	474	ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1
[1218]	475
	476	! ! ------------------------- !
	477	! ! Surface temperature !
	478	! ! ------------------------- !
	479	ssnd(jps_toce)%clname = 'O_SSTSST'
	480	ssnd(jps_tice)%clname = 'O_TepIce'
	481	ssnd(jps_tmix)%clname = 'O_TepMix'
[3294]	482	SELECT CASE( TRIM( sn_snd_temp%cldes ) )
[3680]	483	CASE( 'none' ) ! nothing to do
[1218]	484	CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE.
[3294]	485	CASE( 'weighted oce and ice' )
	486	ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE.
	487	IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl
[1218]	488	CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE.
[3294]	489	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' )
[1218]	490	END SELECT
	491
	492	! ! ------------------------- !
	493	! ! Albedo !
	494	! ! ------------------------- !
	495	ssnd(jps_albice)%clname = 'O_AlbIce'
	496	ssnd(jps_albmix)%clname = 'O_AlbMix'
[3294]	497	SELECT CASE( TRIM( sn_snd_alb%cldes ) )
[1218]	498	CASE( 'none' ) ! nothing to do
	499	CASE( 'weighted ice' ) ; ssnd(jps_albice)%laction = .TRUE.
	500	CASE( 'mixed oce-ice' ) ; ssnd(jps_albmix)%laction = .TRUE.
[3294]	501	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' )
[1218]	502	END SELECT
[1232]	503	!
	504	! Need to calculate oceanic albedo if
	505	! 1. sending mixed oce-ice albedo or
	506	! 2. receiving mixed oce-ice solar radiation
[3294]	507	IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN
[1308]	508	CALL albedo_oce( zaos, zacs )
	509	! Due to lack of information on nebulosity : mean clear/overcast sky
	510	albedo_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5
[1232]	511	ENDIF
	512
[1218]	513	! ! ------------------------- !
	514	! ! Ice fraction & Thickness !
	515	! ! ------------------------- !
[3294]	516	ssnd(jps_fice)%clname = 'OIceFrc'
	517	ssnd(jps_hice)%clname = 'OIceTck'
	518	ssnd(jps_hsnw)%clname = 'OSnwTck'
	519	IF( k_ice /= 0 ) THEN
	520	ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case)
	521	! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now
	522	IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl
	523	ENDIF
	524
	525	SELECT CASE ( TRIM( sn_snd_thick%cldes ) )
[3680]	526	CASE( 'none' ) ! nothing to do
	527	CASE( 'ice and snow' )
[3294]	528	ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
	529	IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
	530	ssnd(jps_hice:jps_hsnw)%nct = jpl
	531	ELSE
	532	IF ( jpl > 1 ) THEN
[3680]	533	CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' )
[3294]	534	ENDIF
	535	ENDIF
	536	CASE ( 'weighted ice and snow' )
	537	ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
	538	IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = jpl
	539	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' )
	540	END SELECT
	541
[1218]	542	! ! ------------------------- !
	543	! ! Surface current !
	544	! ! ------------------------- !
	545	! ocean currents ! ice velocities
	546	ssnd(jps_ocx1)%clname = 'O_OCurx1' ; ssnd(jps_ivx1)%clname = 'O_IVelx1'
	547	ssnd(jps_ocy1)%clname = 'O_OCury1' ; ssnd(jps_ivy1)%clname = 'O_IVely1'
	548	ssnd(jps_ocz1)%clname = 'O_OCurz1' ; ssnd(jps_ivz1)%clname = 'O_IVelz1'
	549	!
[2090]	550	ssnd(jps_ocx1:jps_ivz1)%nsgn = -1. ! vectors: change of the sign at the north fold
[1218]	551
[3294]	552	IF( sn_snd_crt%clvgrd == 'U,V' ) THEN
	553	ssnd(jps_ocx1)%clgrid = 'U' ; ssnd(jps_ocy1)%clgrid = 'V'
	554	ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN
	555	CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' )
	556	ssnd(jps_ocx1:jps_ivz1)%clgrid = 'T' ! all oce and ice components on the same unique grid
	557	ENDIF
[1226]	558	ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE. ! default: all are send
[3294]	559	IF( TRIM( sn_snd_crt%clvref ) == 'spherical' ) ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE.
	560	IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) ssnd(jps_ocx1:jps_ivz1)%nsgn = 1.
	561	SELECT CASE( TRIM( sn_snd_crt%cldes ) )
[1226]	562	CASE( 'none' ) ; ssnd(jps_ocx1:jps_ivz1)%laction = .FALSE.
	563	CASE( 'oce only' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
[1218]	564	CASE( 'weighted oce and ice' ) ! nothing to do
[1226]	565	CASE( 'mixed oce-ice' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
[3294]	566	CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crt%cldes' )
[1218]	567	END SELECT
	568
[1534]	569	! ! ------------------------- !
	570	! ! CO2 flux !
	571	! ! ------------------------- !
[3294]	572	ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE.
[1534]	573	!
[1218]	574	! ================================ !
	575	! initialisation of the coupler !
	576	! ================================ !
[1226]	577
[4990]	578	CALL cpl_define(jprcv, jpsnd,nn_cplmodel)
	579	IF (ln_usecplmask) THEN
	580	xcplmask(:,:,:) = 0.
	581	CALL iom_open( 'cplmask', inum )
	582	CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel), &
	583	& kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) )
	584	CALL iom_close( inum )
	585	ELSE
	586	xcplmask(:,:,:) = 1.
	587	ENDIF
[1218]	588	!
[4990]	589	IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) ) &
[2528]	590	& CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
	591
[3294]	592	CALL wrk_dealloc( jpi,jpj, zacs, zaos )
[2715]	593	!
[3294]	594	IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_init')
	595	!
[1218]	596	END SUBROUTINE sbc_cpl_init
	597
	598
	599	SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )
	600	!!----------------------------------------------------------------------
	601	!! * ROUTINE sbc_cpl_rcv *
[888]	602	!!
[1218]	603	!! ** Purpose : provide the stress over the ocean and, if no sea-ice,
	604	!! provide the ocean heat and freshwater fluxes.
[888]	605	!!
[1218]	606	!! ** Method : - Receive all the atmospheric fields (stored in frcv array). called at each time step.
	607	!! OASIS controls if there is something do receive or not. nrcvinfo contains the info
	608	!! to know if the field was really received or not
[888]	609	!!
[1218]	610	!! --> If ocean stress was really received:
[888]	611	!!
[1218]	612	!! - transform the received ocean stress vector from the received
	613	!! referential and grid into an atmosphere-ocean stress in
	614	!! the (i,j) ocean referencial and at the ocean velocity point.
	615	!! The received stress are :
	616	!! - defined by 3 components (if cartesian coordinate)
	617	!! or by 2 components (if spherical)
	618	!! - oriented along geographical coordinate (if eastward-northward)
	619	!! or along the local grid coordinate (if local grid)
	620	!! - given at U- and V-point, resp. if received on 2 grids
	621	!! or at T-point if received on 1 grid
	622	!! Therefore and if necessary, they are successively
	623	!! processed in order to obtain them
	624	!! first as 2 components on the sphere
	625	!! second as 2 components oriented along the local grid
	626	!! third as 2 components on the U,V grid
[888]	627	!!
[1218]	628	!! -->
[888]	629	!!
[1218]	630	!! - In 'ocean only' case, non solar and solar ocean heat fluxes
	631	!! and total ocean freshwater fluxes
	632	!!
	633	!! ** Method : receive all fields from the atmosphere and transform
	634	!! them into ocean surface boundary condition fields
	635	!!
	636	!! ** Action : update utau, vtau ocean stress at U,V grid
[4990]	637	!! taum wind stress module at T-point
	638	!! wndm wind speed module at T-point over free ocean or leads in presence of sea-ice
[3625]	639	!! qns non solar heat fluxes including emp heat content (ocean only case)
	640	!! and the latent heat flux of solid precip. melting
	641	!! qsr solar ocean heat fluxes (ocean only case)
	642	!! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case)
[888]	643	!!----------------------------------------------------------------------
[1218]	644	INTEGER, INTENT(in) :: kt ! ocean model time step index
	645	INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation
	646	INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)
[888]	647	!!
[1696]	648	LOGICAL :: llnewtx, llnewtau ! update wind stress components and module??
[1218]	649	INTEGER :: ji, jj, jn ! dummy loop indices
	650	INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000)
	651	REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars
[1226]	652	REAL(wp) :: zcoef ! temporary scalar
[1695]	653	REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3
	654	REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient
	655	REAL(wp) :: zzx, zzy ! temporary variables
[3294]	656	REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty
[1218]	657	!!----------------------------------------------------------------------
[3294]	658	!
	659	IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv')
	660	!
	661	CALL wrk_alloc( jpi,jpj, ztx, zty )
[1218]	662	! ! Receive all the atmos. fields (including ice information)
	663	isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges
	664	DO jn = 1, jprcv ! received fields sent by the atmosphere
[4990]	665	IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) )
[1218]	666	END DO
[888]	667
[1218]	668	! ! ========================= !
[1696]	669	IF( srcv(jpr_otx1)%laction ) THEN ! ocean stress components !
[1218]	670	! ! ========================= !
[3294]	671	! define frcv(jpr_otx1)%z3(:,:,1) and frcv(jpr_oty1)%z3(:,:,1): stress at U/V point along model grid
[1218]	672	! => need to be done only when we receive the field
[1698]	673	IF( nrcvinfo(jpr_otx1) == OASIS_Rcv ) THEN
[1218]	674	!
[3294]	675	IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere
[1218]	676	! ! (cartesian to spherical -> 3 to 2 components)
	677	!
[3294]	678	CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1), &
[1218]	679	& srcv(jpr_otx1)%clgrid, ztx, zty )
[3294]	680	frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid
	681	frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid
[1218]	682	!
	683	IF( srcv(jpr_otx2)%laction ) THEN
[3294]	684	CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1), &
[1218]	685	& srcv(jpr_otx2)%clgrid, ztx, zty )
[3294]	686	frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid
	687	frcv(jpr_oty2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid
[1218]	688	ENDIF
	689	!
	690	ENDIF
	691	!
[3294]	692	IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid
[1218]	693	! ! (geographical to local grid -> rotate the components)
[3294]	694	CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )
[1218]	695	IF( srcv(jpr_otx2)%laction ) THEN
[3294]	696	CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )
	697	ELSE
	698	CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )
[1218]	699	ENDIF
[3632]	700	frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid
[3294]	701	frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid
[1218]	702	ENDIF
	703	!
	704	IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN
	705	DO jj = 2, jpjm1 ! T ==> (U,V)
	706	DO ji = fs_2, fs_jpim1 ! vector opt.
[3294]	707	frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) )
	708	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]	709	END DO
	710	END DO
[3294]	711	CALL lbc_lnk( frcv(jpr_otx1)%z3(:,:,1), 'U', -1. ) ; CALL lbc_lnk( frcv(jpr_oty1)%z3(:,:,1), 'V', -1. )
[1218]	712	ENDIF
[1696]	713	llnewtx = .TRUE.
	714	ELSE
	715	llnewtx = .FALSE.
[1218]	716	ENDIF
	717	! ! ========================= !
	718	ELSE ! No dynamical coupling !
	719	! ! ========================= !
[3294]	720	frcv(jpr_otx1)%z3(:,:,1) = 0.e0 ! here simply set to zero
	721	frcv(jpr_oty1)%z3(:,:,1) = 0.e0 ! an external read in a file can be added instead
[1696]	722	llnewtx = .TRUE.
[1218]	723	!
	724	ENDIF
	725
[1696]	726	! ! ========================= !
	727	! ! wind stress module ! (taum)
	728	! ! ========================= !
	729	!
	730	IF( .NOT. srcv(jpr_taum)%laction ) THEN ! compute wind stress module from its components if not received
	731	! => need to be done only when otx1 was changed
	732	IF( llnewtx ) THEN
[1695]	733	!CDIR NOVERRCHK
[1696]	734	DO jj = 2, jpjm1
[1695]	735	!CDIR NOVERRCHK
[1696]	736	DO ji = fs_2, fs_jpim1 ! vect. opt.
[3294]	737	zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
	738	zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)
	739	frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
[1696]	740	END DO
[1695]	741	END DO
[3294]	742	CALL lbc_lnk( frcv(jpr_taum)%z3(:,:,1), 'T', 1. )
[1696]	743	llnewtau = .TRUE.
	744	ELSE
	745	llnewtau = .FALSE.
	746	ENDIF
	747	ELSE
[1706]	748	llnewtau = nrcvinfo(jpr_taum) == OASIS_Rcv
[1726]	749	! Stress module can be negative when received (interpolation problem)
	750	IF( llnewtau ) THEN
[3625]	751	frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) )
[1726]	752	ENDIF
[1696]	753	ENDIF
	754
	755	! ! ========================= !
	756	! ! 10 m wind speed ! (wndm)
	757	! ! ========================= !
	758	!
	759	IF( .NOT. srcv(jpr_w10m)%laction ) THEN ! compute wind spreed from wind stress module if not received
	760	! => need to be done only when taumod was changed
	761	IF( llnewtau ) THEN
[1695]	762	zcoef = 1. / ( zrhoa * zcdrag )
[1697]	763	!CDIR NOVERRCHK
[1695]	764	DO jj = 1, jpj
[1697]	765	!CDIR NOVERRCHK
[1695]	766	DO ji = 1, jpi
[3294]	767	wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
[1695]	768	END DO
	769	END DO
	770	ENDIF
[3294]	771	ELSE
	772	IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)
[1696]	773	ENDIF
	774
[3294]	775	! u(v)tau and taum will be modified by ice model
[1696]	776	! -> need to be reset before each call of the ice/fsbc
	777	IF( MOD( kt-1, k_fsbc ) == 0 ) THEN
	778	!
[3294]	779	utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)
	780	vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)
	781	taum(:,:) = frcv(jpr_taum)%z3(:,:,1)
[1705]	782	CALL iom_put( "taum_oce", taum ) ! output wind stress module
[1695]	783	!
[1218]	784	ENDIF
[3294]	785
	786	#if defined key_cpl_carbon_cycle
	787	! ! atmosph. CO2 (ppm)
	788	IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1)
	789	#endif
	790
[1218]	791	! ! ========================= !
[1226]	792	IF( k_ice <= 1 ) THEN ! heat & freshwater fluxes ! (Ocean only case)
[1218]	793	! ! ========================= !
	794	!
[3625]	795	! ! total freshwater fluxes over the ocean (emp)
[3294]	796	SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation
[1218]	797	CASE( 'conservative' )
[3294]	798	emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
[1308]	799	CASE( 'oce only', 'oce and ice' )
[3294]	800	emp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
[1308]	801	CASE default
[3294]	802	CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
[1218]	803	END SELECT
	804	!
	805	! ! runoffs and calving (added in emp)
[3294]	806	IF( srcv(jpr_rnf)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1)
	807	IF( srcv(jpr_cal)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1)
[1218]	808	!
	809	!!gm : this seems to be internal cooking, not sure to need that in a generic interface
	810	!!gm at least should be optional...
[3294]	811	!! IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN ! add to the total freshwater budget
[1218]	812	!! ! remove negative runoff
[3294]	813	!! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
	814	!! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
[1218]	815	!! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) ! sum over the global domain
	816	!! IF( lk_mpp ) CALL mpp_sum( zcumulneg )
	817	!! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points
	818	!! zcumulneg = 1.e0 + zcumulneg / zcumulpos
[3294]	819	!! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg
[1218]	820	!! ENDIF
	821	!! ! add runoff to e-p
[3294]	822	!! emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1)
[1218]	823	!! ENDIF
	824	!!gm end of internal cooking
	825	!
[3625]	826	! ! non solar heat flux over the ocean (qns)
	827	IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
	828	IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
[4990]	829	! update qns over the free ocean with:
	830	qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST)
	831	IF( srcv(jpr_snow )%laction ) THEN
	832	qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean
[3625]	833	ENDIF
	834
	835	! ! solar flux over the ocean (qsr)
	836	IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
	837	IF( srcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
	838	IF( ln_dm2dc ) qsr(:,:) = sbc_dcy( qsr ) ! modify qsr to include the diurnal cycle
	839	!
[1230]	840
[1218]	841	ENDIF
	842	!
[3294]	843	CALL wrk_dealloc( jpi,jpj, ztx, zty )
[2715]	844	!
[3294]	845	IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv')
	846	!
[1218]	847	END SUBROUTINE sbc_cpl_rcv
	848
	849
	850	SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )
	851	!!----------------------------------------------------------------------
	852	!! * ROUTINE sbc_cpl_ice_tau *
	853	!!
	854	!! ** Purpose : provide the stress over sea-ice in coupled mode
	855	!!
	856	!! ** Method : transform the received stress from the atmosphere into
	857	!! an atmosphere-ice stress in the (i,j) ocean referencial
[2528]	858	!! and at the velocity point of the sea-ice model (cp_ice_msh):
[1218]	859	!! 'C'-grid : i- (j-) components given at U- (V-) point
[2528]	860	!! 'I'-grid : B-grid lower-left corner: both components given at I-point
[1218]	861	!!
	862	!! The received stress are :
	863	!! - defined by 3 components (if cartesian coordinate)
	864	!! or by 2 components (if spherical)
	865	!! - oriented along geographical coordinate (if eastward-northward)
	866	!! or along the local grid coordinate (if local grid)
	867	!! - given at U- and V-point, resp. if received on 2 grids
	868	!! or at a same point (T or I) if received on 1 grid
	869	!! Therefore and if necessary, they are successively
	870	!! processed in order to obtain them
	871	!! first as 2 components on the sphere
	872	!! second as 2 components oriented along the local grid
[2528]	873	!! third as 2 components on the cp_ice_msh point
[1218]	874	!!
[4148]	875	!! Except in 'oce and ice' case, only one vector stress field
[1218]	876	!! is received. It has already been processed in sbc_cpl_rcv
	877	!! so that it is now defined as (i,j) components given at U-
[4148]	878	!! and V-points, respectively. Therefore, only the third
[2528]	879	!! transformation is done and only if the ice-grid is a 'I'-grid.
[1218]	880	!!
[2528]	881	!! ** Action : return ptau_i, ptau_j, the stress over the ice at cp_ice_msh point
[1218]	882	!!----------------------------------------------------------------------
[2715]	883	REAL(wp), INTENT(out), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2]
	884	REAL(wp), INTENT(out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid)
	885	!!
[1218]	886	INTEGER :: ji, jj ! dummy loop indices
	887	INTEGER :: itx ! index of taux over ice
[3294]	888	REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty
[1218]	889	!!----------------------------------------------------------------------
[3294]	890	!
	891	IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_tau')
	892	!
	893	CALL wrk_alloc( jpi,jpj, ztx, zty )
[1218]	894
[4990]	895	IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1
[1218]	896	ELSE ; itx = jpr_otx1
	897	ENDIF
	898
	899	! do something only if we just received the stress from atmosphere
[1698]	900	IF( nrcvinfo(itx) == OASIS_Rcv ) THEN
[1218]	901
[4990]	902	! ! ======================= !
	903	IF( srcv(jpr_itx1)%laction ) THEN ! ice stress received !
	904	! ! ======================= !
[1218]	905	!
[3294]	906	IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere
[1218]	907	! ! (cartesian to spherical -> 3 to 2 components)
[3294]	908	CALL geo2oce( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1), &
[1218]	909	& srcv(jpr_itx1)%clgrid, ztx, zty )
[3294]	910	frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid
	911	frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid
[1218]	912	!
	913	IF( srcv(jpr_itx2)%laction ) THEN
[3294]	914	CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1), &
[1218]	915	& srcv(jpr_itx2)%clgrid, ztx, zty )
[3294]	916	frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid
	917	frcv(jpr_ity2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid
[1218]	918	ENDIF
	919	!
[888]	920	ENDIF
[1218]	921	!
[3294]	922	IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid
[1218]	923	! ! (geographical to local grid -> rotate the components)
[3294]	924	CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )
[1218]	925	IF( srcv(jpr_itx2)%laction ) THEN
[3294]	926	CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )
[1218]	927	ELSE
[3294]	928	CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty )
[1218]	929	ENDIF
[3632]	930	frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid
[3294]	931	frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid
[1218]	932	ENDIF
	933	! ! ======================= !
	934	ELSE ! use ocean stress !
	935	! ! ======================= !
[3294]	936	frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1)
	937	frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1)
[1218]	938	!
	939	ENDIF
[888]	940
[1218]	941	! ! ======================= !
	942	! ! put on ice grid !
	943	! ! ======================= !
	944	!
	945	! j+1 j -----V---F
[2528]	946	! ice stress on ice velocity point (cp_ice_msh) ! \|
[1467]	947	! (C-grid ==>(U,V) or B-grid ==> I or F) j \| T U
[1218]	948	! \| \|
	949	! j j-1 -I-------\|
	950	! (for I) \| \|
	951	! i-1 i i
	952	! i i+1 (for I)
[2528]	953	SELECT CASE ( cp_ice_msh )
[1218]	954	!
[1467]	955	CASE( 'I' ) ! B-grid ==> I
[1218]	956	SELECT CASE ( srcv(jpr_itx1)%clgrid )
	957	CASE( 'U' )
	958	DO jj = 2, jpjm1 ! (U,V) ==> I
[1694]	959	DO ji = 2, jpim1 ! NO vector opt.
[3294]	960	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji-1,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )
	961	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )
[1218]	962	END DO
	963	END DO
	964	CASE( 'F' )
	965	DO jj = 2, jpjm1 ! F ==> I
[1694]	966	DO ji = 2, jpim1 ! NO vector opt.
[3294]	967	p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji-1,jj-1,1)
	968	p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji-1,jj-1,1)
[1218]	969	END DO
	970	END DO
	971	CASE( 'T' )
	972	DO jj = 2, jpjm1 ! T ==> I
[1694]	973	DO ji = 2, jpim1 ! NO vector opt.
[3294]	974	p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj ,1) &
	975	& + frcv(jpr_itx1)%z3(ji,jj-1,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )
	976	p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) &
	977	& + frcv(jpr_oty1)%z3(ji,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )
[1218]	978	END DO
	979	END DO
	980	CASE( 'I' )
[3294]	981	p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! I ==> I
	982	p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
[1218]	983	END SELECT
	984	IF( srcv(jpr_itx1)%clgrid /= 'I' ) THEN
	985	CALL lbc_lnk( p_taui, 'I', -1. ) ; CALL lbc_lnk( p_tauj, 'I', -1. )
	986	ENDIF
	987	!
[1467]	988	CASE( 'F' ) ! B-grid ==> F
	989	SELECT CASE ( srcv(jpr_itx1)%clgrid )
	990	CASE( 'U' )
	991	DO jj = 2, jpjm1 ! (U,V) ==> F
	992	DO ji = fs_2, fs_jpim1 ! vector opt.
[3294]	993	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj+1,1) )
	994	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) )
[1467]	995	END DO
	996	END DO
	997	CASE( 'I' )
	998	DO jj = 2, jpjm1 ! I ==> F
[1694]	999	DO ji = 2, jpim1 ! NO vector opt.
[3294]	1000	p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji+1,jj+1,1)
	1001	p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji+1,jj+1,1)
[1467]	1002	END DO
	1003	END DO
	1004	CASE( 'T' )
	1005	DO jj = 2, jpjm1 ! T ==> F
[1694]	1006	DO ji = 2, jpim1 ! NO vector opt.
[3294]	1007	p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) &
	1008	& + frcv(jpr_itx1)%z3(ji,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj+1,1) )
	1009	p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) &
	1010	& + frcv(jpr_ity1)%z3(ji,jj+1,1) + frcv(jpr_ity1)%z3(ji+1,jj+1,1) )
[1467]	1011	END DO
	1012	END DO
	1013	CASE( 'F' )
[3294]	1014	p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! F ==> F
	1015	p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
[1467]	1016	END SELECT
	1017	IF( srcv(jpr_itx1)%clgrid /= 'F' ) THEN
	1018	CALL lbc_lnk( p_taui, 'F', -1. ) ; CALL lbc_lnk( p_tauj, 'F', -1. )
	1019	ENDIF
	1020	!
[1218]	1021	CASE( 'C' ) ! C-grid ==> U,V
	1022	SELECT CASE ( srcv(jpr_itx1)%clgrid )
	1023	CASE( 'U' )
[3294]	1024	p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! (U,V) ==> (U,V)
	1025	p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
[1218]	1026	CASE( 'F' )
	1027	DO jj = 2, jpjm1 ! F ==> (U,V)
	1028	DO ji = fs_2, fs_jpim1 ! vector opt.
[3294]	1029	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj-1,1) )
	1030	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(jj,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) )
[1218]	1031	END DO
	1032	END DO
	1033	CASE( 'T' )
	1034	DO jj = 2, jpjm1 ! T ==> (U,V)
	1035	DO ji = fs_2, fs_jpim1 ! vector opt.
[3294]	1036	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
	1037	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
[1218]	1038	END DO
	1039	END DO
	1040	CASE( 'I' )
	1041	DO jj = 2, jpjm1 ! I ==> (U,V)
[1694]	1042	DO ji = 2, jpim1 ! NO vector opt.
[3294]	1043	p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) )
	1044	p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji ,jj+1,1) )
[1218]	1045	END DO
	1046	END DO
	1047	END SELECT
	1048	IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN
	1049	CALL lbc_lnk( p_taui, 'U', -1. ) ; CALL lbc_lnk( p_tauj, 'V', -1. )
	1050	ENDIF
	1051	END SELECT
	1052
	1053	ENDIF
	1054	!
[3294]	1055	CALL wrk_dealloc( jpi,jpj, ztx, zty )
[2715]	1056	!
[3294]	1057	IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_tau')
	1058	!
[1218]	1059	END SUBROUTINE sbc_cpl_ice_tau
	1060
	1061
[3294]	1062	SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist )
[1218]	1063	!!----------------------------------------------------------------------
[3294]	1064	!! * ROUTINE sbc_cpl_ice_flx *
[1218]	1065	!!
	1066	!! ** Purpose : provide the heat and freshwater fluxes of the
	1067	!! ocean-ice system.
	1068	!!
	1069	!! ** Method : transform the fields received from the atmosphere into
	1070	!! surface heat and fresh water boundary condition for the
	1071	!! ice-ocean system. The following fields are provided:
	1072	!! * total non solar, solar and freshwater fluxes (qns_tot,
	1073	!! qsr_tot and emp_tot) (total means weighted ice-ocean flux)
	1074	!! NB: emp_tot include runoffs and calving.
	1075	!! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where
	1076	!! emp_ice = sublimation - solid precipitation as liquid
	1077	!! precipitation are re-routed directly to the ocean and
	1078	!! runoffs and calving directly enter the ocean.
	1079	!! * solid precipitation (sprecip), used to add to qns_tot
	1080	!! the heat lost associated to melting solid precipitation
	1081	!! over the ocean fraction.
	1082	!! ===>> CAUTION here this changes the net heat flux received from
	1083	!! the atmosphere
	1084	!!
	1085	!! - the fluxes have been separated from the stress as
	1086	!! (a) they are updated at each ice time step compare to
	1087	!! an update at each coupled time step for the stress, and
	1088	!! (b) the conservative computation of the fluxes over the
	1089	!! sea-ice area requires the knowledge of the ice fraction
	1090	!! after the ice advection and before the ice thermodynamics,
	1091	!! so that the stress is updated before the ice dynamics
	1092	!! while the fluxes are updated after it.
	1093	!!
	1094	!! ** Action : update at each nf_ice time step:
[3294]	1095	!! qns_tot, qsr_tot non-solar and solar total heat fluxes
	1096	!! qns_ice, qsr_ice non-solar and solar heat fluxes over the ice
	1097	!! emp_tot total evaporation - precipitation(liquid and solid) (-runoff)(-calving)
	1098	!! emp_ice ice sublimation - solid precipitation over the ice
	1099	!! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice
[1226]	1100	!! sprecip solid precipitation over the ocean
[1218]	1101	!!----------------------------------------------------------------------
[3294]	1102	REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1]
[1468]	1103	! optional arguments, used only in 'mixed oce-ice' case
[4990]	1104	REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo
	1105	REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius]
[2715]	1106	REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin]
[3294]	1107	!
	1108	INTEGER :: jl ! dummy loop index
	1109	REAL(wp), POINTER, DIMENSION(:,:) :: zcptn, ztmp, zicefr
[1218]	1110	!!----------------------------------------------------------------------
[3294]	1111	!
	1112	IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx')
	1113	!
	1114	CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr )
[2715]	1115
[3294]	1116	zicefr(:,:) = 1.- p_frld(:,:)
[3625]	1117	zcptn(:,:) = rcp * sst_m(:,:)
[888]	1118	!
[1218]	1119	! ! ========================= !
	1120	! ! freshwater budget ! (emp)
	1121	! ! ========================= !
[888]	1122	!
[1218]	1123	! ! total Precipitations - total Evaporation (emp_tot)
	1124	! ! solid precipitation - sublimation (emp_ice)
	1125	! ! solid Precipitation (sprecip)
[3294]	1126	SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
[1218]	1127	CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
[3294]	1128	sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here
	1129	tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here
	1130	emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:)
	1131	emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)
[4990]	1132	CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation
	1133	IF( iom_use('hflx_rain_cea') ) &
	1134	CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip.
	1135	IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) &
	1136	ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)
	1137	IF( iom_use('evap_ao_cea' ) ) &
	1138	CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average)
	1139	IF( iom_use('hflx_evap_cea') ) &
	1140	CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) ) ! heat flux from from evap (cell average)
[3294]	1141	CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
	1142	emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
	1143	emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1)
	1144	sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1)
[1218]	1145	END SELECT
[3294]	1146
[4990]	1147	CALL iom_put( 'snowpre' , sprecip ) ! Snow
	1148	IF( iom_use('snow_ao_cea') ) &
	1149	CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average)
	1150	IF( iom_use('snow_ai_cea') ) &
	1151	CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average)
	1152	IF( iom_use('subl_ai_cea') ) &
	1153	CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average)
[1218]	1154	!
	1155	! ! runoffs and calving (put in emp_tot)
[1756]	1156	IF( srcv(jpr_rnf)%laction ) THEN
[3294]	1157	emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)
[4990]	1158	CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers
	1159	IF( iom_use('hflx_rnf_cea') ) &
	1160	CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers
[1756]	1161	ENDIF
	1162	IF( srcv(jpr_cal)%laction ) THEN
[3294]	1163	emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
	1164	CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) )
[1756]	1165	ENDIF
[888]	1166	!
[1218]	1167	!!gm : this seems to be internal cooking, not sure to need that in a generic interface
	1168	!!gm at least should be optional...
	1169	!! ! remove negative runoff ! sum over the global domain
[3294]	1170	!! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
	1171	!! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
[1218]	1172	!! IF( lk_mpp ) CALL mpp_sum( zcumulpos )
	1173	!! IF( lk_mpp ) CALL mpp_sum( zcumulneg )
	1174	!! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points
	1175	!! zcumulneg = 1.e0 + zcumulneg / zcumulpos
[3294]	1176	!! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg
[1218]	1177	!! ENDIF
[3294]	1178	!! emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) ! add runoff to e-p
[1218]	1179	!!
	1180	!!gm end of internal cooking
[888]	1181
[1218]	1182	! ! ========================= !
[3294]	1183	SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns)
[1218]	1184	! ! ========================= !
[3294]	1185	CASE( 'oce only' ) ! the required field is directly provided
	1186	qns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1)
[1218]	1187	CASE( 'conservative' ) ! the required fields are directly provided
[3294]	1188	qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)
	1189	IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
	1190	qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
	1191	ELSE
	1192	! Set all category values equal for the moment
	1193	DO jl=1,jpl
	1194	qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
	1195	ENDDO
	1196	ENDIF
[1218]	1197	CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes
[3294]	1198	qns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
	1199	IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
	1200	DO jl=1,jpl
	1201	qns_tot(:,: ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)
	1202	qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
	1203	ENDDO
	1204	ELSE
	1205	DO jl=1,jpl
	1206	qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
	1207	qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
	1208	ENDDO
	1209	ENDIF
[1218]	1210	CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations
[3294]	1211	! NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED
	1212	qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)
	1213	qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) &
	1214	& + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) &
	1215	& + pist(:,:,1) * zicefr(:,:) ) )
[1218]	1216	END SELECT
[3625]	1217	ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus
	1218	qns_tot(:,:) = qns_tot(:,:) & ! qns_tot update over free ocean with:
	1219	& - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting
	1220	& - ( emp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST)
	1221	& - emp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:)
[4990]	1222	IF( iom_use('hflx_snow_cea') ) &
	1223	CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average)
[1218]	1224	!!gm
	1225	!! currently it is taken into account in leads budget but not in the qns_tot, and thus not in
	1226	!! the flux that enter the ocean....
	1227	!! moreover 1 - it is not diagnose anywhere....
	1228	!! 2 - it is unclear for me whether this heat lost is taken into account in the atmosphere or not...
	1229	!!
	1230	!! similar job should be done for snow and precipitation temperature
[1860]	1231	!
	1232	IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting
[3294]	1233	ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting
	1234	qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:)
[4990]	1235	IF( iom_use('hflx_cal_cea') ) &
	1236	CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving
[1742]	1237	ENDIF
[1218]	1238
	1239	! ! ========================= !
[3294]	1240	SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr)
[1218]	1241	! ! ========================= !
[3294]	1242	CASE( 'oce only' )
[3625]	1243	qsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
[1218]	1244	CASE( 'conservative' )
[3294]	1245	qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
	1246	IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
	1247	qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
	1248	ELSE
	1249	! Set all category values equal for the moment
	1250	DO jl=1,jpl
	1251	qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
	1252	ENDDO
	1253	ENDIF
	1254	qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
	1255	qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
[1218]	1256	CASE( 'oce and ice' )
[3294]	1257	qsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
	1258	IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
	1259	DO jl=1,jpl
	1260	qsr_tot(:,: ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)
	1261	qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
	1262	ENDDO
	1263	ELSE
	1264	DO jl=1,jpl
	1265	qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
	1266	qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
	1267	ENDDO
	1268	ENDIF
[1218]	1269	CASE( 'mixed oce-ice' )
[3294]	1270	qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
	1271	! NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED
[1232]	1272	! Create solar heat flux over ice using incoming solar heat flux and albedos
	1273	! ( see OASIS3 user guide, 5th edition, p39 )
[3294]	1274	qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) &
	1275	& / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) &
	1276	& + palbi (:,:,1) * zicefr(:,:) ) )
[1218]	1277	END SELECT
[2528]	1278	IF( ln_dm2dc ) THEN ! modify qsr to include the diurnal cycle
[3294]	1279	qsr_tot(:,: ) = sbc_dcy( qsr_tot(:,: ) )
	1280	DO jl=1,jpl
	1281	qsr_ice(:,:,jl) = sbc_dcy( qsr_ice(:,:,jl) )
	1282	ENDDO
[2528]	1283	ENDIF
[1218]	1284
[4990]	1285	! ! ========================= !
	1286	SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt !
	1287	! ! ========================= !
[1226]	1288	CASE ('coupled')
[3294]	1289	IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
	1290	dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
	1291	ELSE
	1292	! Set all category values equal for the moment
	1293	DO jl=1,jpl
	1294	dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
	1295	ENDDO
	1296	ENDIF
[1226]	1297	END SELECT
	1298
[4990]	1299	! ! ========================= !
	1300	SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt !
	1301	! ! ========================= !
[3294]	1302	CASE ('coupled')
	1303	topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:)
	1304	botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:)
	1305	END SELECT
	1306
[4990]	1307	! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 )
	1308	! Used for LIM2 and LIM3
[4162]	1309	! Coupled case: since cloud cover is not received from atmosphere
[4990]	1310	! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81)
	1311	fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
	1312	fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
[4162]	1313
[3294]	1314	CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr )
[2715]	1315	!
[3294]	1316	IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx')
	1317	!
[1226]	1318	END SUBROUTINE sbc_cpl_ice_flx
[1218]	1319
	1320
	1321	SUBROUTINE sbc_cpl_snd( kt )
	1322	!!----------------------------------------------------------------------
	1323	!! * ROUTINE sbc_cpl_snd *
	1324	!!
	1325	!! ** Purpose : provide the ocean-ice informations to the atmosphere
	1326	!!
[4990]	1327	!! ** Method : send to the atmosphere through a call to cpl_snd
[1218]	1328	!! all the needed fields (as defined in sbc_cpl_init)
	1329	!!----------------------------------------------------------------------
	1330	INTEGER, INTENT(in) :: kt
[2715]	1331	!
[3294]	1332	INTEGER :: ji, jj, jl ! dummy loop indices
[2715]	1333	INTEGER :: isec, info ! local integer
[3294]	1334	REAL(wp), POINTER, DIMENSION(:,:) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
	1335	REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp3, ztmp4
[1218]	1336	!!----------------------------------------------------------------------
[3294]	1337	!
	1338	IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_snd')
	1339	!
	1340	CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
	1341	CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 )
[888]	1342
[1218]	1343	isec = ( kt - nit000 ) * NINT(rdttra(1)) ! date of exchanges
[888]	1344
[1218]	1345	zfr_l(:,:) = 1.- fr_i(:,:)
	1346	! ! ------------------------- !
	1347	! ! Surface temperature ! in Kelvin
	1348	! ! ------------------------- !
[3680]	1349	IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
	1350	SELECT CASE( sn_snd_temp%cldes)
	1351	CASE( 'oce only' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0
	1352	CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)
	1353	SELECT CASE( sn_snd_temp%clcat )
	1354	CASE( 'yes' )
	1355	ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
	1356	CASE( 'no' )
	1357	ztmp3(:,:,:) = 0.0
	1358	DO jl=1,jpl
	1359	ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
	1360	ENDDO
	1361	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
	1362	END SELECT
	1363	CASE( 'mixed oce-ice' )
[4664]	1364	ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)
[3294]	1365	DO jl=1,jpl
[3680]	1366	ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
[3294]	1367	ENDDO
[3680]	1368	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
[3294]	1369	END SELECT
[4990]	1370	IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
	1371	IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info )
	1372	IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
[3680]	1373	ENDIF
[1218]	1374	! ! ------------------------- !
	1375	! ! Albedo !
	1376	! ! ------------------------- !
	1377	IF( ssnd(jps_albice)%laction ) THEN ! ice
[3294]	1378	ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
[4990]	1379	CALL cpl_snd( jps_albice, isec, ztmp3, info )
[888]	1380	ENDIF
[1218]	1381	IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean
[3294]	1382	ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:)
	1383	DO jl=1,jpl
	1384	ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl)
	1385	ENDDO
[4990]	1386	CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
[1218]	1387	ENDIF
	1388	! ! ------------------------- !
	1389	! ! Ice fraction & Thickness !
	1390	! ! ------------------------- !
[3294]	1391	! Send ice fraction field
[3680]	1392	IF( ssnd(jps_fice)%laction ) THEN
	1393	SELECT CASE( sn_snd_thick%clcat )
	1394	CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl)
	1395	CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(:,: )
	1396	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
	1397	END SELECT
[4990]	1398	CALL cpl_snd( jps_fice, isec, ztmp3, info )
[3680]	1399	ENDIF
[3294]	1400
	1401	! Send ice and snow thickness field
[3680]	1402	IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN
	1403	SELECT CASE( sn_snd_thick%cldes)
	1404	CASE( 'none' ) ! nothing to do
	1405	CASE( 'weighted ice and snow' )
	1406	SELECT CASE( sn_snd_thick%clcat )
	1407	CASE( 'yes' )
	1408	ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) * a_i(:,:,1:jpl)
	1409	ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) * a_i(:,:,1:jpl)
	1410	CASE( 'no' )
	1411	ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0
	1412	DO jl=1,jpl
	1413	ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl)
	1414	ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl)
	1415	ENDDO
	1416	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
	1417	END SELECT
	1418	CASE( 'ice and snow' )
	1419	ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl)
	1420	ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl)
	1421	CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' )
[3294]	1422	END SELECT
[4990]	1423	IF( ssnd(jps_hice)%laction ) CALL cpl_snd( jps_hice, isec, ztmp3, info )
	1424	IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info )
[3680]	1425	ENDIF
[1218]	1426	!
[1534]	1427	#if defined key_cpl_carbon_cycle
[1218]	1428	! ! ------------------------- !
[1534]	1429	! ! CO2 flux from PISCES !
	1430	! ! ------------------------- !
[4990]	1431	IF( ssnd(jps_co2)%laction ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )
[1534]	1432	!
	1433	#endif
[3294]	1434	! ! ------------------------- !
[1218]	1435	IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current !
	1436	! ! ------------------------- !
[1467]	1437	!
	1438	! j+1 j -----V---F
[1694]	1439	! surface velocity always sent from T point ! \|
[1467]	1440	! j \| T U
	1441	! \| \|
	1442	! j j-1 -I-------\|
	1443	! (for I) \| \|
	1444	! i-1 i i
	1445	! i i+1 (for I)
[3294]	1446	SELECT CASE( TRIM( sn_snd_crt%cldes ) )
[1467]	1447	CASE( 'oce only' ) ! C-grid ==> T
[1218]	1448	DO jj = 2, jpjm1
	1449	DO ji = fs_2, fs_jpim1 ! vector opt.
	1450	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) )
[1308]	1451	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) )
[1218]	1452	END DO
	1453	END DO
	1454	CASE( 'weighted oce and ice' )
[2528]	1455	SELECT CASE ( cp_ice_msh )
[1467]	1456	CASE( 'C' ) ! Ocean and Ice on C-grid ==> T
[1218]	1457	DO jj = 2, jpjm1
	1458	DO ji = fs_2, fs_jpim1 ! vector opt.
[1472]	1459	zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj)
	1460	zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj)
	1461	zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
	1462	zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
[1218]	1463	END DO
	1464	END DO
[1467]	1465	CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T
[1218]	1466	DO jj = 2, jpjm1
[1694]	1467	DO ji = 2, jpim1 ! NO vector opt.
[1693]	1468	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj)
[1472]	1469	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj)
	1470	zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) &
	1471	& + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
	1472	zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) &
	1473	& + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
[1218]	1474	END DO
	1475	END DO
[1467]	1476	CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T
	1477	DO jj = 2, jpjm1
[1694]	1478	DO ji = 2, jpim1 ! NO vector opt.
[1693]	1479	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj)
[1472]	1480	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj)
	1481	zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) &
	1482	& + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
	1483	zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) &
	1484	& + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
[1467]	1485	END DO
	1486	END DO
	1487	END SELECT
[1218]	1488	CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. )
	1489	CASE( 'mixed oce-ice' )
[2528]	1490	SELECT CASE ( cp_ice_msh )
[1467]	1491	CASE( 'C' ) ! Ocean and Ice on C-grid ==> T
[1218]	1492	DO jj = 2, jpjm1
[1308]	1493	DO ji = fs_2, fs_jpim1 ! vector opt.
[1472]	1494	zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) &
	1495	& + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
	1496	zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) &
	1497	& + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
[1308]	1498	END DO
[1218]	1499	END DO
[1467]	1500	CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T
[1218]	1501	DO jj = 2, jpjm1
[1694]	1502	DO ji = 2, jpim1 ! NO vector opt.
[1693]	1503	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) &
[1472]	1504	& + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) &
	1505	& + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
	1506	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) &
	1507	& + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) &
	1508	& + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
[1218]	1509	END DO
	1510	END DO
[1467]	1511	CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T
	1512	DO jj = 2, jpjm1
[1694]	1513	DO ji = 2, jpim1 ! NO vector opt.
[1693]	1514	zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) &
[1472]	1515	& + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) &
	1516	& + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
	1517	zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) &
	1518	& + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) &
	1519	& + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
[1467]	1520	END DO
	1521	END DO
	1522	END SELECT
[1218]	1523	END SELECT
[3294]	1524	CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. )
[888]	1525	!
[1218]	1526	!
[3294]	1527	IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components
[1218]	1528	! ! Ocean component
	1529	CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component
	1530	CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
	1531	zotx1(:,:) = ztmp1(:,:) ! overwrite the components
	1532	zoty1(:,:) = ztmp2(:,:)
	1533	IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component
	1534	CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component
	1535	CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
	1536	zitx1(:,:) = ztmp1(:,:) ! overwrite the components
	1537	zity1(:,:) = ztmp2(:,:)
	1538	ENDIF
	1539	ENDIF
	1540	!
	1541	! spherical coordinates to cartesian -> 2 components to 3 components
[3294]	1542	IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN
[1218]	1543	ztmp1(:,:) = zotx1(:,:) ! ocean currents
	1544	ztmp2(:,:) = zoty1(:,:)
[1226]	1545	CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
[1218]	1546	!
	1547	IF( ssnd(jps_ivx1)%laction ) THEN ! ice velocities
	1548	ztmp1(:,:) = zitx1(:,:)
	1549	ztmp1(:,:) = zity1(:,:)
[1226]	1550	CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
[1218]	1551	ENDIF
	1552	ENDIF
	1553	!
[4990]	1554	IF( ssnd(jps_ocx1)%laction ) CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid
	1555	IF( ssnd(jps_ocy1)%laction ) CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid
	1556	IF( ssnd(jps_ocz1)%laction ) CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid
[1218]	1557	!
[4990]	1558	IF( ssnd(jps_ivx1)%laction ) CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid
	1559	IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid
	1560	IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid
[1534]	1561	!
[888]	1562	ENDIF
[2715]	1563	!
[3294]	1564	CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
	1565	CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )
[2715]	1566	!
[3294]	1567	IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_snd')
	1568	!
[1226]	1569	END SUBROUTINE sbc_cpl_snd
[1218]	1570
[888]	1571	!!======================================================================
	1572	END MODULE sbccpl

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

Download in other formats: