source: branches/UKMO/dev_r5518_ww3_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 5893

Last change on this file since 5893 was 5893, checked in by jcastill, 5 years ago

Remove the dependency of UM when transferring currents to the wave model

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