source: NEMO/branches/UKMO/NEMO_4.0.1_icesheet_and_river_coupling/src/OCE/SBC/sbccpl.F90 @ 12689

Last change on this file since 12689 was 12689, checked in by dancopsey, 8 months ago

Remove any 2D greenland or antarctic mass arrays

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