source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 6488

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

Commit changes from dev_r5518_coupling_GSI7_GSI8_landice and its ancestor branch dev_r5518_CICE_coupling_GSI7_GSI8.
Custom merge into /branches/UKMO/dev_r5518_GO6_package/NEMOGCM: r6023 cf. r5668 of /branches/UKMO/dev_r5518_coupling_GSI7_GSI8_landice/NEMOGCM@6487

Custom merge into /branches/UKMO/dev_r5518_GO6_package/NEMOGCM: r5668 cf. r5662 of /branches/UKMO/dev_r5518_CICE_coupling_GSI7_GSI8/NEMOGCM@6487

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