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 @ 15178

Last change on this file since 15178 was 15178, checked in by dancopsey, 14 months ago

Allow just the passing of sea ice fractions and weighted sea ice thicknesses

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