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 NEMO/trunk/src/OCE/SBC – NEMO

source: NEMO/trunk/src/OCE/SBC/sbccpl.F90 @ 13472

Last change on this file since 13472 was 13472, checked in by smasson, 4 years ago

trunk: commit changes from r4.0-HEAD from 13284 to 13449, see #2523

  • Property svn:keywords set to Id
File size: 158.9 KB
Line 
1MODULE sbccpl
2   !!======================================================================
3   !!                       ***  MODULE  sbccpl  ***
4   !! Surface Boundary Condition :  momentum, heat and freshwater fluxes in coupled mode
5   !!======================================================================
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
9   !!            3.4  ! 2011_11  (C. Harris) more flexibility + multi-category fields
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   namsbc_cpl      : coupled formulation namlist
14   !!   sbc_cpl_init    : initialisation of the coupled exchanges
15   !!   sbc_cpl_rcv     : receive fields from the atmosphere over the ocean (ocean only)
16   !!                     receive stress from the atmosphere over the ocean (ocean-ice case)
17   !!   sbc_cpl_ice_tau : receive stress from the atmosphere over ice
18   !!   sbc_cpl_ice_flx : receive fluxes from the atmosphere over ice
19   !!   sbc_cpl_snd     : send     fields to the atmosphere
20   !!----------------------------------------------------------------------
21   USE dom_oce         ! ocean space and time domain
22   USE sbc_oce         ! Surface boundary condition: ocean fields
23   USE trc_oce         ! share SMS/Ocean variables
24   USE sbc_ice         ! Surface boundary condition: ice fields
25   USE sbcapr          ! Stochastic param. : ???
26   USE sbcdcy          ! surface boundary condition: diurnal cycle
27   USE sbcwave         ! surface boundary condition: waves
28   USE phycst          ! physical constants
29   USE isf_oce , ONLY : l_isfoasis, fwfisf_oasis ! ice shelf boundary condition
30#if defined key_si3
31   USE ice            ! ice variables
32#endif
33   USE cpl_oasis3     ! OASIS3 coupling
34   USE geo2ocean      !
35   USE oce     , ONLY : ts, uu, vv, ssh, fraqsr_1lev
36   USE ocealb         !
37   USE eosbn2         !
38   USE sbcrnf  , ONLY : l_rnfcpl
39#if defined key_cice
40   USE ice_domain_size, only: ncat
41#endif
42#if defined key_si3
43   USE icevar         ! for CALL ice_var_snwblow
44#endif
45   !
46   USE in_out_manager ! I/O manager
47   USE iom            ! NetCDF library
48   USE lib_mpp        ! distribued memory computing library
49   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
50
51#if defined key_oasis3 
52   USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut 
53#endif
54
55   IMPLICIT NONE
56   PRIVATE
57
58   PUBLIC   sbc_cpl_init      ! routine called by sbcmod.F90
59   PUBLIC   sbc_cpl_rcv       ! routine called by icestp.F90
60   PUBLIC   sbc_cpl_snd       ! routine called by step.F90
61   PUBLIC   sbc_cpl_ice_tau   ! routine called by icestp.F90
62   PUBLIC   sbc_cpl_ice_flx   ! routine called by icestp.F90
63   PUBLIC   sbc_cpl_alloc     ! routine called in sbcice_cice.F90
64
65   INTEGER, PARAMETER ::   jpr_otx1   =  1   ! 3 atmosphere-ocean stress components on grid 1
66   INTEGER, PARAMETER ::   jpr_oty1   =  2   !
67   INTEGER, PARAMETER ::   jpr_otz1   =  3   !
68   INTEGER, PARAMETER ::   jpr_otx2   =  4   ! 3 atmosphere-ocean stress components on grid 2
69   INTEGER, PARAMETER ::   jpr_oty2   =  5   !
70   INTEGER, PARAMETER ::   jpr_otz2   =  6   !
71   INTEGER, PARAMETER ::   jpr_itx1   =  7   ! 3 atmosphere-ice   stress components on grid 1
72   INTEGER, PARAMETER ::   jpr_ity1   =  8   !
73   INTEGER, PARAMETER ::   jpr_itz1   =  9   !
74   INTEGER, PARAMETER ::   jpr_itx2   = 10   ! 3 atmosphere-ice   stress components on grid 2
75   INTEGER, PARAMETER ::   jpr_ity2   = 11   !
76   INTEGER, PARAMETER ::   jpr_itz2   = 12   !
77   INTEGER, PARAMETER ::   jpr_qsroce = 13   ! Qsr above the ocean
78   INTEGER, PARAMETER ::   jpr_qsrice = 14   ! Qsr above the ice
79   INTEGER, PARAMETER ::   jpr_qsrmix = 15 
80   INTEGER, PARAMETER ::   jpr_qnsoce = 16   ! Qns above the ocean
81   INTEGER, PARAMETER ::   jpr_qnsice = 17   ! Qns above the ice
82   INTEGER, PARAMETER ::   jpr_qnsmix = 18
83   INTEGER, PARAMETER ::   jpr_rain   = 19   ! total liquid precipitation (rain)
84   INTEGER, PARAMETER ::   jpr_snow   = 20   ! solid precipitation over the ocean (snow)
85   INTEGER, PARAMETER ::   jpr_tevp   = 21   ! total evaporation
86   INTEGER, PARAMETER ::   jpr_ievp   = 22   ! solid evaporation (sublimation)
87   INTEGER, PARAMETER ::   jpr_sbpr   = 23   ! sublimation - liquid precipitation - solid precipitation
88   INTEGER, PARAMETER ::   jpr_semp   = 24   ! solid freshwater budget (sublimation - snow)
89   INTEGER, PARAMETER ::   jpr_oemp   = 25   ! ocean freshwater budget (evap - precip)
90   INTEGER, PARAMETER ::   jpr_w10m   = 26   ! 10m wind
91   INTEGER, PARAMETER ::   jpr_dqnsdt = 27   ! d(Q non solar)/d(temperature)
92   INTEGER, PARAMETER ::   jpr_rnf    = 28   ! runoffs
93   INTEGER, PARAMETER ::   jpr_cal    = 29   ! calving
94   INTEGER, PARAMETER ::   jpr_taum   = 30   ! wind stress module
95   INTEGER, PARAMETER ::   jpr_co2    = 31
96   INTEGER, PARAMETER ::   jpr_topm   = 32   ! topmeltn
97   INTEGER, PARAMETER ::   jpr_botm   = 33   ! botmeltn
98   INTEGER, PARAMETER ::   jpr_sflx   = 34   ! salt flux
99   INTEGER, PARAMETER ::   jpr_toce   = 35   ! ocean temperature
100   INTEGER, PARAMETER ::   jpr_soce   = 36   ! ocean salinity
101   INTEGER, PARAMETER ::   jpr_ocx1   = 37   ! ocean current on grid 1
102   INTEGER, PARAMETER ::   jpr_ocy1   = 38   !
103   INTEGER, PARAMETER ::   jpr_ssh    = 39   ! sea surface height
104   INTEGER, PARAMETER ::   jpr_fice   = 40   ! ice fraction         
105   INTEGER, PARAMETER ::   jpr_e3t1st = 41   ! first T level thickness
106   INTEGER, PARAMETER ::   jpr_fraqsr = 42   ! fraction of solar net radiation absorbed in the first ocean level
107   INTEGER, PARAMETER ::   jpr_mslp   = 43   ! mean sea level pressure
108   INTEGER, PARAMETER ::   jpr_hsig   = 44   ! Hsig
109   INTEGER, PARAMETER ::   jpr_phioc  = 45   ! Wave=>ocean energy flux
110   INTEGER, PARAMETER ::   jpr_sdrftx = 46   ! Stokes drift on grid 1
111   INTEGER, PARAMETER ::   jpr_sdrfty = 47   ! Stokes drift on grid 2
112   INTEGER, PARAMETER ::   jpr_wper   = 48   ! Mean wave period
113   INTEGER, PARAMETER ::   jpr_wnum   = 49   ! Mean wavenumber
114   INTEGER, PARAMETER ::   jpr_tauwoc = 50   ! Stress fraction adsorbed by waves
115   INTEGER, PARAMETER ::   jpr_wdrag  = 51   ! Neutral surface drag coefficient
116   INTEGER, PARAMETER ::   jpr_isf    = 52
117   INTEGER, PARAMETER ::   jpr_icb    = 53
118   INTEGER, PARAMETER ::   jpr_wfreq  = 54   ! Wave peak frequency
119   INTEGER, PARAMETER ::   jpr_tauwx  = 55   ! x component of the ocean stress from waves
120   INTEGER, PARAMETER ::   jpr_tauwy  = 56   ! y component of the ocean stress from waves
121   INTEGER, PARAMETER ::   jpr_ts_ice = 57   ! Sea ice surface temp
122
123   INTEGER, PARAMETER ::   jprcv      = 57   ! total number of fields received 
124
125   INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere
126   INTEGER, PARAMETER ::   jps_toce   =  2   ! ocean temperature
127   INTEGER, PARAMETER ::   jps_tice   =  3   ! ice   temperature
128   INTEGER, PARAMETER ::   jps_tmix   =  4   ! mixed temperature (ocean+ice)
129   INTEGER, PARAMETER ::   jps_albice =  5   ! ice   albedo
130   INTEGER, PARAMETER ::   jps_albmix =  6   ! mixed albedo
131   INTEGER, PARAMETER ::   jps_hice   =  7   ! ice  thickness
132   INTEGER, PARAMETER ::   jps_hsnw   =  8   ! snow thickness
133   INTEGER, PARAMETER ::   jps_ocx1   =  9   ! ocean current on grid 1
134   INTEGER, PARAMETER ::   jps_ocy1   = 10   !
135   INTEGER, PARAMETER ::   jps_ocz1   = 11   !
136   INTEGER, PARAMETER ::   jps_ivx1   = 12   ! ice   current on grid 1
137   INTEGER, PARAMETER ::   jps_ivy1   = 13   !
138   INTEGER, PARAMETER ::   jps_ivz1   = 14   !
139   INTEGER, PARAMETER ::   jps_co2    = 15
140   INTEGER, PARAMETER ::   jps_soce   = 16   ! ocean salinity
141   INTEGER, PARAMETER ::   jps_ssh    = 17   ! sea surface height
142   INTEGER, PARAMETER ::   jps_qsroce = 18   ! Qsr above the ocean
143   INTEGER, PARAMETER ::   jps_qnsoce = 19   ! Qns above the ocean
144   INTEGER, PARAMETER ::   jps_oemp   = 20   ! ocean freshwater budget (evap - precip)
145   INTEGER, PARAMETER ::   jps_sflx   = 21   ! salt flux
146   INTEGER, PARAMETER ::   jps_otx1   = 22   ! 2 atmosphere-ocean stress components on grid 1
147   INTEGER, PARAMETER ::   jps_oty1   = 23   !
148   INTEGER, PARAMETER ::   jps_rnf    = 24   ! runoffs
149   INTEGER, PARAMETER ::   jps_taum   = 25   ! wind stress module
150   INTEGER, PARAMETER ::   jps_fice2  = 26   ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling)
151   INTEGER, PARAMETER ::   jps_e3t1st = 27   ! first level depth (vvl)
152   INTEGER, PARAMETER ::   jps_fraqsr = 28   ! fraction of solar net radiation absorbed in the first ocean level
153   INTEGER, PARAMETER ::   jps_ficet  = 29   ! total ice fraction 
154   INTEGER, PARAMETER ::   jps_ocxw   = 30   ! currents on grid 1 
155   INTEGER, PARAMETER ::   jps_ocyw   = 31   ! currents on grid 2
156   INTEGER, PARAMETER ::   jps_wlev   = 32   ! water level
157   INTEGER, PARAMETER ::   jps_fice1  = 33   ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes)
158   INTEGER, PARAMETER ::   jps_a_p    = 34   ! meltpond area fraction
159   INTEGER, PARAMETER ::   jps_ht_p   = 35   ! meltpond thickness
160   INTEGER, PARAMETER ::   jps_kice   = 36   ! sea ice effective conductivity
161   INTEGER, PARAMETER ::   jps_sstfrz = 37   ! sea surface freezing temperature
162   INTEGER, PARAMETER ::   jps_ttilyr = 38   ! sea ice top layer temp
163
164   INTEGER, PARAMETER ::   jpsnd      = 38   ! total number of fields sent
165
166#if ! defined key_oasis3
167   ! Dummy variables to enable compilation when oasis3 is not being used
168   INTEGER                    ::   OASIS_Sent        = -1 
169   INTEGER                    ::   OASIS_SentOut     = -1 
170   INTEGER                    ::   OASIS_ToRest      = -1 
171   INTEGER                    ::   OASIS_ToRestOut   = -1 
172#endif 
173
174   !                                  !!** namelist namsbc_cpl **
175   TYPE ::   FLD_C                     !   
176      CHARACTER(len = 32) ::   cldes      ! desciption of the coupling strategy
177      CHARACTER(len = 32) ::   clcat      ! multiple ice categories strategy
178      CHARACTER(len = 32) ::   clvref     ! reference of vector ('spherical' or 'cartesian')
179      CHARACTER(len = 32) ::   clvor      ! orientation of vector fields ('eastward-northward' or 'local grid')
180      CHARACTER(len = 32) ::   clvgrd     ! grids on which is located the vector fields
181   END TYPE FLD_C
182   !                                   ! Send to the atmosphere 
183   TYPE(FLD_C) ::   sn_snd_temp  , sn_snd_alb , sn_snd_thick, sn_snd_crt   , sn_snd_co2,  &
184      &             sn_snd_thick1, sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_ttilyr
185   !                                   ! Received from the atmosphere
186   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_tauw, sn_rcv_dqnsdt, sn_rcv_qsr,  &
187      &             sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf, sn_rcv_ts_ice
188   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf
189   ! Send to waves
190   TYPE(FLD_C) ::   sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev 
191   ! Received from waves
192   TYPE(FLD_C) ::   sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, sn_rcv_tauwoc, &
193                    sn_rcv_wdrag, sn_rcv_wfreq
194   !                                   ! Other namelist parameters
195   INTEGER     ::   nn_cplmodel           ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
196   LOGICAL     ::   ln_usecplmask         !  use a coupling mask file to merge data received from several models
197                                          !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
198   LOGICAL     ::   ln_scale_ice_flux     !  use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration)
199
200   TYPE ::   DYNARR     
201      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z3   
202   END TYPE DYNARR
203
204   TYPE( DYNARR ), SAVE, DIMENSION(jprcv) ::   frcv                ! all fields recieved from the atmosphere
205
206   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   alb_oce_mix    ! ocean albedo sent to atmosphere (mix clear/overcast sky)
207#if defined key_si3 || defined key_cice
208   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i_last_couple !: Ice fractional area at last coupling time
209#endif
210
211   REAL(wp) ::   rpref = 101000._wp   ! reference atmospheric pressure[N/m2]
212   REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rho0)
213
214   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   nrcvinfo           ! OASIS info argument
215
216   !! Substitution
217#  include "do_loop_substitute.h90"
218#  include "domzgr_substitute.h90"
219   !!----------------------------------------------------------------------
220   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
221   !! $Id$
222   !! Software governed by the CeCILL license (see ./LICENSE)
223   !!----------------------------------------------------------------------
224CONTAINS
225 
226   INTEGER FUNCTION sbc_cpl_alloc()
227      !!----------------------------------------------------------------------
228      !!             ***  FUNCTION sbc_cpl_alloc  ***
229      !!----------------------------------------------------------------------
230      INTEGER :: ierr(5)
231      !!----------------------------------------------------------------------
232      ierr(:) = 0
233      !
234      ALLOCATE( alb_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) )
235     
236#if ! defined key_si3 && ! defined key_cice
237      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init)
238#endif
239      ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) )
240#if defined key_si3 || defined key_cice
241      ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(4) )
242#endif
243      !
244      IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(5) )
245
246      sbc_cpl_alloc = MAXVAL( ierr )
247      CALL mpp_sum ( 'sbccpl', sbc_cpl_alloc )
248      IF( sbc_cpl_alloc > 0 )   CALL ctl_warn('sbc_cpl_alloc: allocation of arrays failed')
249      !
250   END FUNCTION sbc_cpl_alloc
251
252
253   SUBROUTINE sbc_cpl_init( k_ice )     
254      !!----------------------------------------------------------------------
255      !!             ***  ROUTINE sbc_cpl_init  ***
256      !!
257      !! ** Purpose :   Initialisation of send and received information from
258      !!                the atmospheric component
259      !!
260      !! ** Method  : * Read namsbc_cpl namelist
261      !!              * define the receive interface
262      !!              * define the send    interface
263      !!              * initialise the OASIS coupler
264      !!----------------------------------------------------------------------
265      INTEGER, INTENT(in) ::   k_ice   ! ice management in the sbc (=0/1/2/3)
266      !
267      INTEGER ::   jn          ! dummy loop index
268      INTEGER ::   ios, inum   ! Local integer
269      REAL(wp), DIMENSION(jpi,jpj) ::   zacs, zaos
270      !!
271      NAMELIST/namsbc_cpl/  nn_cplmodel  , ln_usecplmask, nn_cats_cpl , ln_scale_ice_flux,             &
272         &                  sn_snd_temp  , sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2   ,  & 
273         &                  sn_snd_ttilyr, sn_snd_cond  , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1,  & 
274         &                  sn_snd_ifrac , sn_snd_crtw  , sn_snd_wlev , sn_rcv_hsig  , sn_rcv_phioc ,  & 
275         &                  sn_rcv_w10m  , sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr   ,  & 
276         &                  sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum  , sn_rcv_tauwoc,  &
277         &                  sn_rcv_wdrag , sn_rcv_qns   , sn_rcv_emp  , sn_rcv_rnf   , sn_rcv_cal   ,  &
278         &                  sn_rcv_iceflx, sn_rcv_co2   , sn_rcv_mslp ,                                &
279         &                  sn_rcv_icb   , sn_rcv_isf   , sn_rcv_wfreq, sn_rcv_tauw  ,                 &
280         &                  sn_rcv_ts_ice
281      !!---------------------------------------------------------------------
282      !
283      ! ================================ !
284      !      Namelist informations       !
285      ! ================================ !
286      !
287      READ  ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901)
288901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist' )
289      !
290      READ  ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 )
291902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist' )
292      IF(lwm) WRITE ( numond, namsbc_cpl )
293      !
294      IF(lwp) THEN                        ! control print
295         WRITE(numout,*)
296         WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist '
297         WRITE(numout,*)'~~~~~~~~~~~~'
298      ENDIF
299      IF( lwp .AND. ln_cpl ) THEN                        ! control print
300         WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel
301         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask
302         WRITE(numout,*)'  ln_scale_ice_flux                   = ', ln_scale_ice_flux
303         WRITE(numout,*)'  nn_cats_cpl                         = ', nn_cats_cpl
304         WRITE(numout,*)'  received fields (mutiple ice categogies)'
305         WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')'
306         WRITE(numout,*)'      stress module                   = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')'
307         WRITE(numout,*)'      surface stress                  = ', TRIM(sn_rcv_tau%cldes   ), ' (', TRIM(sn_rcv_tau%clcat   ), ')'
308         WRITE(numout,*)'                     - referential    = ', sn_rcv_tau%clvref
309         WRITE(numout,*)'                     - orientation    = ', sn_rcv_tau%clvor
310         WRITE(numout,*)'                     - mesh           = ', sn_rcv_tau%clvgrd
311         WRITE(numout,*)'      non-solar heat flux sensitivity = ', TRIM(sn_rcv_dqnsdt%cldes), ' (', TRIM(sn_rcv_dqnsdt%clcat), ')'
312         WRITE(numout,*)'      solar heat flux                 = ', TRIM(sn_rcv_qsr%cldes   ), ' (', TRIM(sn_rcv_qsr%clcat   ), ')'
313         WRITE(numout,*)'      non-solar heat flux             = ', TRIM(sn_rcv_qns%cldes   ), ' (', TRIM(sn_rcv_qns%clcat   ), ')'
314         WRITE(numout,*)'      freshwater budget               = ', TRIM(sn_rcv_emp%cldes   ), ' (', TRIM(sn_rcv_emp%clcat   ), ')'
315         WRITE(numout,*)'      runoffs                         = ', TRIM(sn_rcv_rnf%cldes   ), ' (', TRIM(sn_rcv_rnf%clcat   ), ')'
316         WRITE(numout,*)'      calving                         = ', TRIM(sn_rcv_cal%cldes   ), ' (', TRIM(sn_rcv_cal%clcat   ), ')'
317         WRITE(numout,*)'      iceberg                         = ', TRIM(sn_rcv_icb%cldes   ), ' (', TRIM(sn_rcv_icb%clcat   ), ')'
318         WRITE(numout,*)'      ice shelf                       = ', TRIM(sn_rcv_isf%cldes   ), ' (', TRIM(sn_rcv_isf%clcat   ), ')'
319         WRITE(numout,*)'      sea ice heat fluxes             = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')'
320         WRITE(numout,*)'      atm co2                         = ', TRIM(sn_rcv_co2%cldes   ), ' (', TRIM(sn_rcv_co2%clcat   ), ')'
321         WRITE(numout,*)'      significant wave heigth         = ', TRIM(sn_rcv_hsig%cldes  ), ' (', TRIM(sn_rcv_hsig%clcat  ), ')' 
322         WRITE(numout,*)'      wave to oce energy flux         = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')' 
323         WRITE(numout,*)'      Surface Stokes drift grid u     = ', TRIM(sn_rcv_sdrfx%cldes ), ' (', TRIM(sn_rcv_sdrfx%clcat ), ')' 
324         WRITE(numout,*)'      Surface Stokes drift grid v     = ', TRIM(sn_rcv_sdrfy%cldes ), ' (', TRIM(sn_rcv_sdrfy%clcat ), ')' 
325         WRITE(numout,*)'      Mean wave period                = ', TRIM(sn_rcv_wper%cldes  ), ' (', TRIM(sn_rcv_wper%clcat  ), ')' 
326         WRITE(numout,*)'      Mean wave number                = ', TRIM(sn_rcv_wnum%cldes  ), ' (', TRIM(sn_rcv_wnum%clcat  ), ')' 
327         WRITE(numout,*)'      Wave peak frequency             = ', TRIM(sn_rcv_wfreq%cldes ), ' (', TRIM(sn_rcv_wfreq%clcat ), ')'
328         WRITE(numout,*)'      Stress frac adsorbed by waves   = ', TRIM(sn_rcv_tauwoc%cldes), ' (', TRIM(sn_rcv_tauwoc%clcat ), ')' 
329         WRITE(numout,*)'      Stress components by waves      = ', TRIM(sn_rcv_tauw%cldes  ), ' (', TRIM(sn_rcv_tauw%clcat  ), ')'
330         WRITE(numout,*)'      Neutral surf drag coefficient   = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')' 
331         WRITE(numout,*)'      Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')' 
332         WRITE(numout,*)'  sent fields (multiple ice categories)'
333         WRITE(numout,*)'      surface temperature             = ', TRIM(sn_snd_temp%cldes  ), ' (', TRIM(sn_snd_temp%clcat  ), ')'
334         WRITE(numout,*)'      top ice layer temperature       = ', TRIM(sn_snd_ttilyr%cldes), ' (', TRIM(sn_snd_ttilyr%clcat), ')'
335         WRITE(numout,*)'      albedo                          = ', TRIM(sn_snd_alb%cldes   ), ' (', TRIM(sn_snd_alb%clcat   ), ')'
336         WRITE(numout,*)'      ice/snow thickness              = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')'
337         WRITE(numout,*)'      total ice fraction              = ', TRIM(sn_snd_ifrac%cldes ), ' (', TRIM(sn_snd_ifrac%clcat ), ')' 
338         WRITE(numout,*)'      surface current                 = ', TRIM(sn_snd_crt%cldes   ), ' (', TRIM(sn_snd_crt%clcat   ), ')'
339         WRITE(numout,*)'                      - referential   = ', sn_snd_crt%clvref 
340         WRITE(numout,*)'                      - orientation   = ', sn_snd_crt%clvor
341         WRITE(numout,*)'                      - mesh          = ', sn_snd_crt%clvgrd
342         WRITE(numout,*)'      oce co2 flux                    = ', TRIM(sn_snd_co2%cldes   ), ' (', TRIM(sn_snd_co2%clcat   ), ')'
343         WRITE(numout,*)'      ice effective conductivity      = ', TRIM(sn_snd_cond%cldes  ), ' (', TRIM(sn_snd_cond%clcat  ), ')'
344         WRITE(numout,*)'      meltponds fraction and depth    = ', TRIM(sn_snd_mpnd%cldes  ), ' (', TRIM(sn_snd_mpnd%clcat  ), ')'
345         WRITE(numout,*)'      sea surface freezing temp       = ', TRIM(sn_snd_sstfrz%cldes), ' (', TRIM(sn_snd_sstfrz%clcat), ')'
346         WRITE(numout,*)'      water level                     = ', TRIM(sn_snd_wlev%cldes  ), ' (', TRIM(sn_snd_wlev%clcat  ), ')' 
347         WRITE(numout,*)'      mean sea level pressure         = ', TRIM(sn_rcv_mslp%cldes  ), ' (', TRIM(sn_rcv_mslp%clcat  ), ')' 
348         WRITE(numout,*)'      surface current to waves        = ', TRIM(sn_snd_crtw%cldes  ), ' (', TRIM(sn_snd_crtw%clcat  ), ')' 
349         WRITE(numout,*)'                      - referential   = ', sn_snd_crtw%clvref 
350         WRITE(numout,*)'                      - orientation   = ', sn_snd_crtw%clvor 
351         WRITE(numout,*)'                      - mesh          = ', sn_snd_crtw%clvgrd 
352      ENDIF
353
354      !                                   ! allocate sbccpl arrays
355      IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )
356     
357      ! ================================ !
358      !   Define the receive interface   !
359      ! ================================ !
360      nrcvinfo(:) = OASIS_idle   ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress
361
362      ! for each field: define the OASIS name                              (srcv(:)%clname)
363      !                 define receive or not from the namelist parameters (srcv(:)%laction)
364      !                 define the north fold type of lbc                  (srcv(:)%nsgn)
365
366      ! default definitions of srcv
367      srcv(:)%laction = .FALSE.   ;   srcv(:)%clgrid = 'T'   ;   srcv(:)%nsgn = 1.   ;   srcv(:)%nct = 1
368
369      !                                                      ! ------------------------- !
370      !                                                      ! ice and ocean wind stress !   
371      !                                                      ! ------------------------- !
372      !                                                           ! Name
373      srcv(jpr_otx1)%clname = 'O_OTaux1'      ! 1st ocean component on grid ONE (T or U)
374      srcv(jpr_oty1)%clname = 'O_OTauy1'      ! 2nd   -      -         -     -
375      srcv(jpr_otz1)%clname = 'O_OTauz1'      ! 3rd   -      -         -     -
376      srcv(jpr_otx2)%clname = 'O_OTaux2'      ! 1st ocean component on grid TWO (V)
377      srcv(jpr_oty2)%clname = 'O_OTauy2'      ! 2nd   -      -         -     -
378      srcv(jpr_otz2)%clname = 'O_OTauz2'      ! 3rd   -      -         -     -
379      !
380      srcv(jpr_itx1)%clname = 'O_ITaux1'      ! 1st  ice  component on grid ONE (T, F, I or U)
381      srcv(jpr_ity1)%clname = 'O_ITauy1'      ! 2nd   -      -         -     -
382      srcv(jpr_itz1)%clname = 'O_ITauz1'      ! 3rd   -      -         -     -
383      srcv(jpr_itx2)%clname = 'O_ITaux2'      ! 1st  ice  component on grid TWO (V)
384      srcv(jpr_ity2)%clname = 'O_ITauy2'      ! 2nd   -      -         -     -
385      srcv(jpr_itz2)%clname = 'O_ITauz2'      ! 3rd   -      -         -     -
386      !
387      ! Vectors: change of sign at north fold ONLY if on the local grid
388      IF(       TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM( sn_rcv_tau%cldes ) == 'oce and ice'  &
389           .OR. TRIM( sn_rcv_tau%cldes ) == 'mixed oce-ice' ) THEN ! avoid working with the atmospheric fields if they are not coupled
390      !
391      IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' )   srcv(jpr_otx1:jpr_itz2)%nsgn = -1.
392     
393      !                                                           ! Set grid and action
394      SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) )      !  'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V'
395      CASE( 'T' ) 
396         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point
397         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1
398         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1
399      CASE( 'U,V' ) 
400         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
401         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
402         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'U'        ! ice components given at U-point
403         srcv(jpr_itx2:jpr_itz2)%clgrid  = 'V'        !           and           V-point
404         srcv(jpr_otx1:jpr_itz2)%laction = .TRUE.     ! receive oce and ice components on both grid 1 & 2
405      CASE( 'U,V,T' )
406         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
407         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
408         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'T'        ! ice components given at T-point
409         srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2
410         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only
411      CASE( 'U,V,I' )
412         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
413         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
414         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'I'        ! ice components given at I-point
415         srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2
416         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only
417      CASE( 'U,V,F' )
418         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
419         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
420         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point
421         srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2
422         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only
423      CASE( 'T,I' ) 
424         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point
425         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'I'        ! ice components given at I-point
426         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1
427         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1
428      CASE( 'T,F' ) 
429         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point
430         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point
431         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1
432         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1
433      CASE( 'T,U,V' )
434         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'T'        ! oce components given at T-point
435         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'U'        ! ice components given at U-point
436         srcv(jpr_itx2:jpr_itz2)%clgrid  = 'V'        !           and           V-point
437         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 only
438         srcv(jpr_itx1:jpr_itz2)%laction = .TRUE.     ! receive ice components on grid 1 & 2
439      CASE default   
440         CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' )
441      END SELECT
442      !
443      IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' )   &           ! spherical: 3rd component not received
444         &     srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE. 
445      !
446      IF( TRIM( sn_rcv_tau%clvor  ) == 'local grid' ) THEN        ! already on local grid -> no need of the second grid
447            srcv(jpr_otx2:jpr_otz2)%laction = .FALSE. 
448            srcv(jpr_itx2:jpr_itz2)%laction = .FALSE. 
449            srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid   ! not needed but cleaner...
450            srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid   ! not needed but cleaner...
451      ENDIF
452      !
453      IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN        ! 'oce and ice' case ocean stress on ocean mesh used
454         srcv(jpr_itx1:jpr_itz2)%laction = .FALSE.    ! ice components not received
455         srcv(jpr_itx1)%clgrid = 'U'                  ! ocean stress used after its transformation
456         srcv(jpr_ity1)%clgrid = 'V'                  ! i.e. it is always at U- & V-points for i- & j-comp. resp.
457      ENDIF
458      ENDIF
459
460      !                                                      ! ------------------------- !
461      !                                                      !    freshwater budget      !   E-P
462      !                                                      ! ------------------------- !
463      ! we suppose that atmosphere modele do not make the difference between precipiration (liquide or solid)
464      ! over ice of free ocean within the same atmospheric cell.cd
465      srcv(jpr_rain)%clname = 'OTotRain'      ! Rain = liquid precipitation
466      srcv(jpr_snow)%clname = 'OTotSnow'      ! Snow = solid precipitation
467      srcv(jpr_tevp)%clname = 'OTotEvap'      ! total evaporation (over oce + ice sublimation)
468      srcv(jpr_ievp)%clname = 'OIceEvap'      ! evaporation over ice = sublimation
469      srcv(jpr_sbpr)%clname = 'OSubMPre'      ! sublimation - liquid precipitation - solid precipitation
470      srcv(jpr_semp)%clname = 'OISubMSn'      ! ice solid water budget = sublimation - solid precipitation
471      srcv(jpr_oemp)%clname = 'OOEvaMPr'      ! ocean water budget = ocean Evap - ocean precip
472      SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
473      CASE( 'none'          )       ! nothing to do
474      CASE( 'oce only'      )   ;   srcv(jpr_oemp)%laction = .TRUE. 
475      CASE( 'conservative'  )
476         srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE.
477         IF( k_ice <= 1 )  srcv(jpr_ievp)%laction = .FALSE.
478      CASE( 'oce and ice'   )   ;   srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE.
479      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' )
480      END SELECT
481      !
482      !                                                      ! ------------------------- !
483      !                                                      !     Runoffs & Calving     !   
484      !                                                      ! ------------------------- !
485      srcv(jpr_rnf   )%clname = 'O_Runoff'
486      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN
487         srcv(jpr_rnf)%laction = .TRUE.
488         l_rnfcpl              = .TRUE.                      ! -> no need to read runoffs in sbcrnf
489         ln_rnf                = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas
490         IF(lwp) WRITE(numout,*)
491         IF(lwp) WRITE(numout,*) '   runoffs received from oasis -> force ln_rnf = ', ln_rnf
492      ENDIF
493      !
494      srcv(jpr_cal)%clname = 'OCalving'   ;  IF( TRIM( sn_rcv_cal%cldes) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE.
495      srcv(jpr_isf)%clname = 'OIcshelf'   ;  IF( TRIM( sn_rcv_isf%cldes) == 'coupled' )   srcv(jpr_isf)%laction = .TRUE.
496      srcv(jpr_icb)%clname = 'OIceberg'   ;  IF( TRIM( sn_rcv_icb%cldes) == 'coupled' )   srcv(jpr_icb)%laction = .TRUE.
497
498      IF( srcv(jpr_isf)%laction ) THEN
499         l_isfoasis = .TRUE.  ! -> isf fwf comes from oasis
500         IF(lwp) WRITE(numout,*)
501         IF(lwp) WRITE(numout,*) '   iceshelf received from oasis '
502         CALL ctl_stop('STOP','not coded')
503      ENDIF
504      !
505      !                                                      ! ------------------------- !
506      !                                                      !    non solar radiation    !   Qns
507      !                                                      ! ------------------------- !
508      srcv(jpr_qnsoce)%clname = 'O_QnsOce'
509      srcv(jpr_qnsice)%clname = 'O_QnsIce'
510      srcv(jpr_qnsmix)%clname = 'O_QnsMix'
511      SELECT CASE( TRIM( sn_rcv_qns%cldes ) )
512      CASE( 'none'          )       ! nothing to do
513      CASE( 'oce only'      )   ;   srcv(               jpr_qnsoce   )%laction = .TRUE.
514      CASE( 'conservative'  )   ;   srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE.
515      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE.
516      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qnsmix   )%laction = .TRUE. 
517      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' )
518      END SELECT
519      IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. nn_cats_cpl > 1 ) &
520         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' )
521      !
522      !                                                      ! ------------------------- !
523      !                                                      !    solar radiation        !   Qsr
524      !                                                      ! ------------------------- !
525      srcv(jpr_qsroce)%clname = 'O_QsrOce'
526      srcv(jpr_qsrice)%clname = 'O_QsrIce'
527      srcv(jpr_qsrmix)%clname = 'O_QsrMix'
528      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )
529      CASE( 'none'          )       ! nothing to do
530      CASE( 'oce only'      )   ;   srcv(               jpr_qsroce   )%laction = .TRUE.
531      CASE( 'conservative'  )   ;   srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE.
532      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE.
533      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qsrmix   )%laction = .TRUE. 
534      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' )
535      END SELECT
536      IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. nn_cats_cpl > 1 ) &
537         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' )
538      !
539      !                                                      ! ------------------------- !
540      !                                                      !   non solar sensitivity   !   d(Qns)/d(T)
541      !                                                      ! ------------------------- !
542      srcv(jpr_dqnsdt)%clname = 'O_dQnsdT'   
543      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' )   srcv(jpr_dqnsdt)%laction = .TRUE.
544      !
545      ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique
546      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' )  &
547         &   CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' )
548      !
549      !                                                      ! ------------------------- !
550      !                                                      !      10m wind module      !   
551      !                                                      ! ------------------------- !
552      srcv(jpr_w10m)%clname = 'O_Wind10'   ;   IF( TRIM(sn_rcv_w10m%cldes  ) == 'coupled' )   srcv(jpr_w10m)%laction = .TRUE. 
553      !
554      !                                                      ! ------------------------- !
555      !                                                      !   wind stress module      !   
556      !                                                      ! ------------------------- !
557      srcv(jpr_taum)%clname = 'O_TauMod'   ;   IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' )   srcv(jpr_taum)%laction = .TRUE.
558      !
559      !                                                      ! ------------------------- !
560      !                                                      !      Atmospheric CO2      !
561      !                                                      ! ------------------------- !
562      srcv(jpr_co2 )%clname = 'O_AtmCO2'   
563      IF( TRIM(sn_rcv_co2%cldes   ) == 'coupled' )  THEN
564         srcv(jpr_co2 )%laction = .TRUE.
565         l_co2cpl = .TRUE.
566         IF(lwp) WRITE(numout,*)
567         IF(lwp) WRITE(numout,*) '   Atmospheric pco2 received from oasis '
568         IF(lwp) WRITE(numout,*)
569      ENDIF
570      !
571      !                                                      ! ------------------------- !
572      !                                                      ! Mean Sea Level Pressure   !
573      !                                                      ! ------------------------- !
574      srcv(jpr_mslp)%clname = 'O_MSLP'     ;   IF( TRIM(sn_rcv_mslp%cldes  ) == 'coupled' )    srcv(jpr_mslp)%laction = .TRUE. 
575      !
576      !                                                      ! ------------------------- !
577      !                                                      !  ice topmelt and botmelt  !   
578      !                                                      ! ------------------------- !
579      srcv(jpr_topm )%clname = 'OTopMlt'
580      srcv(jpr_botm )%clname = 'OBotMlt'
581      IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN
582         IF( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN
583            srcv(jpr_topm:jpr_botm)%nct = nn_cats_cpl
584         ELSE
585            CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' )
586         ENDIF
587         srcv(jpr_topm:jpr_botm)%laction = .TRUE.
588      ENDIF
589      !                                                      ! ------------------------- !
590      !                                                      !    ice skin temperature   !   
591      !                                                      ! ------------------------- !
592      srcv(jpr_ts_ice)%clname = 'OTsfIce'    ! needed by Met Office
593      IF( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' )   srcv(jpr_ts_ice)%laction = .TRUE.
594      IF( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' )   srcv(jpr_ts_ice)%nct     = nn_cats_cpl
595      IF( TRIM( sn_rcv_emp%clcat    ) == 'yes' )   srcv(jpr_ievp)%nct       = nn_cats_cpl
596
597#if defined key_si3
598      IF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN
599         IF( .NOT.srcv(jpr_ts_ice)%laction )  &
600            &   CALL ctl_stop( 'sbc_cpl_init: srcv(jpr_ts_ice)%laction should be set to true when ln_cndflx=T' )     
601      ENDIF
602#endif
603      !                                                      ! ------------------------- !
604      !                                                      !      Wave breaking        !   
605      !                                                      ! ------------------------- !
606      srcv(jpr_hsig)%clname  = 'O_Hsigwa'    ! significant wave height
607      IF( TRIM(sn_rcv_hsig%cldes  ) == 'coupled' )  THEN
608         srcv(jpr_hsig)%laction = .TRUE.
609         cpl_hsig = .TRUE.
610      ENDIF
611      srcv(jpr_phioc)%clname = 'O_PhiOce'    ! wave to ocean energy
612      IF( TRIM(sn_rcv_phioc%cldes ) == 'coupled' )  THEN
613         srcv(jpr_phioc)%laction = .TRUE.
614         cpl_phioc = .TRUE.
615      ENDIF
616      srcv(jpr_sdrftx)%clname = 'O_Sdrfx'    ! Stokes drift in the u direction
617      IF( TRIM(sn_rcv_sdrfx%cldes ) == 'coupled' )  THEN
618         srcv(jpr_sdrftx)%laction = .TRUE.
619         cpl_sdrftx = .TRUE.
620      ENDIF
621      srcv(jpr_sdrfty)%clname = 'O_Sdrfy'    ! Stokes drift in the v direction
622      IF( TRIM(sn_rcv_sdrfy%cldes ) == 'coupled' )  THEN
623         srcv(jpr_sdrfty)%laction = .TRUE.
624         cpl_sdrfty = .TRUE.
625      ENDIF
626      srcv(jpr_wper)%clname = 'O_WPer'       ! mean wave period
627      IF( TRIM(sn_rcv_wper%cldes  ) == 'coupled' )  THEN
628         srcv(jpr_wper)%laction = .TRUE.
629         cpl_wper = .TRUE.
630      ENDIF
631      srcv(jpr_wfreq)%clname = 'O_WFreq'     ! wave peak frequency
632      IF( TRIM(sn_rcv_wfreq%cldes ) == 'coupled' )  THEN
633         srcv(jpr_wfreq)%laction = .TRUE.
634         cpl_wfreq = .TRUE.
635      ENDIF
636      srcv(jpr_wnum)%clname = 'O_WNum'       ! mean wave number
637      IF( TRIM(sn_rcv_wnum%cldes ) == 'coupled' )  THEN
638         srcv(jpr_wnum)%laction = .TRUE.
639         cpl_wnum = .TRUE.
640      ENDIF
641      srcv(jpr_tauwoc)%clname = 'O_TauOce'   ! stress fraction adsorbed by the wave
642      IF( TRIM(sn_rcv_tauwoc%cldes ) == 'coupled' )  THEN
643         srcv(jpr_tauwoc)%laction = .TRUE.
644         cpl_tauwoc = .TRUE.
645      ENDIF
646      srcv(jpr_tauwx)%clname = 'O_Tauwx'      ! ocean stress from wave in the x direction
647      srcv(jpr_tauwy)%clname = 'O_Tauwy'      ! ocean stress from wave in the y direction
648      IF( TRIM(sn_rcv_tauw%cldes ) == 'coupled' )  THEN
649         srcv(jpr_tauwx)%laction = .TRUE.
650         srcv(jpr_tauwy)%laction = .TRUE.
651         cpl_tauw = .TRUE.
652      ENDIF
653      srcv(jpr_wdrag)%clname = 'O_WDrag'     ! neutral surface drag coefficient
654      IF( TRIM(sn_rcv_wdrag%cldes ) == 'coupled' )  THEN
655         srcv(jpr_wdrag)%laction = .TRUE.
656         cpl_wdrag = .TRUE.
657      ENDIF
658      IF( srcv(jpr_tauwoc)%laction .AND. srcv(jpr_tauwx)%laction .AND. srcv(jpr_tauwy)%laction ) &
659            CALL ctl_stop( 'More than one method for modifying the ocean stress has been selected ', &
660                                     '(sn_rcv_tauwoc=coupled and sn_rcv_tauw=coupled)' )
661      !
662      !                                                      ! ------------------------------- !
663      !                                                      !   OPA-SAS coupling - rcv by opa !   
664      !                                                      ! ------------------------------- !
665      srcv(jpr_sflx)%clname = 'O_SFLX'
666      srcv(jpr_fice)%clname = 'RIceFrc'
667      !
668      IF( nn_components == jp_iam_opa ) THEN    ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS)
669         srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
670         srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling
671         srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling
672         srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE.
673         srcv(jpr_otx1)%clgrid = 'U'        ! oce components given at U-point
674         srcv(jpr_oty1)%clgrid = 'V'        !           and           V-point
675         ! Vectors: change of sign at north fold ONLY if on the local grid
676         srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1.
677         sn_rcv_tau%clvgrd = 'U,V'
678         sn_rcv_tau%clvor = 'local grid'
679         sn_rcv_tau%clvref = 'spherical'
680         sn_rcv_emp%cldes = 'oce only'
681         !
682         IF(lwp) THEN                        ! control print
683            WRITE(numout,*)
684            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  '
685            WRITE(numout,*)'               OPA component  '
686            WRITE(numout,*)
687            WRITE(numout,*)'  received fields from SAS component '
688            WRITE(numout,*)'                  ice cover '
689            WRITE(numout,*)'                  oce only EMP  '
690            WRITE(numout,*)'                  salt flux  '
691            WRITE(numout,*)'                  mixed oce-ice solar flux  '
692            WRITE(numout,*)'                  mixed oce-ice non solar flux  '
693            WRITE(numout,*)'                  wind stress U,V on local grid and sperical coordinates '
694            WRITE(numout,*)'                  wind stress module'
695            WRITE(numout,*)
696         ENDIF
697      ENDIF
698      !                                                      ! -------------------------------- !
699      !                                                      !   OPA-SAS coupling - rcv by sas  !   
700      !                                                      ! -------------------------------- !
701      srcv(jpr_toce  )%clname = 'I_SSTSST'
702      srcv(jpr_soce  )%clname = 'I_SSSal'
703      srcv(jpr_ocx1  )%clname = 'I_OCurx1'
704      srcv(jpr_ocy1  )%clname = 'I_OCury1'
705      srcv(jpr_ssh   )%clname = 'I_SSHght'
706      srcv(jpr_e3t1st)%clname = 'I_E3T1st'   
707      srcv(jpr_fraqsr)%clname = 'I_FraQsr'   
708      !
709      IF( nn_components == jp_iam_sas ) THEN
710         IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
711         IF( .NOT. ln_cpl ) srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling
712         IF( .NOT. ln_cpl ) srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling
713         srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE.
714         srcv( jpr_e3t1st )%laction = .NOT.ln_linssh
715         srcv(jpr_ocx1)%clgrid = 'U'        ! oce components given at U-point
716         srcv(jpr_ocy1)%clgrid = 'V'        !           and           V-point
717         ! Vectors: change of sign at north fold ONLY if on the local grid
718         srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1.
719         ! Change first letter to couple with atmosphere if already coupled OPA
720         ! this is nedeed as each variable name used in the namcouple must be unique:
721         ! for example O_Runoff received by OPA from SAS and therefore S_Runoff received by SAS from the Atmosphere
722         DO jn = 1, jprcv
723            IF( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname))
724         END DO
725         !
726         IF(lwp) THEN                        ! control print
727            WRITE(numout,*)
728            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  '
729            WRITE(numout,*)'               SAS component  '
730            WRITE(numout,*)
731            IF( .NOT. ln_cpl ) THEN
732               WRITE(numout,*)'  received fields from OPA component '
733            ELSE
734               WRITE(numout,*)'  Additional received fields from OPA component : '
735            ENDIF
736            WRITE(numout,*)'               sea surface temperature (Celsius) '
737            WRITE(numout,*)'               sea surface salinity ' 
738            WRITE(numout,*)'               surface currents ' 
739            WRITE(numout,*)'               sea surface height ' 
740            WRITE(numout,*)'               thickness of first ocean T level '       
741            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level'
742            WRITE(numout,*)
743         ENDIF
744      ENDIF
745     
746      ! =================================================== !
747      ! Allocate all parts of frcv used for received fields !
748      ! =================================================== !
749      DO jn = 1, jprcv
750         IF( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
751      END DO
752      ! Allocate taum part of frcv which is used even when not received as coupling field
753      IF( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
754      ! Allocate w10m part of frcv which is used even when not received as coupling field
755      IF( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )
756      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field
757      IF( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )
758      IF( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )
759      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.
760      IF( k_ice /= 0 ) THEN
761         IF( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )
762         IF( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
763      ENDIF
764
765      ! ================================ !
766      !     Define the send interface    !
767      ! ================================ !
768      ! for each field: define the OASIS name                           (ssnd(:)%clname)
769      !                 define send or not from the namelist parameters (ssnd(:)%laction)
770      !                 define the north fold type of lbc               (ssnd(:)%nsgn)
771     
772      ! default definitions of nsnd
773      ssnd(:)%laction = .FALSE.   ;   ssnd(:)%clgrid = 'T'   ;   ssnd(:)%nsgn = 1.  ; ssnd(:)%nct = 1
774         
775      !                                                      ! ------------------------- !
776      !                                                      !    Surface temperature    !
777      !                                                      ! ------------------------- !
778      ssnd(jps_toce)%clname   = 'O_SSTSST'
779      ssnd(jps_tice)%clname   = 'O_TepIce'
780      ssnd(jps_ttilyr)%clname = 'O_TtiLyr'
781      ssnd(jps_tmix)%clname   = 'O_TepMix'
782      SELECT CASE( TRIM( sn_snd_temp%cldes ) )
783      CASE( 'none'                                 )       ! nothing to do
784      CASE( 'oce only'                             )   ;   ssnd( jps_toce )%laction = .TRUE.
785      CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice' )
786         ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE.
787         IF( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = nn_cats_cpl
788      CASE( 'mixed oce-ice'                        )   ;   ssnd( jps_tmix )%laction = .TRUE.
789      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' )
790      END SELECT
791           
792      !                                                      ! ------------------------- !
793      !                                                      !          Albedo           !
794      !                                                      ! ------------------------- !
795      ssnd(jps_albice)%clname = 'O_AlbIce' 
796      ssnd(jps_albmix)%clname = 'O_AlbMix'
797      SELECT CASE( TRIM( sn_snd_alb%cldes ) )
798      CASE( 'none'                 )     ! nothing to do
799      CASE( 'ice' , 'weighted ice' )   ; ssnd(jps_albice)%laction = .TRUE.
800      CASE( 'mixed oce-ice'        )   ; ssnd(jps_albmix)%laction = .TRUE.
801      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' )
802      END SELECT
803      !
804      ! Need to calculate oceanic albedo if
805      !     1. sending mixed oce-ice albedo or
806      !     2. receiving mixed oce-ice solar radiation
807      IF( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN
808         CALL oce_alb( zaos, zacs )
809         ! Due to lack of information on nebulosity : mean clear/overcast sky
810         alb_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5
811      ENDIF
812      !                                                      ! ------------------------- !
813      !                                                      !  Ice fraction & Thickness !
814      !                                                      ! ------------------------- !
815      ssnd(jps_fice)%clname  = 'OIceFrc'
816      ssnd(jps_ficet)%clname = 'OIceFrcT' 
817      ssnd(jps_hice)%clname  = 'OIceTck'
818      ssnd(jps_a_p)%clname   = 'OPndFrc'
819      ssnd(jps_ht_p)%clname  = 'OPndTck'
820      ssnd(jps_hsnw)%clname  = 'OSnwTck'
821      ssnd(jps_fice1)%clname = 'OIceFrd'
822      IF( k_ice /= 0 ) THEN
823         ssnd(jps_fice)%laction  = .TRUE.                 ! if ice treated in the ocean (even in climato case)
824         ssnd(jps_fice1)%laction = .TRUE.                 ! First-order regridded ice concentration, to be used producing atmos-to-ice fluxes (Met Office requirement)
825! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now
826         IF( TRIM( sn_snd_thick%clcat  ) == 'yes' ) ssnd(jps_fice)%nct  = nn_cats_cpl
827         IF( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl
828      ENDIF
829     
830      IF(TRIM( sn_snd_ifrac%cldes )  == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 
831
832      SELECT CASE ( TRIM( sn_snd_thick%cldes ) )
833      CASE( 'none'         )       ! nothing to do
834      CASE( 'ice and snow' ) 
835         ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
836         IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
837            ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl
838         ENDIF
839      CASE ( 'weighted ice and snow' ) 
840         ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
841         IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl
842      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' )
843      END SELECT
844
845      ! Initialise ice fractions from last coupling time to zero (needed by Met-Office)
846#if defined key_si3 || defined key_cice
847       a_i_last_couple(:,:,:) = 0._wp
848#endif
849      !                                                      ! ------------------------- !
850      !                                                      !      Ice Meltponds        !
851      !                                                      ! ------------------------- !
852      ! Needed by Met Office
853      ssnd(jps_a_p)%clname  = 'OPndFrc'   
854      ssnd(jps_ht_p)%clname = 'OPndTck'   
855      SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) ) 
856      CASE ( 'none' ) 
857         ssnd(jps_a_p)%laction  = .FALSE. 
858         ssnd(jps_ht_p)%laction = .FALSE. 
859      CASE ( 'ice only' ) 
860         ssnd(jps_a_p)%laction  = .TRUE. 
861         ssnd(jps_ht_p)%laction = .TRUE. 
862         IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN
863            ssnd(jps_a_p)%nct  = nn_cats_cpl 
864            ssnd(jps_ht_p)%nct = nn_cats_cpl 
865         ELSE
866            IF( nn_cats_cpl > 1 ) THEN
867               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 
868            ENDIF
869         ENDIF
870      CASE ( 'weighted ice' ) 
871         ssnd(jps_a_p)%laction  = .TRUE. 
872         ssnd(jps_ht_p)%laction = .TRUE. 
873         IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN
874            ssnd(jps_a_p)%nct  = nn_cats_cpl 
875            ssnd(jps_ht_p)%nct = nn_cats_cpl 
876         ENDIF
877      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes; '//sn_snd_mpnd%cldes ) 
878      END SELECT 
879 
880      !                                                      ! ------------------------- !
881      !                                                      !      Surface current      !
882      !                                                      ! ------------------------- !
883      !        ocean currents              !            ice velocities
884      ssnd(jps_ocx1)%clname = 'O_OCurx1'   ;   ssnd(jps_ivx1)%clname = 'O_IVelx1'
885      ssnd(jps_ocy1)%clname = 'O_OCury1'   ;   ssnd(jps_ivy1)%clname = 'O_IVely1'
886      ssnd(jps_ocz1)%clname = 'O_OCurz1'   ;   ssnd(jps_ivz1)%clname = 'O_IVelz1'
887      ssnd(jps_ocxw)%clname = 'O_OCurxw' 
888      ssnd(jps_ocyw)%clname = 'O_OCuryw' 
889      !
890      ssnd(jps_ocx1:jps_ivz1)%nsgn = -1.   ! vectors: change of the sign at the north fold
891
892      IF( sn_snd_crt%clvgrd == 'U,V' ) THEN
893         ssnd(jps_ocx1)%clgrid = 'U' ; ssnd(jps_ocy1)%clgrid = 'V'
894      ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN 
895         CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' )
896      ENDIF
897      ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE.   ! default: all are send
898      IF( TRIM( sn_snd_crt%clvref ) == 'spherical' )   ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE. 
899      IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) ssnd(jps_ocx1:jps_ivz1)%nsgn = 1.
900      SELECT CASE( TRIM( sn_snd_crt%cldes ) )
901      CASE( 'none'                 )   ;   ssnd(jps_ocx1:jps_ivz1)%laction = .FALSE.
902      CASE( 'oce only'             )   ;   ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
903      CASE( 'weighted oce and ice' )   !   nothing to do
904      CASE( 'mixed oce-ice'        )   ;   ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
905      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crt%cldes' )
906      END SELECT
907
908      ssnd(jps_ocxw:jps_ocyw)%nsgn = -1.   ! vectors: change of the sign at the north fold
909       
910      IF( sn_snd_crtw%clvgrd == 'U,V' ) THEN
911         ssnd(jps_ocxw)%clgrid = 'U' ; ssnd(jps_ocyw)%clgrid = 'V' 
912      ELSE IF( sn_snd_crtw%clvgrd /= 'T' ) THEN
913         CALL ctl_stop( 'sn_snd_crtw%clvgrd must be equal to T' ) 
914      ENDIF
915      IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) ssnd(jps_ocxw:jps_ocyw)%nsgn = 1. 
916      SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 
917         CASE( 'none'                 )   ; ssnd(jps_ocxw:jps_ocyw)%laction = .FALSE. 
918         CASE( 'oce only'             )   ; ssnd(jps_ocxw:jps_ocyw)%laction = .TRUE. 
919         CASE( 'weighted oce and ice' )   !   nothing to do
920         CASE( 'mixed oce-ice'        )   ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 
921         CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crtw%cldes' ) 
922      END SELECT 
923
924      !                                                      ! ------------------------- !
925      !                                                      !          CO2 flux         !
926      !                                                      ! ------------------------- !
927      ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE.
928      !
929      !                                                      ! ------------------------- !
930      !                                                      ! Sea surface freezing temp !
931      !                                                      ! ------------------------- !
932      ! needed by Met Office
933      ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' )  ssnd(jps_sstfrz)%laction = .TRUE. 
934      !
935      !                                                      ! ------------------------- !
936      !                                                      !    Ice conductivity       !
937      !                                                      ! ------------------------- !
938      ! needed by Met Office
939      ! Note that ultimately we will move to passing an ocean effective conductivity as well so there
940      ! will be some changes to the parts of the code which currently relate only to ice conductivity
941      ssnd(jps_ttilyr )%clname = 'O_TtiLyr' 
942      SELECT CASE ( TRIM( sn_snd_ttilyr%cldes ) ) 
943      CASE ( 'none' ) 
944         ssnd(jps_ttilyr)%laction = .FALSE. 
945      CASE ( 'ice only' ) 
946         ssnd(jps_ttilyr)%laction = .TRUE. 
947         IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN
948            ssnd(jps_ttilyr)%nct = nn_cats_cpl 
949         ELSE
950            IF( nn_cats_cpl > 1 ) THEN
951               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' ) 
952            ENDIF
953         ENDIF
954      CASE ( 'weighted ice' ) 
955         ssnd(jps_ttilyr)%laction = .TRUE. 
956         IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl 
957      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes ) 
958      END SELECT
959
960      ssnd(jps_kice )%clname = 'OIceKn' 
961      SELECT CASE ( TRIM( sn_snd_cond%cldes ) ) 
962      CASE ( 'none' ) 
963         ssnd(jps_kice)%laction = .FALSE. 
964      CASE ( 'ice only' ) 
965         ssnd(jps_kice)%laction = .TRUE. 
966         IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN
967            ssnd(jps_kice)%nct = nn_cats_cpl 
968         ELSE
969            IF( nn_cats_cpl > 1 ) THEN
970               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 
971            ENDIF
972         ENDIF
973      CASE ( 'weighted ice' ) 
974         ssnd(jps_kice)%laction = .TRUE. 
975         IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl 
976      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes ) 
977      END SELECT 
978      !
979      !                                                      ! ------------------------- !
980      !                                                      !     Sea surface height    !
981      !                                                      ! ------------------------- !
982      ssnd(jps_wlev)%clname = 'O_Wlevel' ;  IF( TRIM(sn_snd_wlev%cldes) == 'coupled' )   ssnd(jps_wlev)%laction = .TRUE. 
983
984      !                                                      ! ------------------------------- !
985      !                                                      !   OPA-SAS coupling - snd by opa !   
986      !                                                      ! ------------------------------- !
987      ssnd(jps_ssh   )%clname = 'O_SSHght' 
988      ssnd(jps_soce  )%clname = 'O_SSSal' 
989      ssnd(jps_e3t1st)%clname = 'O_E3T1st'   
990      ssnd(jps_fraqsr)%clname = 'O_FraQsr'
991      !
992      IF( nn_components == jp_iam_opa ) THEN
993         ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
994         ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE.
995         ssnd( jps_e3t1st )%laction = .NOT.ln_linssh
996         ! vector definition: not used but cleaner...
997         ssnd(jps_ocx1)%clgrid  = 'U'        ! oce components given at U-point
998         ssnd(jps_ocy1)%clgrid  = 'V'        !           and           V-point
999         sn_snd_crt%clvgrd = 'U,V'
1000         sn_snd_crt%clvor = 'local grid'
1001         sn_snd_crt%clvref = 'spherical'
1002         !
1003         IF(lwp) THEN                        ! control print
1004            WRITE(numout,*)
1005            WRITE(numout,*)'  sent fields to SAS component '
1006            WRITE(numout,*)'               sea surface temperature (T before, Celsius) '
1007            WRITE(numout,*)'               sea surface salinity ' 
1008            WRITE(numout,*)'               surface currents U,V on local grid and spherical coordinates' 
1009            WRITE(numout,*)'               sea surface height ' 
1010            WRITE(numout,*)'               thickness of first ocean T level '       
1011            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level'
1012            WRITE(numout,*)
1013         ENDIF
1014      ENDIF
1015      !                                                      ! ------------------------------- !
1016      !                                                      !   OPA-SAS coupling - snd by sas !   
1017      !                                                      ! ------------------------------- !
1018      ssnd(jps_sflx  )%clname = 'I_SFLX'     
1019      ssnd(jps_fice2 )%clname = 'IIceFrc'
1020      ssnd(jps_qsroce)%clname = 'I_QsrOce'   
1021      ssnd(jps_qnsoce)%clname = 'I_QnsOce'   
1022      ssnd(jps_oemp  )%clname = 'IOEvaMPr' 
1023      ssnd(jps_otx1  )%clname = 'I_OTaux1'   
1024      ssnd(jps_oty1  )%clname = 'I_OTauy1'   
1025      ssnd(jps_rnf   )%clname = 'I_Runoff'   
1026      ssnd(jps_taum  )%clname = 'I_TauMod'   
1027      !
1028      IF( nn_components == jp_iam_sas ) THEN
1029         IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
1030         ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE.
1031         !
1032         ! Change first letter to couple with atmosphere if already coupled with sea_ice
1033         ! this is nedeed as each variable name used in the namcouple must be unique:
1034         ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere
1035         DO jn = 1, jpsnd
1036            IF( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname))
1037         END DO
1038         !
1039         IF(lwp) THEN                        ! control print
1040            WRITE(numout,*)
1041            IF( .NOT. ln_cpl ) THEN
1042               WRITE(numout,*)'  sent fields to OPA component '
1043            ELSE
1044               WRITE(numout,*)'  Additional sent fields to OPA component : '
1045            ENDIF
1046            WRITE(numout,*)'                  ice cover '
1047            WRITE(numout,*)'                  oce only EMP  '
1048            WRITE(numout,*)'                  salt flux  '
1049            WRITE(numout,*)'                  mixed oce-ice solar flux  '
1050            WRITE(numout,*)'                  mixed oce-ice non solar flux  '
1051            WRITE(numout,*)'                  wind stress U,V components'
1052            WRITE(numout,*)'                  wind stress module'
1053         ENDIF
1054      ENDIF
1055
1056      !
1057      ! ================================ !
1058      !   initialisation of the coupler  !
1059      ! ================================ !
1060
1061      CALL cpl_define(jprcv, jpsnd, nn_cplmodel)
1062     
1063      IF(ln_usecplmask) THEN
1064         xcplmask(:,:,:) = 0.
1065         CALL iom_open( 'cplmask', inum )
1066         CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:jpi,1:jpj,1:nn_cplmodel),   &
1067            &          kstart = (/ mig(1),mjg(1),1 /), kcount = (/ jpi,jpj,nn_cplmodel /) )
1068         CALL iom_close( inum )
1069      ELSE
1070         xcplmask(:,:,:) = 1.
1071      ENDIF
1072      xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 )
1073      !
1074   END SUBROUTINE sbc_cpl_init
1075
1076
1077   SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice, Kbb, Kmm )     
1078      !!----------------------------------------------------------------------
1079      !!             ***  ROUTINE sbc_cpl_rcv  ***
1080      !!
1081      !! ** Purpose :   provide the stress over the ocean and, if no sea-ice,
1082      !!                provide the ocean heat and freshwater fluxes.
1083      !!
1084      !! ** Method  : - Receive all the atmospheric fields (stored in frcv array). called at each time step.
1085      !!                OASIS controls if there is something do receive or not. nrcvinfo contains the info
1086      !!                to know if the field was really received or not
1087      !!
1088      !!              --> If ocean stress was really received:
1089      !!
1090      !!                  - transform the received ocean stress vector from the received
1091      !!                 referential and grid into an atmosphere-ocean stress in
1092      !!                 the (i,j) ocean referencial and at the ocean velocity point.
1093      !!                    The received stress are :
1094      !!                     - defined by 3 components (if cartesian coordinate)
1095      !!                            or by 2 components (if spherical)
1096      !!                     - oriented along geographical   coordinate (if eastward-northward)
1097      !!                            or  along the local grid coordinate (if local grid)
1098      !!                     - given at U- and V-point, resp.   if received on 2 grids
1099      !!                            or at T-point               if received on 1 grid
1100      !!                    Therefore and if necessary, they are successively
1101      !!                  processed in order to obtain them
1102      !!                     first  as  2 components on the sphere
1103      !!                     second as  2 components oriented along the local grid
1104      !!                     third  as  2 components on the U,V grid
1105      !!
1106      !!              -->
1107      !!
1108      !!              - In 'ocean only' case, non solar and solar ocean heat fluxes
1109      !!             and total ocean freshwater fluxes 
1110      !!
1111      !! ** Method  :   receive all fields from the atmosphere and transform
1112      !!              them into ocean surface boundary condition fields
1113      !!
1114      !! ** Action  :   update  utau, vtau   ocean stress at U,V grid
1115      !!                        taum         wind stress module at T-point
1116      !!                        wndm         wind speed  module at T-point over free ocean or leads in presence of sea-ice
1117      !!                        qns          non solar heat fluxes including emp heat content    (ocean only case)
1118      !!                                     and the latent heat flux of solid precip. melting
1119      !!                        qsr          solar ocean heat fluxes   (ocean only case)
1120      !!                        emp          upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case)
1121      !!----------------------------------------------------------------------
1122      USE zdf_oce,  ONLY :   ln_zdfswm
1123      !
1124      INTEGER, INTENT(in) ::   kt          ! ocean model time step index
1125      INTEGER, INTENT(in) ::   k_fsbc      ! frequency of sbc (-> ice model) computation
1126      INTEGER, INTENT(in) ::   k_ice       ! ice management in the sbc (=0/1/2/3)
1127      INTEGER, INTENT(in) ::   Kbb, Kmm    ! ocean model time level indices
1128      !!
1129      LOGICAL  ::   llnewtx, llnewtau      ! update wind stress components and module??
1130      INTEGER  ::   ji, jj, jn             ! dummy loop indices
1131      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdt did not change since nit000)
1132      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars     
1133      REAL(wp) ::   zcoef                  ! temporary scalar
1134      REAL(wp) ::   zrhoa  = 1.22          ! Air density kg/m3
1135      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient
1136      REAL(wp) ::   zzx, zzy               ! temporary variables
1137      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty, zmsk, zemp, zqns, zqsr, zcloud_fra
1138      !!----------------------------------------------------------------------
1139      !
1140      IF( kt == nit000 ) THEN
1141      !   cannot be done in the init phase when we use agrif as cpl_freq requires that oasis_enddef is done
1142         ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' )
1143         IF( ln_dm2dc .AND. ncpl_qsr_freq /= 86400 )   &
1144            &   CALL ctl_stop( 'sbc_cpl_rcv: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
1145
1146         IF( ncpl_qsr_freq /= 0) ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top
1147         
1148      ENDIF
1149      !
1150      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
1151      !
1152      !                                                      ! ======================================================= !
1153      !                                                      ! Receive all the atmos. fields (including ice information)
1154      !                                                      ! ======================================================= !
1155      isec = ( kt - nit000 ) * NINT( rn_Dt )                      ! date of exchanges
1156      DO jn = 1, jprcv                                          ! received fields sent by the atmosphere
1157         IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )
1158      END DO
1159
1160      !                                                      ! ========================= !
1161      IF( srcv(jpr_otx1)%laction ) THEN                      !  ocean stress components  !
1162         !                                                   ! ========================= !
1163         ! define frcv(jpr_otx1)%z3(:,:,1) and frcv(jpr_oty1)%z3(:,:,1): stress at U/V point along model grid
1164         ! => need to be done only when we receive the field
1165         IF(  nrcvinfo(jpr_otx1) == OASIS_Rcv ) THEN
1166            !
1167            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere
1168               !                                                       ! (cartesian to spherical -> 3 to 2 components)
1169               !
1170               CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1),   &
1171                  &          srcv(jpr_otx1)%clgrid, ztx, zty )
1172               frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid
1173               frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid
1174               !
1175               IF( srcv(jpr_otx2)%laction ) THEN
1176                  CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1),   &
1177                     &          srcv(jpr_otx2)%clgrid, ztx, zty )
1178                  frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid
1179                  frcv(jpr_oty2)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid
1180               ENDIF
1181               !
1182            ENDIF
1183            !
1184            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid
1185               !                                                       ! (geographical to local grid -> rotate the components)
1186               CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )   
1187               IF( srcv(jpr_otx2)%laction ) THEN
1188                  CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )   
1189               ELSE
1190                  CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 
1191               ENDIF
1192               frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid
1193               frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid
1194            ENDIF
1195            !                             
1196            IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN
1197               DO_2D( 0, 0, 0, 0 )
1198                  frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) )
1199                  frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji  ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) )
1200               END_2D
1201               CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U',  -1.0_wp, frcv(jpr_oty1)%z3(:,:,1), 'V',  -1.0_wp )
1202            ENDIF
1203            llnewtx = .TRUE.
1204         ELSE
1205            llnewtx = .FALSE.
1206         ENDIF
1207         !                                                   ! ========================= !
1208      ELSE                                                   !   No dynamical coupling   !
1209         !                                                   ! ========================= !
1210         frcv(jpr_otx1)%z3(:,:,1) = 0.e0                               ! here simply set to zero
1211         frcv(jpr_oty1)%z3(:,:,1) = 0.e0                               ! an external read in a file can be added instead
1212         llnewtx = .TRUE.
1213         !
1214      ENDIF
1215      !                                                      ! ========================= !
1216      !                                                      !    wind stress module     !   (taum)
1217      !                                                      ! ========================= !
1218      IF( .NOT. srcv(jpr_taum)%laction ) THEN                    ! compute wind stress module from its components if not received
1219         ! => need to be done only when otx1 was changed
1220         IF( llnewtx ) THEN
1221            DO_2D( 0, 0, 0, 0 )
1222               zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
1223               zzy = frcv(jpr_oty1)%z3(ji  ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)
1224               frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
1225            END_2D
1226            CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1.0_wp )
1227            llnewtau = .TRUE.
1228         ELSE
1229            llnewtau = .FALSE.
1230         ENDIF
1231      ELSE
1232         llnewtau = nrcvinfo(jpr_taum) == OASIS_Rcv
1233         ! Stress module can be negative when received (interpolation problem)
1234         IF( llnewtau ) THEN
1235            frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) )
1236         ENDIF
1237      ENDIF
1238      !
1239      !                                                      ! ========================= !
1240      !                                                      !      10 m wind speed      !   (wndm)
1241      !                                                      ! ========================= !
1242      IF( .NOT. srcv(jpr_w10m)%laction ) THEN                    ! compute wind spreed from wind stress module if not received 
1243         ! => need to be done only when taumod was changed
1244         IF( llnewtau ) THEN
1245            zcoef = 1. / ( zrhoa * zcdrag ) 
1246            DO_2D( 1, 1, 1, 1 )
1247               frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
1248            END_2D
1249         ENDIF
1250      ENDIF
1251!!$      !                                                      ! ========================= !
1252!!$      SELECT CASE( TRIM( sn_rcv_clouds%cldes ) )             !       cloud fraction      !
1253!!$      !                                                      ! ========================= !
1254!!$      cloud_fra(:,:) = frcv(jpr_clfra)*z3(:,:,1)
1255!!$      END SELECT
1256!!$
1257      zcloud_fra(:,:) = pp_cldf   ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm.
1258      IF( ln_mixcpl ) THEN
1259         cloud_fra(:,:) = cloud_fra(:,:) * xcplmask(:,:,0) + zcloud_fra(:,:)* zmsk(:,:)
1260      ELSE
1261         cloud_fra(:,:) = zcloud_fra(:,:)
1262      ENDIF
1263      !                                                      ! ========================= !
1264      ! u(v)tau and taum will be modified by ice model
1265      ! -> need to be reset before each call of the ice/fsbc     
1266      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN
1267         !
1268         IF( ln_mixcpl ) THEN
1269            utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:)
1270            vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:)
1271            taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:)
1272            wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:)
1273         ELSE
1274            utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)
1275            vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)
1276            taum(:,:) = frcv(jpr_taum)%z3(:,:,1)
1277            wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)
1278         ENDIF
1279         CALL iom_put( "taum_oce", taum )   ! output wind stress module
1280         
1281      ENDIF
1282
1283      !                                                      ! ================== !
1284      !                                                      ! atmosph. CO2 (ppm) !
1285      !                                                      ! ================== !
1286      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1)
1287      !
1288      !                                                      ! ========================= !
1289      !                                                      ! Mean Sea Level Pressure   !   (taum)
1290      !                                                      ! ========================= !
1291      IF( srcv(jpr_mslp)%laction ) THEN                    ! UKMO SHELF effect of atmospheric pressure on SSH
1292          IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields
1293
1294          r1_grau = 1.e0 / (grav * rho0)               !* constant for optimization
1295          ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau    ! equivalent ssh (inverse barometer)
1296          apr   (:,:) =     frcv(jpr_mslp)%z3(:,:,1)                         !atmospheric pressure
1297   
1298          IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:)  ! correct this later (read from restart if possible)
1299      ENDIF 
1300      !
1301      IF( ln_sdw ) THEN  ! Stokes Drift correction activated
1302      !                                                      ! ========================= !
1303      !                                                      !       Stokes drift u      !
1304      !                                                      ! ========================= !
1305         IF( srcv(jpr_sdrftx)%laction ) ut0sd(:,:) = frcv(jpr_sdrftx)%z3(:,:,1)
1306      !
1307      !                                                      ! ========================= !
1308      !                                                      !       Stokes drift v      !
1309      !                                                      ! ========================= !
1310         IF( srcv(jpr_sdrfty)%laction ) vt0sd(:,:) = frcv(jpr_sdrfty)%z3(:,:,1)
1311      !
1312      !                                                      ! ========================= !
1313      !                                                      !      Wave mean period     !
1314      !                                                      ! ========================= !
1315         IF( srcv(jpr_wper)%laction ) wmp(:,:) = frcv(jpr_wper)%z3(:,:,1)
1316      !
1317      !                                                      ! ========================= !
1318      !                                                      !  Significant wave height  !
1319      !                                                      ! ========================= !
1320         IF( srcv(jpr_hsig)%laction ) hsw(:,:) = frcv(jpr_hsig)%z3(:,:,1)
1321      !
1322      !                                                      ! ========================= ! 
1323      !                                                      !    Wave peak frequency    !
1324      !                                                      ! ========================= ! 
1325         IF( srcv(jpr_wfreq)%laction ) wfreq(:,:) = frcv(jpr_wfreq)%z3(:,:,1)
1326      !
1327      !                                                      ! ========================= !
1328      !                                                      !    Vertical mixing Qiao   !
1329      !                                                      ! ========================= !
1330         IF( srcv(jpr_wnum)%laction .AND. ln_zdfswm ) wnum(:,:) = frcv(jpr_wnum)%z3(:,:,1)
1331
1332         ! Calculate the 3D Stokes drift both in coupled and not fully uncoupled mode
1333         IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction &
1334                                      .OR. srcv(jpr_hsig)%laction   .OR. srcv(jpr_wfreq)%laction) THEN
1335            CALL sbc_stokes( Kmm )
1336         ENDIF
1337      ENDIF
1338      !                                                      ! ========================= !
1339      !                                                      ! Stress adsorbed by waves  !
1340      !                                                      ! ========================= !
1341      IF( srcv(jpr_tauwoc)%laction .AND. ln_tauwoc ) tauoc_wave(:,:) = frcv(jpr_tauwoc)%z3(:,:,1)
1342
1343      !                                                      ! ========================= ! 
1344      !                                                      ! Stress component by waves !
1345      !                                                      ! ========================= ! 
1346      IF( srcv(jpr_tauwx)%laction .AND. srcv(jpr_tauwy)%laction .AND. ln_tauw ) THEN
1347         tauw_x(:,:) = frcv(jpr_tauwx)%z3(:,:,1)
1348         tauw_y(:,:) = frcv(jpr_tauwy)%z3(:,:,1)
1349      ENDIF
1350
1351      !                                                      ! ========================= !
1352      !                                                      !   Wave drag coefficient   !
1353      !                                                      ! ========================= !
1354      IF( srcv(jpr_wdrag)%laction .AND. ln_cdgw )   cdn_wave(:,:) = frcv(jpr_wdrag)%z3(:,:,1)
1355
1356      !  Fields received by SAS when OASIS coupling
1357      !  (arrays no more filled at sbcssm stage)
1358      !                                                      ! ================== !
1359      !                                                      !        SSS         !
1360      !                                                      ! ================== !
1361      IF( srcv(jpr_soce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
1362         sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1)
1363         CALL iom_put( 'sss_m', sss_m )
1364      ENDIF
1365      !                                               
1366      !                                                      ! ================== !
1367      !                                                      !        SST         !
1368      !                                                      ! ================== !
1369      IF( srcv(jpr_toce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
1370         sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1)
1371         IF( srcv(jpr_soce)%laction .AND. l_useCT ) THEN    ! make sure that sst_m is the potential temperature
1372            sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) )
1373         ENDIF
1374      ENDIF
1375      !                                                      ! ================== !
1376      !                                                      !        SSH         !
1377      !                                                      ! ================== !
1378      IF( srcv(jpr_ssh )%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
1379         ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1)
1380         CALL iom_put( 'ssh_m', ssh_m )
1381      ENDIF
1382      !                                                      ! ================== !
1383      !                                                      !  surface currents  !
1384      !                                                      ! ================== !
1385      IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
1386         ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1)
1387         uu(:,:,1,Kbb) = ssu_m(:,:)                          ! will be used in icestp in the call of ice_forcing_tau
1388         uu(:,:,1,Kmm) = ssu_m(:,:)                          ! will be used in sbc_cpl_snd if atmosphere coupling
1389         CALL iom_put( 'ssu_m', ssu_m )
1390      ENDIF
1391      IF( srcv(jpr_ocy1)%laction ) THEN
1392         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
1393         vv(:,:,1,Kbb) = ssv_m(:,:)                          ! will be used in icestp in the call of ice_forcing_tau
1394         vv(:,:,1,Kmm) = ssv_m(:,:)                          ! will be used in sbc_cpl_snd if atmosphere coupling
1395         CALL iom_put( 'ssv_m', ssv_m )
1396      ENDIF
1397      !                                                      ! ======================== !
1398      !                                                      !  first T level thickness !
1399      !                                                      ! ======================== !
1400      IF( srcv(jpr_e3t1st )%laction ) THEN                   ! received by sas in case of opa <-> sas coupling
1401         e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1)
1402         CALL iom_put( 'e3t_m', e3t_m(:,:) )
1403      ENDIF
1404      !                                                      ! ================================ !
1405      !                                                      !  fraction of solar net radiation !
1406      !                                                      ! ================================ !
1407      IF( srcv(jpr_fraqsr)%laction ) THEN                    ! received by sas in case of opa <-> sas coupling
1408         frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1)
1409         CALL iom_put( 'frq_m', frq_m )
1410      ENDIF
1411     
1412      !                                                      ! ========================= !
1413      IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN   !  heat & freshwater fluxes ! (Ocean only case)
1414         !                                                   ! ========================= !
1415         !
1416         !                                                       ! total freshwater fluxes over the ocean (emp)
1417         IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN
1418            SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation
1419            CASE( 'conservative' )
1420               zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
1421            CASE( 'oce only', 'oce and ice' )
1422               zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
1423            CASE default
1424               CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
1425            END SELECT
1426         ELSE
1427            zemp(:,:) = 0._wp
1428         ENDIF
1429         !
1430         !                                                        ! runoffs and calving (added in emp)
1431         IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1432         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1)
1433 
1434         IF( srcv(jpr_icb)%laction )  THEN
1435             fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
1436             rnf(:,:)    = rnf(:,:) + fwficb(:,:)   ! iceberg added to runfofs
1437         ENDIF
1438         !
1439         ! ice shelf fwf
1440         IF( srcv(jpr_isf)%laction )  THEN
1441            fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting) 
1442         END IF
1443       
1444         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
1445         ELSE                   ;   emp(:,:) =                              zemp(:,:)
1446         ENDIF
1447         !
1448         !                                                       ! non solar heat flux over the ocean (qns)
1449         IF(      srcv(jpr_qnsoce)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
1450         ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
1451         ELSE                                       ;   zqns(:,:) = 0._wp
1452         ENDIF
1453         ! update qns over the free ocean with:
1454         IF( nn_components /= jp_iam_opa ) THEN
1455            zqns(:,:) =  zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp         ! remove heat content due to mass flux (assumed to be at SST)
1456            IF( srcv(jpr_snow  )%laction ) THEN
1457               zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * rLfus   ! energy for melting solid precipitation over the free ocean
1458            ENDIF
1459         ENDIF
1460         !
1461         IF( srcv(jpr_icb)%laction )  zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove heat content associated to iceberg melting
1462         !
1463         IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:)
1464         ELSE                   ;   qns(:,:) =                              zqns(:,:)
1465         ENDIF
1466
1467         !                                                       ! solar flux over the ocean          (qsr)
1468         IF     ( srcv(jpr_qsroce)%laction ) THEN   ;   zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
1469         ELSE IF( srcv(jpr_qsrmix)%laction ) then   ;   zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
1470         ELSE                                       ;   zqsr(:,:) = 0._wp
1471         ENDIF
1472         IF( ln_dm2dc .AND. ln_cpl )   zqsr(:,:) = sbc_dcy( zqsr )   ! modify qsr to include the diurnal cycle
1473         IF( ln_mixcpl ) THEN   ;   qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:)
1474         ELSE                   ;   qsr(:,:) =                              zqsr(:,:)
1475         ENDIF
1476         !
1477         ! salt flux over the ocean (received by opa in case of opa <-> sas coupling)
1478         IF( srcv(jpr_sflx )%laction )   sfx(:,:) = frcv(jpr_sflx  )%z3(:,:,1)
1479         ! Ice cover  (received by opa in case of opa <-> sas coupling)
1480         IF( srcv(jpr_fice )%laction )   fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1)
1481         !
1482      ENDIF
1483      !
1484   END SUBROUTINE sbc_cpl_rcv
1485   
1486
1487   SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )     
1488      !!----------------------------------------------------------------------
1489      !!             ***  ROUTINE sbc_cpl_ice_tau  ***
1490      !!
1491      !! ** Purpose :   provide the stress over sea-ice in coupled mode
1492      !!
1493      !! ** Method  :   transform the received stress from the atmosphere into
1494      !!             an atmosphere-ice stress in the (i,j) ocean referencial
1495      !!             and at the velocity point of the sea-ice model:
1496      !!                'C'-grid : i- (j-) components given at U- (V-) point
1497      !!
1498      !!                The received stress are :
1499      !!                 - defined by 3 components (if cartesian coordinate)
1500      !!                        or by 2 components (if spherical)
1501      !!                 - oriented along geographical   coordinate (if eastward-northward)
1502      !!                        or  along the local grid coordinate (if local grid)
1503      !!                 - given at U- and V-point, resp.   if received on 2 grids
1504      !!                        or at a same point (T or I) if received on 1 grid
1505      !!                Therefore and if necessary, they are successively
1506      !!             processed in order to obtain them
1507      !!                 first  as  2 components on the sphere
1508      !!                 second as  2 components oriented along the local grid
1509      !!                 third  as  2 components on the ice grid point
1510      !!
1511      !!                Except in 'oce and ice' case, only one vector stress field
1512      !!             is received. It has already been processed in sbc_cpl_rcv
1513      !!             so that it is now defined as (i,j) components given at U-
1514      !!             and V-points, respectively. 
1515      !!
1516      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice
1517      !!----------------------------------------------------------------------
1518      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2]
1519      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid)
1520      !!
1521      INTEGER ::   ji, jj   ! dummy loop indices
1522      INTEGER ::   itx      ! index of taux over ice
1523      REAL(wp)                     ::   zztmp1, zztmp2
1524      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty 
1525      !!----------------------------------------------------------------------
1526      !
1527      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1   
1528      ELSE                                ;   itx =  jpr_otx1
1529      ENDIF
1530
1531      ! do something only if we just received the stress from atmosphere
1532      IF(  nrcvinfo(itx) == OASIS_Rcv ) THEN
1533         !                                                      ! ======================= !
1534         IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   !
1535            !                                                   ! ======================= !
1536           
1537            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere
1538               !                                                       ! (cartesian to spherical -> 3 to 2 components)
1539               CALL geo2oce(  frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1),   &
1540                  &          srcv(jpr_itx1)%clgrid, ztx, zty )
1541               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid
1542               frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid
1543               !
1544               IF( srcv(jpr_itx2)%laction ) THEN
1545                  CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1),   &
1546                     &          srcv(jpr_itx2)%clgrid, ztx, zty )
1547                  frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid
1548                  frcv(jpr_ity2)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid
1549               ENDIF
1550               !
1551            ENDIF
1552            !
1553            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid
1554               !                                                       ! (geographical to local grid -> rotate the components)
1555               CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )   
1556               IF( srcv(jpr_itx2)%laction ) THEN
1557                  CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )   
1558               ELSE
1559                  CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty ) 
1560               ENDIF
1561               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid
1562               frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 1st grid
1563            ENDIF
1564            !                                                   ! ======================= !
1565         ELSE                                                   !     use ocean stress    !
1566            !                                                   ! ======================= !
1567            frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1)
1568            frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1)
1569            !
1570         ENDIF
1571         !                                                      ! ======================= !
1572         !                                                      !     put on ice grid     !
1573         !                                                      ! ======================= !
1574         !   
1575         !                                                  j+1   j     -----V---F
1576         ! ice stress on ice velocity point                              !       |
1577         ! (C-grid ==>(U,V))                                      j      |   T   U
1578         !                                                               |       |
1579         !                                                   j    j-1   -I-------|
1580         !                                               (for I)         |       |
1581         !                                                              i-1  i   i
1582         !                                                               i      i+1 (for I)
1583         SELECT CASE ( srcv(jpr_itx1)%clgrid )
1584         CASE( 'U' )
1585            p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! (U,V) ==> (U,V)
1586            p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
1587         CASE( 'T' )
1588            DO_2D( 0, 0, 0, 0 )
1589               ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology
1590               zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) )
1591               zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) )
1592               p_taui(ji,jj) = zztmp1 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
1593               p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
1594            END_2D
1595            CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. )
1596         END SELECT
1597         
1598      ENDIF
1599      !
1600   END SUBROUTINE sbc_cpl_ice_tau
1601   
1602
1603   SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi )
1604      !!----------------------------------------------------------------------
1605      !!             ***  ROUTINE sbc_cpl_ice_flx  ***
1606      !!
1607      !! ** Purpose :   provide the heat and freshwater fluxes of the ocean-ice system
1608      !!
1609      !! ** Method  :   transform the fields received from the atmosphere into
1610      !!             surface heat and fresh water boundary condition for the
1611      !!             ice-ocean system. The following fields are provided:
1612      !!               * total non solar, solar and freshwater fluxes (qns_tot,
1613      !!             qsr_tot and emp_tot) (total means weighted ice-ocean flux)
1614      !!             NB: emp_tot include runoffs and calving.
1615      !!               * fluxes over ice (qns_ice, qsr_ice, emp_ice) where
1616      !!             emp_ice = sublimation - solid precipitation as liquid
1617      !!             precipitation are re-routed directly to the ocean and
1618      !!             calving directly enter the ocean (runoffs are read but included in trasbc.F90)
1619      !!               * solid precipitation (sprecip), used to add to qns_tot
1620      !!             the heat lost associated to melting solid precipitation
1621      !!             over the ocean fraction.
1622      !!               * heat content of rain, snow and evap can also be provided,
1623      !!             otherwise heat flux associated with these mass flux are
1624      !!             guessed (qemp_oce, qemp_ice)
1625      !!
1626      !!             - the fluxes have been separated from the stress as
1627      !!               (a) they are updated at each ice time step compare to
1628      !!               an update at each coupled time step for the stress, and
1629      !!               (b) the conservative computation of the fluxes over the
1630      !!               sea-ice area requires the knowledge of the ice fraction
1631      !!               after the ice advection and before the ice thermodynamics,
1632      !!               so that the stress is updated before the ice dynamics
1633      !!               while the fluxes are updated after it.
1634      !!
1635      !! ** Details
1636      !!             qns_tot = (1-a) * qns_oce + a * qns_ice               => provided
1637      !!                     + qemp_oce + qemp_ice                         => recalculated and added up to qns
1638      !!
1639      !!             qsr_tot = (1-a) * qsr_oce + a * qsr_ice               => provided
1640      !!
1641      !!             emp_tot = emp_oce + emp_ice                           => calving is provided and added to emp_tot (and emp_oce).
1642      !!                                                                      runoff (which includes rivers+icebergs) and iceshelf
1643      !!                                                                      are provided but not included in emp here. Only runoff will
1644      !!                                                                      be included in emp in other parts of NEMO code
1645      !! ** Action  :   update at each nf_ice time step:
1646      !!                   qns_tot, qsr_tot  non-solar and solar total heat fluxes
1647      !!                   qns_ice, qsr_ice  non-solar and solar heat fluxes over the ice
1648      !!                   emp_tot           total evaporation - precipitation(liquid and solid) (-calving)
1649      !!                   emp_ice           ice sublimation - solid precipitation over the ice
1650      !!                   dqns_ice          d(non-solar heat flux)/d(Temperature) over the ice
1651      !!                   sprecip           solid precipitation over the ocean 
1652      !!----------------------------------------------------------------------
1653      REAL(wp), INTENT(in)   , DIMENSION(:,:)             ::   picefr     ! ice fraction                [0 to 1]
1654      !                                                   !!           ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling
1655      REAL(wp), INTENT(in)   , DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo
1656      REAL(wp), INTENT(in)   , DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius]
1657      REAL(wp), INTENT(inout), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin] => inout for Met-Office
1658      REAL(wp), INTENT(in)   , DIMENSION(:,:,:), OPTIONAL ::   phs        ! snow depth                  [m]
1659      REAL(wp), INTENT(in)   , DIMENSION(:,:,:), OPTIONAL ::   phi        ! ice thickness               [m]
1660      !
1661      INTEGER  ::   ji, jj, jl   ! dummy loop index
1662      REAL(wp), DIMENSION(jpi,jpj)     ::   zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw
1663      REAL(wp), DIMENSION(jpi,jpj)     ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip  , zevap_oce, zdevap_ice
1664      REAL(wp), DIMENSION(jpi,jpj)     ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice
1665      REAL(wp), DIMENSION(jpi,jpj)     ::   zevap_ice_total
1666      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu
1667      REAL(wp), DIMENSION(jpi,jpj)     ::   ztri
1668      !!----------------------------------------------------------------------
1669      !
1670      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
1671      ziceld(:,:) = 1._wp - picefr(:,:)
1672      zcptn (:,:) = rcp * sst_m(:,:)
1673      !
1674      !                                                      ! ========================= !
1675      !                                                      !    freshwater budget      !   (emp_tot)
1676      !                                                      ! ========================= !
1677      !
1678      !                                                           ! solid Precipitation                                (sprecip)
1679      !                                                           ! liquid + solid Precipitation                       (tprecip)
1680      !                                                           ! total Evaporation - total Precipitation            (emp_tot)
1681      !                                                           ! sublimation - solid precipitation (cell average)   (emp_ice)
1682      SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
1683      CASE( 'conservative' )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
1684         zsprecip(:,:) =   frcv(jpr_snow)%z3(:,:,1)                  ! May need to ensure positive here
1685         ztprecip(:,:) =   frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here
1686         zemp_tot(:,:) =   frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)
1687      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
1688         zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
1689         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:)
1690         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1)
1691         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:)
1692      CASE( 'none'      )       ! Not available as for now: needs additional coding below when computing zevap_oce
1693      !                         ! since fields received are not defined with none option
1694         CALL ctl_stop( 'STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_emp value in namelist namsbc_cpl' )
1695      END SELECT
1696
1697#if defined key_si3
1698
1699      ! --- evaporation over ice (kg/m2/s) --- !
1700      IF (ln_scale_ice_flux) THEN ! typically met-office requirements
1701         IF (sn_rcv_emp%clcat == 'yes') THEN
1702            WHERE( a_i(:,:,:) > 1.e-10 )  ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
1703            ELSEWHERE                     ; zevap_ice(:,:,:) = 0._wp
1704            END WHERE
1705            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:)
1706            ELSEWHERE                     ; zevap_ice_total(:,:) = 0._wp
1707            END WHERE
1708         ELSE
1709            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:)
1710            ELSEWHERE                     ; zevap_ice(:,:,1) = 0._wp
1711            END WHERE
1712            zevap_ice_total(:,:) = zevap_ice(:,:,1)
1713            DO jl = 2, jpl
1714               zevap_ice(:,:,jl) = zevap_ice(:,:,1)
1715            ENDDO
1716         ENDIF
1717      ELSE
1718         IF (sn_rcv_emp%clcat == 'yes') THEN
1719            zevap_ice(:,:,1:jpl) = frcv(jpr_ievp)%z3(:,:,1:jpl)
1720            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:)
1721            ELSEWHERE                     ; zevap_ice_total(:,:) = 0._wp
1722            END WHERE
1723         ELSE
1724            zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1)
1725            zevap_ice_total(:,:) = zevap_ice(:,:,1)
1726            DO jl = 2, jpl
1727               zevap_ice(:,:,jl) = zevap_ice(:,:,1)
1728            ENDDO
1729         ENDIF
1730      ENDIF
1731
1732      IF ( TRIM( sn_rcv_emp%cldes ) == 'conservative' ) THEN
1733         ! For conservative case zemp_ice has not been defined yet. Do it now.
1734         zemp_ice(:,:) = zevap_ice_total(:,:) * picefr(:,:) - frcv(jpr_snow)%z3(:,:,1) * picefr(:,:)
1735      ENDIF
1736
1737      ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing)
1738      zsnw(:,:) = 0._wp   ;   CALL ice_var_snwblow( ziceld, zsnw )
1739     
1740      ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- !
1741      zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( picefr(:,:) - zsnw(:,:) )  ! emp_ice = A * sublimation - zsnw * sprecip
1742      zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:)                                ! emp_oce = emp_tot - emp_ice
1743
1744      ! --- evaporation over ocean (used later for qemp) --- !
1745      zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) * picefr(:,:)
1746
1747      ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0
1748      ! therefore, sublimation is not redistributed over the ice categories when no subgrid scale fluxes are provided by atm.
1749      zdevap_ice(:,:) = 0._wp
1750     
1751      ! --- Continental fluxes --- !
1752      IF( srcv(jpr_rnf)%laction ) THEN   ! runoffs (included in emp later on)
1753         rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1754      ENDIF
1755      IF( srcv(jpr_cal)%laction ) THEN   ! calving (put in emp_tot and emp_oce)
1756         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
1757         zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1)
1758      ENDIF
1759      IF( srcv(jpr_icb)%laction ) THEN   ! iceberg added to runoffs
1760         fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
1761         rnf(:,:)    = rnf(:,:) + fwficb(:,:)
1762      ENDIF
1763      IF( srcv(jpr_isf)%laction ) THEN   ! iceshelf (fwfisf <0 mean melting)
1764        fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) 
1765      ENDIF
1766
1767      IF( ln_mixcpl ) THEN
1768         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
1769         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
1770         emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:)
1771         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
1772         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
1773         DO jl = 1, jpl
1774            evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:,jl) * zmsk(:,:)
1775            devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:)    * zmsk(:,:)
1776         END DO
1777      ELSE
1778         emp_tot (:,:)   = zemp_tot (:,:)
1779         emp_ice (:,:)   = zemp_ice (:,:)
1780         emp_oce (:,:)   = zemp_oce (:,:)     
1781         sprecip (:,:)   = zsprecip (:,:)
1782         tprecip (:,:)   = ztprecip (:,:)
1783         evap_ice(:,:,:) = zevap_ice(:,:,:)
1784         DO jl = 1, jpl
1785            devap_ice(:,:,jl) = zdevap_ice(:,:)
1786         END DO
1787      ENDIF
1788
1789#else
1790      zsnw(:,:) = picefr(:,:)
1791      ! --- Continental fluxes --- !
1792      IF( srcv(jpr_rnf)%laction ) THEN   ! runoffs (included in emp later on)
1793         rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1794      ENDIF
1795      IF( srcv(jpr_cal)%laction ) THEN   ! calving (put in emp_tot)
1796         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
1797      ENDIF
1798      IF( srcv(jpr_icb)%laction ) THEN   ! iceberg added to runoffs
1799         fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
1800         rnf(:,:)    = rnf(:,:) + fwficb(:,:)
1801      ENDIF
1802      IF( srcv(jpr_isf)%laction ) THEN   ! iceshelf (fwfisf <0 mean melting)
1803        fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)
1804      ENDIF
1805      !
1806      IF( ln_mixcpl ) THEN
1807         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
1808         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
1809         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
1810         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
1811      ELSE
1812         emp_tot(:,:) =                                  zemp_tot(:,:)
1813         emp_ice(:,:) =                                  zemp_ice(:,:)
1814         sprecip(:,:) =                                  zsprecip(:,:)
1815         tprecip(:,:) =                                  ztprecip(:,:)
1816      ENDIF
1817      !
1818#endif
1819
1820      ! outputs
1821!!      IF( srcv(jpr_rnf)%laction )   CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1)                                 )  ! runoff
1822!!      IF( srcv(jpr_isf)%laction )   CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1)                         )  ! iceshelf
1823      IF( srcv(jpr_cal)%laction )    CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1)                )  ! calving
1824      IF( srcv(jpr_icb)%laction )    CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1)                )  ! icebergs
1825      IF( iom_use('snowpre') )       CALL iom_put( 'snowpre'     , sprecip(:,:)                                          )  ! Snow
1826      IF( iom_use('precip') )        CALL iom_put( 'precip'      , tprecip(:,:)                                          )  ! total  precipitation
1827      IF( iom_use('rain') )          CALL iom_put( 'rain'        , tprecip(:,:) - sprecip(:,:)                           )  ! liquid precipitation
1828      IF( iom_use('snow_ao_cea') )   CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average)
1829      IF( iom_use('snow_ai_cea') )   CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average)
1830      IF( iom_use('rain_ao_cea') )   CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:)         )  ! liquid precipitation over ocean (cell average)
1831      IF( iom_use('subl_ai_cea') )   CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) )     ! Sublimation over sea-ice (cell average)
1832      IF( iom_use('evap_ao_cea') )   CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1)  &
1833         &                                                         - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)
1834      ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf
1835      !
1836      !                                                      ! ========================= !
1837      SELECT CASE( TRIM( sn_rcv_qns%cldes ) )                !   non solar heat fluxes   !   (qns)
1838      !                                                      ! ========================= !
1839      CASE( 'oce only' )         ! the required field is directly provided
1840         zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
1841         ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero
1842         ! here so the only flux is the ocean only one.
1843         zqns_ice(:,:,:) = 0._wp 
1844      CASE( 'conservative' )     ! the required fields are directly provided
1845         zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
1846         IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
1847            zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
1848         ELSE
1849            DO jl = 1, jpl
1850               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal
1851            END DO
1852         ENDIF
1853      CASE( 'oce and ice' )      ! the total flux is computed from ocean and ice fluxes
1854         zqns_tot(:,:) =  ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
1855         IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
1856            DO jl=1,jpl
1857               zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)   
1858               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
1859            ENDDO
1860         ELSE
1861            zqns_tot(:,:) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
1862            DO jl = 1, jpl
1863               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
1864            END DO
1865         ENDIF
1866      CASE( 'mixed oce-ice' )    ! the ice flux is cumputed from the total flux, the SST and ice informations
1867! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
1868         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
1869         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
1870            DO jl = 1, jpl
1871               zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:,jl)    &
1872                  &             + frcv(jpr_dqnsdt)%z3(:,:,jl) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:)   &
1873                  &                                             + pist(:,:,jl) * picefr(:,:) ) )
1874            END DO
1875         ELSE
1876            DO jl = 1, jpl
1877               zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:, 1)    &
1878                  &             + frcv(jpr_dqnsdt)%z3(:,:, 1) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:)   &
1879                  &                                             + pist(:,:,jl) * picefr(:,:) ) )
1880            END DO
1881         ENDIF
1882      END SELECT
1883      !                                     
1884      ! --- calving (removed from qns_tot) --- !
1885      IF( srcv(jpr_cal)%laction )   zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * rLfus  ! remove latent heat of calving
1886                                                                                                     ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean
1887      ! --- iceberg (removed from qns_tot) --- !
1888      IF( srcv(jpr_icb)%laction )   zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus  ! remove latent heat of iceberg melting
1889
1890#if defined key_si3     
1891      ! --- non solar flux over ocean --- !
1892      !         note: ziceld cannot be = 0 since we limit the ice concentration to amax
1893      zqns_oce = 0._wp
1894      WHERE( ziceld /= 0._wp )   zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / ziceld(:,:)
1895
1896      ! Heat content per unit mass of snow (J/kg)
1897      WHERE( SUM( a_i, dim=3 ) > 1.e-10 )   ;   zcptsnw(:,:) = rcpi * SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 )
1898      ELSEWHERE                             ;   zcptsnw(:,:) = zcptn(:,:)
1899      ENDWHERE
1900      ! Heat content per unit mass of rain (J/kg)
1901      zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) ) 
1902
1903      ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- !
1904      zqprec_ice(:,:) = rhos * ( zcptsnw(:,:) - rLfus )
1905
1906      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- !
1907      DO jl = 1, jpl
1908         zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * rcpi ) but atm. does not take it into account
1909      END DO
1910
1911      ! --- heat flux associated with emp (W/m2) --- !
1912      zqemp_oce(:,:) = -  zevap_oce(:,:)                                      *   zcptn   (:,:)   &        ! evap
1913         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptrain(:,:)   &        ! liquid precip
1914         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - rLfus )  ! solid precip over ocean + snow melting
1915      zqemp_ice(:,:) =     zsprecip(:,:)                   * zsnw             * ( zcptsnw (:,:) - rLfus )  ! solid precip over ice (qevap_ice=0 since atm. does not take it into account)
1916!!    zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * picefr(:,:)      *   zcptsnw (:,:)   &        ! ice evap
1917!!       &             +   zsprecip(:,:)                   * zsnw             * zqprec_ice(:,:) * r1_rhos  ! solid precip over ice
1918     
1919      ! --- total non solar flux (including evap/precip) --- !
1920      zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:)
1921
1922      ! --- in case both coupled/forced are active, we must mix values --- !
1923      IF( ln_mixcpl ) THEN
1924         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
1925         qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:)
1926         DO jl=1,jpl
1927            qns_ice  (:,:,jl) = qns_ice  (:,:,jl) * xcplmask(:,:,0) +  zqns_ice  (:,:,jl)* zmsk(:,:)
1928            qevap_ice(:,:,jl) = qevap_ice(:,:,jl) * xcplmask(:,:,0) +  zqevap_ice(:,:,jl)* zmsk(:,:)
1929         ENDDO
1930         qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:)
1931         qemp_oce (:,:) =  qemp_oce(:,:) * xcplmask(:,:,0) +  zqemp_oce(:,:)* zmsk(:,:)
1932         qemp_ice (:,:) =  qemp_ice(:,:) * xcplmask(:,:,0) +  zqemp_ice(:,:)* zmsk(:,:)
1933      ELSE
1934         qns_tot  (:,:  ) = zqns_tot  (:,:  )
1935         qns_oce  (:,:  ) = zqns_oce  (:,:  )
1936         qns_ice  (:,:,:) = zqns_ice  (:,:,:)
1937         qevap_ice(:,:,:) = zqevap_ice(:,:,:)
1938         qprec_ice(:,:  ) = zqprec_ice(:,:  )
1939         qemp_oce (:,:  ) = zqemp_oce (:,:  )
1940         qemp_ice (:,:  ) = zqemp_ice (:,:  )
1941      ENDIF
1942
1943#else
1944      zcptsnw (:,:) = zcptn(:,:)
1945      zcptrain(:,:) = zcptn(:,:)
1946     
1947      ! clem: this formulation is certainly wrong... but better than it was...
1948      zqns_tot(:,:) = zqns_tot(:,:)                             &          ! zqns_tot update over free ocean with:
1949         &          - (  ziceld(:,:) * zsprecip(:,:) * rLfus )  &          ! remove the latent heat flux of solid precip. melting
1950         &          - (  zemp_tot(:,:)                          &          ! remove the heat content of mass flux (assumed to be at SST)
1951         &             - zemp_ice(:,:) ) * zcptn(:,:) 
1952
1953     IF( ln_mixcpl ) THEN
1954         qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
1955         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) +  zqns_tot(:,:)* zmsk(:,:)
1956         DO jl=1,jpl
1957            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:)
1958         ENDDO
1959      ELSE
1960         qns_tot(:,:  ) = zqns_tot(:,:  )
1961         qns_ice(:,:,:) = zqns_ice(:,:,:)
1962      ENDIF
1963
1964#endif
1965      ! outputs
1966      IF( srcv(jpr_cal)%laction       ) CALL iom_put('hflx_cal_cea'    , - frcv(jpr_cal)%z3(:,:,1) * rLfus )                      ! latent heat from calving
1967      IF( srcv(jpr_icb)%laction       ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )                      ! latent heat from icebergs melting
1968      IF( iom_use('hflx_rain_cea')    ) CALL iom_put('hflx_rain_cea'   , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average)
1969      IF( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) &
1970           &                                                              * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) )            ! heat flux from evap (cell average)
1971      IF( iom_use('hflx_prec_cea')    ) CALL iom_put('hflx_prec_cea'   ,  sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) +  &                    ! heat flux from all precip (cell avg)
1972         &                                                               ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )
1973      IF( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  )               ! heat flux from snow (cell average)
1974      IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &
1975           &                                                              * ( 1._wp - zsnw(:,:) )                  )               ! heat flux from snow (over ocean)
1976      IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
1977           &                                                              *           zsnw(:,:)                    )               ! heat flux from snow (over ice)
1978      ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp.
1979      !
1980      !                                                      ! ========================= !
1981      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )                !      solar heat fluxes    !   (qsr)
1982      !                                                      ! ========================= !
1983      CASE( 'oce only' )
1984         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
1985         ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero
1986         ! here so the only flux is the ocean only one.
1987         zqsr_ice(:,:,:) = 0._wp
1988      CASE( 'conservative' )
1989         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
1990         IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
1991            zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
1992         ELSE
1993            ! Set all category values equal for the moment
1994            DO jl = 1, jpl
1995               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
1996            END DO
1997         ENDIF
1998      CASE( 'oce and ice' )
1999         zqsr_tot(:,:  ) =  ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
2000         IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
2001            DO jl = 1, jpl
2002               zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)   
2003               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
2004            END DO
2005         ELSE
2006            zqsr_tot(:,:) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
2007            DO jl = 1, jpl
2008               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
2009            END DO
2010         ENDIF
2011      CASE( 'mixed oce-ice' )
2012         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
2013! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
2014!       Create solar heat flux over ice using incoming solar heat flux and albedos
2015!       ( see OASIS3 user guide, 5th edition, p39 )
2016         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
2017            DO jl = 1, jpl
2018               zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:,jl) * ( 1.- palbi(:,:,jl) )   &
2019                  &            / (  1.- ( alb_oce_mix(:,:   ) * ziceld(:,:)       &
2020                  &                     + palbi      (:,:,jl) * picefr(:,:) ) )
2021            END DO
2022         ELSE
2023            DO jl = 1, jpl
2024               zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:, 1) * ( 1.- palbi(:,:,jl) )   &
2025                  &            / (  1.- ( alb_oce_mix(:,:   ) * ziceld(:,:)       &
2026                  &                     + palbi      (:,:,jl) * picefr(:,:) ) )
2027            END DO
2028         ENDIF
2029      CASE( 'none'      )       ! Not available as for now: needs additional coding 
2030      !                         ! since fields received, here zqsr_tot,  are not defined with none option
2031         CALL ctl_stop( 'STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_qsr value in namelist namsbc_cpl' )
2032      END SELECT
2033      IF( ln_dm2dc .AND. ln_cpl ) THEN   ! modify qsr to include the diurnal cycle
2034         zqsr_tot(:,:  ) = sbc_dcy( zqsr_tot(:,:  ) )
2035         DO jl = 1, jpl
2036            zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) )
2037         END DO
2038      ENDIF
2039
2040#if defined key_si3
2041      ! --- solar flux over ocean --- !
2042      !         note: ziceld cannot be = 0 since we limit the ice concentration to amax
2043      zqsr_oce = 0._wp
2044      WHERE( ziceld /= 0._wp )  zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:)
2045
2046      IF( ln_mixcpl ) THEN   ;   qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) +  zqsr_oce(:,:)* zmsk(:,:)
2047      ELSE                   ;   qsr_oce(:,:) = zqsr_oce(:,:)   ;   ENDIF
2048#endif
2049
2050      IF( ln_mixcpl ) THEN
2051         qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
2052         qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) +  zqsr_tot(:,:)* zmsk(:,:)
2053         DO jl = 1, jpl
2054            qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) +  zqsr_ice(:,:,jl)* zmsk(:,:)
2055         END DO
2056      ELSE
2057         qsr_tot(:,:  ) = zqsr_tot(:,:  )
2058         qsr_ice(:,:,:) = zqsr_ice(:,:,:)
2059      ENDIF
2060
2061      !                                                      ! ========================= !
2062      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) )             !          d(qns)/dt        !
2063      !                                                      ! ========================= !
2064      CASE ('coupled')
2065         IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
2066            zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
2067         ELSE
2068            ! Set all category values equal for the moment
2069            DO jl=1,jpl
2070               zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
2071            ENDDO
2072         ENDIF
2073      CASE( 'none' ) 
2074         zdqns_ice(:,:,:) = 0._wp
2075      END SELECT
2076     
2077      IF( ln_mixcpl ) THEN
2078         DO jl=1,jpl
2079            dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)
2080         ENDDO
2081      ELSE
2082         dqns_ice(:,:,:) = zdqns_ice(:,:,:)
2083      ENDIF
2084
2085#if defined key_si3     
2086      !                                                      ! ========================= !
2087      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !  ice topmelt and botmelt  !
2088      !                                                      ! ========================= !
2089      CASE ('coupled')
2090         IF (ln_scale_ice_flux) THEN
2091            WHERE( a_i(:,:,:) > 1.e-10_wp )
2092               qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
2093               qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
2094            ELSEWHERE
2095               qml_ice(:,:,:) = 0.0_wp
2096               qcn_ice(:,:,:) = 0.0_wp
2097            END WHERE
2098         ELSE
2099            qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:)
2100            qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:)
2101         ENDIF
2102      END SELECT
2103      !                                                      ! ========================= !
2104      !                                                      !      Transmitted Qsr      !   [W/m2]
2105      !                                                      ! ========================= !
2106      IF( .NOT.ln_cndflx ) THEN                              !==  No conduction flux as surface forcing  ==!
2107         !
2108         IF( nn_qtrice == 0 ) THEN
2109            ! formulation derived from Grenfell and Maykut (1977), where transmission rate
2110            !    1) depends on cloudiness
2111            !       ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81)
2112            !       !      should be real cloud fraction instead (as in the bulk) but needs to be read from atm.
2113            !    2) is 0 when there is any snow
2114            !    3) tends to 1 for thin ice
2115            ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm
2116            DO jl = 1, jpl
2117               WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )       ! linear decrease from hi=0 to 10cm 
2118                  zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) )
2119               ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )       ! constant (ztri) when hi>10cm
2120                  zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ztri(:,:)
2121               ELSEWHERE                                                           ! zero when hs>0
2122                  zqtr_ice_top(:,:,jl) = 0._wp 
2123               END WHERE
2124            ENDDO
2125         ELSEIF( nn_qtrice == 1 ) THEN
2126            ! formulation is derived from the thesis of M. Lebrun (2019).
2127            !    It represents the best fit using several sets of observations
2128            !    It comes with snow conductivities adapted to freezing/melting conditions (see icethd_zdf_bl99.F90)
2129            zqtr_ice_top(:,:,:) = 0.3_wp * zqsr_ice(:,:,:)
2130         ENDIF
2131         !     
2132      ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN      !==  conduction flux as surface forcing  ==!
2133         !
2134         !          ! ===> here we must receive the qtr_ice_top array from the coupler
2135         !                 for now just assume zero (fully opaque ice)
2136         zqtr_ice_top(:,:,:) = 0._wp
2137         !
2138      ENDIF
2139      !
2140      IF( ln_mixcpl ) THEN
2141         DO jl=1,jpl
2142            qtr_ice_top(:,:,jl) = qtr_ice_top(:,:,jl) * xcplmask(:,:,0) + zqtr_ice_top(:,:,jl) * zmsk(:,:)
2143         ENDDO
2144      ELSE
2145         qtr_ice_top(:,:,:) = zqtr_ice_top(:,:,:)
2146      ENDIF
2147      !                                                      ! ================== !
2148      !                                                      !   ice skin temp.   !
2149      !                                                      ! ================== !
2150      ! needed by Met Office
2151      IF( srcv(jpr_ts_ice)%laction ) THEN
2152         WHERE    ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0  )   ;   ztsu(:,:,:) =   0. + rt0 
2153         ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. )   ;   ztsu(:,:,:) = -60. + rt0
2154         ELSEWHERE                                        ;   ztsu(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:) + rt0
2155         END WHERE
2156         !
2157         IF( ln_mixcpl ) THEN
2158            DO jl=1,jpl
2159               pist(:,:,jl) = pist(:,:,jl) * xcplmask(:,:,0) + ztsu(:,:,jl) * zmsk(:,:)
2160            ENDDO
2161         ELSE
2162            pist(:,:,:) = ztsu(:,:,:)
2163         ENDIF
2164         !
2165      ENDIF
2166      !
2167#endif
2168      !
2169   END SUBROUTINE sbc_cpl_ice_flx
2170   
2171   
2172   SUBROUTINE sbc_cpl_snd( kt, Kbb, Kmm )
2173      !!----------------------------------------------------------------------
2174      !!             ***  ROUTINE sbc_cpl_snd  ***
2175      !!
2176      !! ** Purpose :   provide the ocean-ice informations to the atmosphere
2177      !!
2178      !! ** Method  :   send to the atmosphere through a call to cpl_snd
2179      !!              all the needed fields (as defined in sbc_cpl_init)
2180      !!----------------------------------------------------------------------
2181      INTEGER, INTENT(in) ::   kt
2182      INTEGER, INTENT(in) ::   Kbb, Kmm    ! ocean model time level index
2183      !
2184      INTEGER ::   ji, jj, jl   ! dummy loop indices
2185      INTEGER ::   isec, info   ! local integer
2186      REAL(wp) ::   zumax, zvmax
2187      REAL(wp), DIMENSION(jpi,jpj)     ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
2188      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   ztmp3, ztmp4   
2189      !!----------------------------------------------------------------------
2190      !
2191      isec = ( kt - nit000 ) * NINT( rn_Dt )        ! date of exchanges
2192      info = OASIS_idle
2193
2194      zfr_l(:,:) = 1.- fr_i(:,:)
2195      !                                                      ! ------------------------- !
2196      !                                                      !    Surface temperature    !   in Kelvin
2197      !                                                      ! ------------------------- !
2198      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
2199         
2200         IF( nn_components == jp_iam_opa ) THEN
2201            ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm)   ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part
2202         ELSE
2203            ! we must send the surface potential temperature
2204            IF( l_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) )
2205            ELSE                   ;   ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm)
2206            ENDIF
2207            !
2208            SELECT CASE( sn_snd_temp%cldes)
2209            CASE( 'oce only'             )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0
2210            CASE( 'oce and ice'          )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0
2211               SELECT CASE( sn_snd_temp%clcat )
2212               CASE( 'yes' )   
2213                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl)
2214               CASE( 'no' )
2215                  WHERE( SUM( a_i, dim=3 ) /= 0. )
2216                     ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 )
2217                  ELSEWHERE
2218                     ztmp3(:,:,1) = rt0
2219                  END WHERE
2220               CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
2221               END SELECT
2222            CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)   
2223               SELECT CASE( sn_snd_temp%clcat )
2224               CASE( 'yes' )   
2225                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2226               CASE( 'no' )
2227                  ztmp3(:,:,:) = 0.0
2228                  DO jl=1,jpl
2229                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
2230                  ENDDO
2231               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
2232               END SELECT
2233            CASE( 'oce and weighted ice')    ;   ztmp1(:,:) =   ts(:,:,1,jp_tem,Kmm) + rt0 
2234               SELECT CASE( sn_snd_temp%clcat ) 
2235               CASE( 'yes' )   
2236                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
2237               CASE( 'no' ) 
2238                  ztmp3(:,:,:) = 0.0 
2239                  DO jl=1,jpl 
2240                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
2241                  ENDDO 
2242               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
2243               END SELECT
2244            CASE( 'mixed oce-ice'        )   
2245               ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 
2246               DO jl=1,jpl
2247                  ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
2248               ENDDO
2249            CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
2250            END SELECT
2251         ENDIF
2252         IF( ssnd(jps_toce)%laction )   CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2253         IF( ssnd(jps_tice)%laction )   CALL cpl_snd( jps_tice, isec, ztmp3, info )
2254         IF( ssnd(jps_tmix)%laction )   CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2255      ENDIF
2256      !
2257      !                                                      ! ------------------------- !
2258      !                                                      ! 1st layer ice/snow temp.  !
2259      !                                                      ! ------------------------- !
2260#if defined key_si3
2261      ! needed by  Met Office
2262      IF( ssnd(jps_ttilyr)%laction) THEN
2263         SELECT CASE( sn_snd_ttilyr%cldes)
2264         CASE ('weighted ice')
2265            ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
2266         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ttilyr%cldes' )
2267         END SELECT
2268         IF( ssnd(jps_ttilyr)%laction )   CALL cpl_snd( jps_ttilyr, isec, ztmp3, info )
2269      ENDIF
2270#endif
2271      !                                                      ! ------------------------- !
2272      !                                                      !           Albedo          !
2273      !                                                      ! ------------------------- !
2274      IF( ssnd(jps_albice)%laction ) THEN                         ! ice
2275          SELECT CASE( sn_snd_alb%cldes )
2276          CASE( 'ice' )
2277             SELECT CASE( sn_snd_alb%clcat )
2278             CASE( 'yes' )   
2279                ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
2280             CASE( 'no' )
2281                WHERE( SUM( a_i, dim=3 ) /= 0. )
2282                   ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 )
2283                ELSEWHERE
2284                   ztmp1(:,:) = alb_oce_mix(:,:)
2285                END WHERE
2286             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' )
2287             END SELECT
2288          CASE( 'weighted ice' )   ;
2289             SELECT CASE( sn_snd_alb%clcat )
2290             CASE( 'yes' )   
2291                ztmp3(:,:,1:jpl) =  alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2292             CASE( 'no' )
2293                WHERE( fr_i (:,:) > 0. )
2294                   ztmp1(:,:) = SUM (  alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 )
2295                ELSEWHERE
2296                   ztmp1(:,:) = 0.
2297                END WHERE
2298             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' )
2299             END SELECT
2300          CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' )
2301         END SELECT
2302
2303         SELECT CASE( sn_snd_alb%clcat )
2304            CASE( 'yes' )   
2305               CALL cpl_snd( jps_albice, isec, ztmp3, info )      !-> MV this has never been checked in coupled mode
2306            CASE( 'no'  )   
2307               CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
2308         END SELECT
2309      ENDIF
2310
2311      IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean
2312         ztmp1(:,:) = alb_oce_mix(:,:) * zfr_l(:,:)
2313         DO jl = 1, jpl
2314            ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl)
2315         END DO
2316         CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2317      ENDIF
2318      !                                                      ! ------------------------- !
2319      !                                                      !  Ice fraction & Thickness !
2320      !                                                      ! ------------------------- !
2321      ! Send ice fraction field to atmosphere
2322      IF( ssnd(jps_fice)%laction ) THEN
2323         SELECT CASE( sn_snd_thick%clcat )
2324         CASE( 'yes' )   ;   ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl)
2325         CASE( 'no'  )   ;   ztmp3(:,:,1    ) = fr_i(:,:      )
2326         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2327         END SELECT
2328         CALL cpl_snd( jps_fice, isec, ztmp3, info )
2329      ENDIF
2330
2331#if defined key_si3 || defined key_cice
2332      ! If this coupling was successful then save ice fraction for use between coupling points.
2333      ! This is needed for some calculations where the ice fraction at the last coupling point
2334      ! is needed.
2335      IF(  info == OASIS_Sent    .OR. info == OASIS_ToRest .OR. & 
2336         & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN
2337         IF ( sn_snd_thick%clcat == 'yes' ) THEN
2338           a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl)
2339         ENDIF
2340      ENDIF
2341#endif
2342
2343      IF( ssnd(jps_fice1)%laction ) THEN
2344         SELECT CASE( sn_snd_thick1%clcat )
2345         CASE( 'yes' )   ;   ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl)
2346         CASE( 'no'  )   ;   ztmp3(:,:,1    ) = fr_i(:,:      )
2347         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' )
2348         END SELECT
2349         CALL cpl_snd( jps_fice1, isec, ztmp3, info )
2350      ENDIF
2351     
2352      ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling)
2353      IF( ssnd(jps_fice2)%laction ) THEN
2354         ztmp3(:,:,1) = fr_i(:,:)
2355         IF( ssnd(jps_fice2)%laction )   CALL cpl_snd( jps_fice2, isec, ztmp3, info )
2356      ENDIF
2357
2358      ! Send ice and snow thickness field
2359      IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN
2360         SELECT CASE( sn_snd_thick%cldes)
2361         CASE( 'none'                  )       ! nothing to do
2362         CASE( 'weighted ice and snow' )   
2363            SELECT CASE( sn_snd_thick%clcat )
2364            CASE( 'yes' )   
2365               ztmp3(:,:,1:jpl) =  h_i(:,:,1:jpl) * a_i(:,:,1:jpl)
2366               ztmp4(:,:,1:jpl) =  h_s(:,:,1:jpl) * a_i(:,:,1:jpl)
2367            CASE( 'no' )
2368               ztmp3(:,:,:) = 0.0   ;  ztmp4(:,:,:) = 0.0
2369               DO jl=1,jpl
2370                  ztmp3(:,:,1) = ztmp3(:,:,1) + h_i(:,:,jl) * a_i(:,:,jl)
2371                  ztmp4(:,:,1) = ztmp4(:,:,1) + h_s(:,:,jl) * a_i(:,:,jl)
2372               ENDDO
2373            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2374            END SELECT
2375         CASE( 'ice and snow'         )   
2376            SELECT CASE( sn_snd_thick%clcat )
2377            CASE( 'yes' )
2378               ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl)
2379               ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl)
2380            CASE( 'no' )
2381               WHERE( SUM( a_i, dim=3 ) /= 0. )
2382                  ztmp3(:,:,1) = SUM( h_i * a_i, dim=3 ) / SUM( a_i, dim=3 )
2383                  ztmp4(:,:,1) = SUM( h_s * a_i, dim=3 ) / SUM( a_i, dim=3 )
2384               ELSEWHERE
2385                 ztmp3(:,:,1) = 0.
2386                 ztmp4(:,:,1) = 0.
2387               END WHERE
2388            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2389            END SELECT
2390         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' )
2391         END SELECT
2392         IF( ssnd(jps_hice)%laction )   CALL cpl_snd( jps_hice, isec, ztmp3, info )
2393         IF( ssnd(jps_hsnw)%laction )   CALL cpl_snd( jps_hsnw, isec, ztmp4, info )
2394      ENDIF
2395
2396#if defined key_si3
2397      !                                                      ! ------------------------- !
2398      !                                                      !      Ice melt ponds       !
2399      !                                                      ! ------------------------- !
2400      ! needed by Met Office: 1) fraction of ponded ice 2) local/actual pond depth
2401      IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN
2402         SELECT CASE( sn_snd_mpnd%cldes) 
2403         CASE( 'ice only' ) 
2404            SELECT CASE( sn_snd_mpnd%clcat ) 
2405            CASE( 'yes' ) 
2406               ztmp3(:,:,1:jpl) =  a_ip_eff(:,:,1:jpl)
2407               ztmp4(:,:,1:jpl) =  h_ip(:,:,1:jpl) 
2408            CASE( 'no' ) 
2409               ztmp3(:,:,:) = 0.0 
2410               ztmp4(:,:,:) = 0.0 
2411               DO jl=1,jpl 
2412                 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl)
2413                 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl)
2414               ENDDO 
2415            CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' ) 
2416            END SELECT 
2417         CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%cldes' )     
2418         END SELECT 
2419         IF( ssnd(jps_a_p)%laction  )   CALL cpl_snd( jps_a_p , isec, ztmp3, info )     
2420         IF( ssnd(jps_ht_p)%laction )   CALL cpl_snd( jps_ht_p, isec, ztmp4, info )     
2421      ENDIF 
2422      !
2423      !                                                      ! ------------------------- !
2424      !                                                      !     Ice conductivity      !
2425      !                                                      ! ------------------------- !
2426      ! needed by Met Office
2427      IF( ssnd(jps_kice)%laction ) THEN
2428         SELECT CASE( sn_snd_cond%cldes) 
2429         CASE( 'weighted ice' )   
2430            SELECT CASE( sn_snd_cond%clcat ) 
2431            CASE( 'yes' )   
2432          ztmp3(:,:,1:jpl) =  cnd_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
2433            CASE( 'no' ) 
2434               ztmp3(:,:,:) = 0.0 
2435               DO jl=1,jpl 
2436                 ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(:,:,jl) 
2437               ENDDO 
2438            CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' ) 
2439            END SELECT
2440         CASE( 'ice only' )   
2441           ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) 
2442         CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%cldes' )     
2443         END SELECT
2444         IF( ssnd(jps_kice)%laction )   CALL cpl_snd( jps_kice, isec, ztmp3, info ) 
2445      ENDIF 
2446#endif
2447
2448      !                                                      ! ------------------------- !
2449      !                                                      !  CO2 flux from PISCES     !
2450      !                                                      ! ------------------------- !
2451      IF( ssnd(jps_co2)%laction .AND. l_co2cpl )   THEN
2452         ztmp1(:,:) = oce_co2(:,:) * 1000.  ! conversion in molC/m2/s
2453         CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ) , info )
2454      ENDIF
2455      !
2456      !                                                      ! ------------------------- !
2457      IF( ssnd(jps_ocx1)%laction ) THEN                      !      Surface current      !
2458         !                                                   ! ------------------------- !
2459         !   
2460         !                                                  j+1   j     -----V---F
2461         ! surface velocity always sent from T point                     !       |
2462         !                                                        j      |   T   U
2463         !                                                               |       |
2464         !                                                   j    j-1   -I-------|
2465         !                                               (for I)         |       |
2466         !                                                              i-1  i   i
2467         !                                                               i      i+1 (for I)
2468         IF( nn_components == jp_iam_opa ) THEN
2469            zotx1(:,:) = uu(:,:,1,Kmm) 
2470            zoty1(:,:) = vv(:,:,1,Kmm) 
2471         ELSE       
2472            SELECT CASE( TRIM( sn_snd_crt%cldes ) )
2473            CASE( 'oce only'             )      ! C-grid ==> T
2474               DO_2D( 0, 0, 0, 0 )
2475                  zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj  ,1,Kmm) )
2476                  zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji  ,jj-1,1,Kmm) ) 
2477               END_2D
2478            CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T 
2479               DO_2D( 0, 0, 0, 0 )
2480                  zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj) 
2481                  zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)
2482                  zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  )     + u_ice(ji-1,jj    )     ) *  fr_i(ji,jj)
2483                  zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  )     + v_ice(ji  ,jj-1  )     ) *  fr_i(ji,jj)
2484               END_2D
2485               CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp )
2486            CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T
2487               DO_2D( 0, 0, 0, 0 )
2488                  zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   &
2489                     &         + 0.5 * ( u_ice(ji,jj  )     + u_ice(ji-1,jj    )     ) *  fr_i(ji,jj)
2490                  zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)   &
2491                     &         + 0.5 * ( v_ice(ji,jj  )     + v_ice(ji  ,jj-1  )     ) *  fr_i(ji,jj)
2492               END_2D
2493            END SELECT
2494            CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp,  zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp )
2495            !
2496         ENDIF
2497         !
2498         !
2499         IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components
2500            !                                                                     ! Ocean component
2501            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component
2502            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component
2503            zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components
2504            zoty1(:,:) = ztmp2(:,:)
2505            IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component
2506               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component
2507               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component
2508               zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components
2509               zity1(:,:) = ztmp2(:,:)
2510            ENDIF
2511         ENDIF
2512         !
2513         ! spherical coordinates to cartesian -> 2 components to 3 components
2514         IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN
2515            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents
2516            ztmp2(:,:) = zoty1(:,:)
2517            CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
2518            !
2519            IF( ssnd(jps_ivx1)%laction ) THEN           ! ice velocities
2520               ztmp1(:,:) = zitx1(:,:)
2521               ztmp1(:,:) = zity1(:,:)
2522               CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
2523            ENDIF
2524         ENDIF
2525         !
2526         IF( ssnd(jps_ocx1)%laction )   CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid
2527         IF( ssnd(jps_ocy1)%laction )   CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid
2528         IF( ssnd(jps_ocz1)%laction )   CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid
2529         !
2530         IF( ssnd(jps_ivx1)%laction )   CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid
2531         IF( ssnd(jps_ivy1)%laction )   CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid
2532         IF( ssnd(jps_ivz1)%laction )   CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid
2533         !
2534      ENDIF
2535      !
2536      !                                                      ! ------------------------- !
2537      !                                                      !  Surface current to waves !
2538      !                                                      ! ------------------------- !
2539      IF( ssnd(jps_ocxw)%laction .OR. ssnd(jps_ocyw)%laction ) THEN 
2540          !     
2541          !                                                  j+1  j     -----V---F
2542          ! surface velocity always sent from T point                    !       |
2543          !                                                       j      |   T   U
2544          !                                                              |       |
2545          !                                                   j   j-1   -I-------|
2546          !                                               (for I)        |       |
2547          !                                                             i-1  i   i
2548          !                                                              i      i+1 (for I)
2549          SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 
2550          CASE( 'oce only'             )      ! C-grid ==> T
2551             DO_2D( 0, 0, 0, 0 )
2552                zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj  ,1,Kmm) ) 
2553                zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) ) 
2554             END_2D
2555          CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T   
2556             DO_2D( 0, 0, 0, 0 )
2557                zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   
2558                zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 
2559                zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
2560                zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
2561             END_2D
2562             CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp,  zity1, 'T', -1.0_wp ) 
2563          CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T 
2564             DO_2D( 0, 0, 0, 0 )
2565                zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   & 
2566                   &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
2567                zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)   & 
2568                   &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
2569             END_2D
2570          END SELECT
2571         CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp ) 
2572         !
2573         !
2574         IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components
2575         !                                                                        ! Ocean component
2576            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->e', ztmp1 )       ! 1st component 
2577            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->n', ztmp2 )       ! 2nd component 
2578            zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components 
2579            zoty1(:,:) = ztmp2(:,:) 
2580            IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component
2581               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component 
2582               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component 
2583               zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components 
2584               zity1(:,:) = ztmp2(:,:) 
2585            ENDIF
2586         ENDIF 
2587         !
2588!         ! spherical coordinates to cartesian -> 2 components to 3 components
2589!         IF( TRIM( sn_snd_crtw%clvref ) == 'cartesian' ) THEN
2590!            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents
2591!            ztmp2(:,:) = zoty1(:,:)
2592!            CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
2593!            !
2594!            IF( ssnd(jps_ivx1)%laction ) THEN           ! ice velocities
2595!               ztmp1(:,:) = zitx1(:,:)
2596!               ztmp1(:,:) = zity1(:,:)
2597!               CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
2598!            ENDIF
2599!         ENDIF
2600         !
2601         IF( ssnd(jps_ocxw)%laction )   CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid
2602         IF( ssnd(jps_ocyw)%laction )   CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid
2603         
2604      ENDIF 
2605      !
2606      IF( ssnd(jps_ficet)%laction ) THEN
2607         CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info ) 
2608      ENDIF 
2609      !                                                      ! ------------------------- !
2610      !                                                      !   Water levels to waves   !
2611      !                                                      ! ------------------------- !
2612      IF( ssnd(jps_wlev)%laction ) THEN
2613         IF( ln_apr_dyn ) THEN 
2614            IF( kt /= nit000 ) THEN 
2615               ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
2616            ELSE 
2617               ztmp1(:,:) = ssh(:,:,Kbb) 
2618            ENDIF 
2619         ELSE 
2620            ztmp1(:,:) = ssh(:,:,Kmm) 
2621         ENDIF 
2622         CALL cpl_snd( jps_wlev  , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
2623      ENDIF 
2624      !
2625      !  Fields sent by OPA to SAS when doing OPA<->SAS coupling
2626      !                                                        ! SSH
2627      IF( ssnd(jps_ssh )%laction )  THEN
2628         !                          ! removed inverse barometer ssh when Patm
2629         !                          forcing is used (for sea-ice dynamics)
2630         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
2631         ELSE                    ;   ztmp1(:,:) = ssh(:,:,Kmm)
2632         ENDIF
2633         CALL cpl_snd( jps_ssh   , isec, RESHAPE ( ztmp1            , (/jpi,jpj,1/) ), info )
2634
2635      ENDIF
2636      !                                                        ! SSS
2637      IF( ssnd(jps_soce  )%laction )  THEN
2638         CALL cpl_snd( jps_soce  , isec, RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) ), info )
2639      ENDIF
2640      !                                                        ! first T level thickness
2641      IF( ssnd(jps_e3t1st )%laction )  THEN
2642         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(:,:,1,Kmm)   , (/jpi,jpj,1/) ), info )
2643      ENDIF
2644      !                                                        ! Qsr fraction
2645      IF( ssnd(jps_fraqsr)%laction )  THEN
2646         CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info )
2647      ENDIF
2648      !
2649      !  Fields sent by SAS to OPA when OASIS coupling
2650      !                                                        ! Solar heat flux
2651      IF( ssnd(jps_qsroce)%laction )  CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info )
2652      IF( ssnd(jps_qnsoce)%laction )  CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info )
2653      IF( ssnd(jps_oemp  )%laction )  CALL cpl_snd( jps_oemp  , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info )
2654      IF( ssnd(jps_sflx  )%laction )  CALL cpl_snd( jps_sflx  , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info )
2655      IF( ssnd(jps_otx1  )%laction )  CALL cpl_snd( jps_otx1  , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info )
2656      IF( ssnd(jps_oty1  )%laction )  CALL cpl_snd( jps_oty1  , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info )
2657      IF( ssnd(jps_rnf   )%laction )  CALL cpl_snd( jps_rnf   , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info )
2658      IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info )
2659
2660#if defined key_si3
2661      !                                                      ! ------------------------- !
2662      !                                                      ! Sea surface freezing temp !
2663      !                                                      ! ------------------------- !
2664      ! needed by Met Office
2665      CALL eos_fzp(ts(:,:,1,jp_sal,Kmm), sstfrz)
2666      ztmp1(:,:) = sstfrz(:,:) + rt0
2667      IF( ssnd(jps_sstfrz)%laction )  CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info)
2668#endif
2669      !
2670   END SUBROUTINE sbc_cpl_snd
2671   
2672   !!======================================================================
2673END MODULE sbccpl
Note: See TracBrowser for help on using the repository browser.