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

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

source: NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/OCE/SBC/sbccpl.F90 @ 12937

Last change on this file since 12937 was 12937, checked in by dancopsey, 3 years ago

Merge in Clem's branch. It was originally here:

svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/UKMO/NEMO_4.0.1_dan_test_clems_branch

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