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 NEMO/trunk/src/OCE/SBC – NEMO

source: NEMO/trunk/src/OCE/SBC/sbccpl.F90 @ 15267

Last change on this file since 15267 was 15004, checked in by mathiot, 3 years ago

ticket #2960: commit fix to the trunk (WARNING: output convention of isf fluxes changed from oce->isf to isf->oce), no impact on the input file needed for some options

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