source: branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 9023

Last change on this file since 9023 was 9023, checked in by timgraham, 3 years ago

Merged METO_MERCATOR branch and resolved all conflicts in OPA_SRC

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