source: branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 5443

Last change on this file since 5443 was 5443, checked in by davestorkey, 5 years ago

Update 2015/dev_r5021_UKMO1_CICE_coupling branch to revision 5442 of the trunk.

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