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

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

source: branches/UKMO/dev_merge_2017_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 9679

Last change on this file since 9679 was 9679, checked in by dancopsey, 6 years ago

Merge in r8183 version of this branch (dev_r8183_GC_couple_pkg [8730:8734])

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