New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
sbccpl.F90 in NEMO/branches/UKMO/NEMO_4.0.1_icesheet_and_river_coupling/src/OCE/SBC – NEMO

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

Last change on this file since 12580 was 12580, checked in by dancopsey, 2 years ago

Add 1D river coupling code from changeset 10269 of GO6 package branch
branches/UKMO/dev_r5518_GO6_package

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