source: NEMO/branches/UKMO/NEMO_4.0_GC_couple_pkg/src/OCE/SBC/sbccpl.F90 @ 11105

Last change on this file since 11105 was 11105, checked in by dancopsey, 16 months ago

Merged in changes from dev_merge_2017_GC_couple_pkg branch except for zotx1 and zoty1 changes in sbccpl.F90.

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