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

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

Merge branch r6232_sst_landsea_cpl@7466

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