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

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

Merge branch r6232_hadgem3_mct@7457

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