source: branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 10394

Last change on this file since 10394 was 10394, checked in by jcastill, 23 months ago

Merged r6232_hadgem3_cplseq@7460 branch

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