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

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

source: branches/UKMO/dev_r5518_coupling_GSI7_GSI8_landice/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 5756

Last change on this file since 5756 was 5756, checked in by dancopsey, 9 years ago

Using absolute tolerance for land ice mass change. Also do not allow negative numbers. If it goes negative remember the previous mass and wait for it to increase above that (passing zero as iceberg flux in the mean time).

File size: 137.3 KB
Line 
1MODULE sbccpl
2   !!======================================================================
3   !!                       ***  MODULE  sbccpl  ***
4   !! Surface Boundary Condition :  momentum, heat and freshwater fluxes in coupled mode
5   !!======================================================================
6   !! History :  2.0  ! 2007-06  (R. Redler, N. Keenlyside, W. Park) Original code split into flxmod & taumod
7   !!            3.0  ! 2008-02  (G. Madec, C Talandier)  surface module
8   !!            3.1  ! 2009_02  (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface
9   !!            3.4  ! 2011_11  (C. Harris) more flexibility + multi-category fields
10   !!----------------------------------------------------------------------
11   !!----------------------------------------------------------------------
12   !!   namsbc_cpl      : coupled formulation namlist
13   !!   sbc_cpl_init    : initialisation of the coupled exchanges
14   !!   sbc_cpl_rcv     : receive fields from the atmosphere over the ocean (ocean only)
15   !!                     receive stress from the atmosphere over the ocean (ocean-ice case)
16   !!   sbc_cpl_ice_tau : receive stress from the atmosphere over ice
17   !!   sbc_cpl_ice_flx : receive fluxes from the atmosphere over ice
18   !!   sbc_cpl_snd     : send     fields to the atmosphere
19   !!----------------------------------------------------------------------
20   USE dom_oce         ! ocean space and time domain
21   USE sbc_oce         ! Surface boundary condition: ocean fields
22   USE sbc_ice         ! Surface boundary condition: ice fields
23   USE sbcapr
24   USE sbcdcy          ! surface boundary condition: diurnal cycle
25   USE phycst          ! physical constants
26#if defined key_lim3
27   USE ice             ! ice variables
28#endif
29#if defined key_lim2
30   USE par_ice_2       ! ice parameters
31   USE ice_2           ! ice variables
32#endif
33   USE cpl_oasis3      ! OASIS3 coupling
34   USE geo2ocean       !
35   USE oce   , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev
36   USE albedo          !
37   USE in_out_manager  ! I/O manager
38   USE iom             ! NetCDF library
39   USE lib_mpp         ! distribued memory computing library
40   USE wrk_nemo        ! work arrays
41   USE timing          ! Timing
42   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
43   USE eosbn2
44   USE sbcrnf   , ONLY : l_rnfcpl
45#if defined key_cpl_carbon_cycle
46   USE p4zflx, ONLY : oce_co2
47#endif
48#if defined key_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         CALL iom_put( 'ssu_m', ssu_m )
1189      ENDIF
1190      IF( srcv(jpr_ocy1)%laction ) THEN
1191         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
1192         vb (:,:,1) = ssv_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau
1193         CALL iom_put( 'ssv_m', ssv_m )
1194      ENDIF
1195      !                                                      ! ======================== !
1196      !                                                      !  first T level thickness !
1197      !                                                      ! ======================== !
1198      IF( srcv(jpr_e3t1st )%laction ) THEN                   ! received by sas in case of opa <-> sas coupling
1199         e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1)
1200         CALL iom_put( 'e3t_m', e3t_m(:,:) )
1201      ENDIF
1202      !                                                      ! ================================ !
1203      !                                                      !  fraction of solar net radiation !
1204      !                                                      ! ================================ !
1205      IF( srcv(jpr_fraqsr)%laction ) THEN                    ! received by sas in case of opa <-> sas coupling
1206         frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1)
1207         CALL iom_put( 'frq_m', frq_m )
1208      ENDIF
1209     
1210      !                                                      ! ========================= !
1211      IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN   !  heat & freshwater fluxes ! (Ocean only case)
1212         !                                                   ! ========================= !
1213         !
1214         !                                                       ! total freshwater fluxes over the ocean (emp)
1215         IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN
1216            SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation
1217            CASE( 'conservative' )
1218               zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
1219            CASE( 'oce only', 'oce and ice' )
1220               zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
1221            CASE default
1222               CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
1223            END SELECT
1224         ELSE
1225            zemp(:,:) = 0._wp
1226         ENDIF
1227         !
1228         !                                                        ! runoffs and calving (added in emp)
1229         IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1230         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1)
1231         
1232         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
1233         ELSE                   ;   emp(:,:) =                              zemp(:,:)
1234         ENDIF
1235         !
1236         !                                                       ! non solar heat flux over the ocean (qns)
1237         IF(      srcv(jpr_qnsoce)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
1238         ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
1239         ELSE                                       ;   zqns(:,:) = 0._wp
1240         END IF
1241         ! update qns over the free ocean with:
1242         IF( nn_components /= jp_iam_opa ) THEN
1243            zqns(:,:) =  zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp         ! remove heat content due to mass flux (assumed to be at SST)
1244            IF( srcv(jpr_snow  )%laction ) THEN
1245               zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean
1246            ENDIF
1247         ENDIF
1248         IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:)
1249         ELSE                   ;   qns(:,:) =                              zqns(:,:)
1250         ENDIF
1251
1252         !                                                       ! solar flux over the ocean          (qsr)
1253         IF     ( srcv(jpr_qsroce)%laction ) THEN   ;   zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
1254         ELSE IF( srcv(jpr_qsrmix)%laction ) then   ;   zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
1255         ELSE                                       ;   zqsr(:,:) = 0._wp
1256         ENDIF
1257         IF( ln_dm2dc .AND. ln_cpl )   zqsr(:,:) = sbc_dcy( zqsr )   ! modify qsr to include the diurnal cycle
1258         IF( ln_mixcpl ) THEN   ;   qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:)
1259         ELSE                   ;   qsr(:,:) =                              zqsr(:,:)
1260         ENDIF
1261         !
1262         ! salt flux over the ocean (received by opa in case of opa <-> sas coupling)
1263         IF( srcv(jpr_sflx )%laction )   sfx(:,:) = frcv(jpr_sflx  )%z3(:,:,1)
1264         ! Ice cover  (received by opa in case of opa <-> sas coupling)
1265         IF( srcv(jpr_fice )%laction )   fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1)
1266         !
1267
1268      ENDIF
1269     
1270      !                                                        ! land ice masses : Greenland
1271      zepsilon = rn_iceshelf_fluxes_tolerance
1272
1273      IF( srcv(jpr_grnm)%laction ) THEN
1274         greenland_icesheet_mass_array(:,:) = frcv(jpr_grnm)%z3(:,:,1)
1275         ! take average over ocean points of input array to avoid cumulative error over time
1276         zgreenland_icesheet_mass_in = SUM( greenland_icesheet_mass_array(:,:) * tmask(:,:,1) )
1277         IF(lk_mpp) CALL mpp_sum( zgreenland_icesheet_mass_in )
1278         zmask_sum = SUM( tmask(:,:,1) )
1279         IF(lk_mpp) CALL mpp_sum( zmask_sum ) 
1280         zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum
1281         greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt         
1282         IF( ABS( zgreenland_icesheet_mass_in - greenland_icesheet_mass ) > zepsilon ) THEN
1283            zgreenland_icesheet_mass_b = greenland_icesheet_mass
1284           
1285            ! Only update the mass if it has increased
1286            IF ( (zgreenland_icesheet_mass_in - greenland_icesheet_mass) > 0.0 ) THEN
1287               greenland_icesheet_mass = zgreenland_icesheet_mass_in
1288            ENDIF
1289           
1290            IF( zgreenland_icesheet_mass_b /= 0.0 ) &
1291           &     greenland_icesheet_mass_rate_of_change = ( greenland_icesheet_mass - zgreenland_icesheet_mass_b ) / greenland_icesheet_timelapsed 
1292            greenland_icesheet_timelapsed = 0.0_wp       
1293         ENDIF
1294         IF(lwp) WRITE(numout,*) 'Greenland icesheet mass (kg) read in is ', zgreenland_icesheet_mass_in
1295         IF(lwp) WRITE(numout,*) 'Greenland icesheet mass (kg) used is    ', greenland_icesheet_mass
1296         IF(lwp) WRITE(numout,*) 'Greenland icesheet mass rate of change (kg/s) is ', greenland_icesheet_mass_rate_of_change
1297         IF(lwp) WRITE(numout,*) 'Greenland icesheet seconds lapsed since last change is ', greenland_icesheet_timelapsed
1298      ENDIF
1299
1300      !                                                        ! land ice masses : Antarctica
1301      IF( srcv(jpr_antm)%laction ) THEN
1302         antarctica_icesheet_mass_array(:,:) = frcv(jpr_antm)%z3(:,:,1)
1303         ! take average over ocean points of input array to avoid cumulative error from rounding errors over time
1304         zantarctica_icesheet_mass_in = SUM( antarctica_icesheet_mass_array(:,:) * tmask(:,:,1) )
1305         IF(lk_mpp) CALL mpp_sum( zantarctica_icesheet_mass_in )
1306         zmask_sum = SUM( tmask(:,:,1) )
1307         IF(lk_mpp) CALL mpp_sum( zmask_sum ) 
1308         zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum
1309         antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt         
1310         IF( ABS( zantarctica_icesheet_mass_in - antarctica_icesheet_mass ) > zepsilon ) THEN
1311            zantarctica_icesheet_mass_b = antarctica_icesheet_mass
1312           
1313            ! Only update the mass if it has increased
1314            IF ( (zantarctica_icesheet_mass_in - antarctica_icesheet_mass) > 0.0 ) THEN
1315               antarctica_icesheet_mass = zantarctica_icesheet_mass_in
1316            END IF
1317           
1318            IF( zantarctica_icesheet_mass_b /= 0.0 ) &
1319          &      antarctica_icesheet_mass_rate_of_change = ( antarctica_icesheet_mass - zantarctica_icesheet_mass_b ) / antarctica_icesheet_timelapsed 
1320            antarctica_icesheet_timelapsed = 0.0_wp       
1321         ENDIF
1322         IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass (kg) read in is ', zantarctica_icesheet_mass_in
1323         IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass (kg) used is    ', antarctica_icesheet_mass
1324         IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass rate of change (kg/s) is ', antarctica_icesheet_mass_rate_of_change
1325         IF(lwp) WRITE(numout,*) 'Antarctica icesheet seconds lapsed since last change is ', antarctica_icesheet_timelapsed
1326      ENDIF
1327
1328      !
1329      CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )
1330      !
1331      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv')
1332      !
1333   END SUBROUTINE sbc_cpl_rcv
1334   
1335
1336   SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )     
1337      !!----------------------------------------------------------------------
1338      !!             ***  ROUTINE sbc_cpl_ice_tau  ***
1339      !!
1340      !! ** Purpose :   provide the stress over sea-ice in coupled mode
1341      !!
1342      !! ** Method  :   transform the received stress from the atmosphere into
1343      !!             an atmosphere-ice stress in the (i,j) ocean referencial
1344      !!             and at the velocity point of the sea-ice model (cp_ice_msh):
1345      !!                'C'-grid : i- (j-) components given at U- (V-) point
1346      !!                'I'-grid : B-grid lower-left corner: both components given at I-point
1347      !!
1348      !!                The received stress are :
1349      !!                 - defined by 3 components (if cartesian coordinate)
1350      !!                        or by 2 components (if spherical)
1351      !!                 - oriented along geographical   coordinate (if eastward-northward)
1352      !!                        or  along the local grid coordinate (if local grid)
1353      !!                 - given at U- and V-point, resp.   if received on 2 grids
1354      !!                        or at a same point (T or I) if received on 1 grid
1355      !!                Therefore and if necessary, they are successively
1356      !!             processed in order to obtain them
1357      !!                 first  as  2 components on the sphere
1358      !!                 second as  2 components oriented along the local grid
1359      !!                 third  as  2 components on the cp_ice_msh point
1360      !!
1361      !!                Except in 'oce and ice' case, only one vector stress field
1362      !!             is received. It has already been processed in sbc_cpl_rcv
1363      !!             so that it is now defined as (i,j) components given at U-
1364      !!             and V-points, respectively. Therefore, only the third
1365      !!             transformation is done and only if the ice-grid is a 'I'-grid.
1366      !!
1367      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice at cp_ice_msh point
1368      !!----------------------------------------------------------------------
1369      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2]
1370      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid)
1371      !!
1372      INTEGER ::   ji, jj                          ! dummy loop indices
1373      INTEGER ::   itx                             ! index of taux over ice
1374      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty 
1375      !!----------------------------------------------------------------------
1376      !
1377      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_tau')
1378      !
1379      CALL wrk_alloc( jpi,jpj, ztx, zty )
1380
1381      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1   
1382      ELSE                                ;   itx =  jpr_otx1
1383      ENDIF
1384
1385      ! do something only if we just received the stress from atmosphere
1386      IF(  nrcvinfo(itx) == OASIS_Rcv ) THEN
1387
1388         !                                                      ! ======================= !
1389         IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   !
1390            !                                                   ! ======================= !
1391           
1392            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere
1393               !                                                       ! (cartesian to spherical -> 3 to 2 components)
1394               CALL geo2oce(  frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1),   &
1395                  &          srcv(jpr_itx1)%clgrid, ztx, zty )
1396               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid
1397               frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid
1398               !
1399               IF( srcv(jpr_itx2)%laction ) THEN
1400                  CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1),   &
1401                     &          srcv(jpr_itx2)%clgrid, ztx, zty )
1402                  frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid
1403                  frcv(jpr_ity2)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid
1404               ENDIF
1405               !
1406            ENDIF
1407            !
1408            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid
1409               !                                                       ! (geographical to local grid -> rotate the components)
1410               CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )   
1411               IF( srcv(jpr_itx2)%laction ) THEN
1412                  CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )   
1413               ELSE
1414                  CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty ) 
1415               ENDIF
1416               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid
1417               frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 1st grid
1418            ENDIF
1419            !                                                   ! ======================= !
1420         ELSE                                                   !     use ocean stress    !
1421            !                                                   ! ======================= !
1422            frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1)
1423            frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1)
1424            !
1425         ENDIF
1426         !                                                      ! ======================= !
1427         !                                                      !     put on ice grid     !
1428         !                                                      ! ======================= !
1429         !   
1430         !                                                  j+1   j     -----V---F
1431         ! ice stress on ice velocity point (cp_ice_msh)                 !       |
1432         ! (C-grid ==>(U,V) or B-grid ==> I or F)                 j      |   T   U
1433         !                                                               |       |
1434         !                                                   j    j-1   -I-------|
1435         !                                               (for I)         |       |
1436         !                                                              i-1  i   i
1437         !                                                               i      i+1 (for I)
1438         SELECT CASE ( cp_ice_msh )
1439            !
1440         CASE( 'I' )                                         ! B-grid ==> I
1441            SELECT CASE ( srcv(jpr_itx1)%clgrid )
1442            CASE( 'U' )
1443               DO jj = 2, jpjm1                                   ! (U,V) ==> I
1444                  DO ji = 2, jpim1   ! NO vector opt.
1445                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji-1,jj  ,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )
1446                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )
1447                  END DO
1448               END DO
1449            CASE( 'F' )
1450               DO jj = 2, jpjm1                                   ! F ==> I
1451                  DO ji = 2, jpim1   ! NO vector opt.
1452                     p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji-1,jj-1,1)
1453                     p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji-1,jj-1,1)
1454                  END DO
1455               END DO
1456            CASE( 'T' )
1457               DO jj = 2, jpjm1                                   ! T ==> I
1458                  DO ji = 2, jpim1   ! NO vector opt.
1459                     p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj  ,1) + frcv(jpr_itx1)%z3(ji-1,jj  ,1)   &
1460                        &                   + frcv(jpr_itx1)%z3(ji,jj-1,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) ) 
1461                     p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj  ,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1)   &
1462                        &                   + frcv(jpr_oty1)%z3(ji,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )
1463                  END DO
1464               END DO
1465            CASE( 'I' )
1466               p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! I ==> I
1467               p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
1468            END SELECT
1469            IF( srcv(jpr_itx1)%clgrid /= 'I' ) THEN
1470               CALL lbc_lnk( p_taui, 'I',  -1. )   ;   CALL lbc_lnk( p_tauj, 'I',  -1. )
1471            ENDIF
1472            !
1473         CASE( 'F' )                                         ! B-grid ==> F
1474            SELECT CASE ( srcv(jpr_itx1)%clgrid )
1475            CASE( 'U' )
1476               DO jj = 2, jpjm1                                   ! (U,V) ==> F
1477                  DO ji = fs_2, fs_jpim1   ! vector opt.
1478                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj+1,1) )
1479                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji+1,jj  ,1) )
1480                  END DO
1481               END DO
1482            CASE( 'I' )
1483               DO jj = 2, jpjm1                                   ! I ==> F
1484                  DO ji = 2, jpim1   ! NO vector opt.
1485                     p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji+1,jj+1,1)
1486                     p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji+1,jj+1,1)
1487                  END DO
1488               END DO
1489            CASE( 'T' )
1490               DO jj = 2, jpjm1                                   ! T ==> F
1491                  DO ji = 2, jpim1   ! NO vector opt.
1492                     p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj  ,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1)   &
1493                        &                   + frcv(jpr_itx1)%z3(ji,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj+1,1) ) 
1494                     p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj  ,1) + frcv(jpr_ity1)%z3(ji+1,jj  ,1)   &
1495                        &                   + frcv(jpr_ity1)%z3(ji,jj+1,1) + frcv(jpr_ity1)%z3(ji+1,jj+1,1) )
1496                  END DO
1497               END DO
1498            CASE( 'F' )
1499               p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! F ==> F
1500               p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
1501            END SELECT
1502            IF( srcv(jpr_itx1)%clgrid /= 'F' ) THEN
1503               CALL lbc_lnk( p_taui, 'F',  -1. )   ;   CALL lbc_lnk( p_tauj, 'F',  -1. )
1504            ENDIF
1505            !
1506         CASE( 'C' )                                         ! C-grid ==> U,V
1507            SELECT CASE ( srcv(jpr_itx1)%clgrid )
1508            CASE( 'U' )
1509               p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! (U,V) ==> (U,V)
1510               p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
1511            CASE( 'F' )
1512               DO jj = 2, jpjm1                                   ! F ==> (U,V)
1513                  DO ji = fs_2, fs_jpim1   ! vector opt.
1514                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj-1,1) )
1515                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(jj,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1) )
1516                  END DO
1517               END DO
1518            CASE( 'T' )
1519               DO jj = 2, jpjm1                                   ! T ==> (U,V)
1520                  DO ji = fs_2, fs_jpim1   ! vector opt.
1521                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
1522                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
1523                  END DO
1524               END DO
1525            CASE( 'I' )
1526               DO jj = 2, jpjm1                                   ! I ==> (U,V)
1527                  DO ji = 2, jpim1   ! NO vector opt.
1528                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1) )
1529                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji  ,jj+1,1) )
1530                  END DO
1531               END DO
1532            END SELECT
1533            IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN
1534               CALL lbc_lnk( p_taui, 'U',  -1. )   ;   CALL lbc_lnk( p_tauj, 'V',  -1. )
1535            ENDIF
1536         END SELECT
1537
1538      ENDIF
1539      !   
1540      CALL wrk_dealloc( jpi,jpj, ztx, zty )
1541      !
1542      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_tau')
1543      !
1544   END SUBROUTINE sbc_cpl_ice_tau
1545   
1546
1547   SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist )
1548      !!----------------------------------------------------------------------
1549      !!             ***  ROUTINE sbc_cpl_ice_flx  ***
1550      !!
1551      !! ** Purpose :   provide the heat and freshwater fluxes of the
1552      !!              ocean-ice system.
1553      !!
1554      !! ** Method  :   transform the fields received from the atmosphere into
1555      !!             surface heat and fresh water boundary condition for the
1556      !!             ice-ocean system. The following fields are provided:
1557      !!              * total non solar, solar and freshwater fluxes (qns_tot,
1558      !!             qsr_tot and emp_tot) (total means weighted ice-ocean flux)
1559      !!             NB: emp_tot include runoffs and calving.
1560      !!              * fluxes over ice (qns_ice, qsr_ice, emp_ice) where
1561      !!             emp_ice = sublimation - solid precipitation as liquid
1562      !!             precipitation are re-routed directly to the ocean and
1563      !!             runoffs and calving directly enter the ocean.
1564      !!              * solid precipitation (sprecip), used to add to qns_tot
1565      !!             the heat lost associated to melting solid precipitation
1566      !!             over the ocean fraction.
1567      !!       ===>> CAUTION here this changes the net heat flux received from
1568      !!             the atmosphere
1569      !!
1570      !!                  - the fluxes have been separated from the stress as
1571      !!                 (a) they are updated at each ice time step compare to
1572      !!                 an update at each coupled time step for the stress, and
1573      !!                 (b) the conservative computation of the fluxes over the
1574      !!                 sea-ice area requires the knowledge of the ice fraction
1575      !!                 after the ice advection and before the ice thermodynamics,
1576      !!                 so that the stress is updated before the ice dynamics
1577      !!                 while the fluxes are updated after it.
1578      !!
1579      !! ** Action  :   update at each nf_ice time step:
1580      !!                   qns_tot, qsr_tot  non-solar and solar total heat fluxes
1581      !!                   qns_ice, qsr_ice  non-solar and solar heat fluxes over the ice
1582      !!                   emp_tot            total evaporation - precipitation(liquid and solid) (-runoff)(-calving)
1583      !!                   emp_ice            ice sublimation - solid precipitation over the ice
1584      !!                   dqns_ice           d(non-solar heat flux)/d(Temperature) over the ice
1585      !!                   sprecip             solid precipitation over the ocean 
1586      !!----------------------------------------------------------------------
1587      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1]
1588      ! optional arguments, used only in 'mixed oce-ice' case
1589      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo
1590      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius]
1591      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin]
1592      !
1593      INTEGER ::   jl         ! dummy loop index
1594      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zicefr, zmsk
1595      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot
1596      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice
1597      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM3
1598      !!----------------------------------------------------------------------
1599      !
1600      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx')
1601      !
1602      CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )
1603      CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice )
1604
1605      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
1606      zicefr(:,:) = 1.- p_frld(:,:)
1607      zcptn(:,:) = rcp * sst_m(:,:)
1608      !
1609      !                                                      ! ========================= !
1610      !                                                      !    freshwater budget      !   (emp)
1611      !                                                      ! ========================= !
1612      !
1613      !                                                           ! total Precipitation - total Evaporation (emp_tot)
1614      !                                                           ! solid precipitation - sublimation       (emp_ice)
1615      !                                                           ! solid Precipitation                     (sprecip)
1616      !                                                           ! liquid + solid Precipitation            (tprecip)
1617      SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
1618      CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
1619         zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                  ! May need to ensure positive here
1620         ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here
1621         zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)         
1622#if defined key_cice
1623         IF ( TRIM(sn_rcv_emp%clcat) == 'yes' ) THEN
1624            ! zemp_ice is the sum of frcv(jpr_ievp)%z3(:,:,1) over all layers - snow
1625            zemp_ice(:,:) = - frcv(jpr_snow)%z3(:,:,1)
1626            DO jl=1,jpl
1627               zemp_ice(:,:   ) = zemp_ice(:,:) + frcv(jpr_ievp)%z3(:,:,jl)
1628            ENDDO
1629            ! latent heat coupled for each category in CICE
1630            qla_ice(:,:,1:jpl) = - frcv(jpr_ievp)%z3(:,:,1:jpl) * lsub
1631         ELSE
1632            ! If CICE has multicategories it still expects coupling fields for
1633            ! each even if we treat as a single field
1634            ! The latent heat flux is split between the ice categories according
1635            ! to the fraction of the ice in each category
1636            zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)
1637            WHERE ( zicefr(:,:) /= 0._wp ) 
1638               ztmp(:,:) = 1./zicefr(:,:)
1639            ELSEWHERE 
1640               ztmp(:,:) = 0.e0
1641            END WHERE 
1642            DO jl=1,jpl
1643               qla_ice(:,:,jl) = - a_i(:,:,jl) * ztmp(:,:) * frcv(jpr_ievp)%z3(:,:,1) * lsub 
1644            END DO
1645            WHERE ( zicefr(:,:) == 0._wp )  qla_ice(:,:,1) = -frcv(jpr_ievp)%z3(:,:,1) * lsub 
1646         ENDIF
1647#else         
1648         zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)
1649#endif                 
1650            CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation
1651         IF( iom_use('hflx_rain_cea') )   &
1652            CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from liq. precip.
1653         IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') )   &
1654            ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)
1655         IF( iom_use('evap_ao_cea'  ) )   &
1656            CALL iom_put( 'evap_ao_cea'  , ztmp                   )   ! ice-free oce evap (cell average)
1657         IF( iom_use('hflx_evap_cea') )   &
1658            CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) )   ! heat flux from from evap (cell average)
1659      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
1660         zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
1661         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1)
1662         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1)
1663         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:)
1664      END SELECT
1665
1666      IF( iom_use('subl_ai_cea') )   &
1667         CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average)
1668      !   
1669      !                                                           ! runoffs and calving (put in emp_tot)
1670      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1671      IF( srcv(jpr_cal)%laction ) THEN
1672         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
1673         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) )
1674      ENDIF
1675
1676      IF( ln_mixcpl ) THEN
1677         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
1678         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
1679         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
1680         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
1681      ELSE
1682         emp_tot(:,:) =                                  zemp_tot(:,:)
1683         emp_ice(:,:) =                                  zemp_ice(:,:)
1684         sprecip(:,:) =                                  zsprecip(:,:)
1685         tprecip(:,:) =                                  ztprecip(:,:)
1686      ENDIF
1687
1688         CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow
1689      IF( iom_use('snow_ao_cea') )   &
1690         CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:)             )   ! Snow        over ice-free ocean  (cell average)
1691      IF( iom_use('snow_ai_cea') )   &
1692         CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:)             )   ! Snow        over sea-ice         (cell average)
1693
1694      !                                                      ! ========================= !
1695      SELECT CASE( TRIM( sn_rcv_qns%cldes ) )                !   non solar heat fluxes   !   (qns)
1696      !                                                      ! ========================= !
1697      CASE( 'oce only' )                                     ! the required field is directly provided
1698         zqns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1)
1699      CASE( 'conservative' )                                      ! the required fields are directly provided
1700         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
1701         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
1702            zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
1703         ELSE
1704            ! Set all category values equal for the moment
1705            DO jl=1,jpl
1706               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
1707            ENDDO
1708         ENDIF
1709      CASE( 'oce and ice' )       ! the total flux is computed from ocean and ice fluxes
1710         zqns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
1711         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
1712            DO jl=1,jpl
1713               zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)   
1714               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
1715            ENDDO
1716         ELSE
1717            qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
1718            DO jl=1,jpl
1719               zqns_tot(:,:   ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
1720               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
1721            ENDDO
1722         ENDIF
1723      CASE( 'mixed oce-ice' )     ! the ice flux is cumputed from the total flux, the SST and ice informations
1724! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
1725         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
1726         zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    &
1727            &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   &
1728            &                                                   +          pist(:,:,1)   * zicefr(:,:) ) )
1729      END SELECT
1730!!gm
1731!!    currently it is taken into account in leads budget but not in the zqns_tot, and thus not in
1732!!    the flux that enter the ocean....
1733!!    moreover 1 - it is not diagnose anywhere....
1734!!             2 - it is unclear for me whether this heat lost is taken into account in the atmosphere or not...
1735!!
1736!! similar job should be done for snow and precipitation temperature
1737      !                                     
1738      IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting
1739         ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus               ! add the latent heat of iceberg melting
1740         zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:)
1741         IF( iom_use('hflx_cal_cea') )   &
1742            CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving
1743      ENDIF
1744
1745      ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus
1746      IF( iom_use('hflx_snow_cea') )    CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average)
1747
1748#if defined key_lim3
1749      CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 
1750
1751      ! --- evaporation --- !
1752      ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation
1753      ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice
1754      !                 but it is incoherent WITH the ice model 
1755      DO jl=1,jpl
1756         evap_ice(:,:,jl) = 0._wp  ! should be: frcv(jpr_ievp)%z3(:,:,1)
1757      ENDDO
1758      zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean
1759
1760      ! --- evaporation minus precipitation --- !
1761      emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:)
1762
1763      ! --- non solar flux over ocean --- !
1764      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax
1765      zqns_oce = 0._wp
1766      WHERE( p_frld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:)
1767
1768      ! --- heat flux associated with emp --- !
1769      zsnw(:,:) = 0._wp
1770      CALL lim_thd_snwblow( p_frld, zsnw )  ! snow distribution over ice after wind blowing
1771      zqemp_oce(:,:) = -      zevap(:,:)                   * p_frld(:,:)      *   zcptn(:,:)   &      ! evap
1772         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptn(:,:)   &      ! liquid precip
1773         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean
1774      qemp_ice(:,:)  = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptn(:,:)   &      ! ice evap
1775         &             +   zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice
1776
1777      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
1778      zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus )
1779
1780      ! --- total non solar flux --- !
1781      zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:)
1782
1783      ! --- in case both coupled/forced are active, we must mix values --- !
1784      IF( ln_mixcpl ) THEN
1785         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
1786         qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:)
1787         DO jl=1,jpl
1788            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:)
1789         ENDDO
1790         qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:)
1791         qemp_oce (:,:) =  qemp_oce(:,:) * xcplmask(:,:,0) +  zqemp_oce(:,:)* zmsk(:,:)
1792!!clem         evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0)
1793      ELSE
1794         qns_tot  (:,:  ) = zqns_tot  (:,:  )
1795         qns_oce  (:,:  ) = zqns_oce  (:,:  )
1796         qns_ice  (:,:,:) = zqns_ice  (:,:,:)
1797         qprec_ice(:,:)   = zqprec_ice(:,:)
1798         qemp_oce (:,:)   = zqemp_oce (:,:)
1799      ENDIF
1800
1801      CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 
1802#else
1803
1804      ! clem: this formulation is certainly wrong... but better than it was...
1805      zqns_tot(:,:) = zqns_tot(:,:)                       &            ! zqns_tot update over free ocean with:
1806         &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting
1807         &          - (  zemp_tot(:,:)                    &            ! remove the heat content of mass flux (assumed to be at SST)
1808         &             - zemp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:) 
1809
1810     IF( ln_mixcpl ) THEN
1811         qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
1812         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) +  zqns_tot(:,:)* zmsk(:,:)
1813         DO jl=1,jpl
1814            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:)
1815         ENDDO
1816      ELSE
1817         qns_tot(:,:  ) = zqns_tot(:,:  )
1818         qns_ice(:,:,:) = zqns_ice(:,:,:)
1819      ENDIF
1820
1821#endif
1822
1823      !                                                      ! ========================= !
1824      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )                !      solar heat fluxes    !   (qsr)
1825      !                                                      ! ========================= !
1826      CASE( 'oce only' )
1827         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
1828      CASE( 'conservative' )
1829         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
1830         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
1831            zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
1832         ELSE
1833            ! Set all category values equal for the moment
1834            DO jl=1,jpl
1835               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
1836            ENDDO
1837         ENDIF
1838         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
1839         zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
1840      CASE( 'oce and ice' )
1841         zqsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
1842         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
1843            DO jl=1,jpl
1844               zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)   
1845               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
1846            ENDDO
1847         ELSE
1848            qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
1849            DO jl=1,jpl
1850               zqsr_tot(:,:   ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
1851               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
1852            ENDDO
1853         ENDIF
1854      CASE( 'mixed oce-ice' )
1855         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
1856! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
1857!       Create solar heat flux over ice using incoming solar heat flux and albedos
1858!       ( see OASIS3 user guide, 5th edition, p39 )
1859         zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   &
1860            &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)       &
1861            &                     + palbi         (:,:,1) * zicefr(:,:) ) )
1862      END SELECT
1863      IF( ln_dm2dc .AND. ln_cpl ) THEN   ! modify qsr to include the diurnal cycle
1864         zqsr_tot(:,:  ) = sbc_dcy( zqsr_tot(:,:  ) )
1865         DO jl=1,jpl
1866            zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) )
1867         ENDDO
1868      ENDIF
1869
1870#if defined key_lim3
1871      CALL wrk_alloc( jpi,jpj, zqsr_oce ) 
1872      ! --- solar flux over ocean --- !
1873      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax
1874      zqsr_oce = 0._wp
1875      WHERE( p_frld /= 0._wp )  zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:)
1876
1877      IF( ln_mixcpl ) THEN   ;   qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) +  zqsr_oce(:,:)* zmsk(:,:)
1878      ELSE                   ;   qsr_oce(:,:) = zqsr_oce(:,:)   ;   ENDIF
1879
1880      CALL wrk_dealloc( jpi,jpj, zqsr_oce ) 
1881#endif
1882
1883      IF( ln_mixcpl ) THEN
1884         qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
1885         qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) +  zqsr_tot(:,:)* zmsk(:,:)
1886         DO jl=1,jpl
1887            qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) +  zqsr_ice(:,:,jl)* zmsk(:,:)
1888         ENDDO
1889      ELSE
1890         qsr_tot(:,:  ) = zqsr_tot(:,:  )
1891         qsr_ice(:,:,:) = zqsr_ice(:,:,:)
1892      ENDIF
1893
1894      !                                                      ! ========================= !
1895      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) )             !          d(qns)/dt        !
1896      !                                                      ! ========================= !
1897      CASE ('coupled')
1898         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
1899            zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
1900         ELSE
1901            ! Set all category values equal for the moment
1902            DO jl=1,jpl
1903               zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
1904            ENDDO
1905         ENDIF
1906      END SELECT
1907     
1908      IF( ln_mixcpl ) THEN
1909         DO jl=1,jpl
1910            dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)
1911         ENDDO
1912      ELSE
1913         dqns_ice(:,:,:) = zdqns_ice(:,:,:)
1914      ENDIF
1915     
1916      !                                                      ! ========================= !
1917      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !    topmelt and botmelt    !
1918      !                                                      ! ========================= !
1919      CASE ('coupled')
1920         topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:)
1921         botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:)
1922      END SELECT
1923
1924      ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 )
1925      ! Used for LIM2 and LIM3
1926      ! Coupled case: since cloud cover is not received from atmosphere
1927      !               ===> used prescribed cloud fraction representative for polar oceans in summer (0.81)
1928      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
1929      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
1930
1931      CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )
1932      CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice )
1933      !
1934      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_flx')
1935      !
1936   END SUBROUTINE sbc_cpl_ice_flx
1937   
1938   
1939   SUBROUTINE sbc_cpl_snd( kt )
1940      !!----------------------------------------------------------------------
1941      !!             ***  ROUTINE sbc_cpl_snd  ***
1942      !!
1943      !! ** Purpose :   provide the ocean-ice informations to the atmosphere
1944      !!
1945      !! ** Method  :   send to the atmosphere through a call to cpl_snd
1946      !!              all the needed fields (as defined in sbc_cpl_init)
1947      !!----------------------------------------------------------------------
1948      INTEGER, INTENT(in) ::   kt
1949      !
1950      INTEGER ::   ji, jj, jl   ! dummy loop indices
1951      INTEGER ::   isec, info   ! local integer
1952      REAL(wp) ::   zumax, zvmax
1953      REAL(wp), POINTER, DIMENSION(:,:)   ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
1954      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmp3, ztmp4   
1955      !!----------------------------------------------------------------------
1956      !
1957      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_snd')
1958      !
1959      CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
1960      CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 )
1961
1962      isec = ( kt - nit000 ) * NINT(rdttra(1))        ! date of exchanges
1963
1964      zfr_l(:,:) = 1.- fr_i(:,:)
1965      !                                                      ! ------------------------- !
1966      !                                                      !    Surface temperature    !   in Kelvin
1967      !                                                      ! ------------------------- !
1968      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
1969         
1970         IF ( nn_components == jp_iam_opa ) THEN
1971            ztmp1(:,:) = tsn(:,:,1,jp_tem)   ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part
1972         ELSE
1973            ! we must send the surface potential temperature
1974            IF( ln_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
1975            ELSE                    ;   ztmp1(:,:) = tsn(:,:,1,jp_tem)
1976            ENDIF
1977            !
1978            SELECT CASE( sn_snd_temp%cldes)
1979            CASE( 'oce only'             )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0
1980            CASE( 'oce and ice'          )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0
1981               SELECT CASE( sn_snd_temp%clcat )
1982               CASE( 'yes' )   
1983                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl)
1984               CASE( 'no' )
1985                  WHERE( SUM( a_i, dim=3 ) /= 0. )
1986                     ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 )
1987                  ELSEWHERE
1988                     ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?)
1989                  END WHERE
1990               CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
1991               END SELECT
1992            CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)   
1993               SELECT CASE( sn_snd_temp%clcat )
1994               CASE( 'yes' )   
1995                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
1996               CASE( 'no' )
1997                  ztmp3(:,:,:) = 0.0
1998                  DO jl=1,jpl
1999                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
2000                  ENDDO
2001               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
2002               END SELECT
2003            CASE( 'oce and weighted ice' )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0 
2004               SELECT CASE( sn_snd_temp%clcat )
2005               CASE( 'yes' )   
2006           ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2007               CASE( 'no' )
2008           ztmp3(:,:,:) = 0.0
2009           DO jl=1,jpl
2010                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
2011           ENDDO
2012               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
2013               END SELECT
2014            CASE( 'mixed oce-ice'        )   
2015               ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 
2016               DO jl=1,jpl
2017                  ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
2018               ENDDO
2019            CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
2020            END SELECT
2021         ENDIF
2022         IF( ssnd(jps_toce)%laction )   CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2023         IF( ssnd(jps_tice)%laction )   CALL cpl_snd( jps_tice, isec, ztmp3, info )
2024         IF( ssnd(jps_tmix)%laction )   CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2025      ENDIF
2026      !                                                      ! ------------------------- !
2027      !                                                      !           Albedo          !
2028      !                                                      ! ------------------------- !
2029      IF( ssnd(jps_albice)%laction ) THEN                         ! ice
2030         SELECT CASE( sn_snd_alb%cldes )
2031         CASE( 'ice'          )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
2032         CASE( 'weighted ice' )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2033         CASE default             ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' )
2034         END SELECT
2035         CALL cpl_snd( jps_albice, isec, ztmp3, info )
2036      ENDIF
2037      IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean
2038         ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:)
2039         DO jl=1,jpl
2040            ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl)
2041         ENDDO
2042         CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2043      ENDIF
2044      !                                                      ! ------------------------- !
2045      !                                                      !  Ice fraction & Thickness !
2046      !                                                      ! ------------------------- !
2047      ! Send ice fraction field to atmosphere
2048      IF( ssnd(jps_fice)%laction ) THEN
2049         SELECT CASE( sn_snd_thick%clcat )
2050         CASE( 'yes' )   ;   ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl)
2051         CASE( 'no'  )   ;   ztmp3(:,:,1    ) = fr_i(:,:      )
2052         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2053         END SELECT
2054         IF( ssnd(jps_fice)%laction )   CALL cpl_snd( jps_fice, isec, ztmp3, info )
2055      ENDIF
2056     
2057      ! Send ice fraction field (first order interpolation), for weighting UM fluxes to be passed to NEMO
2058      IF (ssnd(jps_fice1)%laction) THEN
2059         SELECT CASE (sn_snd_thick1%clcat)
2060         CASE( 'yes' )   ;   ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl)
2061         CASE( 'no' )    ;   ztmp3(:,:,1) = fr_i(:,:)
2062         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' )
2063    END SELECT
2064         CALL cpl_snd (jps_fice1, isec, ztmp3, info)
2065      ENDIF
2066     
2067      ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling)
2068      IF( ssnd(jps_fice2)%laction ) THEN
2069         ztmp3(:,:,1) = fr_i(:,:)
2070         IF( ssnd(jps_fice2)%laction )   CALL cpl_snd( jps_fice2, isec, ztmp3, info )
2071      ENDIF
2072
2073      ! Send ice and snow thickness field
2074      IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN
2075         SELECT CASE( sn_snd_thick%cldes)
2076         CASE( 'none'                  )       ! nothing to do
2077         CASE( 'weighted ice and snow' )   
2078            SELECT CASE( sn_snd_thick%clcat )
2079            CASE( 'yes' )   
2080               ztmp3(:,:,1:jpl) =  ht_i(:,:,1:jpl) * a_i(:,:,1:jpl)
2081               ztmp4(:,:,1:jpl) =  ht_s(:,:,1:jpl) * a_i(:,:,1:jpl)
2082            CASE( 'no' )
2083               ztmp3(:,:,:) = 0.0   ;  ztmp4(:,:,:) = 0.0
2084               DO jl=1,jpl
2085                  ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl)
2086                  ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl)
2087               ENDDO
2088            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2089            END SELECT
2090         CASE( 'ice and snow'         )   
2091            SELECT CASE( sn_snd_thick%clcat )
2092            CASE( 'yes' )
2093               ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl)
2094               ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl)
2095            CASE( 'no' )
2096               WHERE( SUM( a_i, dim=3 ) /= 0. )
2097                  ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 )
2098                  ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 )
2099               ELSEWHERE
2100                 ztmp3(:,:,1) = 0.
2101                 ztmp4(:,:,1) = 0.
2102               END WHERE
2103            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
2104            END SELECT
2105         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' )
2106         END SELECT
2107         IF( ssnd(jps_hice)%laction )   CALL cpl_snd( jps_hice, isec, ztmp3, info )
2108         IF( ssnd(jps_hsnw)%laction )   CALL cpl_snd( jps_hsnw, isec, ztmp4, info )
2109      ENDIF
2110      !
2111      ! Send meltpond fields
2112      IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN
2113         SELECT CASE( sn_snd_mpnd%cldes) 
2114         CASE( 'weighted ice' ) 
2115            SELECT CASE( sn_snd_mpnd%clcat ) 
2116            CASE( 'yes' ) 
2117               ztmp3(:,:,1:jpl) =  a_p(:,:,1:jpl) * a_i(:,:,1:jpl) 
2118               ztmp4(:,:,1:jpl) =  ht_p(:,:,1:jpl) * a_i(:,:,1:jpl) 
2119            CASE( 'no' ) 
2120               ztmp3(:,:,:) = 0.0 
2121               ztmp4(:,:,:) = 0.0 
2122               DO jl=1,jpl 
2123                 ztmp3(:,:,1) = ztmp3(:,:,1) + a_p(:,:,jpl) * a_i(:,:,jpl) 
2124                 ztmp4(:,:,1) = ztmp4(:,:,1) + ht_p(:,:,jpl) * a_i(:,:,jpl) 
2125               ENDDO 
2126            CASE default    ;   CALL ctl_stop( 'sbc_cpl_mpd: wrong definition of sn_snd_mpnd%clcat' ) 
2127            END SELECT
2128         CASE( 'ice only' )   
2129            ztmp3(:,:,1:jpl) = a_p(:,:,1:jpl) 
2130            ztmp4(:,:,1:jpl) = ht_p(:,:,1:jpl) 
2131         END SELECT
2132         IF( ssnd(jps_a_p)%laction )   CALL cpl_snd( jps_a_p, isec, ztmp3, info )   
2133         IF( ssnd(jps_ht_p)%laction )   CALL cpl_snd( jps_ht_p, isec, ztmp4, info )   
2134         !
2135         ! Send ice effective conductivity
2136         SELECT CASE( sn_snd_cond%cldes)
2137         CASE( 'weighted ice' )   
2138            SELECT CASE( sn_snd_cond%clcat )
2139            CASE( 'yes' )   
2140               ztmp3(:,:,1:jpl) =  kn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
2141            CASE( 'no' )
2142               ztmp3(:,:,:) = 0.0
2143               DO jl=1,jpl
2144                 ztmp3(:,:,1) = ztmp3(:,:,1) + kn_ice(:,:,jl) * a_i(:,:,jl)
2145               ENDDO
2146            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' )
2147            END SELECT
2148         CASE( 'ice only' )   
2149           ztmp3(:,:,1:jpl) = kn_ice(:,:,1:jpl)
2150         END SELECT
2151         IF( ssnd(jps_kice)%laction )   CALL cpl_snd( jps_kice, isec, ztmp3, info )
2152      ENDIF
2153      !
2154      !
2155#if defined key_cpl_carbon_cycle
2156      !                                                      ! ------------------------- !
2157      !                                                      !  CO2 flux from PISCES     !
2158      !                                                      ! ------------------------- !
2159      IF( ssnd(jps_co2)%laction )   CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )
2160      !
2161#endif
2162      !                                                      ! ------------------------- !
2163      IF( ssnd(jps_ocx1)%laction ) THEN                      !      Surface current      !
2164         !                                                   ! ------------------------- !
2165         !   
2166         !                                                  j+1   j     -----V---F
2167         ! surface velocity always sent from T point                     !       |
2168         !                                                        j      |   T   U
2169         !                                                               |       |
2170         !                                                   j    j-1   -I-------|
2171         !                                               (for I)         |       |
2172         !                                                              i-1  i   i
2173         !                                                               i      i+1 (for I)
2174         IF( nn_components == jp_iam_opa ) THEN
2175            zotx1(:,:) = un(:,:,1) 
2176            zoty1(:,:) = vn(:,:,1) 
2177         ELSE       
2178            SELECT CASE( TRIM( sn_snd_crt%cldes ) )
2179            CASE( 'oce only'             )      ! C-grid ==> T
2180               DO jj = 2, jpjm1
2181                  DO ji = fs_2, fs_jpim1   ! vector opt.
2182                     zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) )
2183                     zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) ) 
2184                  END DO
2185               END DO
2186            CASE( 'weighted oce and ice' )   
2187               SELECT CASE ( cp_ice_msh )
2188               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
2189                  DO jj = 2, jpjm1
2190                     DO ji = fs_2, fs_jpim1   ! vector opt.
2191                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj) 
2192                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)
2193                        zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
2194                        zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
2195                     END DO
2196                  END DO
2197               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T
2198                  DO jj = 2, jpjm1
2199                     DO ji = 2, jpim1   ! NO vector opt.
2200                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj) 
2201                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj) 
2202                        zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     &
2203                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
2204                        zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     &
2205                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
2206                     END DO
2207                  END DO
2208               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T
2209                  DO jj = 2, jpjm1
2210                     DO ji = 2, jpim1   ! NO vector opt.
2211                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj) 
2212                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj) 
2213                        zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &
2214                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
2215                        zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &
2216                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
2217                     END DO
2218                  END DO
2219               END SELECT
2220               CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. )
2221            CASE( 'mixed oce-ice'        )
2222               SELECT CASE ( cp_ice_msh )
2223               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
2224                  DO jj = 2, jpjm1
2225                     DO ji = fs_2, fs_jpim1   ! vector opt.
2226                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   &
2227                           &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
2228                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   &
2229                           &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
2230                     END DO
2231                  END DO
2232               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T
2233                  DO jj = 2, jpjm1
2234                     DO ji = 2, jpim1   ! NO vector opt.
2235                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &   
2236                           &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     &
2237                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
2238                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
2239                           &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     &
2240                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
2241                     END DO
2242                  END DO
2243               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T
2244                  DO jj = 2, jpjm1
2245                     DO ji = 2, jpim1   ! NO vector opt.
2246                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &   
2247                           &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &
2248                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
2249                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
2250                           &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &
2251                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
2252                     END DO
2253                  END DO
2254               END SELECT
2255            END SELECT
2256            CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. )
2257            !
2258         ENDIF
2259         !
2260         !
2261         IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components
2262            !                                                                     ! Ocean component
2263            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component
2264            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component
2265            zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components
2266            zoty1(:,:) = ztmp2(:,:)
2267            IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component
2268               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component
2269               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component
2270               zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components
2271               zity1(:,:) = ztmp2(:,:)
2272            ENDIF
2273         ENDIF
2274         !
2275         ! spherical coordinates to cartesian -> 2 components to 3 components
2276         IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN
2277            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents
2278            ztmp2(:,:) = zoty1(:,:)
2279            CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
2280            !
2281            IF( ssnd(jps_ivx1)%laction ) THEN           ! ice velocities
2282               ztmp1(:,:) = zitx1(:,:)
2283               ztmp1(:,:) = zity1(:,:)
2284               CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
2285            ENDIF
2286         ENDIF
2287         !
2288         IF( ssnd(jps_ocx1)%laction )   CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid
2289         IF( ssnd(jps_ocy1)%laction )   CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid
2290         IF( ssnd(jps_ocz1)%laction )   CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid
2291         !
2292         IF( ssnd(jps_ivx1)%laction )   CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid
2293         IF( ssnd(jps_ivy1)%laction )   CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid
2294         IF( ssnd(jps_ivz1)%laction )   CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid
2295         !
2296      ENDIF
2297      !
2298      !
2299      !  Fields sent by OPA to SAS when doing OPA<->SAS coupling
2300      !                                                        ! SSH
2301      IF( ssnd(jps_ssh )%laction )  THEN
2302         !                          ! removed inverse barometer ssh when Patm
2303         !                          forcing is used (for sea-ice dynamics)
2304         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
2305         ELSE                    ;   ztmp1(:,:) = sshn(:,:)
2306         ENDIF
2307         CALL cpl_snd( jps_ssh   , isec, RESHAPE ( ztmp1            , (/jpi,jpj,1/) ), info )
2308
2309      ENDIF
2310      !                                                        ! SSS
2311      IF( ssnd(jps_soce  )%laction )  THEN
2312         CALL cpl_snd( jps_soce  , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info )
2313      ENDIF
2314      !                                                        ! first T level thickness
2315      IF( ssnd(jps_e3t1st )%laction )  THEN
2316         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1)   , (/jpi,jpj,1/) ), info )
2317      ENDIF
2318      !                                                        ! Qsr fraction
2319      IF( ssnd(jps_fraqsr)%laction )  THEN
2320         CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info )
2321      ENDIF
2322      !
2323      !  Fields sent by SAS to OPA when OASIS coupling
2324      !                                                        ! Solar heat flux
2325      IF( ssnd(jps_qsroce)%laction )  CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info )
2326      IF( ssnd(jps_qnsoce)%laction )  CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info )
2327      IF( ssnd(jps_oemp  )%laction )  CALL cpl_snd( jps_oemp  , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info )
2328      IF( ssnd(jps_sflx  )%laction )  CALL cpl_snd( jps_sflx  , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info )
2329      IF( ssnd(jps_otx1  )%laction )  CALL cpl_snd( jps_otx1  , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info )
2330      IF( ssnd(jps_oty1  )%laction )  CALL cpl_snd( jps_oty1  , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info )
2331      IF( ssnd(jps_rnf   )%laction )  CALL cpl_snd( jps_rnf   , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info )
2332      IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info )
2333     
2334      ztmp1(:,:) = sstfrz(:,:) + rt0
2335      IF( ssnd(jps_sstfrz)%laction )  CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
2336      !
2337      CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
2338      CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )
2339      !
2340      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_snd')
2341      !
2342   END SUBROUTINE sbc_cpl_snd
2343   
2344   !!======================================================================
2345END MODULE sbccpl
Note: See TracBrowser for help on using the repository browser.