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

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

source: NEMO/branches/UKMO/NEMO_4.0.1_NGMS_couple_dan/src/OCE/SBC/sbccpl.F90 @ 15433

Last change on this file since 15433 was 15433, checked in by dancopsey, 12 months ago

Add evap only option

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