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

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

Fix compile errors.

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