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

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

source: branches/UKMO/r6232_hadgem3_cplseq/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 7460

Last change on this file since 7460 was 7460, checked in by jcastill, 5 years ago

Changes as in branches/UKMO/dev_r5107_hadgem3_cplseq

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