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

Last change on this file since 6498 was 6498, checked in by timgraham, 9 years ago

Merge head of nemo_v3_6_STABLE into package branch

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