source: NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl/src/OCE/SBC/sbccpl.F90 @ 12686

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