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

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

source: branches/UKMO/dev_r5107_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 5575

Last change on this file since 5575 was 5575, checked in by davestorkey, 9 years ago

Update UKMO/dev_r5107_hadgem3_cplfld branch to trunk revision 5518
(= branching point of NEMO 3.6_stable).

File size: 124.3 KB
Line 
1MODULE sbccpl
2   !!======================================================================
3   !!                       ***  MODULE  sbccpl  ***
4   !! Surface Boundary Condition :  momentum, heat and freshwater fluxes in coupled mode
5   !!======================================================================
6   !! History :  2.0  ! 2007-06  (R. Redler, N. Keenlyside, W. Park) Original code split into flxmod & taumod
7   !!            3.0  ! 2008-02  (G. Madec, C Talandier)  surface module
8   !!            3.1  ! 2009_02  (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface
9   !!            3.4  ! 2011_11  (C. Harris) more flexibility + multi-category fields
10   !!----------------------------------------------------------------------
11   !!----------------------------------------------------------------------
12   !!   namsbc_cpl      : coupled formulation namlist
13   !!   sbc_cpl_init    : initialisation of the coupled exchanges
14   !!   sbc_cpl_rcv     : receive fields from the atmosphere over the ocean (ocean only)
15   !!                     receive stress from the atmosphere over the ocean (ocean-ice case)
16   !!   sbc_cpl_ice_tau : receive stress from the atmosphere over ice
17   !!   sbc_cpl_ice_flx : receive fluxes from the atmosphere over ice
18   !!   sbc_cpl_snd     : send     fields to the atmosphere
19   !!----------------------------------------------------------------------
20   USE dom_oce         ! ocean space and time domain
21   USE sbc_oce         ! Surface boundary condition: ocean fields
22   USE sbc_ice         ! Surface boundary condition: ice fields
23   USE sbcapr
24   USE sbcdcy          ! surface boundary condition: diurnal cycle
25   USE phycst          ! physical constants
26#if defined key_lim3
27   USE ice             ! ice variables
28#endif
29#if defined key_lim2
30   USE par_ice_2       ! ice parameters
31   USE ice_2           ! ice variables
32#endif
33   USE cpl_oasis3      ! OASIS3 coupling
34   USE geo2ocean       !
35   USE oce   , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev
36   USE albedo          !
37   USE in_out_manager  ! I/O manager
38   USE iom             ! NetCDF library
39   USE lib_mpp         ! distribued memory computing library
40   USE wrk_nemo        ! work arrays
41   USE timing          ! Timing
42   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
43   USE eosbn2
44   USE sbcrnf   , ONLY : l_rnfcpl
45#if defined key_cpl_carbon_cycle
46   USE p4zflx, ONLY : oce_co2
47#endif
48#if defined key_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, zmsk, zemp, zqns, zqsr, ztx2, zty2
858      !!----------------------------------------------------------------------
859      !
860      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv')
861      !
862      CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 )
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         CALL iom_put( 'ssu_m', ssu_m )
1059      ENDIF
1060      IF( srcv(jpr_ocy1)%laction ) THEN
1061         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
1062         vb (:,:,1) = ssv_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau
1063         CALL iom_put( 'ssv_m', ssv_m )
1064      ENDIF
1065      !                                                      ! ======================== !
1066      !                                                      !  first T level thickness !
1067      !                                                      ! ======================== !
1068      IF( srcv(jpr_e3t1st )%laction ) THEN                   ! received by sas in case of opa <-> sas coupling
1069         e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1)
1070         CALL iom_put( 'e3t_m', e3t_m(:,:) )
1071      ENDIF
1072      !                                                      ! ================================ !
1073      !                                                      !  fraction of solar net radiation !
1074      !                                                      ! ================================ !
1075      IF( srcv(jpr_fraqsr)%laction ) THEN                    ! received by sas in case of opa <-> sas coupling
1076         frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1)
1077         CALL iom_put( 'frq_m', frq_m )
1078      ENDIF
1079     
1080      !                                                      ! ========================= !
1081      IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN   !  heat & freshwater fluxes ! (Ocean only case)
1082         !                                                   ! ========================= !
1083         !
1084         !                                                       ! total freshwater fluxes over the ocean (emp)
1085         IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN
1086            SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation
1087            CASE( 'conservative' )
1088               zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
1089            CASE( 'oce only', 'oce and ice' )
1090               zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
1091            CASE default
1092               CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
1093            END SELECT
1094         ELSE
1095            zemp(:,:) = 0._wp
1096         ENDIF
1097         !
1098         !                                                        ! runoffs and calving (added in emp)
1099         IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1100         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1)
1101         
1102         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
1103         ELSE                   ;   emp(:,:) =                              zemp(:,:)
1104         ENDIF
1105         !
1106         !                                                       ! non solar heat flux over the ocean (qns)
1107         IF(      srcv(jpr_qnsoce)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
1108         ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
1109         ELSE                                       ;   zqns(:,:) = 0._wp
1110         END IF
1111         ! update qns over the free ocean with:
1112         IF( nn_components /= jp_iam_opa ) THEN
1113            zqns(:,:) =  zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp         ! remove heat content due to mass flux (assumed to be at SST)
1114            IF( srcv(jpr_snow  )%laction ) THEN
1115               zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean
1116            ENDIF
1117         ENDIF
1118         IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:)
1119         ELSE                   ;   qns(:,:) =                              zqns(:,:)
1120         ENDIF
1121
1122         !                                                       ! solar flux over the ocean          (qsr)
1123         IF     ( srcv(jpr_qsroce)%laction ) THEN   ;   zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
1124         ELSE IF( srcv(jpr_qsrmix)%laction ) then   ;   zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
1125         ELSE                                       ;   zqsr(:,:) = 0._wp
1126         ENDIF
1127         IF( ln_dm2dc .AND. ln_cpl )   zqsr(:,:) = sbc_dcy( zqsr )   ! modify qsr to include the diurnal cycle
1128         IF( ln_mixcpl ) THEN   ;   qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:)
1129         ELSE                   ;   qsr(:,:) =                              zqsr(:,:)
1130         ENDIF
1131         !
1132         ! salt flux over the ocean (received by opa in case of opa <-> sas coupling)
1133         IF( srcv(jpr_sflx )%laction )   sfx(:,:) = frcv(jpr_sflx  )%z3(:,:,1)
1134         ! Ice cover  (received by opa in case of opa <-> sas coupling)
1135         IF( srcv(jpr_fice )%laction )   fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1)
1136         !
1137
1138      ENDIF
1139      !
1140      CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 )
1141      !
1142      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv')
1143      !
1144   END SUBROUTINE sbc_cpl_rcv
1145   
1146
1147   SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )     
1148      !!----------------------------------------------------------------------
1149      !!             ***  ROUTINE sbc_cpl_ice_tau  ***
1150      !!
1151      !! ** Purpose :   provide the stress over sea-ice in coupled mode
1152      !!
1153      !! ** Method  :   transform the received stress from the atmosphere into
1154      !!             an atmosphere-ice stress in the (i,j) ocean referencial
1155      !!             and at the velocity point of the sea-ice model (cp_ice_msh):
1156      !!                'C'-grid : i- (j-) components given at U- (V-) point
1157      !!                'I'-grid : B-grid lower-left corner: both components given at I-point
1158      !!
1159      !!                The received stress are :
1160      !!                 - defined by 3 components (if cartesian coordinate)
1161      !!                        or by 2 components (if spherical)
1162      !!                 - oriented along geographical   coordinate (if eastward-northward)
1163      !!                        or  along the local grid coordinate (if local grid)
1164      !!                 - given at U- and V-point, resp.   if received on 2 grids
1165      !!                        or at a same point (T or I) if received on 1 grid
1166      !!                Therefore and if necessary, they are successively
1167      !!             processed in order to obtain them
1168      !!                 first  as  2 components on the sphere
1169      !!                 second as  2 components oriented along the local grid
1170      !!                 third  as  2 components on the cp_ice_msh point
1171      !!
1172      !!                Except in 'oce and ice' case, only one vector stress field
1173      !!             is received. It has already been processed in sbc_cpl_rcv
1174      !!             so that it is now defined as (i,j) components given at U-
1175      !!             and V-points, respectively. Therefore, only the third
1176      !!             transformation is done and only if the ice-grid is a 'I'-grid.
1177      !!
1178      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice at cp_ice_msh point
1179      !!----------------------------------------------------------------------
1180      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2]
1181      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid)
1182      !!
1183      INTEGER ::   ji, jj                          ! dummy loop indices
1184      INTEGER ::   itx                             ! index of taux over ice
1185      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty 
1186      !!----------------------------------------------------------------------
1187      !
1188      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_tau')
1189      !
1190      CALL wrk_alloc( jpi,jpj, ztx, zty )
1191
1192      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1   
1193      ELSE                                ;   itx =  jpr_otx1
1194      ENDIF
1195
1196      ! do something only if we just received the stress from atmosphere
1197      IF(  nrcvinfo(itx) == OASIS_Rcv ) THEN
1198
1199         !                                                      ! ======================= !
1200         IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   !
1201            !                                                   ! ======================= !
1202           
1203            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere
1204               !                                                       ! (cartesian to spherical -> 3 to 2 components)
1205               CALL geo2oce(  frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1),   &
1206                  &          srcv(jpr_itx1)%clgrid, ztx, zty )
1207               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid
1208               frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid
1209               !
1210               IF( srcv(jpr_itx2)%laction ) THEN
1211                  CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1),   &
1212                     &          srcv(jpr_itx2)%clgrid, ztx, zty )
1213                  frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid
1214                  frcv(jpr_ity2)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid
1215               ENDIF
1216               !
1217            ENDIF
1218            !
1219            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid
1220               !                                                       ! (geographical to local grid -> rotate the components)
1221               CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )   
1222               IF( srcv(jpr_itx2)%laction ) THEN
1223                  CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )   
1224               ELSE
1225                  CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty ) 
1226               ENDIF
1227               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid
1228               frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 1st grid
1229            ENDIF
1230            !                                                   ! ======================= !
1231         ELSE                                                   !     use ocean stress    !
1232            !                                                   ! ======================= !
1233            frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1)
1234            frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1)
1235            !
1236         ENDIF
1237         !                                                      ! ======================= !
1238         !                                                      !     put on ice grid     !
1239         !                                                      ! ======================= !
1240         !   
1241         !                                                  j+1   j     -----V---F
1242         ! ice stress on ice velocity point (cp_ice_msh)                 !       |
1243         ! (C-grid ==>(U,V) or B-grid ==> I or F)                 j      |   T   U
1244         !                                                               |       |
1245         !                                                   j    j-1   -I-------|
1246         !                                               (for I)         |       |
1247         !                                                              i-1  i   i
1248         !                                                               i      i+1 (for I)
1249         SELECT CASE ( cp_ice_msh )
1250            !
1251         CASE( 'I' )                                         ! B-grid ==> I
1252            SELECT CASE ( srcv(jpr_itx1)%clgrid )
1253            CASE( 'U' )
1254               DO jj = 2, jpjm1                                   ! (U,V) ==> I
1255                  DO ji = 2, jpim1   ! NO vector opt.
1256                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji-1,jj  ,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )
1257                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )
1258                  END DO
1259               END DO
1260            CASE( 'F' )
1261               DO jj = 2, jpjm1                                   ! F ==> I
1262                  DO ji = 2, jpim1   ! NO vector opt.
1263                     p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji-1,jj-1,1)
1264                     p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji-1,jj-1,1)
1265                  END DO
1266               END DO
1267            CASE( 'T' )
1268               DO jj = 2, jpjm1                                   ! T ==> I
1269                  DO ji = 2, jpim1   ! NO vector opt.
1270                     p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj  ,1) + frcv(jpr_itx1)%z3(ji-1,jj  ,1)   &
1271                        &                   + frcv(jpr_itx1)%z3(ji,jj-1,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) ) 
1272                     p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj  ,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1)   &
1273                        &                   + frcv(jpr_oty1)%z3(ji,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )
1274                  END DO
1275               END DO
1276            CASE( 'I' )
1277               p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! I ==> I
1278               p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
1279            END SELECT
1280            IF( srcv(jpr_itx1)%clgrid /= 'I' ) THEN
1281               CALL lbc_lnk( p_taui, 'I',  -1. )   ;   CALL lbc_lnk( p_tauj, 'I',  -1. )
1282            ENDIF
1283            !
1284         CASE( 'F' )                                         ! B-grid ==> F
1285            SELECT CASE ( srcv(jpr_itx1)%clgrid )
1286            CASE( 'U' )
1287               DO jj = 2, jpjm1                                   ! (U,V) ==> F
1288                  DO ji = fs_2, fs_jpim1   ! vector opt.
1289                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj+1,1) )
1290                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji+1,jj  ,1) )
1291                  END DO
1292               END DO
1293            CASE( 'I' )
1294               DO jj = 2, jpjm1                                   ! I ==> F
1295                  DO ji = 2, jpim1   ! NO vector opt.
1296                     p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji+1,jj+1,1)
1297                     p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji+1,jj+1,1)
1298                  END DO
1299               END DO
1300            CASE( 'T' )
1301               DO jj = 2, jpjm1                                   ! T ==> F
1302                  DO ji = 2, jpim1   ! NO vector opt.
1303                     p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj  ,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1)   &
1304                        &                   + frcv(jpr_itx1)%z3(ji,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj+1,1) ) 
1305                     p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj  ,1) + frcv(jpr_ity1)%z3(ji+1,jj  ,1)   &
1306                        &                   + frcv(jpr_ity1)%z3(ji,jj+1,1) + frcv(jpr_ity1)%z3(ji+1,jj+1,1) )
1307                  END DO
1308               END DO
1309            CASE( 'F' )
1310               p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! F ==> F
1311               p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
1312            END SELECT
1313            IF( srcv(jpr_itx1)%clgrid /= 'F' ) THEN
1314               CALL lbc_lnk( p_taui, 'F',  -1. )   ;   CALL lbc_lnk( p_tauj, 'F',  -1. )
1315            ENDIF
1316            !
1317         CASE( 'C' )                                         ! C-grid ==> U,V
1318            SELECT CASE ( srcv(jpr_itx1)%clgrid )
1319            CASE( 'U' )
1320               p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! (U,V) ==> (U,V)
1321               p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
1322            CASE( 'F' )
1323               DO jj = 2, jpjm1                                   ! F ==> (U,V)
1324                  DO ji = fs_2, fs_jpim1   ! vector opt.
1325                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj-1,1) )
1326                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(jj,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1) )
1327                  END DO
1328               END DO
1329            CASE( 'T' )
1330               DO jj = 2, jpjm1                                   ! T ==> (U,V)
1331                  DO ji = fs_2, fs_jpim1   ! vector opt.
1332                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
1333                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
1334                  END DO
1335               END DO
1336            CASE( 'I' )
1337               DO jj = 2, jpjm1                                   ! I ==> (U,V)
1338                  DO ji = 2, jpim1   ! NO vector opt.
1339                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1) )
1340                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji  ,jj+1,1) )
1341                  END DO
1342               END DO
1343            END SELECT
1344            IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN
1345               CALL lbc_lnk( p_taui, 'U',  -1. )   ;   CALL lbc_lnk( p_tauj, 'V',  -1. )
1346            ENDIF
1347         END SELECT
1348
1349      ENDIF
1350      !   
1351      CALL wrk_dealloc( jpi,jpj, ztx, zty )
1352      !
1353      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_tau')
1354      !
1355   END SUBROUTINE sbc_cpl_ice_tau
1356   
1357
1358   SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist )
1359      !!----------------------------------------------------------------------
1360      !!             ***  ROUTINE sbc_cpl_ice_flx  ***
1361      !!
1362      !! ** Purpose :   provide the heat and freshwater fluxes of the
1363      !!              ocean-ice system.
1364      !!
1365      !! ** Method  :   transform the fields received from the atmosphere into
1366      !!             surface heat and fresh water boundary condition for the
1367      !!             ice-ocean system. The following fields are provided:
1368      !!              * total non solar, solar and freshwater fluxes (qns_tot,
1369      !!             qsr_tot and emp_tot) (total means weighted ice-ocean flux)
1370      !!             NB: emp_tot include runoffs and calving.
1371      !!              * fluxes over ice (qns_ice, qsr_ice, emp_ice) where
1372      !!             emp_ice = sublimation - solid precipitation as liquid
1373      !!             precipitation are re-routed directly to the ocean and
1374      !!             runoffs and calving directly enter the ocean.
1375      !!              * solid precipitation (sprecip), used to add to qns_tot
1376      !!             the heat lost associated to melting solid precipitation
1377      !!             over the ocean fraction.
1378      !!       ===>> CAUTION here this changes the net heat flux received from
1379      !!             the atmosphere
1380      !!
1381      !!                  - the fluxes have been separated from the stress as
1382      !!                 (a) they are updated at each ice time step compare to
1383      !!                 an update at each coupled time step for the stress, and
1384      !!                 (b) the conservative computation of the fluxes over the
1385      !!                 sea-ice area requires the knowledge of the ice fraction
1386      !!                 after the ice advection and before the ice thermodynamics,
1387      !!                 so that the stress is updated before the ice dynamics
1388      !!                 while the fluxes are updated after it.
1389      !!
1390      !! ** Action  :   update at each nf_ice time step:
1391      !!                   qns_tot, qsr_tot  non-solar and solar total heat fluxes
1392      !!                   qns_ice, qsr_ice  non-solar and solar heat fluxes over the ice
1393      !!                   emp_tot            total evaporation - precipitation(liquid and solid) (-runoff)(-calving)
1394      !!                   emp_ice            ice sublimation - solid precipitation over the ice
1395      !!                   dqns_ice           d(non-solar heat flux)/d(Temperature) over the ice
1396      !!                   sprecip             solid precipitation over the ocean 
1397      !!----------------------------------------------------------------------
1398      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1]
1399      ! optional arguments, used only in 'mixed oce-ice' case
1400      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo
1401      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius]
1402      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin]
1403      !
1404      INTEGER ::   jl         ! dummy loop index
1405      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zicefr, zmsk
1406      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot
1407      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice
1408      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM3
1409      !!----------------------------------------------------------------------
1410      !
1411      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx')
1412      !
1413      CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )
1414      CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice )
1415
1416      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
1417      zicefr(:,:) = 1.- p_frld(:,:)
1418      zcptn(:,:) = rcp * sst_m(:,:)
1419      !
1420      !                                                      ! ========================= !
1421      !                                                      !    freshwater budget      !   (emp)
1422      !                                                      ! ========================= !
1423      !
1424      !                                                           ! total Precipitation - total Evaporation (emp_tot)
1425      !                                                           ! solid precipitation - sublimation       (emp_ice)
1426      !                                                           ! solid Precipitation                     (sprecip)
1427      !                                                           ! liquid + solid Precipitation            (tprecip)
1428      SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
1429      CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
1430         zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                  ! May need to ensure positive here
1431         ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here
1432         zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)
1433         zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)
1434            CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation
1435         IF( iom_use('hflx_rain_cea') )   &
1436            CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from liq. precip.
1437         IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') )   &
1438            ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)
1439         IF( iom_use('evap_ao_cea'  ) )   &
1440            CALL iom_put( 'evap_ao_cea'  , ztmp                   )   ! ice-free oce evap (cell average)
1441         IF( iom_use('hflx_evap_cea') )   &
1442            CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) )   ! heat flux from from evap (cell average)
1443      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
1444         zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
1445         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1)
1446         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1)
1447         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:)
1448      END SELECT
1449
1450      IF( iom_use('subl_ai_cea') )   &
1451         CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average)
1452      !   
1453      !                                                           ! runoffs and calving (put in emp_tot)
1454      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
1455      IF( srcv(jpr_cal)%laction ) THEN
1456         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
1457         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) )
1458      ENDIF
1459
1460      IF( ln_mixcpl ) THEN
1461         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
1462         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
1463         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
1464         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
1465      ELSE
1466         emp_tot(:,:) =                                  zemp_tot(:,:)
1467         emp_ice(:,:) =                                  zemp_ice(:,:)
1468         sprecip(:,:) =                                  zsprecip(:,:)
1469         tprecip(:,:) =                                  ztprecip(:,:)
1470      ENDIF
1471
1472         CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow
1473      IF( iom_use('snow_ao_cea') )   &
1474         CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:)             )   ! Snow        over ice-free ocean  (cell average)
1475      IF( iom_use('snow_ai_cea') )   &
1476         CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:)             )   ! Snow        over sea-ice         (cell average)
1477
1478      !                                                      ! ========================= !
1479      SELECT CASE( TRIM( sn_rcv_qns%cldes ) )                !   non solar heat fluxes   !   (qns)
1480      !                                                      ! ========================= !
1481      CASE( 'oce only' )                                     ! the required field is directly provided
1482         zqns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1)
1483      CASE( 'conservative' )                                      ! the required fields are directly provided
1484         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
1485         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
1486            zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
1487         ELSE
1488            ! Set all category values equal for the moment
1489            DO jl=1,jpl
1490               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
1491            ENDDO
1492         ENDIF
1493      CASE( 'oce and ice' )       ! the total flux is computed from ocean and ice fluxes
1494         zqns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
1495         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
1496            DO jl=1,jpl
1497               zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)   
1498               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
1499            ENDDO
1500         ELSE
1501            qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
1502            DO jl=1,jpl
1503               zqns_tot(:,:   ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
1504               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
1505            ENDDO
1506         ENDIF
1507      CASE( 'mixed oce-ice' )     ! the ice flux is cumputed from the total flux, the SST and ice informations
1508! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
1509         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
1510         zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    &
1511            &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   &
1512            &                                                   +          pist(:,:,1)   * zicefr(:,:) ) )
1513      END SELECT
1514!!gm
1515!!    currently it is taken into account in leads budget but not in the zqns_tot, and thus not in
1516!!    the flux that enter the ocean....
1517!!    moreover 1 - it is not diagnose anywhere....
1518!!             2 - it is unclear for me whether this heat lost is taken into account in the atmosphere or not...
1519!!
1520!! similar job should be done for snow and precipitation temperature
1521      !                                     
1522      IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting
1523         ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus               ! add the latent heat of iceberg melting
1524         zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:)
1525         IF( iom_use('hflx_cal_cea') )   &
1526            CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving
1527      ENDIF
1528
1529      ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus
1530      IF( iom_use('hflx_snow_cea') )    CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average)
1531
1532#if defined key_lim3
1533      CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 
1534
1535      ! --- evaporation --- !
1536      ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation
1537      ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice
1538      !                 but it is incoherent WITH the ice model 
1539      DO jl=1,jpl
1540         evap_ice(:,:,jl) = 0._wp  ! should be: frcv(jpr_ievp)%z3(:,:,1)
1541      ENDDO
1542      zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean
1543
1544      ! --- evaporation minus precipitation --- !
1545      emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:)
1546
1547      ! --- non solar flux over ocean --- !
1548      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax
1549      zqns_oce = 0._wp
1550      WHERE( p_frld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:)
1551
1552      ! --- heat flux associated with emp --- !
1553      zsnw(:,:) = 0._wp
1554      CALL lim_thd_snwblow( p_frld, zsnw )  ! snow distribution over ice after wind blowing
1555      zqemp_oce(:,:) = -      zevap(:,:)                   * p_frld(:,:)      *   zcptn(:,:)   &      ! evap
1556         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptn(:,:)   &      ! liquid precip
1557         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean
1558      qemp_ice(:,:)  = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptn(:,:)   &      ! ice evap
1559         &             +   zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice
1560
1561      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
1562      zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus )
1563
1564      ! --- total non solar flux --- !
1565      zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:)
1566
1567      ! --- in case both coupled/forced are active, we must mix values --- !
1568      IF( ln_mixcpl ) THEN
1569         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
1570         qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:)
1571         DO jl=1,jpl
1572            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:)
1573         ENDDO
1574         qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:)
1575         qemp_oce (:,:) =  qemp_oce(:,:) * xcplmask(:,:,0) +  zqemp_oce(:,:)* zmsk(:,:)
1576!!clem         evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0)
1577      ELSE
1578         qns_tot  (:,:  ) = zqns_tot  (:,:  )
1579         qns_oce  (:,:  ) = zqns_oce  (:,:  )
1580         qns_ice  (:,:,:) = zqns_ice  (:,:,:)
1581         qprec_ice(:,:)   = zqprec_ice(:,:)
1582         qemp_oce (:,:)   = zqemp_oce (:,:)
1583      ENDIF
1584
1585      CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 
1586#else
1587
1588      ! clem: this formulation is certainly wrong... but better than it was...
1589      zqns_tot(:,:) = zqns_tot(:,:)                       &            ! zqns_tot update over free ocean with:
1590         &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting
1591         &          - (  zemp_tot(:,:)                    &            ! remove the heat content of mass flux (assumed to be at SST)
1592         &             - zemp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:) 
1593
1594     IF( ln_mixcpl ) THEN
1595         qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
1596         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) +  zqns_tot(:,:)* zmsk(:,:)
1597         DO jl=1,jpl
1598            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:)
1599         ENDDO
1600      ELSE
1601         qns_tot(:,:  ) = zqns_tot(:,:  )
1602         qns_ice(:,:,:) = zqns_ice(:,:,:)
1603      ENDIF
1604
1605#endif
1606
1607      !                                                      ! ========================= !
1608      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )                !      solar heat fluxes    !   (qsr)
1609      !                                                      ! ========================= !
1610      CASE( 'oce only' )
1611         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
1612      CASE( 'conservative' )
1613         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
1614         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
1615            zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
1616         ELSE
1617            ! Set all category values equal for the moment
1618            DO jl=1,jpl
1619               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
1620            ENDDO
1621         ENDIF
1622         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
1623         zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
1624      CASE( 'oce and ice' )
1625         zqsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
1626         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
1627            DO jl=1,jpl
1628               zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)   
1629               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
1630            ENDDO
1631         ELSE
1632            qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
1633            DO jl=1,jpl
1634               zqsr_tot(:,:   ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
1635               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
1636            ENDDO
1637         ENDIF
1638      CASE( 'mixed oce-ice' )
1639         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
1640! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
1641!       Create solar heat flux over ice using incoming solar heat flux and albedos
1642!       ( see OASIS3 user guide, 5th edition, p39 )
1643         zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   &
1644            &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)       &
1645            &                     + palbi         (:,:,1) * zicefr(:,:) ) )
1646      END SELECT
1647      IF( ln_dm2dc .AND. ln_cpl ) THEN   ! modify qsr to include the diurnal cycle
1648         zqsr_tot(:,:  ) = sbc_dcy( zqsr_tot(:,:  ) )
1649         DO jl=1,jpl
1650            zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) )
1651         ENDDO
1652      ENDIF
1653
1654#if defined key_lim3
1655      CALL wrk_alloc( jpi,jpj, zqsr_oce ) 
1656      ! --- solar flux over ocean --- !
1657      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax
1658      zqsr_oce = 0._wp
1659      WHERE( p_frld /= 0._wp )  zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:)
1660
1661      IF( ln_mixcpl ) THEN   ;   qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) +  zqsr_oce(:,:)* zmsk(:,:)
1662      ELSE                   ;   qsr_oce(:,:) = zqsr_oce(:,:)   ;   ENDIF
1663
1664      CALL wrk_dealloc( jpi,jpj, zqsr_oce ) 
1665#endif
1666
1667      IF( ln_mixcpl ) THEN
1668         qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
1669         qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) +  zqsr_tot(:,:)* zmsk(:,:)
1670         DO jl=1,jpl
1671            qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) +  zqsr_ice(:,:,jl)* zmsk(:,:)
1672         ENDDO
1673      ELSE
1674         qsr_tot(:,:  ) = zqsr_tot(:,:  )
1675         qsr_ice(:,:,:) = zqsr_ice(:,:,:)
1676      ENDIF
1677
1678      !                                                      ! ========================= !
1679      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) )             !          d(qns)/dt        !
1680      !                                                      ! ========================= !
1681      CASE ('coupled')
1682         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
1683            zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
1684         ELSE
1685            ! Set all category values equal for the moment
1686            DO jl=1,jpl
1687               zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
1688            ENDDO
1689         ENDIF
1690      END SELECT
1691     
1692      IF( ln_mixcpl ) THEN
1693         DO jl=1,jpl
1694            dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)
1695         ENDDO
1696      ELSE
1697         dqns_ice(:,:,:) = zdqns_ice(:,:,:)
1698      ENDIF
1699     
1700      !                                                      ! ========================= !
1701      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !    topmelt and botmelt    !
1702      !                                                      ! ========================= !
1703      CASE ('coupled')
1704         topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:)
1705         botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:)
1706      END SELECT
1707
1708      ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 )
1709      ! Used for LIM2 and LIM3
1710      ! Coupled case: since cloud cover is not received from atmosphere
1711      !               ===> used prescribed cloud fraction representative for polar oceans in summer (0.81)
1712      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
1713      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
1714
1715      CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )
1716      CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice )
1717      !
1718      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_flx')
1719      !
1720   END SUBROUTINE sbc_cpl_ice_flx
1721   
1722   
1723   SUBROUTINE sbc_cpl_snd( kt )
1724      !!----------------------------------------------------------------------
1725      !!             ***  ROUTINE sbc_cpl_snd  ***
1726      !!
1727      !! ** Purpose :   provide the ocean-ice informations to the atmosphere
1728      !!
1729      !! ** Method  :   send to the atmosphere through a call to cpl_snd
1730      !!              all the needed fields (as defined in sbc_cpl_init)
1731      !!----------------------------------------------------------------------
1732      INTEGER, INTENT(in) ::   kt
1733      !
1734      INTEGER ::   ji, jj, jl   ! dummy loop indices
1735      INTEGER ::   ikchoix
1736      INTEGER ::   isec, info   ! local integer
1737      REAL(wp) ::   zumax, zvmax
1738      REAL(wp), POINTER, DIMENSION(:,:)   ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
1739      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmp3, ztmp4   
1740      !!----------------------------------------------------------------------
1741      !
1742      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_snd')
1743      !
1744      CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
1745      CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 )
1746
1747      isec = ( kt - nit000 ) * NINT(rdttra(1))        ! date of exchanges
1748
1749      zfr_l(:,:) = 1.- fr_i(:,:)
1750      !                                                      ! ------------------------- !
1751      !                                                      !    Surface temperature    !   in Kelvin
1752      !                                                      ! ------------------------- !
1753      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
1754         
1755         IF ( nn_components == jp_iam_opa ) THEN
1756            ztmp1(:,:) = tsn(:,:,1,jp_tem)   ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part
1757         ELSE
1758            ! we must send the surface potential temperature
1759            IF( ln_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
1760            ELSE                    ;   ztmp1(:,:) = tsn(:,:,1,jp_tem)
1761            ENDIF
1762            !
1763            SELECT CASE( sn_snd_temp%cldes)
1764            CASE( 'oce only'             )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0
1765            CASE( 'oce and ice'          )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0
1766               SELECT CASE( sn_snd_temp%clcat )
1767               CASE( 'yes' )   
1768                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl)
1769               CASE( 'no' )
1770                  WHERE( SUM( a_i, dim=3 ) /= 0. )
1771                     ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 )
1772                  ELSEWHERE
1773                     ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?)
1774                  END WHERE
1775               CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
1776               END SELECT
1777            CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)   
1778               SELECT CASE( sn_snd_temp%clcat )
1779               CASE( 'yes' )   
1780                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
1781               CASE( 'no' )
1782                  ztmp3(:,:,:) = 0.0
1783                  DO jl=1,jpl
1784                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
1785                  ENDDO
1786               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
1787               END SELECT
1788            CASE( 'mixed oce-ice'        )   
1789               ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 
1790               DO jl=1,jpl
1791                  ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
1792               ENDDO
1793            CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
1794            END SELECT
1795         ENDIF
1796         IF( ssnd(jps_toce)%laction )   CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
1797         IF( ssnd(jps_tice)%laction )   CALL cpl_snd( jps_tice, isec, ztmp3, info )
1798         IF( ssnd(jps_tmix)%laction )   CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
1799      ENDIF
1800      !                                                      ! ------------------------- !
1801      !                                                      !           Albedo          !
1802      !                                                      ! ------------------------- !
1803      IF( ssnd(jps_albice)%laction ) THEN                         ! ice
1804         SELECT CASE( sn_snd_alb%cldes )
1805         CASE( 'ice'          )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
1806         CASE( 'weighted ice' )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
1807         CASE default             ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' )
1808         END SELECT
1809         CALL cpl_snd( jps_albice, isec, ztmp3, info )
1810      ENDIF
1811      IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean
1812         ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:)
1813         DO jl=1,jpl
1814            ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl)
1815         ENDDO
1816         CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
1817      ENDIF
1818      !                                                      ! ------------------------- !
1819      !                                                      !  Ice fraction & Thickness !
1820      !                                                      ! ------------------------- !
1821      ! Send ice fraction field to atmosphere
1822      IF( ssnd(jps_fice)%laction ) THEN
1823         SELECT CASE( sn_snd_thick%clcat )
1824         CASE( 'yes' )   ;   ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl)
1825         CASE( 'no'  )   ;   ztmp3(:,:,1    ) = fr_i(:,:      )
1826         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
1827         END SELECT
1828         IF( ssnd(jps_fice)%laction )   CALL cpl_snd( jps_fice, isec, ztmp3, info )
1829      ENDIF
1830     
1831      ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling)
1832      IF( ssnd(jps_fice2)%laction ) THEN
1833         ztmp3(:,:,1) = fr_i(:,:)
1834         IF( ssnd(jps_fice2)%laction )   CALL cpl_snd( jps_fice2, isec, ztmp3, info )
1835      ENDIF
1836
1837      ! Send ice and snow thickness field
1838      IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN
1839         SELECT CASE( sn_snd_thick%cldes)
1840         CASE( 'none'                  )       ! nothing to do
1841         CASE( 'weighted ice and snow' )   
1842            SELECT CASE( sn_snd_thick%clcat )
1843            CASE( 'yes' )   
1844               ztmp3(:,:,1:jpl) =  ht_i(:,:,1:jpl) * a_i(:,:,1:jpl)
1845               ztmp4(:,:,1:jpl) =  ht_s(:,:,1:jpl) * a_i(:,:,1:jpl)
1846            CASE( 'no' )
1847               ztmp3(:,:,:) = 0.0   ;  ztmp4(:,:,:) = 0.0
1848               DO jl=1,jpl
1849                  ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl)
1850                  ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl)
1851               ENDDO
1852            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
1853            END SELECT
1854         CASE( 'ice and snow'         )   
1855            SELECT CASE( sn_snd_thick%clcat )
1856            CASE( 'yes' )
1857               ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl)
1858               ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl)
1859            CASE( 'no' )
1860               WHERE( SUM( a_i, dim=3 ) /= 0. )
1861                  ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 )
1862                  ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 )
1863               ELSEWHERE
1864                 ztmp3(:,:,1) = 0.
1865                 ztmp4(:,:,1) = 0.
1866               END WHERE
1867            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
1868            END SELECT
1869         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' )
1870         END SELECT
1871         IF( ssnd(jps_hice)%laction )   CALL cpl_snd( jps_hice, isec, ztmp3, info )
1872         IF( ssnd(jps_hsnw)%laction )   CALL cpl_snd( jps_hsnw, isec, ztmp4, info )
1873      ENDIF
1874      !
1875#if defined key_cpl_carbon_cycle
1876      !                                                      ! ------------------------- !
1877      !                                                      !  CO2 flux from PISCES     !
1878      !                                                      ! ------------------------- !
1879      IF( ssnd(jps_co2)%laction )   CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )
1880      !
1881#endif
1882      !                                                      ! ------------------------- !
1883      IF( ssnd(jps_ocx1)%laction ) THEN                      !      Surface current      !
1884         !                                                   ! ------------------------- !
1885         !   
1886         !                                                  j+1   j     -----V---F
1887         ! surface velocity always sent from T point                     !       |
1888         ! [except for HadGEM3]                                   j      |   T   U
1889         !                                                               |       |
1890         !                                                   j    j-1   -I-------|
1891         !                                               (for I)         |       |
1892         !                                                              i-1  i   i
1893         !                                                               i      i+1 (for I)
1894         IF( nn_components == jp_iam_opa ) THEN
1895            zotx1(:,:) = un(:,:,1) 
1896            zoty1(:,:) = vn(:,:,1) 
1897         ELSE       
1898            SELECT CASE( TRIM( sn_snd_crt%cldes ) )
1899            CASE( 'oce only'             )      ! C-grid ==> T
1900               IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN
1901                  DO jj = 2, jpjm1
1902                     DO ji = fs_2, fs_jpim1   ! vector opt.
1903                        zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) )
1904                        zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) ) 
1905                     END DO
1906                  END DO
1907               ELSE
1908! Temporarily Changed for UKV
1909                  DO jj = 2, jpjm1
1910                     DO ji = 2, jpim1
1911                        zotx1(ji,jj) = un(ji,jj,1)
1912                        zoty1(ji,jj) = vn(ji,jj,1)
1913                     END DO
1914                  END DO
1915               ENDIF
1916            CASE( 'weighted oce and ice' )   
1917               SELECT CASE ( cp_ice_msh )
1918               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
1919                  DO jj = 2, jpjm1
1920                     DO ji = fs_2, fs_jpim1   ! vector opt.
1921                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj) 
1922                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)
1923                        zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
1924                        zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
1925                     END DO
1926                  END DO
1927               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T
1928                  DO jj = 2, jpjm1
1929                     DO ji = 2, jpim1   ! NO vector opt.
1930                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj) 
1931                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj) 
1932                        zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     &
1933                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
1934                        zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     &
1935                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
1936                     END DO
1937                  END DO
1938               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T
1939                  DO jj = 2, jpjm1
1940                     DO ji = 2, jpim1   ! NO vector opt.
1941                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj) 
1942                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj) 
1943                        zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &
1944                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
1945                        zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &
1946                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
1947                     END DO
1948                  END DO
1949               END SELECT
1950               CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. )
1951            CASE( 'mixed oce-ice'        )
1952               SELECT CASE ( cp_ice_msh )
1953               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
1954                  DO jj = 2, jpjm1
1955                     DO ji = fs_2, fs_jpim1   ! vector opt.
1956                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   &
1957                           &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
1958                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   &
1959                           &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
1960                     END DO
1961                  END DO
1962               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T
1963                  DO jj = 2, jpjm1
1964                     DO ji = 2, jpim1   ! NO vector opt.
1965                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &   
1966                           &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     &
1967                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
1968                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
1969                           &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     &
1970                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
1971                     END DO
1972                  END DO
1973               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T
1974                  IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN
1975                     DO jj = 2, jpjm1
1976                        DO ji = 2, jpim1   ! NO vector opt.
1977                           zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj,1) ) * zfr_l(ji,jj)   &   
1978                                &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &
1979                                &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
1980                           zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji,jj-1,1) ) * zfr_l(ji,jj)   &
1981                                &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &
1982                                &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
1983                       END DO
1984#if defined key_cice
1985                  ELSE
1986! Temporarily Changed for HadGEM3
1987                     DO jj = 2, jpjm1
1988                        DO ji = 2, jpim1   ! NO vector opt.
1989                           zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1)             &
1990                                &              + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) ) 
1991                           zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1)             &
1992                                &              + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) ) 
1993                        END DO
1994                     END DO
1995#endif
1996                  ENDIF
1997               END SELECT
1998            END SELECT
1999            CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. )
2000            !
2001         ENDIF
2002         !
2003         !
2004         IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components
2005            !                                                                     ! Ocean component
2006            IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN
2007               CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component
2008               CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component
2009               zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components
2010               zoty1(:,:) = ztmp2(:,:)
2011               IF( ssnd(jps_ivx1)%laction ) THEN                                  ! Ice component
2012                  CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component
2013                  CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component
2014                  zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components
2015                  zity1(:,:) = ztmp2(:,:)
2016               ENDIF
2017            ELSE
2018               ! Temporary code for HadGEM3 - will be removed eventually.
2019               ! Only applies when we want uvel on U grid and vvel on V grid
2020               ! Rotate U and V onto geographic grid before sending.
2021
2022               DO jj=2,jpjm1
2023                  DO ji=2,jpim1
2024                     ztmp1(ji,jj)=0.25*vmask(ji,jj,1)                  &
2025                          *(zotx1(ji,jj)+zotx1(ji-1,jj)    &
2026                          +zotx1(ji,jj+1)+zotx1(ji-1,jj+1))
2027                     ztmp2(ji,jj)=0.25*umask(ji,jj,1)                  &
2028                          *(zoty1(ji,jj)+zoty1(ji+1,jj)    &
2029                          +zoty1(ji,jj-1)+zoty1(ji+1,jj-1))
2030                  ENDDO
2031               ENDDO
2032               
2033               ! Ensure any N fold and wrap columns are updated
2034               CALL lbc_lnk(ztmp1, 'V', -1.0)
2035               CALL lbc_lnk(ztmp2, 'U', -1.0)
2036               
2037               ikchoix = -1
2038               CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix)
2039           ENDIF
2040         ENDIF
2041         !
2042         ! spherical coordinates to cartesian -> 2 components to 3 components
2043         IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN
2044            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents
2045            ztmp2(:,:) = zoty1(:,:)
2046            CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
2047            !
2048            IF( ssnd(jps_ivx1)%laction ) THEN           ! ice velocities
2049               ztmp1(:,:) = zitx1(:,:)
2050               ztmp1(:,:) = zity1(:,:)
2051               CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
2052            ENDIF
2053         ENDIF
2054         !
2055         IF( ssnd(jps_ocx1)%laction )   CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid
2056         IF( ssnd(jps_ocy1)%laction )   CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid
2057         IF( ssnd(jps_ocz1)%laction )   CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid
2058         !
2059         IF( ssnd(jps_ivx1)%laction )   CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid
2060         IF( ssnd(jps_ivy1)%laction )   CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid
2061         IF( ssnd(jps_ivz1)%laction )   CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid
2062         !
2063      ENDIF
2064      !
2065      !
2066      !  Fields sent by OPA to SAS when doing OPA<->SAS coupling
2067      !                                                        ! SSH
2068      IF( ssnd(jps_ssh )%laction )  THEN
2069         !                          ! removed inverse barometer ssh when Patm
2070         !                          forcing is used (for sea-ice dynamics)
2071         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
2072         ELSE                    ;   ztmp1(:,:) = sshn(:,:)
2073         ENDIF
2074         CALL cpl_snd( jps_ssh   , isec, RESHAPE ( ztmp1            , (/jpi,jpj,1/) ), info )
2075
2076      ENDIF
2077      !                                                        ! SSS
2078      IF( ssnd(jps_soce  )%laction )  THEN
2079         CALL cpl_snd( jps_soce  , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info )
2080      ENDIF
2081      !                                                        ! first T level thickness
2082      IF( ssnd(jps_e3t1st )%laction )  THEN
2083         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1)   , (/jpi,jpj,1/) ), info )
2084      ENDIF
2085      !                                                        ! Qsr fraction
2086      IF( ssnd(jps_fraqsr)%laction )  THEN
2087         CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info )
2088      ENDIF
2089      !
2090      !  Fields sent by SAS to OPA when OASIS coupling
2091      !                                                        ! Solar heat flux
2092      IF( ssnd(jps_qsroce)%laction )  CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info )
2093      IF( ssnd(jps_qnsoce)%laction )  CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info )
2094      IF( ssnd(jps_oemp  )%laction )  CALL cpl_snd( jps_oemp  , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info )
2095      IF( ssnd(jps_sflx  )%laction )  CALL cpl_snd( jps_sflx  , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info )
2096      IF( ssnd(jps_otx1  )%laction )  CALL cpl_snd( jps_otx1  , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info )
2097      IF( ssnd(jps_oty1  )%laction )  CALL cpl_snd( jps_oty1  , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info )
2098      IF( ssnd(jps_rnf   )%laction )  CALL cpl_snd( jps_rnf   , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info )
2099      IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info )
2100
2101      CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
2102      CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )
2103      !
2104      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_snd')
2105      !
2106   END SUBROUTINE sbc_cpl_snd
2107   
2108   !!======================================================================
2109END MODULE sbccpl
Note: See TracBrowser for help on using the repository browser.