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/UKMO/NEMO_4.0.4_mirror/src/OCE/SBC – NEMO

source: NEMO/branches/UKMO/NEMO_4.0.4_mirror/src/OCE/SBC/sbccpl.F90 @ 14075

Last change on this file since 14075 was 14075, checked in by cguiavarch, 20 months ago

UKMO/NEMO_4.0.4_mirror : Remove SVN keywords.

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