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 @ 7672

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

Further changes to remove the UM dependency in case of a coupled run, so that ocean can also run in coupled mode with a wave model only: until now, if running in forced/coupled mode (ln_mixcpl), the program expected forcing files and coupling fields from the atmosphere, and they were 'merged' together using a coupling map; if the coupling map was not provided, the coupling fields overwrote the input fields even if they were not actually coupled and did not have any valid information. If we were coupling to a wave model and not an atmosphere model, the forcing fields read from file were being overwritten but the atmosphere coupling fields, which did not contain any valid information.

Now, it is possible to couple in real mixed mode, where the fields can independently be read either from forcing files or from coupling (ocean coupled to an atmosphere model, a wave model, or both), and the coupling mapping is only needed if a field if both provided via coupling and a forcing file.

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