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

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

source: branches/UKMO/dev_r5377_UKMO1_CICE_coupling_GSI7/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 5391

Last change on this file since 5391 was 5391, checked in by jamrae, 9 years ago

Corrected an error.

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