source: branches/UKMO/dev_r5518_GSI7_GSI8_landice_bitcomp_medusa/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 6669

Last change on this file since 6669 was 6669, checked in by frrh, 4 years ago

Corrections for compilation with MEDUSA branche which needs
associated changes to ensure relevant variables are publically available
and of the correct dimension.

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