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/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 10473

Last change on this file since 10473 was 10473, checked in by jcastill, 4 years ago

Merged branch UKMO/r6232_INGV1_WAVE-coupling@7620

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