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

source: branches/r6232_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 7463

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

Changes as in branches/UKMO/dev_r5107_hadgem3_cplfld

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