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

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

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

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

Add a 'standard formulation' for calculating momentum from forcing winds using a constant drag coefficient; remove drag coefficient checks after fixing the wave model

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