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/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC – NEMO

source: NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/SBC/sbccpl.F90 @ 13630

Last change on this file since 13630 was 13630, checked in by mocavero, 3 years ago

Add neighborhood collectives calls in the NEMO src - ticket #2496

  • Property svn:keywords set to Id
File size: 159.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 )                                        ! T ==> (U,V)
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#if defined key_mpi3
1202               CALL lbc_lnk_nc_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U',  -1.0_wp, frcv(jpr_oty1)%z3(:,:,1), 'V',  -1.0_wp )
1203#else
1204               CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U',  -1.0_wp, frcv(jpr_oty1)%z3(:,:,1), 'V',  -1.0_wp )
1205#endif
1206            ENDIF
1207            llnewtx = .TRUE.
1208         ELSE
1209            llnewtx = .FALSE.
1210         ENDIF
1211         !                                                   ! ========================= !
1212      ELSE                                                   !   No dynamical coupling   !
1213         !                                                   ! ========================= !
1214         frcv(jpr_otx1)%z3(:,:,1) = 0.e0                               ! here simply set to zero
1215         frcv(jpr_oty1)%z3(:,:,1) = 0.e0                               ! an external read in a file can be added instead
1216         llnewtx = .TRUE.
1217         !
1218      ENDIF
1219      !                                                      ! ========================= !
1220      !                                                      !    wind stress module     !   (taum)
1221      !                                                      ! ========================= !
1222      IF( .NOT. srcv(jpr_taum)%laction ) THEN                    ! compute wind stress module from its components if not received
1223         ! => need to be done only when otx1 was changed
1224         IF( llnewtx ) THEN
1225            DO_2D( 0, 0, 0, 0 )
1226               zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
1227               zzy = frcv(jpr_oty1)%z3(ji  ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)
1228               frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
1229            END_2D
1230#if defined key_mpi3
1231            CALL lbc_lnk_nc_multi( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1.0_wp )
1232#else
1233            CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1.0_wp )
1234#endif
1235            llnewtau = .TRUE.
1236         ELSE
1237            llnewtau = .FALSE.
1238         ENDIF
1239      ELSE
1240         llnewtau = nrcvinfo(jpr_taum) == OASIS_Rcv
1241         ! Stress module can be negative when received (interpolation problem)
1242         IF( llnewtau ) THEN
1243            frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) )
1244         ENDIF
1245      ENDIF
1246      !
1247      !                                                      ! ========================= !
1248      !                                                      !      10 m wind speed      !   (wndm)
1249      !                                                      ! ========================= !
1250      IF( .NOT. srcv(jpr_w10m)%laction ) THEN                    ! compute wind spreed from wind stress module if not received 
1251         ! => need to be done only when taumod was changed
1252         IF( llnewtau ) THEN
1253            zcoef = 1. / ( zrhoa * zcdrag ) 
1254            DO_2D( 1, 1, 1, 1 )
1255               frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
1256            END_2D
1257         ENDIF
1258      ENDIF
1259!!$      !                                                      ! ========================= !
1260!!$      SELECT CASE( TRIM( sn_rcv_clouds%cldes ) )             !       cloud fraction      !
1261!!$      !                                                      ! ========================= !
1262!!$      cloud_fra(:,:) = frcv(jpr_clfra)*z3(:,:,1)
1263!!$      END SELECT
1264!!$
1265      zcloud_fra(:,:) = pp_cldf   ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm.
1266      IF( ln_mixcpl ) THEN
1267         cloud_fra(:,:) = cloud_fra(:,:) * xcplmask(:,:,0) + zcloud_fra(:,:)* zmsk(:,:)
1268      ELSE
1269         cloud_fra(:,:) = zcloud_fra(:,:)
1270      ENDIF
1271      !                                                      ! ========================= !
1272      ! u(v)tau and taum will be modified by ice model
1273      ! -> need to be reset before each call of the ice/fsbc     
1274      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN
1275         !
1276         IF( ln_mixcpl ) THEN
1277            utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:)
1278            vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:)
1279            taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:)
1280            wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:)
1281         ELSE
1282            utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)
1283            vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)
1284            taum(:,:) = frcv(jpr_taum)%z3(:,:,1)
1285            wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)
1286         ENDIF
1287         CALL iom_put( "taum_oce", taum )   ! output wind stress module
1288         
1289      ENDIF
1290
1291      !                                                      ! ================== !
1292      !                                                      ! atmosph. CO2 (ppm) !
1293      !                                                      ! ================== !
1294      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1)
1295      !
1296      !                                                      ! ========================= !
1297      !                                                      ! Mean Sea Level Pressure   !   (taum)
1298      !                                                      ! ========================= !
1299      IF( srcv(jpr_mslp)%laction ) THEN                    ! UKMO SHELF effect of atmospheric pressure on SSH
1300          IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields
1301
1302          r1_grau = 1.e0 / (grav * rho0)               !* constant for optimization
1303          ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau    ! equivalent ssh (inverse barometer)
1304          apr   (:,:) =     frcv(jpr_mslp)%z3(:,:,1)                         !atmospheric pressure
1305   
1306          IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:)  ! correct this later (read from restart if possible)
1307      ENDIF 
1308      !
1309      IF( ln_sdw ) THEN  ! Stokes Drift correction activated
1310      !                                                      ! ========================= !
1311      !                                                      !       Stokes drift u      !
1312      !                                                      ! ========================= !
1313         IF( srcv(jpr_sdrftx)%laction ) ut0sd(:,:) = frcv(jpr_sdrftx)%z3(:,:,1)
1314      !
1315      !                                                      ! ========================= !
1316      !                                                      !       Stokes drift v      !
1317      !                                                      ! ========================= !
1318         IF( srcv(jpr_sdrfty)%laction ) vt0sd(:,:) = frcv(jpr_sdrfty)%z3(:,:,1)
1319      !
1320      !                                                      ! ========================= !
1321      !                                                      !      Wave mean period     !
1322      !                                                      ! ========================= !
1323         IF( srcv(jpr_wper)%laction ) wmp(:,:) = frcv(jpr_wper)%z3(:,:,1)
1324      !
1325      !                                                      ! ========================= !
1326      !                                                      !  Significant wave height  !
1327      !                                                      ! ========================= !
1328         IF( srcv(jpr_hsig)%laction ) hsw(:,:) = frcv(jpr_hsig)%z3(:,:,1)
1329      !
1330      !                                                      ! ========================= ! 
1331      !                                                      !    Wave peak frequency    !
1332      !                                                      ! ========================= ! 
1333         IF( srcv(jpr_wfreq)%laction ) wfreq(:,:) = frcv(jpr_wfreq)%z3(:,:,1)
1334      !
1335      !                                                      ! ========================= !
1336      !                                                      !    Vertical mixing Qiao   !
1337      !                                                      ! ========================= !
1338         IF( srcv(jpr_wnum)%laction .AND. ln_zdfswm ) wnum(:,:) = frcv(jpr_wnum)%z3(:,:,1)
1339
1340         ! Calculate the 3D Stokes drift both in coupled and not fully uncoupled mode
1341         IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction &
1342                                      .OR. srcv(jpr_hsig)%laction   .OR. srcv(jpr_wfreq)%laction) THEN
1343            CALL sbc_stokes( Kmm )
1344         ENDIF
1345      ENDIF
1346      !                                                      ! ========================= !
1347      !                                                      ! Stress adsorbed by waves  !
1348      !                                                      ! ========================= !
1349      IF( srcv(jpr_tauwoc)%laction .AND. ln_tauwoc ) tauoc_wave(:,:) = frcv(jpr_tauwoc)%z3(:,:,1)
1350
1351      !                                                      ! ========================= ! 
1352      !                                                      ! Stress component by waves !
1353      !                                                      ! ========================= ! 
1354      IF( srcv(jpr_tauwx)%laction .AND. srcv(jpr_tauwy)%laction .AND. ln_tauw ) THEN
1355         tauw_x(:,:) = frcv(jpr_tauwx)%z3(:,:,1)
1356         tauw_y(:,:) = frcv(jpr_tauwy)%z3(:,:,1)
1357      ENDIF
1358
1359      !                                                      ! ========================= !
1360      !                                                      !   Wave drag coefficient   !
1361      !                                                      ! ========================= !
1362      IF( srcv(jpr_wdrag)%laction .AND. ln_cdgw )   cdn_wave(:,:) = frcv(jpr_wdrag)%z3(:,:,1)
1363
1364      !  Fields received by SAS when OASIS coupling
1365      !  (arrays no more filled at sbcssm stage)
1366      !                                                      ! ================== !
1367      !                                                      !        SSS         !
1368      !                                                      ! ================== !
1369      IF( srcv(jpr_soce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
1370         sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1)
1371         CALL iom_put( 'sss_m', sss_m )
1372      ENDIF
1373      !                                               
1374      !                                                      ! ================== !
1375      !                                                      !        SST         !
1376      !                                                      ! ================== !
1377      IF( srcv(jpr_toce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
1378         sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1)
1379         IF( srcv(jpr_soce)%laction .AND. l_useCT ) THEN    ! make sure that sst_m is the potential temperature
1380            sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) )
1381         ENDIF
1382      ENDIF
1383      !                                                      ! ================== !
1384      !                                                      !        SSH         !
1385      !                                                      ! ================== !
1386      IF( srcv(jpr_ssh )%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
1387         ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1)
1388         CALL iom_put( 'ssh_m', ssh_m )
1389      ENDIF
1390      !                                                      ! ================== !
1391      !                                                      !  surface currents  !
1392      !                                                      ! ================== !
1393      IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
1394         ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1)
1395         uu(:,:,1,Kbb) = ssu_m(:,:)                          ! will be used in icestp in the call of ice_forcing_tau
1396         uu(:,:,1,Kmm) = ssu_m(:,:)                          ! will be used in sbc_cpl_snd if atmosphere coupling
1397         CALL iom_put( 'ssu_m', ssu_m )
1398      ENDIF
1399      IF( srcv(jpr_ocy1)%laction ) THEN
1400         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
1401         vv(:,:,1,Kbb) = ssv_m(:,:)                          ! will be used in icestp in the call of ice_forcing_tau
1402         vv(:,:,1,Kmm) = ssv_m(:,:)                          ! will be used in sbc_cpl_snd if atmosphere coupling
1403         CALL iom_put( 'ssv_m', ssv_m )
1404      ENDIF
1405      !                                                      ! ======================== !
1406      !                                                      !  first T level thickness !
1407      !                                                      ! ======================== !
1408      IF( srcv(jpr_e3t1st )%laction ) THEN                   ! received by sas in case of opa <-> sas coupling
1409         e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1)
1410         CALL iom_put( 'e3t_m', e3t_m(:,:) )
1411      ENDIF
1412      !                                                      ! ================================ !
1413      !                                                      !  fraction of solar net radiation !
1414      !                                                      ! ================================ !
1415      IF( srcv(jpr_fraqsr)%laction ) THEN                    ! received by sas in case of opa <-> sas coupling
1416         frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1)
1417         CALL iom_put( 'frq_m', frq_m )
1418      ENDIF
1419     
1420      !                                                      ! ========================= !
1421      IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN   !  heat & freshwater fluxes ! (Ocean only case)
1422         !                                                   ! ========================= !
1423         !
1424         !                                                       ! total freshwater fluxes over the ocean (emp)
1425         IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN
1426            SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation
1427            CASE( 'conservative' )
1428               zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
1429            CASE( 'oce only', 'oce and ice' )
1430               zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
1431            CASE default
1432               CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
1433            END SELECT
1434         ELSE
1435            zemp(:,:) = 0._wp
1436         ENDIF
1437         !
1438         !                                                        ! runoffs and calving (added in emp)
1439         IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1440         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1)
1441 
1442         IF( srcv(jpr_icb)%laction )  THEN
1443             fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
1444             rnf(:,:)    = rnf(:,:) + fwficb(:,:)   ! iceberg added to runfofs
1445         ENDIF
1446         !
1447         ! ice shelf fwf
1448         IF( srcv(jpr_isf)%laction )  THEN
1449            fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting) 
1450         END IF
1451       
1452         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
1453         ELSE                   ;   emp(:,:) =                              zemp(:,:)
1454         ENDIF
1455         !
1456         !                                                       ! non solar heat flux over the ocean (qns)
1457         IF(      srcv(jpr_qnsoce)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
1458         ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
1459         ELSE                                       ;   zqns(:,:) = 0._wp
1460         ENDIF
1461         ! update qns over the free ocean with:
1462         IF( nn_components /= jp_iam_opa ) THEN
1463            zqns(:,:) =  zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp         ! remove heat content due to mass flux (assumed to be at SST)
1464            IF( srcv(jpr_snow  )%laction ) THEN
1465               zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * rLfus   ! energy for melting solid precipitation over the free ocean
1466            ENDIF
1467         ENDIF
1468         !
1469         IF( srcv(jpr_icb)%laction )  zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove heat content associated to iceberg melting
1470         !
1471         IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:)
1472         ELSE                   ;   qns(:,:) =                              zqns(:,:)
1473         ENDIF
1474
1475         !                                                       ! solar flux over the ocean          (qsr)
1476         IF     ( srcv(jpr_qsroce)%laction ) THEN   ;   zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
1477         ELSE IF( srcv(jpr_qsrmix)%laction ) then   ;   zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
1478         ELSE                                       ;   zqsr(:,:) = 0._wp
1479         ENDIF
1480         IF( ln_dm2dc .AND. ln_cpl )   zqsr(:,:) = sbc_dcy( zqsr )   ! modify qsr to include the diurnal cycle
1481         IF( ln_mixcpl ) THEN   ;   qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:)
1482         ELSE                   ;   qsr(:,:) =                              zqsr(:,:)
1483         ENDIF
1484         !
1485         ! salt flux over the ocean (received by opa in case of opa <-> sas coupling)
1486         IF( srcv(jpr_sflx )%laction )   sfx(:,:) = frcv(jpr_sflx  )%z3(:,:,1)
1487         ! Ice cover  (received by opa in case of opa <-> sas coupling)
1488         IF( srcv(jpr_fice )%laction )   fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1)
1489         !
1490      ENDIF
1491      !
1492   END SUBROUTINE sbc_cpl_rcv
1493   
1494
1495   SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )     
1496      !!----------------------------------------------------------------------
1497      !!             ***  ROUTINE sbc_cpl_ice_tau  ***
1498      !!
1499      !! ** Purpose :   provide the stress over sea-ice in coupled mode
1500      !!
1501      !! ** Method  :   transform the received stress from the atmosphere into
1502      !!             an atmosphere-ice stress in the (i,j) ocean referencial
1503      !!             and at the velocity point of the sea-ice model:
1504      !!                'C'-grid : i- (j-) components given at U- (V-) point
1505      !!
1506      !!                The received stress are :
1507      !!                 - defined by 3 components (if cartesian coordinate)
1508      !!                        or by 2 components (if spherical)
1509      !!                 - oriented along geographical   coordinate (if eastward-northward)
1510      !!                        or  along the local grid coordinate (if local grid)
1511      !!                 - given at U- and V-point, resp.   if received on 2 grids
1512      !!                        or at a same point (T or I) if received on 1 grid
1513      !!                Therefore and if necessary, they are successively
1514      !!             processed in order to obtain them
1515      !!                 first  as  2 components on the sphere
1516      !!                 second as  2 components oriented along the local grid
1517      !!                 third  as  2 components on the ice grid point
1518      !!
1519      !!                Except in 'oce and ice' case, only one vector stress field
1520      !!             is received. It has already been processed in sbc_cpl_rcv
1521      !!             so that it is now defined as (i,j) components given at U-
1522      !!             and V-points, respectively. 
1523      !!
1524      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice
1525      !!----------------------------------------------------------------------
1526      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2]
1527      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid)
1528      !!
1529      INTEGER ::   ji, jj   ! dummy loop indices
1530      INTEGER ::   itx      ! index of taux over ice
1531      REAL(wp)                     ::   zztmp1, zztmp2
1532      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty 
1533      !!----------------------------------------------------------------------
1534      !
1535      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1   
1536      ELSE                                ;   itx =  jpr_otx1
1537      ENDIF
1538
1539      ! do something only if we just received the stress from atmosphere
1540      IF(  nrcvinfo(itx) == OASIS_Rcv ) THEN
1541         !                                                      ! ======================= !
1542         IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   !
1543            !                                                   ! ======================= !
1544           
1545            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere
1546               !                                                       ! (cartesian to spherical -> 3 to 2 components)
1547               CALL geo2oce(  frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1),   &
1548                  &          srcv(jpr_itx1)%clgrid, ztx, zty )
1549               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid
1550               frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid
1551               !
1552               IF( srcv(jpr_itx2)%laction ) THEN
1553                  CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1),   &
1554                     &          srcv(jpr_itx2)%clgrid, ztx, zty )
1555                  frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid
1556                  frcv(jpr_ity2)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid
1557               ENDIF
1558               !
1559            ENDIF
1560            !
1561            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid
1562               !                                                       ! (geographical to local grid -> rotate the components)
1563               CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )   
1564               IF( srcv(jpr_itx2)%laction ) THEN
1565                  CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )   
1566               ELSE
1567                  CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty ) 
1568               ENDIF
1569               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid
1570               frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 1st grid
1571            ENDIF
1572            !                                                   ! ======================= !
1573         ELSE                                                   !     use ocean stress    !
1574            !                                                   ! ======================= !
1575            frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1)
1576            frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1)
1577            !
1578         ENDIF
1579         !                                                      ! ======================= !
1580         !                                                      !     put on ice grid     !
1581         !                                                      ! ======================= !
1582         !   
1583         !                                                  j+1   j     -----V---F
1584         ! ice stress on ice velocity point                              !       |
1585         ! (C-grid ==>(U,V))                                      j      |   T   U
1586         !                                                               |       |
1587         !                                                   j    j-1   -I-------|
1588         !                                               (for I)         |       |
1589         !                                                              i-1  i   i
1590         !                                                               i      i+1 (for I)
1591         SELECT CASE ( srcv(jpr_itx1)%clgrid )
1592         CASE( 'U' )
1593            p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! (U,V) ==> (U,V)
1594            p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
1595         CASE( 'T' )
1596            DO_2D( 0, 0, 0, 0 )                    ! T ==> (U,V)
1597               ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology
1598               zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) )
1599               zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) )
1600               p_taui(ji,jj) = zztmp1 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
1601               p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
1602            END_2D
1603#if defined key_mpi3
1604            CALL lbc_lnk_nc_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. )
1605#else
1606            CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. )
1607#endif
1608         END SELECT
1609         
1610      ENDIF
1611      !
1612   END SUBROUTINE sbc_cpl_ice_tau
1613   
1614
1615   SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi )
1616      !!----------------------------------------------------------------------
1617      !!             ***  ROUTINE sbc_cpl_ice_flx  ***
1618      !!
1619      !! ** Purpose :   provide the heat and freshwater fluxes of the ocean-ice system
1620      !!
1621      !! ** Method  :   transform the fields received from the atmosphere into
1622      !!             surface heat and fresh water boundary condition for the
1623      !!             ice-ocean system. The following fields are provided:
1624      !!               * total non solar, solar and freshwater fluxes (qns_tot,
1625      !!             qsr_tot and emp_tot) (total means weighted ice-ocean flux)
1626      !!             NB: emp_tot include runoffs and calving.
1627      !!               * fluxes over ice (qns_ice, qsr_ice, emp_ice) where
1628      !!             emp_ice = sublimation - solid precipitation as liquid
1629      !!             precipitation are re-routed directly to the ocean and
1630      !!             calving directly enter the ocean (runoffs are read but included in trasbc.F90)
1631      !!               * solid precipitation (sprecip), used to add to qns_tot
1632      !!             the heat lost associated to melting solid precipitation
1633      !!             over the ocean fraction.
1634      !!               * heat content of rain, snow and evap can also be provided,
1635      !!             otherwise heat flux associated with these mass flux are
1636      !!             guessed (qemp_oce, qemp_ice)
1637      !!
1638      !!             - the fluxes have been separated from the stress as
1639      !!               (a) they are updated at each ice time step compare to
1640      !!               an update at each coupled time step for the stress, and
1641      !!               (b) the conservative computation of the fluxes over the
1642      !!               sea-ice area requires the knowledge of the ice fraction
1643      !!               after the ice advection and before the ice thermodynamics,
1644      !!               so that the stress is updated before the ice dynamics
1645      !!               while the fluxes are updated after it.
1646      !!
1647      !! ** Details
1648      !!             qns_tot = (1-a) * qns_oce + a * qns_ice               => provided
1649      !!                     + qemp_oce + qemp_ice                         => recalculated and added up to qns
1650      !!
1651      !!             qsr_tot = (1-a) * qsr_oce + a * qsr_ice               => provided
1652      !!
1653      !!             emp_tot = emp_oce + emp_ice                           => calving is provided and added to emp_tot (and emp_oce).
1654      !!                                                                      runoff (which includes rivers+icebergs) and iceshelf
1655      !!                                                                      are provided but not included in emp here. Only runoff will
1656      !!                                                                      be included in emp in other parts of NEMO code
1657      !! ** Action  :   update at each nf_ice time step:
1658      !!                   qns_tot, qsr_tot  non-solar and solar total heat fluxes
1659      !!                   qns_ice, qsr_ice  non-solar and solar heat fluxes over the ice
1660      !!                   emp_tot           total evaporation - precipitation(liquid and solid) (-calving)
1661      !!                   emp_ice           ice sublimation - solid precipitation over the ice
1662      !!                   dqns_ice          d(non-solar heat flux)/d(Temperature) over the ice
1663      !!                   sprecip           solid precipitation over the ocean 
1664      !!----------------------------------------------------------------------
1665      REAL(wp), INTENT(in)   , DIMENSION(:,:)             ::   picefr     ! ice fraction                [0 to 1]
1666      !                                                   !!           ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling
1667      REAL(wp), INTENT(in)   , DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo
1668      REAL(wp), INTENT(in)   , DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius]
1669      REAL(wp), INTENT(inout), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin] => inout for Met-Office
1670      REAL(wp), INTENT(in)   , DIMENSION(:,:,:), OPTIONAL ::   phs        ! snow depth                  [m]
1671      REAL(wp), INTENT(in)   , DIMENSION(:,:,:), OPTIONAL ::   phi        ! ice thickness               [m]
1672      !
1673      INTEGER  ::   ji, jj, jl   ! dummy loop index
1674      REAL(wp), DIMENSION(jpi,jpj)     ::   zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw
1675      REAL(wp), DIMENSION(jpi,jpj)     ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip  , zevap_oce, zdevap_ice
1676      REAL(wp), DIMENSION(jpi,jpj)     ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice
1677      REAL(wp), DIMENSION(jpi,jpj)     ::   zevap_ice_total
1678      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu
1679      REAL(wp), DIMENSION(jpi,jpj)     ::   ztri
1680      !!----------------------------------------------------------------------
1681      !
1682      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
1683      ziceld(:,:) = 1._wp - picefr(:,:)
1684      zcptn (:,:) = rcp * sst_m(:,:)
1685      !
1686      !                                                      ! ========================= !
1687      !                                                      !    freshwater budget      !   (emp_tot)
1688      !                                                      ! ========================= !
1689      !
1690      !                                                           ! solid Precipitation                                (sprecip)
1691      !                                                           ! liquid + solid Precipitation                       (tprecip)
1692      !                                                           ! total Evaporation - total Precipitation            (emp_tot)
1693      !                                                           ! sublimation - solid precipitation (cell average)   (emp_ice)
1694      SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
1695      CASE( 'conservative' )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
1696         zsprecip(:,:) =   frcv(jpr_snow)%z3(:,:,1)                  ! May need to ensure positive here
1697         ztprecip(:,:) =   frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here
1698         zemp_tot(:,:) =   frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)
1699      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
1700         zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
1701         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:)
1702         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1)
1703         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:)
1704      CASE( 'none'      )       ! Not available as for now: needs additional coding below when computing zevap_oce
1705      !                         ! since fields received are not defined with none option
1706         CALL ctl_stop( 'STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_emp value in namelist namsbc_cpl' )
1707      END SELECT
1708
1709#if defined key_si3
1710
1711      ! --- evaporation over ice (kg/m2/s) --- !
1712      IF (ln_scale_ice_flux) THEN ! typically met-office requirements
1713         IF (sn_rcv_emp%clcat == 'yes') THEN
1714            WHERE( a_i(:,:,:) > 1.e-10 )  ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
1715            ELSEWHERE                     ; zevap_ice(:,:,:) = 0._wp
1716            END WHERE
1717            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:)
1718            ELSEWHERE                     ; zevap_ice_total(:,:) = 0._wp
1719            END WHERE
1720         ELSE
1721            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:)
1722            ELSEWHERE                     ; zevap_ice(:,:,1) = 0._wp
1723            END WHERE
1724            zevap_ice_total(:,:) = zevap_ice(:,:,1)
1725            DO jl = 2, jpl
1726               zevap_ice(:,:,jl) = zevap_ice(:,:,1)
1727            ENDDO
1728         ENDIF
1729      ELSE
1730         IF (sn_rcv_emp%clcat == 'yes') THEN
1731            zevap_ice(:,:,1:jpl) = frcv(jpr_ievp)%z3(:,:,1:jpl)
1732            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:)
1733            ELSEWHERE                     ; zevap_ice_total(:,:) = 0._wp
1734            END WHERE
1735         ELSE
1736            zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1)
1737            zevap_ice_total(:,:) = zevap_ice(:,:,1)
1738            DO jl = 2, jpl
1739               zevap_ice(:,:,jl) = zevap_ice(:,:,1)
1740            ENDDO
1741         ENDIF
1742      ENDIF
1743
1744      IF ( TRIM( sn_rcv_emp%cldes ) == 'conservative' ) THEN
1745         ! For conservative case zemp_ice has not been defined yet. Do it now.
1746         zemp_ice(:,:) = zevap_ice_total(:,:) * picefr(:,:) - frcv(jpr_snow)%z3(:,:,1) * picefr(:,:)
1747      ENDIF
1748
1749      ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing)
1750      zsnw(:,:) = 0._wp   ;   CALL ice_var_snwblow( ziceld, zsnw )
1751     
1752      ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- !
1753      zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( picefr(:,:) - zsnw(:,:) )  ! emp_ice = A * sublimation - zsnw * sprecip
1754      zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:)                                ! emp_oce = emp_tot - emp_ice
1755
1756      ! --- evaporation over ocean (used later for qemp) --- !
1757      zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) * picefr(:,:)
1758
1759      ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0
1760      ! therefore, sublimation is not redistributed over the ice categories when no subgrid scale fluxes are provided by atm.
1761      zdevap_ice(:,:) = 0._wp
1762     
1763      ! --- Continental fluxes --- !
1764      IF( srcv(jpr_rnf)%laction ) THEN   ! runoffs (included in emp later on)
1765         rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1766      ENDIF
1767      IF( srcv(jpr_cal)%laction ) THEN   ! calving (put in emp_tot and emp_oce)
1768         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
1769         zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1)
1770      ENDIF
1771      IF( srcv(jpr_icb)%laction ) THEN   ! iceberg added to runoffs
1772         fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
1773         rnf(:,:)    = rnf(:,:) + fwficb(:,:)
1774      ENDIF
1775      IF( srcv(jpr_isf)%laction ) THEN   ! iceshelf (fwfisf <0 mean melting)
1776        fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) 
1777      ENDIF
1778
1779      IF( ln_mixcpl ) THEN
1780         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
1781         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
1782         emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:)
1783         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
1784         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
1785         DO jl = 1, jpl
1786            evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:,jl) * zmsk(:,:)
1787            devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:)    * zmsk(:,:)
1788         END DO
1789      ELSE
1790         emp_tot (:,:)   = zemp_tot (:,:)
1791         emp_ice (:,:)   = zemp_ice (:,:)
1792         emp_oce (:,:)   = zemp_oce (:,:)     
1793         sprecip (:,:)   = zsprecip (:,:)
1794         tprecip (:,:)   = ztprecip (:,:)
1795         evap_ice(:,:,:) = zevap_ice(:,:,:)
1796         DO jl = 1, jpl
1797            devap_ice(:,:,jl) = zdevap_ice(:,:)
1798         END DO
1799      ENDIF
1800
1801#else
1802      zsnw(:,:) = picefr(:,:)
1803      ! --- Continental fluxes --- !
1804      IF( srcv(jpr_rnf)%laction ) THEN   ! runoffs (included in emp later on)
1805         rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1806      ENDIF
1807      IF( srcv(jpr_cal)%laction ) THEN   ! calving (put in emp_tot)
1808         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
1809      ENDIF
1810      IF( srcv(jpr_icb)%laction ) THEN   ! iceberg added to runoffs
1811         fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
1812         rnf(:,:)    = rnf(:,:) + fwficb(:,:)
1813      ENDIF
1814      IF( srcv(jpr_isf)%laction ) THEN   ! iceshelf (fwfisf <0 mean melting)
1815        fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)
1816      ENDIF
1817      !
1818      IF( ln_mixcpl ) THEN
1819         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
1820         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
1821         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
1822         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
1823      ELSE
1824         emp_tot(:,:) =                                  zemp_tot(:,:)
1825         emp_ice(:,:) =                                  zemp_ice(:,:)
1826         sprecip(:,:) =                                  zsprecip(:,:)
1827         tprecip(:,:) =                                  ztprecip(:,:)
1828      ENDIF
1829      !
1830#endif
1831
1832      ! outputs
1833!!      IF( srcv(jpr_rnf)%laction )   CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1)                                 )  ! runoff
1834!!      IF( srcv(jpr_isf)%laction )   CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1)                         )  ! iceshelf
1835      IF( srcv(jpr_cal)%laction )    CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1)                )  ! calving
1836      IF( srcv(jpr_icb)%laction )    CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1)                )  ! icebergs
1837      IF( iom_use('snowpre') )       CALL iom_put( 'snowpre'     , sprecip(:,:)                                          )  ! Snow
1838      IF( iom_use('precip') )        CALL iom_put( 'precip'      , tprecip(:,:)                                          )  ! total  precipitation
1839      IF( iom_use('rain') )          CALL iom_put( 'rain'        , tprecip(:,:) - sprecip(:,:)                           )  ! liquid precipitation
1840      IF( iom_use('snow_ao_cea') )   CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average)
1841      IF( iom_use('snow_ai_cea') )   CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average)
1842      IF( iom_use('rain_ao_cea') )   CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:)         )  ! liquid precipitation over ocean (cell average)
1843      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)
1844      IF( iom_use('evap_ao_cea') )   CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1)  &
1845         &                                                         - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)
1846      ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf
1847      !
1848      !                                                      ! ========================= !
1849      SELECT CASE( TRIM( sn_rcv_qns%cldes ) )                !   non solar heat fluxes   !   (qns)
1850      !                                                      ! ========================= !
1851      CASE( 'oce only' )         ! the required field is directly provided
1852         zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
1853         ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero
1854         ! here so the only flux is the ocean only one.
1855         zqns_ice(:,:,:) = 0._wp 
1856      CASE( 'conservative' )     ! the required fields are directly provided
1857         zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
1858         IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
1859            zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
1860         ELSE
1861            DO jl = 1, jpl
1862               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal
1863            END DO
1864         ENDIF
1865      CASE( 'oce and ice' )      ! the total flux is computed from ocean and ice fluxes
1866         zqns_tot(:,:) =  ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
1867         IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
1868            DO jl=1,jpl
1869               zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)   
1870               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
1871            ENDDO
1872         ELSE
1873            zqns_tot(:,:) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
1874            DO jl = 1, jpl
1875               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
1876            END DO
1877         ENDIF
1878      CASE( 'mixed oce-ice' )    ! the ice flux is cumputed from the total flux, the SST and ice informations
1879! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
1880         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
1881         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
1882            DO jl = 1, jpl
1883               zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:,jl)    &
1884                  &             + frcv(jpr_dqnsdt)%z3(:,:,jl) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:)   &
1885                  &                                             + pist(:,:,jl) * picefr(:,:) ) )
1886            END DO
1887         ELSE
1888            DO jl = 1, jpl
1889               zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:, 1)    &
1890                  &             + frcv(jpr_dqnsdt)%z3(:,:, 1) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:)   &
1891                  &                                             + pist(:,:,jl) * picefr(:,:) ) )
1892            END DO
1893         ENDIF
1894      END SELECT
1895      !                                     
1896      ! --- calving (removed from qns_tot) --- !
1897      IF( srcv(jpr_cal)%laction )   zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * rLfus  ! remove latent heat of calving
1898                                                                                                     ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean
1899      ! --- iceberg (removed from qns_tot) --- !
1900      IF( srcv(jpr_icb)%laction )   zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus  ! remove latent heat of iceberg melting
1901
1902#if defined key_si3     
1903      ! --- non solar flux over ocean --- !
1904      !         note: ziceld cannot be = 0 since we limit the ice concentration to amax
1905      zqns_oce = 0._wp
1906      WHERE( ziceld /= 0._wp )   zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / ziceld(:,:)
1907
1908      ! Heat content per unit mass of snow (J/kg)
1909      WHERE( SUM( a_i, dim=3 ) > 1.e-10 )   ;   zcptsnw(:,:) = rcpi * SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 )
1910      ELSEWHERE                             ;   zcptsnw(:,:) = zcptn(:,:)
1911      ENDWHERE
1912      ! Heat content per unit mass of rain (J/kg)
1913      zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) ) 
1914
1915      ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- !
1916      zqprec_ice(:,:) = rhos * ( zcptsnw(:,:) - rLfus )
1917
1918      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- !
1919      DO jl = 1, jpl
1920         zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * rcpi ) but atm. does not take it into account
1921      END DO
1922
1923      ! --- heat flux associated with emp (W/m2) --- !
1924      zqemp_oce(:,:) = -  zevap_oce(:,:)                                      *   zcptn   (:,:)   &        ! evap
1925         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptrain(:,:)   &        ! liquid precip
1926         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - rLfus )  ! solid precip over ocean + snow melting
1927      zqemp_ice(:,:) =     zsprecip(:,:)                   * zsnw             * ( zcptsnw (:,:) - rLfus )  ! solid precip over ice (qevap_ice=0 since atm. does not take it into account)
1928!!    zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * picefr(:,:)      *   zcptsnw (:,:)   &        ! ice evap
1929!!       &             +   zsprecip(:,:)                   * zsnw             * zqprec_ice(:,:) * r1_rhos  ! solid precip over ice
1930     
1931      ! --- total non solar flux (including evap/precip) --- !
1932      zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:)
1933
1934      ! --- in case both coupled/forced are active, we must mix values --- !
1935      IF( ln_mixcpl ) THEN
1936         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
1937         qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:)
1938         DO jl=1,jpl
1939            qns_ice  (:,:,jl) = qns_ice  (:,:,jl) * xcplmask(:,:,0) +  zqns_ice  (:,:,jl)* zmsk(:,:)
1940            qevap_ice(:,:,jl) = qevap_ice(:,:,jl) * xcplmask(:,:,0) +  zqevap_ice(:,:,jl)* zmsk(:,:)
1941         ENDDO
1942         qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:)
1943         qemp_oce (:,:) =  qemp_oce(:,:) * xcplmask(:,:,0) +  zqemp_oce(:,:)* zmsk(:,:)
1944         qemp_ice (:,:) =  qemp_ice(:,:) * xcplmask(:,:,0) +  zqemp_ice(:,:)* zmsk(:,:)
1945      ELSE
1946         qns_tot  (:,:  ) = zqns_tot  (:,:  )
1947         qns_oce  (:,:  ) = zqns_oce  (:,:  )
1948         qns_ice  (:,:,:) = zqns_ice  (:,:,:)
1949         qevap_ice(:,:,:) = zqevap_ice(:,:,:)
1950         qprec_ice(:,:  ) = zqprec_ice(:,:  )
1951         qemp_oce (:,:  ) = zqemp_oce (:,:  )
1952         qemp_ice (:,:  ) = zqemp_ice (:,:  )
1953      ENDIF
1954
1955#else
1956      zcptsnw (:,:) = zcptn(:,:)
1957      zcptrain(:,:) = zcptn(:,:)
1958     
1959      ! clem: this formulation is certainly wrong... but better than it was...
1960      zqns_tot(:,:) = zqns_tot(:,:)                             &          ! zqns_tot update over free ocean with:
1961         &          - (  ziceld(:,:) * zsprecip(:,:) * rLfus )  &          ! remove the latent heat flux of solid precip. melting
1962         &          - (  zemp_tot(:,:)                          &          ! remove the heat content of mass flux (assumed to be at SST)
1963         &             - zemp_ice(:,:) ) * zcptn(:,:) 
1964
1965     IF( ln_mixcpl ) THEN
1966         qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
1967         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) +  zqns_tot(:,:)* zmsk(:,:)
1968         DO jl=1,jpl
1969            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:)
1970         ENDDO
1971      ELSE
1972         qns_tot(:,:  ) = zqns_tot(:,:  )
1973         qns_ice(:,:,:) = zqns_ice(:,:,:)
1974      ENDIF
1975
1976#endif
1977      ! outputs
1978      IF( srcv(jpr_cal)%laction       ) CALL iom_put('hflx_cal_cea'    , - frcv(jpr_cal)%z3(:,:,1) * rLfus )                      ! latent heat from calving
1979      IF( srcv(jpr_icb)%laction       ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )                      ! latent heat from icebergs melting
1980      IF( iom_use('hflx_rain_cea')    ) CALL iom_put('hflx_rain_cea'   , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average)
1981      IF( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) &
1982           &                                                              * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) )            ! heat flux from evap (cell average)
1983      IF( iom_use('hflx_prec_cea')    ) CALL iom_put('hflx_prec_cea'   ,  sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) +  &                    ! heat flux from all precip (cell avg)
1984         &                                                               ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )
1985      IF( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  )               ! heat flux from snow (cell average)
1986      IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &
1987           &                                                              * ( 1._wp - zsnw(:,:) )                  )               ! heat flux from snow (over ocean)
1988      IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
1989           &                                                              *           zsnw(:,:)                    )               ! heat flux from snow (over ice)
1990      ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp.
1991      !
1992      !                                                      ! ========================= !
1993      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )                !      solar heat fluxes    !   (qsr)
1994      !                                                      ! ========================= !
1995      CASE( 'oce only' )
1996         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
1997         ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero
1998         ! here so the only flux is the ocean only one.
1999         zqsr_ice(:,:,:) = 0._wp
2000      CASE( 'conservative' )
2001         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
2002         IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
2003            zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
2004         ELSE
2005            ! Set all category values equal for the moment
2006            DO jl = 1, jpl
2007               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
2008            END DO
2009         ENDIF
2010      CASE( 'oce and ice' )
2011         zqsr_tot(:,:  ) =  ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
2012         IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
2013            DO jl = 1, jpl
2014               zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)   
2015               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
2016            END DO
2017         ELSE
2018            zqsr_tot(:,:) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
2019            DO jl = 1, jpl
2020               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
2021            END DO
2022         ENDIF
2023      CASE( 'mixed oce-ice' )
2024         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
2025! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
2026!       Create solar heat flux over ice using incoming solar heat flux and albedos
2027!       ( see OASIS3 user guide, 5th edition, p39 )
2028         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
2029            DO jl = 1, jpl
2030               zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:,jl) * ( 1.- palbi(:,:,jl) )   &
2031                  &            / (  1.- ( alb_oce_mix(:,:   ) * ziceld(:,:)       &
2032                  &                     + palbi      (:,:,jl) * picefr(:,:) ) )
2033            END DO
2034         ELSE
2035            DO jl = 1, jpl
2036               zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:, 1) * ( 1.- palbi(:,:,jl) )   &
2037                  &            / (  1.- ( alb_oce_mix(:,:   ) * ziceld(:,:)       &
2038                  &                     + palbi      (:,:,jl) * picefr(:,:) ) )
2039            END DO
2040         ENDIF
2041      CASE( 'none'      )       ! Not available as for now: needs additional coding 
2042      !                         ! since fields received, here zqsr_tot,  are not defined with none option
2043         CALL ctl_stop( 'STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_qsr value in namelist namsbc_cpl' )
2044      END SELECT
2045      IF( ln_dm2dc .AND. ln_cpl ) THEN   ! modify qsr to include the diurnal cycle
2046         zqsr_tot(:,:  ) = sbc_dcy( zqsr_tot(:,:  ) )
2047         DO jl = 1, jpl
2048            zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) )
2049         END DO
2050      ENDIF
2051
2052#if defined key_si3
2053      ! --- solar flux over ocean --- !
2054      !         note: ziceld cannot be = 0 since we limit the ice concentration to amax
2055      zqsr_oce = 0._wp
2056      WHERE( ziceld /= 0._wp )  zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:)
2057
2058      IF( ln_mixcpl ) THEN   ;   qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) +  zqsr_oce(:,:)* zmsk(:,:)
2059      ELSE                   ;   qsr_oce(:,:) = zqsr_oce(:,:)   ;   ENDIF
2060#endif
2061
2062      IF( ln_mixcpl ) THEN
2063         qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
2064         qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) +  zqsr_tot(:,:)* zmsk(:,:)
2065         DO jl = 1, jpl
2066            qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) +  zqsr_ice(:,:,jl)* zmsk(:,:)
2067         END DO
2068      ELSE
2069         qsr_tot(:,:  ) = zqsr_tot(:,:  )
2070         qsr_ice(:,:,:) = zqsr_ice(:,:,:)
2071      ENDIF
2072
2073      !                                                      ! ========================= !
2074      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) )             !          d(qns)/dt        !
2075      !                                                      ! ========================= !
2076      CASE ('coupled')
2077         IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
2078            zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
2079         ELSE
2080            ! Set all category values equal for the moment
2081            DO jl=1,jpl
2082               zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
2083            ENDDO
2084         ENDIF
2085      CASE( 'none' ) 
2086         zdqns_ice(:,:,:) = 0._wp
2087      END SELECT
2088     
2089      IF( ln_mixcpl ) THEN
2090         DO jl=1,jpl
2091            dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)
2092         ENDDO
2093      ELSE
2094         dqns_ice(:,:,:) = zdqns_ice(:,:,:)
2095      ENDIF
2096
2097#if defined key_si3     
2098      !                                                      ! ========================= !
2099      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !  ice topmelt and botmelt  !
2100      !                                                      ! ========================= !
2101      CASE ('coupled')
2102         IF (ln_scale_ice_flux) THEN
2103            WHERE( a_i(:,:,:) > 1.e-10_wp )
2104               qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
2105               qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
2106            ELSEWHERE
2107               qml_ice(:,:,:) = 0.0_wp
2108               qcn_ice(:,:,:) = 0.0_wp
2109            END WHERE
2110         ELSE
2111            qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:)
2112            qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:)
2113         ENDIF
2114      END SELECT
2115      !                                                      ! ========================= !
2116      !                                                      !      Transmitted Qsr      !   [W/m2]
2117      !                                                      ! ========================= !
2118      IF( .NOT.ln_cndflx ) THEN                              !==  No conduction flux as surface forcing  ==!
2119         !
2120         IF( nn_qtrice == 0 ) THEN
2121            ! formulation derived from Grenfell and Maykut (1977), where transmission rate
2122            !    1) depends on cloudiness
2123            !       ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81)
2124            !       !      should be real cloud fraction instead (as in the bulk) but needs to be read from atm.
2125            !    2) is 0 when there is any snow
2126            !    3) tends to 1 for thin ice
2127            ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm
2128            DO jl = 1, jpl
2129               WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )       ! linear decrease from hi=0 to 10cm 
2130                  zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) )
2131               ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )       ! constant (ztri) when hi>10cm
2132                  zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ztri(:,:)
2133               ELSEWHERE                                                           ! zero when hs>0
2134                  zqtr_ice_top(:,:,jl) = 0._wp 
2135               END WHERE
2136            ENDDO
2137         ELSEIF( nn_qtrice == 1 ) THEN
2138            ! formulation is derived from the thesis of M. Lebrun (2019).
2139            !    It represents the best fit using several sets of observations
2140            !    It comes with snow conductivities adapted to freezing/melting conditions (see icethd_zdf_bl99.F90)
2141            zqtr_ice_top(:,:,:) = 0.3_wp * zqsr_ice(:,:,:)
2142         ENDIF
2143         !     
2144      ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN      !==  conduction flux as surface forcing  ==!
2145         !
2146         !          ! ===> here we must receive the qtr_ice_top array from the coupler
2147         !                 for now just assume zero (fully opaque ice)
2148         zqtr_ice_top(:,:,:) = 0._wp
2149         !
2150      ENDIF
2151      !
2152      IF( ln_mixcpl ) THEN
2153         DO jl=1,jpl
2154            qtr_ice_top(:,:,jl) = qtr_ice_top(:,:,jl) * xcplmask(:,:,0) + zqtr_ice_top(:,:,jl) * zmsk(:,:)
2155         ENDDO
2156      ELSE
2157         qtr_ice_top(:,:,:) = zqtr_ice_top(:,:,:)
2158      ENDIF
2159      !                                                      ! ================== !
2160      !                                                      !   ice skin temp.   !
2161      !                                                      ! ================== !
2162      ! needed by Met Office
2163      IF( srcv(jpr_ts_ice)%laction ) THEN
2164         WHERE    ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0  )   ;   ztsu(:,:,:) =   0. + rt0 
2165         ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. )   ;   ztsu(:,:,:) = -60. + rt0
2166         ELSEWHERE                                        ;   ztsu(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:) + rt0
2167         END WHERE
2168         !
2169         IF( ln_mixcpl ) THEN
2170            DO jl=1,jpl
2171               pist(:,:,jl) = pist(:,:,jl) * xcplmask(:,:,0) + ztsu(:,:,jl) * zmsk(:,:)
2172            ENDDO
2173         ELSE
2174            pist(:,:,:) = ztsu(:,:,:)
2175         ENDIF
2176         !
2177      ENDIF
2178      !
2179#endif
2180      !
2181   END SUBROUTINE sbc_cpl_ice_flx
2182   
2183   
2184   SUBROUTINE sbc_cpl_snd( kt, Kbb, Kmm )
2185      !!----------------------------------------------------------------------
2186      !!             ***  ROUTINE sbc_cpl_snd  ***
2187      !!
2188      !! ** Purpose :   provide the ocean-ice informations to the atmosphere
2189      !!
2190      !! ** Method  :   send to the atmosphere through a call to cpl_snd
2191      !!              all the needed fields (as defined in sbc_cpl_init)
2192      !!----------------------------------------------------------------------
2193      INTEGER, INTENT(in) ::   kt
2194      INTEGER, INTENT(in) ::   Kbb, Kmm    ! ocean model time level index
2195      !
2196      INTEGER ::   ji, jj, jl   ! dummy loop indices
2197      INTEGER ::   isec, info   ! local integer
2198      REAL(wp) ::   zumax, zvmax
2199      REAL(wp), DIMENSION(jpi,jpj)     ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
2200      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   ztmp3, ztmp4   
2201      !!----------------------------------------------------------------------
2202      !
2203      isec = ( kt - nit000 ) * NINT( rn_Dt )        ! date of exchanges
2204      info = OASIS_idle
2205
2206      zfr_l(:,:) = 1.- fr_i(:,:)
2207      !                                                      ! ------------------------- !
2208      !                                                      !    Surface temperature    !   in Kelvin
2209      !                                                      ! ------------------------- !
2210      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
2211         
2212         IF( nn_components == jp_iam_opa ) THEN
2213            ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm)   ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part
2214         ELSE
2215            ! we must send the surface potential temperature
2216            IF( l_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) )
2217            ELSE                   ;   ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm)
2218            ENDIF
2219            !
2220            SELECT CASE( sn_snd_temp%cldes)
2221            CASE( 'oce only'             )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0
2222            CASE( 'oce and ice'          )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0
2223               SELECT CASE( sn_snd_temp%clcat )
2224               CASE( 'yes' )   
2225                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl)
2226               CASE( 'no' )
2227                  WHERE( SUM( a_i, dim=3 ) /= 0. )
2228                     ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 )
2229                  ELSEWHERE
2230                     ztmp3(:,:,1) = rt0
2231                  END WHERE
2232               CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
2233               END SELECT
2234            CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)   
2235               SELECT CASE( sn_snd_temp%clcat )
2236               CASE( 'yes' )   
2237                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2238               CASE( 'no' )
2239                  ztmp3(:,:,:) = 0.0
2240                  DO jl=1,jpl
2241                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
2242                  ENDDO
2243               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
2244               END SELECT
2245            CASE( 'oce and weighted ice')    ;   ztmp1(:,:) =   ts(:,:,1,jp_tem,Kmm) + rt0 
2246               SELECT CASE( sn_snd_temp%clcat ) 
2247               CASE( 'yes' )   
2248                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
2249               CASE( 'no' ) 
2250                  ztmp3(:,:,:) = 0.0 
2251                  DO jl=1,jpl 
2252                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
2253                  ENDDO 
2254               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
2255               END SELECT
2256            CASE( 'mixed oce-ice'        )   
2257               ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 
2258               DO jl=1,jpl
2259                  ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
2260               ENDDO
2261            CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
2262            END SELECT
2263         ENDIF
2264         IF( ssnd(jps_toce)%laction )   CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2265         IF( ssnd(jps_tice)%laction )   CALL cpl_snd( jps_tice, isec, ztmp3, info )
2266         IF( ssnd(jps_tmix)%laction )   CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2267      ENDIF
2268      !
2269      !                                                      ! ------------------------- !
2270      !                                                      ! 1st layer ice/snow temp.  !
2271      !                                                      ! ------------------------- !
2272#if defined key_si3
2273      ! needed by  Met Office
2274      IF( ssnd(jps_ttilyr)%laction) THEN
2275         SELECT CASE( sn_snd_ttilyr%cldes)
2276         CASE ('weighted ice')
2277            ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
2278         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ttilyr%cldes' )
2279         END SELECT
2280         IF( ssnd(jps_ttilyr)%laction )   CALL cpl_snd( jps_ttilyr, isec, ztmp3, info )
2281      ENDIF
2282#endif
2283      !                                                      ! ------------------------- !
2284      !                                                      !           Albedo          !
2285      !                                                      ! ------------------------- !
2286      IF( ssnd(jps_albice)%laction ) THEN                         ! ice
2287          SELECT CASE( sn_snd_alb%cldes )
2288          CASE( 'ice' )
2289             SELECT CASE( sn_snd_alb%clcat )
2290             CASE( 'yes' )   
2291                ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
2292             CASE( 'no' )
2293                WHERE( SUM( a_i, dim=3 ) /= 0. )
2294                   ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 )
2295                ELSEWHERE
2296                   ztmp1(:,:) = alb_oce_mix(:,:)
2297                END WHERE
2298             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' )
2299             END SELECT
2300          CASE( 'weighted ice' )   ;
2301             SELECT CASE( sn_snd_alb%clcat )
2302             CASE( 'yes' )   
2303                ztmp3(:,:,1:jpl) =  alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2304             CASE( 'no' )
2305                WHERE( fr_i (:,:) > 0. )
2306                   ztmp1(:,:) = SUM (  alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 )
2307                ELSEWHERE
2308                   ztmp1(:,:) = 0.
2309                END WHERE
2310             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' )
2311             END SELECT
2312          CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' )
2313         END SELECT
2314
2315         SELECT CASE( sn_snd_alb%clcat )
2316            CASE( 'yes' )   
2317               CALL cpl_snd( jps_albice, isec, ztmp3, info )      !-> MV this has never been checked in coupled mode
2318            CASE( 'no'  )   
2319               CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
2320         END SELECT
2321      ENDIF
2322
2323      IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean
2324         ztmp1(:,:) = alb_oce_mix(:,:) * zfr_l(:,:)
2325         DO jl = 1, jpl
2326            ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl)
2327         END DO
2328         CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2329      ENDIF
2330      !                                                      ! ------------------------- !
2331      !                                                      !  Ice fraction & Thickness !
2332      !                                                      ! ------------------------- !
2333      ! Send ice fraction field to atmosphere
2334      IF( ssnd(jps_fice)%laction ) THEN
2335         SELECT CASE( sn_snd_thick%clcat )
2336         CASE( 'yes' )   ;   ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl)
2337         CASE( 'no'  )   ;   ztmp3(:,:,1    ) = fr_i(:,:      )
2338         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2339         END SELECT
2340         CALL cpl_snd( jps_fice, isec, ztmp3, info )
2341      ENDIF
2342
2343#if defined key_si3 || defined key_cice
2344      ! If this coupling was successful then save ice fraction for use between coupling points.
2345      ! This is needed for some calculations where the ice fraction at the last coupling point
2346      ! is needed.
2347      IF(  info == OASIS_Sent    .OR. info == OASIS_ToRest .OR. & 
2348         & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN
2349         IF ( sn_snd_thick%clcat == 'yes' ) THEN
2350           a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl)
2351         ENDIF
2352      ENDIF
2353#endif
2354
2355      IF( ssnd(jps_fice1)%laction ) THEN
2356         SELECT CASE( sn_snd_thick1%clcat )
2357         CASE( 'yes' )   ;   ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl)
2358         CASE( 'no'  )   ;   ztmp3(:,:,1    ) = fr_i(:,:      )
2359         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' )
2360         END SELECT
2361         CALL cpl_snd( jps_fice1, isec, ztmp3, info )
2362      ENDIF
2363     
2364      ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling)
2365      IF( ssnd(jps_fice2)%laction ) THEN
2366         ztmp3(:,:,1) = fr_i(:,:)
2367         IF( ssnd(jps_fice2)%laction )   CALL cpl_snd( jps_fice2, isec, ztmp3, info )
2368      ENDIF
2369
2370      ! Send ice and snow thickness field
2371      IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN
2372         SELECT CASE( sn_snd_thick%cldes)
2373         CASE( 'none'                  )       ! nothing to do
2374         CASE( 'weighted ice and snow' )   
2375            SELECT CASE( sn_snd_thick%clcat )
2376            CASE( 'yes' )   
2377               ztmp3(:,:,1:jpl) =  h_i(:,:,1:jpl) * a_i(:,:,1:jpl)
2378               ztmp4(:,:,1:jpl) =  h_s(:,:,1:jpl) * a_i(:,:,1:jpl)
2379            CASE( 'no' )
2380               ztmp3(:,:,:) = 0.0   ;  ztmp4(:,:,:) = 0.0
2381               DO jl=1,jpl
2382                  ztmp3(:,:,1) = ztmp3(:,:,1) + h_i(:,:,jl) * a_i(:,:,jl)
2383                  ztmp4(:,:,1) = ztmp4(:,:,1) + h_s(:,:,jl) * a_i(:,:,jl)
2384               ENDDO
2385            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2386            END SELECT
2387         CASE( 'ice and snow'         )   
2388            SELECT CASE( sn_snd_thick%clcat )
2389            CASE( 'yes' )
2390               ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl)
2391               ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl)
2392            CASE( 'no' )
2393               WHERE( SUM( a_i, dim=3 ) /= 0. )
2394                  ztmp3(:,:,1) = SUM( h_i * a_i, dim=3 ) / SUM( a_i, dim=3 )
2395                  ztmp4(:,:,1) = SUM( h_s * a_i, dim=3 ) / SUM( a_i, dim=3 )
2396               ELSEWHERE
2397                 ztmp3(:,:,1) = 0.
2398                 ztmp4(:,:,1) = 0.
2399               END WHERE
2400            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2401            END SELECT
2402         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' )
2403         END SELECT
2404         IF( ssnd(jps_hice)%laction )   CALL cpl_snd( jps_hice, isec, ztmp3, info )
2405         IF( ssnd(jps_hsnw)%laction )   CALL cpl_snd( jps_hsnw, isec, ztmp4, info )
2406      ENDIF
2407
2408#if defined key_si3
2409      !                                                      ! ------------------------- !
2410      !                                                      !      Ice melt ponds       !
2411      !                                                      ! ------------------------- !
2412      ! needed by Met Office: 1) fraction of ponded ice 2) local/actual pond depth
2413      IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN
2414         SELECT CASE( sn_snd_mpnd%cldes) 
2415         CASE( 'ice only' ) 
2416            SELECT CASE( sn_snd_mpnd%clcat ) 
2417            CASE( 'yes' ) 
2418               ztmp3(:,:,1:jpl) =  a_ip_eff(:,:,1:jpl)
2419               ztmp4(:,:,1:jpl) =  h_ip(:,:,1:jpl) 
2420            CASE( 'no' ) 
2421               ztmp3(:,:,:) = 0.0 
2422               ztmp4(:,:,:) = 0.0 
2423               DO jl=1,jpl 
2424                 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl)
2425                 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl)
2426               ENDDO 
2427            CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' ) 
2428            END SELECT 
2429         CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%cldes' )     
2430         END SELECT 
2431         IF( ssnd(jps_a_p)%laction  )   CALL cpl_snd( jps_a_p , isec, ztmp3, info )     
2432         IF( ssnd(jps_ht_p)%laction )   CALL cpl_snd( jps_ht_p, isec, ztmp4, info )     
2433      ENDIF 
2434      !
2435      !                                                      ! ------------------------- !
2436      !                                                      !     Ice conductivity      !
2437      !                                                      ! ------------------------- !
2438      ! needed by Met Office
2439      IF( ssnd(jps_kice)%laction ) THEN
2440         SELECT CASE( sn_snd_cond%cldes) 
2441         CASE( 'weighted ice' )   
2442            SELECT CASE( sn_snd_cond%clcat ) 
2443            CASE( 'yes' )   
2444          ztmp3(:,:,1:jpl) =  cnd_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
2445            CASE( 'no' ) 
2446               ztmp3(:,:,:) = 0.0 
2447               DO jl=1,jpl 
2448                 ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(:,:,jl) 
2449               ENDDO 
2450            CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' ) 
2451            END SELECT
2452         CASE( 'ice only' )   
2453           ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) 
2454         CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%cldes' )     
2455         END SELECT
2456         IF( ssnd(jps_kice)%laction )   CALL cpl_snd( jps_kice, isec, ztmp3, info ) 
2457      ENDIF 
2458#endif
2459
2460      !                                                      ! ------------------------- !
2461      !                                                      !  CO2 flux from PISCES     !
2462      !                                                      ! ------------------------- !
2463      IF( ssnd(jps_co2)%laction .AND. l_co2cpl )   THEN
2464         ztmp1(:,:) = oce_co2(:,:) * 1000.  ! conversion in molC/m2/s
2465         CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ) , info )
2466      ENDIF
2467      !
2468      !                                                      ! ------------------------- !
2469      IF( ssnd(jps_ocx1)%laction ) THEN                      !      Surface current      !
2470         !                                                   ! ------------------------- !
2471         !   
2472         !                                                  j+1   j     -----V---F
2473         ! surface velocity always sent from T point                     !       |
2474         !                                                        j      |   T   U
2475         !                                                               |       |
2476         !                                                   j    j-1   -I-------|
2477         !                                               (for I)         |       |
2478         !                                                              i-1  i   i
2479         !                                                               i      i+1 (for I)
2480         IF( nn_components == jp_iam_opa ) THEN
2481            zotx1(:,:) = uu(:,:,1,Kmm) 
2482            zoty1(:,:) = vv(:,:,1,Kmm) 
2483         ELSE       
2484            SELECT CASE( TRIM( sn_snd_crt%cldes ) )
2485            CASE( 'oce only'             )      ! C-grid ==> T
2486               DO_2D( 0, 0, 0, 0 )
2487                  zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj  ,1,Kmm) )
2488                  zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji  ,jj-1,1,Kmm) ) 
2489               END_2D
2490            CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T 
2491               DO_2D( 0, 0, 0, 0 )
2492                  zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj) 
2493                  zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)
2494                  zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  )     + u_ice(ji-1,jj    )     ) *  fr_i(ji,jj)
2495                  zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  )     + v_ice(ji  ,jj-1  )     ) *  fr_i(ji,jj)
2496               END_2D
2497#if defined key_mpi3
2498               CALL lbc_lnk_nc_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp )
2499#else
2500               CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp )
2501#endif
2502            CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T
2503               DO_2D( 0, 0, 0, 0 )
2504                  zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   &
2505                     &         + 0.5 * ( u_ice(ji,jj  )     + u_ice(ji-1,jj    )     ) *  fr_i(ji,jj)
2506                  zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)   &
2507                     &         + 0.5 * ( v_ice(ji,jj  )     + v_ice(ji  ,jj-1  )     ) *  fr_i(ji,jj)
2508               END_2D
2509            END SELECT
2510#if defined key_mpi3
2511            CALL lbc_lnk_nc_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp,  zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp )
2512#else
2513            CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp,  zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp )
2514#endif
2515            !
2516         ENDIF
2517         !
2518         !
2519         IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components
2520            !                                                                     ! Ocean component
2521            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component
2522            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component
2523            zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components
2524            zoty1(:,:) = ztmp2(:,:)
2525            IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component
2526               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component
2527               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component
2528               zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components
2529               zity1(:,:) = ztmp2(:,:)
2530            ENDIF
2531         ENDIF
2532         !
2533         ! spherical coordinates to cartesian -> 2 components to 3 components
2534         IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN
2535            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents
2536            ztmp2(:,:) = zoty1(:,:)
2537            CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
2538            !
2539            IF( ssnd(jps_ivx1)%laction ) THEN           ! ice velocities
2540               ztmp1(:,:) = zitx1(:,:)
2541               ztmp1(:,:) = zity1(:,:)
2542               CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
2543            ENDIF
2544         ENDIF
2545         !
2546         IF( ssnd(jps_ocx1)%laction )   CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid
2547         IF( ssnd(jps_ocy1)%laction )   CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid
2548         IF( ssnd(jps_ocz1)%laction )   CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid
2549         !
2550         IF( ssnd(jps_ivx1)%laction )   CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid
2551         IF( ssnd(jps_ivy1)%laction )   CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid
2552         IF( ssnd(jps_ivz1)%laction )   CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid
2553         !
2554      ENDIF
2555      !
2556      !                                                      ! ------------------------- !
2557      !                                                      !  Surface current to waves !
2558      !                                                      ! ------------------------- !
2559      IF( ssnd(jps_ocxw)%laction .OR. ssnd(jps_ocyw)%laction ) THEN 
2560          !     
2561          !                                                  j+1  j     -----V---F
2562          ! surface velocity always sent from T point                    !       |
2563          !                                                       j      |   T   U
2564          !                                                              |       |
2565          !                                                   j   j-1   -I-------|
2566          !                                               (for I)        |       |
2567          !                                                             i-1  i   i
2568          !                                                              i      i+1 (for I)
2569          SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 
2570          CASE( 'oce only'             )      ! C-grid ==> T
2571             DO_2D( 0, 0, 0, 0 )
2572                zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj  ,1,Kmm) ) 
2573                zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) ) 
2574             END_2D
2575          CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T   
2576             DO_2D( 0, 0, 0, 0 )
2577                zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   
2578                zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 
2579                zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
2580                zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
2581             END_2D
2582#if defined key_mpi3
2583             CALL lbc_lnk_nc_multi( 'sbccpl', zitx1, 'T', -1.0_wp,  zity1, 'T', -1.0_wp ) 
2584#else
2585             CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp,  zity1, 'T', -1.0_wp ) 
2586#endif
2587          CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T 
2588             DO_2D( 0, 0, 0, 0 )
2589                zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   & 
2590                   &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
2591                zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)   & 
2592                   &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
2593             END_2D
2594          END SELECT
2595#if defined key_mpi3
2596         CALL lbc_lnk_nc_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp ) 
2597#else
2598         CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp ) 
2599#endif
2600         !
2601         !
2602         IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components
2603         !                                                                        ! Ocean component
2604            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->e', ztmp1 )       ! 1st component 
2605            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->n', ztmp2 )       ! 2nd component 
2606            zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components 
2607            zoty1(:,:) = ztmp2(:,:) 
2608            IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component
2609               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component 
2610               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component 
2611               zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components 
2612               zity1(:,:) = ztmp2(:,:) 
2613            ENDIF
2614         ENDIF 
2615         !
2616!         ! spherical coordinates to cartesian -> 2 components to 3 components
2617!         IF( TRIM( sn_snd_crtw%clvref ) == 'cartesian' ) THEN
2618!            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents
2619!            ztmp2(:,:) = zoty1(:,:)
2620!            CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
2621!            !
2622!            IF( ssnd(jps_ivx1)%laction ) THEN           ! ice velocities
2623!               ztmp1(:,:) = zitx1(:,:)
2624!               ztmp1(:,:) = zity1(:,:)
2625!               CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
2626!            ENDIF
2627!         ENDIF
2628         !
2629         IF( ssnd(jps_ocxw)%laction )   CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid
2630         IF( ssnd(jps_ocyw)%laction )   CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid
2631         
2632      ENDIF 
2633      !
2634      IF( ssnd(jps_ficet)%laction ) THEN
2635         CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info ) 
2636      ENDIF 
2637      !                                                      ! ------------------------- !
2638      !                                                      !   Water levels to waves   !
2639      !                                                      ! ------------------------- !
2640      IF( ssnd(jps_wlev)%laction ) THEN
2641         IF( ln_apr_dyn ) THEN 
2642            IF( kt /= nit000 ) THEN 
2643               ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
2644            ELSE 
2645               ztmp1(:,:) = ssh(:,:,Kbb) 
2646            ENDIF 
2647         ELSE 
2648            ztmp1(:,:) = ssh(:,:,Kmm) 
2649         ENDIF 
2650         CALL cpl_snd( jps_wlev  , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
2651      ENDIF 
2652      !
2653      !  Fields sent by OPA to SAS when doing OPA<->SAS coupling
2654      !                                                        ! SSH
2655      IF( ssnd(jps_ssh )%laction )  THEN
2656         !                          ! removed inverse barometer ssh when Patm
2657         !                          forcing is used (for sea-ice dynamics)
2658         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
2659         ELSE                    ;   ztmp1(:,:) = ssh(:,:,Kmm)
2660         ENDIF
2661         CALL cpl_snd( jps_ssh   , isec, RESHAPE ( ztmp1            , (/jpi,jpj,1/) ), info )
2662
2663      ENDIF
2664      !                                                        ! SSS
2665      IF( ssnd(jps_soce  )%laction )  THEN
2666         CALL cpl_snd( jps_soce  , isec, RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) ), info )
2667      ENDIF
2668      !                                                        ! first T level thickness
2669      IF( ssnd(jps_e3t1st )%laction )  THEN
2670         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(:,:,1,Kmm)   , (/jpi,jpj,1/) ), info )
2671      ENDIF
2672      !                                                        ! Qsr fraction
2673      IF( ssnd(jps_fraqsr)%laction )  THEN
2674         CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info )
2675      ENDIF
2676      !
2677      !  Fields sent by SAS to OPA when OASIS coupling
2678      !                                                        ! Solar heat flux
2679      IF( ssnd(jps_qsroce)%laction )  CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info )
2680      IF( ssnd(jps_qnsoce)%laction )  CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info )
2681      IF( ssnd(jps_oemp  )%laction )  CALL cpl_snd( jps_oemp  , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info )
2682      IF( ssnd(jps_sflx  )%laction )  CALL cpl_snd( jps_sflx  , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info )
2683      IF( ssnd(jps_otx1  )%laction )  CALL cpl_snd( jps_otx1  , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info )
2684      IF( ssnd(jps_oty1  )%laction )  CALL cpl_snd( jps_oty1  , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info )
2685      IF( ssnd(jps_rnf   )%laction )  CALL cpl_snd( jps_rnf   , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info )
2686      IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info )
2687
2688#if defined key_si3
2689      !                                                      ! ------------------------- !
2690      !                                                      ! Sea surface freezing temp !
2691      !                                                      ! ------------------------- !
2692      ! needed by Met Office
2693      CALL eos_fzp(ts(:,:,1,jp_sal,Kmm), sstfrz)
2694      ztmp1(:,:) = sstfrz(:,:) + rt0
2695      IF( ssnd(jps_sstfrz)%laction )  CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info)
2696#endif
2697      !
2698   END SUBROUTINE sbc_cpl_snd
2699   
2700   !!======================================================================
2701END MODULE sbccpl
Note: See TracBrowser for help on using the repository browser.