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

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

source: NEMO/branches/UKMO/r4.0-HEAD_r12713_dan_test_clems_branch/src/OCE/SBC/sbccpl.F90 @ 12803

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

Merge in NEMO_4.0.1_GC_couple_pkg

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