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

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

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

Last change on this file since 11343 was 11343, checked in by jcastill, 5 years ago

Some fixes to the pressure correction, when the pressure is received by coupling

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