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_MEDUSA_optim_RH/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 7692

Last change on this file since 7692 was 7692, checked in by frrh, 7 years ago

Strip out svn keywords

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