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

source: branches/UKMO/r6232_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 7471

Last change on this file since 7471 was 7471, checked in by jcastill, 7 years ago

Version as merged to the trunk during the Nov-2016 merge party, equivalent to branches/UKMO/r5936_INGV1_WAVE-coupling@7360

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