source: NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/sbccpl.F90 @ 12154

Last change on this file since 12154 was 12154, checked in by cetlod, 10 months ago

commit

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