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

source: branches/UKMO/r6232_new_runoff_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 11452

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

Changes as in the original branch, plus one bug fix in oce.F90, plus changes to run with the branch but in uncoupled mode - although this is not complete yet

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