source: branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 9119

Last change on this file since 9119 was 9119, checked in by nicolasmartin, 3 years ago

Fix longer lines so should be harmless (passed SETTE compilations)

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