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

source: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 7359

Last change on this file since 7359 was 7359, checked in by emanuelaclementi, 7 years ago

#1805 updated nomenclature in 2016/dev_INGV_UKMO_2016

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