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

source: NEMO/branches/UKMO/NEMO_4.0.4_MEDUSA_externals_GC5/src/OCE/SBC/sbccpl.F90 @ 15808

Last change on this file since 15808 was 15808, checked in by jpalmier, 2 years ago

cpl fix -- define and alloc cpl var back in oce

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