source: branches/UKMO/r5936_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 7150

Last change on this file since 7150 was 7150, checked in by jcastill, 4 years ago

Move one line of code to allow merging with another branch

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