source: NEMO/branches/UKMO/NEMO_4.0.2_GO8_package_ENHANCE-02_ISF_nemo/src/OCE/SBC/sbccpl.F90 @ 12721

Last change on this file since 12721 was 12721, checked in by mathiot, 19 months ago

NEMO_4.0.2_GO8_package_ENHANCE-02_ISF_nemo: add last year isf dev

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