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

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

source: branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 10497

Last change on this file since 10497 was 10497, checked in by jcastill, 6 years ago

Add missing ) and remove empty spaces for merging purposes

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