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

source: branches/UKMO/r6232_HZG_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 9259

Last change on this file since 9259 was 9259, checked in by jcastill, 6 years ago

Changes to stop reading and using the pressure forcing file when coupling to the atmospheric mean sea level pressure

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