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

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

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 7179

Last change on this file since 7179 was 7179, checked in by timgraham, 7 years ago

Manually merge in changes from v3.6_extra_CMIP6_diagnostics branch.
This change also includes a change of the domain_def.xml file so XIOS2 must be used from this revision onwards

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