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

source: branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 8916

Last change on this file since 8916 was 8916, checked in by alexwestmohc, 4 years ago

Protected reading and writing of top layer ice temperature and effective
conductivity in restarts by ln_meto_cpl

Corrected meltponds setting in sbccpl

Added rt0 to sstfrz as this is output in Celsius

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