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

source: branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 2292

Last change on this file since 2292 was 2292, checked in by smasson, 13 years ago

update DEV_r1879_FCM for additional tests...

  • Property svn:keywords set to Id
File size: 87.5 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  !  06-2007  (R. Redler, N. Keenlyside, W. Park) Original code split into flxmod & taumod
7   !!            3.0  !  02-2008  (G. Madec, C Talandier)  surface module
8   !!            3.1  !  02-2009  (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface
9   !!----------------------------------------------------------------------
10#if defined key_oasis3 || defined key_oasis4
11   !!----------------------------------------------------------------------
12   !!   'key_oasis3' or 'key_oasis4'   Coupled Ocean/Atmosphere formulation
13   !!----------------------------------------------------------------------
14   !!   namsbc_cpl      : coupled formulation namlist
15   !!   sbc_cpl_init    : initialisation of the coupled exchanges
16   !!   sbc_cpl_rcv     : receive fields from the atmosphere over the ocean (ocean only)
17   !!                     receive stress from the atmosphere over the ocean (ocean-ice case)
18   !!   sbc_cpl_ice_tau : receive stress from the atmosphere over ice
19   !!   sbc_cpl_ice_flx : receive fluxes from the atmosphere over ice
20   !!   sbc_cpl_snd     : send     fields to the atmosphere
21   !!----------------------------------------------------------------------
22   USE dom_oce         ! ocean space and time domain
23   USE sbc_oce         ! Surface boundary condition: ocean fields
24   USE sbc_ice         ! Surface boundary condition: ice fields
25   USE sbcdcy          ! surface boundary condition: diurnal cycle
26   USE phycst          ! physical constants
27#if defined key_lim3
28   USE par_ice         ! ice parameters
29#endif
30#if defined key_lim2
31   USE par_ice_2       ! ice parameters
32   USE ice_2           ! ice variables
33#endif
34#if defined key_oasis3
35   USE cpl_oasis3      ! OASIS3 coupling
36#endif
37#if defined key_oasis4
38   USE cpl_oasis4      ! OASIS4 coupling
39#endif
40   USE geo2ocean       !
41   USE restart         !
42   USE oce   , ONLY : tn, un, vn
43   USE albedo          !
44   USE in_out_manager  ! I/O manager
45   USE iom             ! NetCDF library
46   USE lib_mpp         ! distribued memory computing library
47   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
48#if defined key_cpl_carbon_cycle
49   USE p4zflx, ONLY : oce_co2
50#endif
51   USE diaar5, ONLY :   lk_diaar5
52   IMPLICIT NONE
53   PRIVATE
54
55   PUBLIC   sbc_cpl_rcv       ! routine called by sbc_ice_lim(_2).F90
56   PUBLIC   sbc_cpl_snd       ! routine called by step.F90
57   PUBLIC   sbc_cpl_ice_tau   ! routine called by sbc_ice_lim(_2).F90
58   PUBLIC   sbc_cpl_ice_flx   ! routine called by sbc_ice_lim(_2).F90
59   
60   INTEGER, PARAMETER ::   jpr_otx1   =  1            ! 3 atmosphere-ocean stress components on grid 1
61   INTEGER, PARAMETER ::   jpr_oty1   =  2            !
62   INTEGER, PARAMETER ::   jpr_otz1   =  3            !
63   INTEGER, PARAMETER ::   jpr_otx2   =  4            ! 3 atmosphere-ocean stress components on grid 2
64   INTEGER, PARAMETER ::   jpr_oty2   =  5            !
65   INTEGER, PARAMETER ::   jpr_otz2   =  6            !
66   INTEGER, PARAMETER ::   jpr_itx1   =  7            ! 3 atmosphere-ice   stress components on grid 1
67   INTEGER, PARAMETER ::   jpr_ity1   =  8            !
68   INTEGER, PARAMETER ::   jpr_itz1   =  9            !
69   INTEGER, PARAMETER ::   jpr_itx2   = 10            ! 3 atmosphere-ice   stress components on grid 2
70   INTEGER, PARAMETER ::   jpr_ity2   = 11            !
71   INTEGER, PARAMETER ::   jpr_itz2   = 12            !
72   INTEGER, PARAMETER ::   jpr_qsroce = 13            ! Qsr above the ocean
73   INTEGER, PARAMETER ::   jpr_qsrice = 14            ! Qsr above the ice
74   INTEGER, PARAMETER ::   jpr_qsrmix = 15 
75   INTEGER, PARAMETER ::   jpr_qnsoce = 16            ! Qns above the ocean
76   INTEGER, PARAMETER ::   jpr_qnsice = 17            ! Qns above the ice
77   INTEGER, PARAMETER ::   jpr_qnsmix = 18
78   INTEGER, PARAMETER ::   jpr_rain   = 19            ! total liquid precipitation (rain)
79   INTEGER, PARAMETER ::   jpr_snow   = 20            ! solid precipitation over the ocean (snow)
80   INTEGER, PARAMETER ::   jpr_tevp   = 21            ! total evaporation
81   INTEGER, PARAMETER ::   jpr_ievp   = 22            ! solid evaporation (sublimation)
82   INTEGER, PARAMETER ::   jpr_sbpr   = 23            ! sublimation - liquid precipitation - solid precipitation
83   INTEGER, PARAMETER ::   jpr_semp   = 24            ! solid freshwater budget (sublimation - snow)
84   INTEGER, PARAMETER ::   jpr_oemp   = 25            ! ocean freshwater budget (evap - precip)
85   INTEGER, PARAMETER ::   jpr_w10m   = 26            ! 10m wind
86   INTEGER, PARAMETER ::   jpr_dqnsdt = 27            ! d(Q non solar)/d(temperature)
87   INTEGER, PARAMETER ::   jpr_rnf    = 28            ! runoffs
88   INTEGER, PARAMETER ::   jpr_cal    = 29            ! calving
89   INTEGER, PARAMETER ::   jpr_taum   = 30            ! wind stress module
90#if ! defined key_cpl_carbon_cycle
91   INTEGER, PARAMETER ::   jprcv      = 30            ! total number of fields received
92#else
93   INTEGER, PARAMETER ::   jpr_co2    = 31
94   INTEGER, PARAMETER ::   jprcv      = 31            ! total number of fields received
95#endif   
96   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction
97   INTEGER, PARAMETER ::   jps_toce   =  2            ! ocean temperature
98   INTEGER, PARAMETER ::   jps_tice   =  3            ! ice   temperature
99   INTEGER, PARAMETER ::   jps_tmix   =  4            ! mixed temperature (ocean+ice)
100   INTEGER, PARAMETER ::   jps_albice =  5            ! ice   albedo
101   INTEGER, PARAMETER ::   jps_albmix =  6            ! mixed albedo
102   INTEGER, PARAMETER ::   jps_hice   =  7            ! ice  thickness
103   INTEGER, PARAMETER ::   jps_hsnw   =  8            ! snow thickness
104   INTEGER, PARAMETER ::   jps_ocx1   =  9            ! ocean current on grid 1
105   INTEGER, PARAMETER ::   jps_ocy1   = 10            !
106   INTEGER, PARAMETER ::   jps_ocz1   = 11            !
107   INTEGER, PARAMETER ::   jps_ivx1   = 12            ! ice   current on grid 1
108   INTEGER, PARAMETER ::   jps_ivy1   = 13            !
109   INTEGER, PARAMETER ::   jps_ivz1   = 14            !
110#if ! defined key_cpl_carbon_cycle
111   INTEGER, PARAMETER ::   jpsnd      = 14            ! total number of fields sended
112#else
113   INTEGER, PARAMETER ::   jps_co2    = 15
114   INTEGER, PARAMETER ::   jpsnd      = 15            ! total number of fields sended
115#endif   
116   !                                                         !!** namelist namsbc_cpl **
117   ! Send to the atmosphere                                   !
118   CHARACTER(len=100) ::   cn_snd_temperature = 'oce only'    ! 'oce only' 'weighted oce and ice' or 'mixed oce-ice'
119   CHARACTER(len=100) ::   cn_snd_albedo      = 'none'        ! 'none' 'weighted ice' or 'mixed oce-ice'
120   CHARACTER(len=100) ::   cn_snd_thickness   = 'none'        ! 'none' or 'weighted ice and snow'
121   CHARACTER(len=100) ::   cn_snd_crt_nature  = 'none'        ! 'none' 'oce only' 'weighted oce and ice' or 'mixed oce-ice'   
122   CHARACTER(len=100) ::   cn_snd_crt_refere  = 'spherical'   ! 'spherical' or 'cartesian'
123   CHARACTER(len=100) ::   cn_snd_crt_orient  = 'local grid'  ! 'eastward-northward' or 'local grid'
124   CHARACTER(len=100) ::   cn_snd_crt_grid    = 'T'           ! always at 'T' point
125#if defined key_cpl_carbon_cycle 
126   CHARACTER(len=100) ::   cn_snd_co2         = 'none'        ! 'none' or 'coupled'
127#endif
128   ! Received from the atmosphere                             !
129   CHARACTER(len=100) ::   cn_rcv_tau_nature  = 'oce only'    ! 'oce only' 'oce and ice' or 'mixed oce-ice'
130   CHARACTER(len=100) ::   cn_rcv_tau_refere  = 'spherical'   ! 'spherical' or 'cartesian'
131   CHARACTER(len=100) ::   cn_rcv_tau_orient  = 'local grid'  ! 'eastward-northward' or 'local grid'
132   CHARACTER(len=100) ::   cn_rcv_tau_grid    = 'T'           ! 'T', 'U,V', 'U,V,I', 'T,I', or 'T,U,V'
133   CHARACTER(len=100) ::   cn_rcv_w10m        = 'none'        ! 'none' or 'coupled'
134   CHARACTER(len=100) ::   cn_rcv_dqnsdt      = 'none'        ! 'none' or 'coupled'
135   CHARACTER(len=100) ::   cn_rcv_qsr         = 'oce only'    ! 'oce only' 'conservative' 'oce and ice' or 'mixed oce-ice'
136   CHARACTER(len=100) ::   cn_rcv_qns         = 'oce only'    ! 'oce only' 'conservative' 'oce and ice' or 'mixed oce-ice'
137   CHARACTER(len=100) ::   cn_rcv_emp         = 'oce only'    ! 'oce only' 'conservative' or 'oce and ice'
138   CHARACTER(len=100) ::   cn_rcv_rnf         = 'coupled'     ! 'coupled' 'climato' or 'mixed'
139   CHARACTER(len=100) ::   cn_rcv_cal         = 'none'        ! 'none' or 'coupled'
140   CHARACTER(len=100) ::   cn_rcv_taumod      = 'none'        ! 'none' or 'coupled'
141#if defined key_cpl_carbon_cycle 
142   CHARACTER(len=100) ::   cn_rcv_co2         = 'none'        ! 'none' or 'coupled'
143#endif
144
145!!   CHARACTER(len=100), PUBLIC ::   cn_rcv_rnf   !: ???             ==>>  !!gm   treat this case in a different maner
146   
147   CHARACTER(len=100), DIMENSION(4) ::   cn_snd_crt           ! array combining cn_snd_crt_*
148   CHARACTER(len=100), DIMENSION(4) ::   cn_rcv_tau           ! array combining cn_rcv_tau_*
149
150   REAL(wp), DIMENSION(jpi,jpj)       ::   albedo_oce_mix     ! ocean albedo sent to atmosphere (mix clear/overcast sky)
151
152   REAL(wp), DIMENSION(jpi,jpj,jprcv) ::   frcv               ! all fields recieved from the atmosphere
153   INTEGER , DIMENSION(        jprcv) ::   nrcvinfo           ! OASIS info argument
154
155#if ! defined key_lim2 && ! defined key_lim3
156   ! quick patch to be able to run the coupled model without sea-ice...
157   INTEGER, PARAMETER               ::   jpl = 1 
158   REAL(wp), DIMENSION(jpi,jpj    ) ::   hicif, hsnif, u_ice, v_ice,fr1_i0,fr2_i0
159   REAL(wp), DIMENSION(jpi,jpj,jpl) ::   tn_ice, alb_ice
160   REAL(wp)                         ::  lfus
161#endif
162
163   !! Substitution
164#  include "vectopt_loop_substitute.h90"
165   !!----------------------------------------------------------------------
166   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008)
167   !! $Id$
168   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
169   !!----------------------------------------------------------------------
170
171CONTAINS
172 
173   SUBROUTINE sbc_cpl_init( k_ice )     
174      !!----------------------------------------------------------------------
175      !!             ***  ROUTINE sbc_cpl_init  ***
176      !!
177      !! ** Purpose :   Initialisation of send and recieved information from
178      !!                the atmospheric component
179      !!
180      !! ** Method  : * Read namsbc_cpl namelist
181      !!              * define the receive interface
182      !!              * define the send    interface
183      !!              * initialise the OASIS coupler
184      !!----------------------------------------------------------------------
185      INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3)
186      !!
187      INTEGER                      ::   jn           ! dummy loop index
188      REAL(wp), DIMENSION(jpi,jpj) ::   zacs, zaos   ! 2D workspace (clear & overcast sky albedos)
189      !!
190      NAMELIST/namsbc_cpl/  cn_snd_temperature, cn_snd_albedo    , cn_snd_thickness,                 &         
191         cn_snd_crt_nature, cn_snd_crt_refere , cn_snd_crt_orient, cn_snd_crt_grid ,                 &
192         cn_rcv_w10m      , cn_rcv_taumod     ,                                                      &
193         cn_rcv_tau_nature, cn_rcv_tau_refere , cn_rcv_tau_orient, cn_rcv_tau_grid ,                 &
194         cn_rcv_dqnsdt    , cn_rcv_qsr        , cn_rcv_qns       , cn_rcv_emp      , cn_rcv_rnf , cn_rcv_cal
195#if defined key_cpl_carbon_cycle 
196      NAMELIST/namsbc_cpl_co2/  cn_snd_co2, cn_rcv_co2
197#endif
198      !!---------------------------------------------------------------------
199
200      ! ================================ !
201      !      Namelist informations       !
202      ! ================================ !
203
204      REWIND( numnam )                    ! ... read namlist namsbc_cpl
205      READ  ( numnam, namsbc_cpl )
206
207      IF(lwp) THEN                        ! control print
208         WRITE(numout,*)
209         WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist '
210         WRITE(numout,*)'~~~~~~~~~~~~'
211         WRITE(numout,*)'   received fields'
212         WRITE(numout,*)'       10m wind module                    cn_rcv_w10m        = ', cn_rcv_w10m 
213         WRITE(numout,*)'       surface stress - nature            cn_rcv_tau_nature  = ', cn_rcv_tau_nature
214         WRITE(numout,*)'                      - referential       cn_rcv_tau_refere  = ', cn_rcv_tau_refere
215         WRITE(numout,*)'                      - orientation       cn_rcv_tau_orient  = ', cn_rcv_tau_orient
216         WRITE(numout,*)'                      - mesh              cn_rcv_tau_grid    = ', cn_rcv_tau_grid
217         WRITE(numout,*)'       non-solar heat flux sensitivity    cn_rcv_dqnsdt      = ', cn_rcv_dqnsdt
218         WRITE(numout,*)'       solar heat flux                    cn_rcv_qsr         = ', cn_rcv_qsr 
219         WRITE(numout,*)'       non-solar heat flux                cn_rcv_qns         = ', cn_rcv_qns
220         WRITE(numout,*)'       freshwater budget                  cn_rcv_emp         = ', cn_rcv_emp
221         WRITE(numout,*)'       runoffs                            cn_rcv_rnf         = ', cn_rcv_rnf
222         WRITE(numout,*)'       calving                            cn_rcv_cal         = ', cn_rcv_cal 
223         WRITE(numout,*)'       stress module                      cn_rcv_taumod      = ', cn_rcv_taumod
224         WRITE(numout,*)'   sent fields'
225         WRITE(numout,*)'       surface temperature                cn_snd_temperature = ', cn_snd_temperature
226         WRITE(numout,*)'       albedo                             cn_snd_albedo      = ', cn_snd_albedo
227         WRITE(numout,*)'       ice/snow thickness                 cn_snd_thickness   = ', cn_snd_thickness 
228         WRITE(numout,*)'       surface current - nature           cn_snd_crt_nature  = ', cn_snd_crt_nature 
229         WRITE(numout,*)'                       - referential      cn_snd_crt_refere  = ', cn_snd_crt_refere 
230         WRITE(numout,*)'                       - orientation      cn_snd_crt_orient  = ', cn_snd_crt_orient
231         WRITE(numout,*)'                       - mesh             cn_snd_crt_grid    = ', cn_snd_crt_grid 
232      ENDIF
233
234#if defined key_cpl_carbon_cycle 
235      REWIND( numnam )                    ! ... read namlist namsbc_cpl_co2
236      READ  ( numnam, namsbc_cpl_co2 )
237      IF(lwp) THEN                        ! control print
238         WRITE(numout,*)
239         WRITE(numout,*)'sbc_cpl_init : namsbc_cpl_co2 namelist '
240         WRITE(numout,*)'~~~~~~~~~~~~'
241         WRITE(numout,*)'   received fields'
242         WRITE(numout,*)'       atm co2                            cn_rcv_co2         = ', cn_rcv_co2
243         WRITE(numout,*)'   sent fields'
244         WRITE(numout,*)'      oce co2 flux                        cn_snd_co2         = ', cn_snd_co2
245          WRITE(numout,*)
246      ENDIF
247#endif
248      ! save current & stress in an array and suppress possible blank in the name
249      cn_snd_crt(1) = TRIM( cn_snd_crt_nature )   ;   cn_snd_crt(2) = TRIM( cn_snd_crt_refere )
250      cn_snd_crt(3) = TRIM( cn_snd_crt_orient )   ;   cn_snd_crt(4) = TRIM( cn_snd_crt_grid   )
251      cn_rcv_tau(1) = TRIM( cn_rcv_tau_nature )   ;   cn_rcv_tau(2) = TRIM( cn_rcv_tau_refere )
252      cn_rcv_tau(3) = TRIM( cn_rcv_tau_orient )   ;   cn_rcv_tau(4) = TRIM( cn_rcv_tau_grid   )
253     
254      ! ================================ !
255      !   Define the receive interface   !
256      ! ================================ !
257      nrcvinfo(:) = OASIS_idle   ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress
258
259      ! for each field: define the OASIS name                              (srcv(:)%clname)
260      !                 define receive or not from the namelist parameters (srcv(:)%laction)
261      !                 define the north fold type of lbc                  (srcv(:)%nsgn)
262
263      ! default definitions of srcv
264      srcv(:)%laction = .FALSE.   ;   srcv(:)%clgrid = 'T'   ;   srcv(:)%nsgn = 1.
265
266      !                                                      ! ------------------------- !
267      !                                                      ! ice and ocean wind stress !   
268      !                                                      ! ------------------------- !
269      !                                                           ! Name
270      srcv(jpr_otx1)%clname = 'O_OTaux1'      ! 1st ocean component on grid ONE (T or U)
271      srcv(jpr_oty1)%clname = 'O_OTauy1'      ! 2nd   -      -         -     -
272      srcv(jpr_otz1)%clname = 'O_OTauz1'      ! 3rd   -      -         -     -
273      srcv(jpr_otx2)%clname = 'O_OTaux2'      ! 1st ocean component on grid TWO (V)
274      srcv(jpr_oty2)%clname = 'O_OTauy2'      ! 2nd   -      -         -     -
275      srcv(jpr_otz2)%clname = 'O_OTauz2'      ! 3rd   -      -         -     -
276      !
277      srcv(jpr_itx1)%clname = 'O_ITaux1'      ! 1st  ice  component on grid ONE (T, F, I or U)
278      srcv(jpr_ity1)%clname = 'O_ITauy1'      ! 2nd   -      -         -     -
279      srcv(jpr_itz1)%clname = 'O_ITauz1'      ! 3rd   -      -         -     -
280      srcv(jpr_itx2)%clname = 'O_ITaux2'      ! 1st  ice  component on grid TWO (V)
281      srcv(jpr_ity2)%clname = 'O_ITauy2'      ! 2nd   -      -         -     -
282      srcv(jpr_itz2)%clname = 'O_ITauz2'      ! 3rd   -      -         -     -
283      !
284      ! Vectors: change of sign at north fold ONLY if on the local grid
285      IF( TRIM( cn_rcv_tau(3) ) == 'local grid' )   srcv(jpr_otx1:jpr_itz2)%nsgn = -1.
286     
287      !                                                           ! Set grid and action
288      SELECT CASE( TRIM( cn_rcv_tau(4) ) )      !  'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V'
289      CASE( 'T' ) 
290         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point
291         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1
292         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1
293      CASE( 'U,V' ) 
294         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
295         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
296         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'U'        ! ice components given at U-point
297         srcv(jpr_itx2:jpr_itz2)%clgrid  = 'V'        !           and           V-point
298         srcv(jpr_otx1:jpr_itz2)%laction = .TRUE.     ! receive oce and ice components on both grid 1 & 2
299      CASE( 'U,V,T' )
300         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
301         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
302         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'T'        ! ice components given at T-point
303         srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2
304         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only
305      CASE( 'U,V,I' )
306         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
307         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
308         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'I'        ! ice components given at I-point
309         srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2
310         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only
311      CASE( 'U,V,F' )
312         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
313         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
314         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point
315         srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2
316         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only
317      CASE( 'T,I' ) 
318         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point
319         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'I'        ! ice components given at I-point
320         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1
321         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1
322      CASE( 'T,F' ) 
323         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point
324         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point
325         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1
326         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1
327      CASE( 'T,U,V' )
328         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'T'        ! oce components given at T-point
329         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'U'        ! ice components given at U-point
330         srcv(jpr_itx2:jpr_itz2)%clgrid  = 'V'        !           and           V-point
331         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 only
332         srcv(jpr_itx1:jpr_itz2)%laction = .TRUE.     ! receive ice components on grid 1 & 2
333      CASE default   
334         CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_tau(4)' )
335      END SELECT
336      !
337      IF( TRIM( cn_rcv_tau(2) ) == 'spherical' )   &           ! spherical: 3rd component not received
338         &     srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE. 
339      !
340      IF( TRIM( cn_rcv_tau(1) ) /= 'oce and ice' ) THEN        ! 'oce and ice' case ocean stress on ocean mesh used
341         srcv(jpr_itx1:jpr_itz2)%laction = .FALSE.    ! ice components not received
342         srcv(jpr_itx1)%clgrid = 'U'                  ! ocean stress used after its transformation
343         srcv(jpr_ity1)%clgrid = 'V'                  ! i.e. it is always at U- & V-points for i- & j-comp. resp.
344      ENDIF
345       
346      !                                                      ! ------------------------- !
347      !                                                      !    freshwater budget      !   E-P
348      !                                                      ! ------------------------- !
349      ! we suppose that atmosphere modele do not make the difference between precipiration (liquide or solid)
350      ! over ice of free ocean within the same atmospheric cell.cd
351      srcv(jpr_rain)%clname = 'OTotRain'      ! Rain = liquid precipitation
352      srcv(jpr_snow)%clname = 'OTotSnow'      ! Snow = solid precipitation
353      srcv(jpr_tevp)%clname = 'OTotEvap'      ! total evaporation (over oce + ice sublimation)
354      srcv(jpr_ievp)%clname = 'OIceEvap'      ! evaporation over ice = sublimation
355      srcv(jpr_sbpr)%clname = 'OSubMPre'      ! sublimation - liquid precipitation - solid precipitation
356      srcv(jpr_semp)%clname = 'OISubMSn'      ! ice solid water budget = sublimation - solid precipitation
357      srcv(jpr_oemp)%clname = 'OOEvaMPr'      ! ocean water budget = ocean Evap - ocean precip
358      SELECT CASE( TRIM( cn_rcv_emp ) )
359      CASE( 'oce only'      )   ;   srcv(                                 jpr_oemp   )%laction = .TRUE. 
360      CASE( 'conservative'  )   ;   srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE.
361      CASE( 'oce and ice'   )   ;   srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE.
362      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_emp' )
363      END SELECT
364
365      !                                                      ! ------------------------- !
366      !                                                      !     Runoffs & Calving     !   
367      !                                                      ! ------------------------- !
368      srcv(jpr_rnf   )%clname = 'O_Runoff'   ;   IF( TRIM( cn_rcv_rnf ) == 'coupled' )   srcv(jpr_rnf)%laction = .TRUE.
369                                                 IF( TRIM( cn_rcv_rnf ) == 'climato' )   THEN   ;   ln_rnf = .TRUE.
370                                                 ELSE                                           ;   ln_rnf = .FALSE.
371                                                 ENDIF
372      srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( cn_rcv_cal ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE.
373
374      !                                                      ! ------------------------- !
375      !                                                      !    non solar radiation    !   Qns
376      !                                                      ! ------------------------- !
377      srcv(jpr_qnsoce)%clname = 'O_QnsOce'
378      srcv(jpr_qnsice)%clname = 'O_QnsIce'
379      srcv(jpr_qnsmix)%clname = 'O_QnsMix'
380      SELECT CASE( TRIM( cn_rcv_qns ) )
381      CASE( 'oce only'      )   ;   srcv(               jpr_qnsoce   )%laction = .TRUE.
382      CASE( 'conservative'  )   ;   srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE.
383      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE.
384      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qnsmix   )%laction = .TRUE. 
385      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qns' )
386      END SELECT
387
388      !                                                      ! ------------------------- !
389      !                                                      !    solar radiation        !   Qsr
390      !                                                      ! ------------------------- !
391      srcv(jpr_qsroce)%clname = 'O_QsrOce'
392      srcv(jpr_qsrice)%clname = 'O_QsrIce'
393      srcv(jpr_qsrmix)%clname = 'O_QsrMix'
394      SELECT CASE( TRIM( cn_rcv_qsr ) )
395      CASE( 'oce only'      )   ;   srcv(               jpr_qsroce   )%laction = .TRUE.
396      CASE( 'conservative'  )   ;   srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE.
397      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE.
398      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qsrmix   )%laction = .TRUE. 
399      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qsr' )
400      END SELECT
401
402      !                                                      ! ------------------------- !
403      !                                                      !   non solar sensitivity   !   d(Qns)/d(T)
404      !                                                      ! ------------------------- !
405      srcv(jpr_dqnsdt)%clname = 'O_dQnsdT'   
406      IF( TRIM( cn_rcv_dqnsdt ) == 'coupled' )   srcv(jpr_dqnsdt)%laction = .TRUE.
407      !
408      ! non solar sensitivity mandatory for ice model
409      IF( TRIM( cn_rcv_dqnsdt ) == 'none' .AND. k_ice /= 0 ) &
410         CALL ctl_stop( 'sbc_cpl_init: cn_rcv_dqnsdt must be coupled in namsbc_cpl namelist' )
411      ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique
412      IF( TRIM( cn_rcv_dqnsdt ) == 'none' .AND. TRIM( cn_rcv_qns ) == 'mixed oce-ice' ) &
413         CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between cn_rcv_qns and cn_rcv_dqnsdt' )
414      !                                                      ! ------------------------- !
415      !                                                      !    Ice Qsr penetration    !   
416      !                                                      ! ------------------------- !
417      ! fraction of net shortwave radiation which is not absorbed in the thin surface layer
418      ! and penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 )
419      ! Coupled case: since cloud cover is not received from atmosphere
420      !               ===> defined as constant value -> definition done in sbc_cpl_init
421      fr1_i0(:,:) = 0.18
422      fr2_i0(:,:) = 0.82
423      !                                                      ! ------------------------- !
424      !                                                      !      10m wind module      !   
425      !                                                      ! ------------------------- !
426      srcv(jpr_w10m)%clname = 'O_Wind10'   ;   IF( TRIM(cn_rcv_w10m  ) == 'coupled' )   srcv(jpr_w10m)%laction = .TRUE. 
427      !
428      !                                                      ! ------------------------- !
429      !                                                      !   wind stress module      !   
430      !                                                      ! ------------------------- !
431      srcv(jpr_taum)%clname = 'O_TauMod'   ;   IF( TRIM(cn_rcv_taumod) == 'coupled' )   srcv(jpr_taum)%laction = .TRUE.
432      lhftau = srcv(jpr_taum)%laction
433
434#if defined key_cpl_carbon_cycle
435      !                                                      ! ------------------------- !
436      !                                                      !      Atmospheric CO2      !
437      !                                                      ! ------------------------- !
438      srcv(jpr_co2 )%clname = 'O_AtmCO2'   ;   IF( TRIM(cn_rcv_co2   ) == 'coupled' )    srcv(jpr_co2 )%laction = .TRUE.
439#endif
440     
441      ! ================================ !
442      !     Define the send interface    !
443      ! ================================ !
444      ! for each field: define the OASIS name                           (srcv(:)%clname)
445      !                 define send or not from the namelist parameters (srcv(:)%laction)
446      !                 define the north fold type of lbc               (srcv(:)%nsgn)
447     
448      ! default definitions of nsnd
449      ssnd(:)%laction = .FALSE.   ;   ssnd(:)%clgrid = 'T'   ;   ssnd(:)%nsgn = 1.
450         
451      !                                                      ! ------------------------- !
452      !                                                      !    Surface temperature    !
453      !                                                      ! ------------------------- !
454      ssnd(jps_toce)%clname = 'O_SSTSST'
455      ssnd(jps_tice)%clname = 'O_TepIce'
456      ssnd(jps_tmix)%clname = 'O_TepMix'
457      SELECT CASE( TRIM( cn_snd_temperature ) )
458      CASE( 'oce only'             )   ;   ssnd(   jps_toce             )%laction = .TRUE.
459      CASE( 'weighted oce and ice' )   ;   ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE.
460      CASE( 'mixed oce-ice'        )   ;   ssnd(   jps_tmix             )%laction = .TRUE.
461      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_temperature' )
462      END SELECT
463     
464      !                                                      ! ------------------------- !
465      !                                                      !          Albedo           !
466      !                                                      ! ------------------------- !
467      ssnd(jps_albice)%clname = 'O_AlbIce' 
468      ssnd(jps_albmix)%clname = 'O_AlbMix'
469      SELECT CASE( TRIM( cn_snd_albedo ) )
470      CASE( 'none'          )       ! nothing to do
471      CASE( 'weighted ice'  )   ;   ssnd(jps_albice)%laction = .TRUE.
472      CASE( 'mixed oce-ice' )   ;   ssnd(jps_albmix)%laction = .TRUE.
473      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_albedo' )
474      END SELECT
475      !
476      ! Need to calculate oceanic albedo if
477      !     1. sending mixed oce-ice albedo or
478      !     2. receiving mixed oce-ice solar radiation
479      IF ( TRIM ( cn_snd_albedo ) == 'mixed oce-ice' .OR. TRIM ( cn_rcv_qsr ) == 'mixed oce-ice' ) THEN
480         CALL albedo_oce( zaos, zacs )
481         ! Due to lack of information on nebulosity : mean clear/overcast sky
482         albedo_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5
483      ENDIF
484
485      !                                                      ! ------------------------- !
486      !                                                      !  Ice fraction & Thickness !
487      !                                                      ! ------------------------- !
488      ssnd(jps_fice)%clname = 'OIceFrac'   
489      ssnd(jps_hice)%clname = 'O_IceTck'
490      ssnd(jps_hsnw)%clname = 'O_SnwTck'
491      IF( k_ice /= 0 )   ssnd(jps_fice)%laction = .TRUE.       ! if ice treated in the ocean (even in climato case)
492      IF( TRIM( cn_snd_thickness ) == 'weighted ice and snow' )   ssnd( (/jps_hice, jps_hsnw/) )%laction = .TRUE.
493         
494      !                                                      ! ------------------------- !
495      !                                                      !      Surface current      !
496      !                                                      ! ------------------------- !
497      !        ocean currents              !            ice velocities
498      ssnd(jps_ocx1)%clname = 'O_OCurx1'   ;   ssnd(jps_ivx1)%clname = 'O_IVelx1'
499      ssnd(jps_ocy1)%clname = 'O_OCury1'   ;   ssnd(jps_ivy1)%clname = 'O_IVely1'
500      ssnd(jps_ocz1)%clname = 'O_OCurz1'   ;   ssnd(jps_ivz1)%clname = 'O_IVelz1'
501      !
502      ssnd(jps_ocx1:jps_ivz1)%nsgn = -1.   ! vectors: change of the sign at the north fold
503
504      IF( cn_snd_crt(4) /= 'T' )   CALL ctl_stop( 'cn_snd_crt(4) must be equal to T' )
505      ssnd(jps_ocx1:jps_ivz1)%clgrid  = 'T'      ! all oce and ice components on the same unique grid
506
507      ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE.   ! default: all are send
508      IF( TRIM( cn_snd_crt(2) ) == 'spherical' )   ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE. 
509      SELECT CASE( TRIM( cn_snd_crt(1) ) )
510      CASE( 'none'                 )   ;   ssnd(jps_ocx1:jps_ivz1)%laction = .FALSE.
511      CASE( 'oce only'             )   ;   ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
512      CASE( 'weighted oce and ice' )   !   nothing to do
513      CASE( 'mixed oce-ice'        )   ;   ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
514      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_crt(1)' )
515      END SELECT
516
517#if defined key_cpl_carbon_cycle
518      !                                                      ! ------------------------- !
519      !                                                      !          CO2 flux         !
520      !                                                      ! ------------------------- !
521      ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(cn_snd_co2) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE.
522#endif
523      !
524      ! ================================ !
525      !   initialisation of the coupler  !
526      ! ================================ !
527
528      CALL cpl_prism_define(jprcv, jpsnd)           
529      !
530      IF( ln_dm2dc .AND. ( cpl_prism_freq( jpr_qsroce ) + cpl_prism_freq( jpr_qsrmix ) /= 86400 ) )   &
531         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
532
533   END SUBROUTINE sbc_cpl_init
534
535
536   SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )     
537      !!----------------------------------------------------------------------
538      !!             ***  ROUTINE sbc_cpl_rcv  ***
539      !!
540      !! ** Purpose :   provide the stress over the ocean and, if no sea-ice,
541      !!                provide the ocean heat and freshwater fluxes.
542      !!
543      !! ** Method  : - Receive all the atmospheric fields (stored in frcv array). called at each time step.
544      !!                OASIS controls if there is something do receive or not. nrcvinfo contains the info
545      !!                to know if the field was really received or not
546      !!
547      !!              --> If ocean stress was really received:
548      !!
549      !!                  - transform the received ocean stress vector from the received
550      !!                 referential and grid into an atmosphere-ocean stress in
551      !!                 the (i,j) ocean referencial and at the ocean velocity point.
552      !!                    The received stress are :
553      !!                     - defined by 3 components (if cartesian coordinate)
554      !!                            or by 2 components (if spherical)
555      !!                     - oriented along geographical   coordinate (if eastward-northward)
556      !!                            or  along the local grid coordinate (if local grid)
557      !!                     - given at U- and V-point, resp.   if received on 2 grids
558      !!                            or at T-point               if received on 1 grid
559      !!                    Therefore and if necessary, they are successively
560      !!                  processed in order to obtain them
561      !!                     first  as  2 components on the sphere
562      !!                     second as  2 components oriented along the local grid
563      !!                     third  as  2 components on the U,V grid
564      !!
565      !!              -->
566      !!
567      !!              - In 'ocean only' case, non solar and solar ocean heat fluxes
568      !!             and total ocean freshwater fluxes 
569      !!
570      !! ** Method  :   receive all fields from the atmosphere and transform
571      !!              them into ocean surface boundary condition fields
572      !!
573      !! ** Action  :   update  utau, vtau   ocean stress at U,V grid
574      !!                        taum, wndm   wind stres and wind speed module at T-point
575      !!                        qns , qsr    non solar and solar ocean heat fluxes   ('ocean only case)
576      !!                        emp = emps   evap. - precip. (- runoffs) (- calving) ('ocean only case)
577      !!----------------------------------------------------------------------
578      INTEGER, INTENT(in) ::   kt       ! ocean model time step index
579      INTEGER, INTENT(in) ::   k_fsbc   ! frequency of sbc (-> ice model) computation
580      INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3)
581      !!
582      LOGICAL ::    llnewtx, llnewtau      ! update wind stress components and module??
583      INTEGER  ::   ji, jj, jn             ! dummy loop indices
584      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000)
585      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars     
586      REAL(wp) ::   zcoef                  ! temporary scalar
587      REAL(wp) ::   zrhoa  = 1.22          ! Air density kg/m3
588      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient
589      REAL(wp) ::   zzx, zzy               ! temporary variables
590      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty   ! 2D workspace
591      !!----------------------------------------------------------------------
592
593      IF( kt == nit000 )   CALL sbc_cpl_init( k_ice )          ! initialisation
594
595      !                                                 ! Receive all the atmos. fields (including ice information)
596      isec = ( kt - nit000 ) * NINT( rdttra(1) )             ! date of exchanges
597      DO jn = 1, jprcv                                       ! received fields sent by the atmosphere
598         IF( srcv(jn)%laction )   CALL cpl_prism_rcv( jn, isec, frcv(:,:,jn), nrcvinfo(jn) )
599      END DO
600
601      !                                                      ! ========================= !
602      IF( srcv(jpr_otx1)%laction ) THEN                      !  ocean stress components  !
603         !                                                   ! ========================= !
604         ! define frcv(:,:,jpr_otx1) and frcv(:,:,jpr_oty1): stress at U/V point along model grid
605         ! => need to be done only when we receive the field
606         IF(  nrcvinfo(jpr_otx1) == OASIS_Rcv ) THEN
607            !
608            IF( TRIM( cn_rcv_tau(2) ) == 'cartesian' ) THEN            ! 2 components on the sphere
609               !                                                       ! (cartesian to spherical -> 3 to 2 components)
610               !
611               CALL geo2oce( frcv(:,:,jpr_otx1), frcv(:,:,jpr_oty1), frcv(:,:,jpr_otz1),   &
612                  &          srcv(jpr_otx1)%clgrid, ztx, zty )
613               frcv(:,:,jpr_otx1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid
614               frcv(:,:,jpr_oty1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid
615               !
616               IF( srcv(jpr_otx2)%laction ) THEN
617                  CALL geo2oce( frcv(:,:,jpr_otx2), frcv(:,:,jpr_oty2), frcv(:,:,jpr_otz2),   &
618                     &          srcv(jpr_otx2)%clgrid, ztx, zty )
619                  frcv(:,:,jpr_otx2) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid
620                  frcv(:,:,jpr_oty2) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid
621               ENDIF
622               !
623            ENDIF
624            !
625            IF( TRIM( cn_rcv_tau(3) ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid
626               !                                                       ! (geographical to local grid -> rotate the components)
627               CALL rot_rep( frcv(:,:,jpr_otx1), frcv(:,:,jpr_oty1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )   
628               frcv(:,:,jpr_otx1) = ztx(:,:)      ! overwrite 1st component on the 1st grid
629               IF( srcv(jpr_otx2)%laction ) THEN
630                  CALL rot_rep( frcv(:,:,jpr_otx2), frcv(:,:,jpr_oty2), srcv(jpr_otx2)%clgrid, 'en->j', zty )   
631               ELSE
632                  CALL rot_rep( frcv(:,:,jpr_otx1), frcv(:,:,jpr_oty1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 
633               ENDIF
634               frcv(:,:,jpr_oty1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid
635            ENDIF
636            !                             
637            IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN
638               DO jj = 2, jpjm1                                          ! T ==> (U,V)
639                  DO ji = fs_2, fs_jpim1   ! vector opt.
640                     frcv(ji,jj,jpr_otx1) = 0.5 * ( frcv(ji+1,jj  ,jpr_otx1) + frcv(ji,jj,jpr_otx1) )
641                     frcv(ji,jj,jpr_oty1) = 0.5 * ( frcv(ji  ,jj+1,jpr_oty1) + frcv(ji,jj,jpr_oty1) )
642                  END DO
643               END DO
644               CALL lbc_lnk( frcv(:,:,jpr_otx1), 'U',  -1. )   ;   CALL lbc_lnk( frcv(:,:,jpr_oty1), 'V',  -1. )
645            ENDIF
646            llnewtx = .TRUE.
647         ELSE
648            llnewtx = .FALSE.
649         ENDIF
650         !                                                   ! ========================= !
651      ELSE                                                   !   No dynamical coupling   !
652         !                                                   ! ========================= !
653         frcv(:,:,jpr_otx1) = 0.e0                               ! here simply set to zero
654         frcv(:,:,jpr_oty1) = 0.e0                               ! an external read in a file can be added instead
655         llnewtx = .TRUE.
656         !
657      ENDIF
658     
659      !                                                      ! ========================= !
660      !                                                      !    wind stress module     !   (taum)
661      !                                                      ! ========================= !
662      !
663      IF( .NOT. srcv(jpr_taum)%laction ) THEN                    ! compute wind stress module from its components if not received
664         ! => need to be done only when otx1 was changed
665         IF( llnewtx ) THEN
666!CDIR NOVERRCHK
667            DO jj = 2, jpjm1
668!CDIR NOVERRCHK
669               DO ji = fs_2, fs_jpim1   ! vect. opt.
670                  zzx = frcv(ji-1,jj  ,jpr_otx1) + frcv(ji,jj,jpr_otx1) 
671                  zzy = frcv(ji  ,jj-1,jpr_oty1) + frcv(ji,jj,jpr_oty1) 
672                  frcv(ji,jj,jpr_taum) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
673               END DO
674            END DO
675            CALL lbc_lnk( frcv(:,:,jpr_taum), 'T', 1. )
676            llnewtau = .TRUE.
677         ELSE
678            llnewtau = .FALSE.
679         ENDIF
680      ELSE
681         llnewtau = nrcvinfo(jpr_taum) == OASIS_Rcv
682         ! Stress module can be negative when received (interpolation problem)
683         IF( llnewtau ) THEN
684            DO jj = 1, jpj
685               DO ji = 1, jpi 
686                  frcv(ji,jj,jpr_taum) = MAX( 0.0e0, frcv(ji,jj,jpr_taum) )
687               END DO
688            END DO
689         ENDIF
690      ENDIF
691     
692      !                                                      ! ========================= !
693      !                                                      !      10 m wind speed      !   (wndm)
694      !                                                      ! ========================= !
695      !
696      IF( .NOT. srcv(jpr_w10m)%laction ) THEN                    ! compute wind spreed from wind stress module if not received 
697         ! => need to be done only when taumod was changed
698         IF( llnewtau ) THEN
699            zcoef = 1. / ( zrhoa * zcdrag ) 
700!CDIR NOVERRCHK
701            DO jj = 1, jpj
702!CDIR NOVERRCHK
703               DO ji = 1, jpi 
704                  frcv(ji,jj,jpr_w10m) = SQRT( frcv(ji,jj,jpr_taum) * zcoef )
705               END DO
706            END DO
707         ENDIF
708      ENDIF
709
710      ! u(v)tau and taum will be modified by ice model (wndm will be changed by PISCES)
711      ! -> need to be reset before each call of the ice/fsbc     
712      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN
713         !
714         utau(:,:) = frcv(:,:,jpr_otx1)                   
715         vtau(:,:) = frcv(:,:,jpr_oty1)
716         taum(:,:) = frcv(:,:,jpr_taum)
717         wndm(:,:) = frcv(:,:,jpr_w10m)
718         CALL iom_put( "taum_oce", taum )   ! output wind stress module
719         
720      ENDIF
721      !                                                      ! ========================= !
722      IF( k_ice <= 1 ) THEN                                  !  heat & freshwater fluxes ! (Ocean only case)
723         !                                                   ! ========================= !
724         !
725         !                                                       ! non solar heat flux over the ocean (qns)
726         IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(:,:,jpr_qnsoce)
727         IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(:,:,jpr_qnsmix) 
728         ! add the latent heat of solid precip. melting
729         IF( srcv(jpr_snow  )%laction )   qns(:,:) = qns(:,:) - frcv(:,:,jpr_snow) * lfus             
730
731         !                                                       ! solar flux over the ocean          (qsr)
732         IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(:,:,jpr_qsroce) 
733         IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(:,:,jpr_qsrmix)
734         IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle
735         !
736         !                                                       ! total freshwater fluxes over the ocean (emp, emps)
737         SELECT CASE( TRIM( cn_rcv_emp ) )                                    ! evaporation - precipitation
738         CASE( 'conservative' )
739            emp(:,:) = frcv(:,:,jpr_tevp) - ( frcv(:,:,jpr_rain) + frcv(:,:,jpr_snow) )
740         CASE( 'oce only', 'oce and ice' )
741            emp(:,:) = frcv(:,:,jpr_oemp)
742         CASE default
743            CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of cn_rcv_emp' )
744         END SELECT
745         !
746         !                                                        ! runoffs and calving (added in emp)
747         IF( srcv(jpr_rnf)%laction )   emp(:,:) = emp(:,:) - frcv(:,:,jpr_rnf)       
748         IF( srcv(jpr_cal)%laction )   emp(:,:) = emp(:,:) - frcv(:,:,jpr_cal)
749         !
750!!gm :  this seems to be internal cooking, not sure to need that in a generic interface
751!!gm                                       at least should be optional...
752!!         IF( TRIM( cn_rcv_rnf ) == 'coupled' ) THEN     ! add to the total freshwater budget
753!!            ! remove negative runoff
754!!            zcumulpos = SUM( MAX( frcv(:,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
755!!            zcumulneg = SUM( MIN( frcv(:,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
756!!            IF( lk_mpp )   CALL mpp_sum( zcumulpos )   ! sum over the global domain
757!!            IF( lk_mpp )   CALL mpp_sum( zcumulneg )
758!!            IF( zcumulpos /= 0. ) THEN                 ! distribute negative runoff on positive runoff grid points
759!!               zcumulneg = 1.e0 + zcumulneg / zcumulpos
760!!               frcv(:,:,jpr_rnf) = MAX( frcv(:,:,jpr_rnf), 0.e0 ) * zcumulneg
761!!            ENDIF     
762!!            ! add runoff to e-p
763!!            emp(:,:) = emp(:,:) - frcv(:,:,jpr_rnf)
764!!         ENDIF
765!!gm  end of internal cooking
766         !
767         emps(:,:) = emp(:,:)                                        ! concentration/dilution = emp
768 
769         !                                                           ! 10 m wind speed
770         IF( srcv(jpr_w10m)%laction )   wndm(:,:) = frcv(:,:,jpr_w10m)
771         !
772#if defined  key_cpl_carbon_cycle
773         !                                                              ! atmosph. CO2 (ppm)
774         IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(:,:,jpr_co2)
775#endif
776
777      ENDIF
778      !
779   END SUBROUTINE sbc_cpl_rcv
780   
781
782   SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )     
783      !!----------------------------------------------------------------------
784      !!             ***  ROUTINE sbc_cpl_ice_tau  ***
785      !!
786      !! ** Purpose :   provide the stress over sea-ice in coupled mode
787      !!
788      !! ** Method  :   transform the received stress from the atmosphere into
789      !!             an atmosphere-ice stress in the (i,j) ocean referencial
790      !!             and at the velocity point of the sea-ice model (cigr_type):
791      !!                'C'-grid : i- (j-) components given at U- (V-) point
792      !!                'B'-grid : both components given at I-point
793      !!
794      !!                The received stress are :
795      !!                 - defined by 3 components (if cartesian coordinate)
796      !!                        or by 2 components (if spherical)
797      !!                 - oriented along geographical   coordinate (if eastward-northward)
798      !!                        or  along the local grid coordinate (if local grid)
799      !!                 - given at U- and V-point, resp.   if received on 2 grids
800      !!                        or at a same point (T or I) if received on 1 grid
801      !!                Therefore and if necessary, they are successively
802      !!             processed in order to obtain them
803      !!                 first  as  2 components on the sphere
804      !!                 second as  2 components oriented along the local grid
805      !!                 third  as  2 components on the cigr_type point
806      !!
807      !!                In 'oce and ice' case, only one vector stress field
808      !!             is received. It has already been processed in sbc_cpl_rcv
809      !!             so that it is now defined as (i,j) components given at U-
810      !!             and V-points, respectively. Therefore, here only the third
811      !!             transformation is done and only if the ice-grid is a 'B'-grid.
812      !!
813      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice at cigr_type point
814      !!----------------------------------------------------------------------
815      REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2]
816      REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid)
817      !!
818      INTEGER ::   ji, jj                          ! dummy loop indices
819      INTEGER ::   itx                             ! index of taux over ice
820      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty   ! 2D workspace
821      !!----------------------------------------------------------------------
822
823      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1   
824      ELSE                                ;   itx =  jpr_otx1
825      ENDIF
826
827      ! do something only if we just received the stress from atmosphere
828      IF(  nrcvinfo(itx) == OASIS_Rcv ) THEN
829
830         !                                                      ! ======================= !
831         IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   !
832            !                                                   ! ======================= !
833           
834            IF( TRIM( cn_rcv_tau(2) ) == 'cartesian' ) THEN            ! 2 components on the sphere
835               !                                                       ! (cartesian to spherical -> 3 to 2 components)
836               CALL geo2oce( frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1), frcv(:,:,jpr_itz1),   &
837                  &          srcv(jpr_itx1)%clgrid, ztx, zty )
838               frcv(:,:,jpr_itx1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid
839               frcv(:,:,jpr_itx1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid
840               !
841               IF( srcv(jpr_itx2)%laction ) THEN
842                  CALL geo2oce( frcv(:,:,jpr_itx2), frcv(:,:,jpr_ity2), frcv(:,:,jpr_itz2),   &
843                     &          srcv(jpr_itx2)%clgrid, ztx, zty )
844                  frcv(:,:,jpr_itx2) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid
845                  frcv(:,:,jpr_ity2) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid
846               ENDIF
847               !
848            ENDIF
849            !
850            IF( TRIM( cn_rcv_tau(3) ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid
851               !                                                       ! (geographical to local grid -> rotate the components)
852               CALL rot_rep( frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )   
853               frcv(:,:,jpr_itx1) = ztx(:,:)      ! overwrite 1st component on the 1st grid
854               IF( srcv(jpr_itx2)%laction ) THEN
855                  CALL rot_rep( frcv(:,:,jpr_itx2), frcv(:,:,jpr_ity2), srcv(jpr_itx2)%clgrid, 'en->j', zty )   
856               ELSE
857                  CALL rot_rep( frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1), srcv(jpr_itx1)%clgrid, 'en->j', zty ) 
858               ENDIF
859               frcv(:,:,jpr_ity1) = zty(:,:)      ! overwrite 2nd component on the 1st grid
860            ENDIF
861            !                                                   ! ======================= !
862         ELSE                                                   !     use ocean stress    !
863            !                                                   ! ======================= !
864            frcv(:,:,jpr_itx1) = frcv(:,:,jpr_otx1)
865            frcv(:,:,jpr_ity1) = frcv(:,:,jpr_oty1)
866            !
867         ENDIF
868
869         !                                                      ! ======================= !
870         !                                                      !     put on ice grid     !
871         !                                                      ! ======================= !
872         !   
873         !                                                  j+1   j     -----V---F
874         ! ice stress on ice velocity point (cigr_type)                  !       |
875         ! (C-grid ==>(U,V) or B-grid ==> I or F)                 j      |   T   U
876         !                                                               |       |
877         !                                                   j    j-1   -I-------|
878         !                                               (for I)         |       |
879         !                                                              i-1  i   i
880         !                                                               i      i+1 (for I)
881         SELECT CASE ( cigr_type )
882            !
883         CASE( 'I' )                                         ! B-grid ==> I
884            SELECT CASE ( srcv(jpr_itx1)%clgrid )
885            CASE( 'U' )
886               DO jj = 2, jpjm1                                   ! (U,V) ==> I
887                  DO ji = 2, jpim1   ! NO vector opt.
888                     p_taui(ji,jj) = 0.5 * ( frcv(ji-1,jj  ,jpr_itx1) + frcv(ji-1,jj-1,jpr_itx1) )
889                     p_tauj(ji,jj) = 0.5 * ( frcv(ji  ,jj-1,jpr_ity1) + frcv(ji-1,jj-1,jpr_ity1) )
890                  END DO
891               END DO
892            CASE( 'F' )
893               DO jj = 2, jpjm1                                   ! F ==> I
894                  DO ji = 2, jpim1   ! NO vector opt.
895                     p_taui(ji,jj) = frcv(ji-1,jj-1,jpr_itx1) 
896                     p_tauj(ji,jj) = frcv(ji-1,jj-1,jpr_ity1) 
897                  END DO
898               END DO
899            CASE( 'T' )
900               DO jj = 2, jpjm1                                   ! T ==> I
901                  DO ji = 2, jpim1   ! NO vector opt.
902                     p_taui(ji,jj) = 0.25 * ( frcv(ji,jj  ,jpr_itx1) + frcv(ji-1,jj  ,jpr_itx1)   &
903                        &                   + frcv(ji,jj-1,jpr_itx1) + frcv(ji-1,jj-1,jpr_itx1) ) 
904                     p_tauj(ji,jj) = 0.25 * ( frcv(ji,jj  ,jpr_ity1) + frcv(ji-1,jj  ,jpr_ity1)   &
905                        &                   + frcv(ji,jj-1,jpr_ity1) + frcv(ji-1,jj-1,jpr_ity1) )
906                  END DO
907               END DO
908            CASE( 'I' )
909               p_taui(:,:) = frcv(:,:,jpr_itx1)                   ! I ==> I
910               p_tauj(:,:) = frcv(:,:,jpr_ity1)
911            END SELECT
912            IF( srcv(jpr_itx1)%clgrid /= 'I' ) THEN
913               CALL lbc_lnk( p_taui, 'I',  -1. )   ;   CALL lbc_lnk( p_tauj, 'I',  -1. )
914            ENDIF
915            !
916         CASE( 'F' )                                         ! B-grid ==> F
917            SELECT CASE ( srcv(jpr_itx1)%clgrid )
918            CASE( 'U' )
919               DO jj = 2, jpjm1                                   ! (U,V) ==> F
920                  DO ji = fs_2, fs_jpim1   ! vector opt.
921                     p_taui(ji,jj) = 0.5 * ( frcv(ji,jj,jpr_itx1) + frcv(ji  ,jj+1,jpr_itx1) )
922                     p_tauj(ji,jj) = 0.5 * ( frcv(ji,jj,jpr_ity1) + frcv(ji+1,jj  ,jpr_ity1) )
923                  END DO
924               END DO
925            CASE( 'I' )
926               DO jj = 2, jpjm1                                   ! I ==> F
927                  DO ji = 2, jpim1   ! NO vector opt.
928                     p_taui(ji,jj) = frcv(ji+1,jj+1,jpr_itx1) 
929                     p_tauj(ji,jj) = frcv(ji+1,jj+1,jpr_ity1) 
930                  END DO
931               END DO
932            CASE( 'T' )
933               DO jj = 2, jpjm1                                   ! T ==> F
934                  DO ji = 2, jpim1   ! NO vector opt.
935                     p_taui(ji,jj) = 0.25 * ( frcv(ji,jj  ,jpr_itx1) + frcv(ji+1,jj  ,jpr_itx1)   &
936                        &                   + frcv(ji,jj+1,jpr_itx1) + frcv(ji+1,jj+1,jpr_itx1) ) 
937                     p_tauj(ji,jj) = 0.25 * ( frcv(ji,jj  ,jpr_ity1) + frcv(ji+1,jj  ,jpr_ity1)   &
938                        &                   + frcv(ji,jj+1,jpr_ity1) + frcv(ji+1,jj+1,jpr_ity1) )
939                  END DO
940               END DO
941            CASE( 'F' )
942               p_taui(:,:) = frcv(:,:,jpr_itx1)                   ! F ==> F
943               p_tauj(:,:) = frcv(:,:,jpr_ity1)
944            END SELECT
945            IF( srcv(jpr_itx1)%clgrid /= 'F' ) THEN
946               CALL lbc_lnk( p_taui, 'F',  -1. )   ;   CALL lbc_lnk( p_tauj, 'F',  -1. )
947            ENDIF
948            !
949         CASE( 'C' )                                         ! C-grid ==> U,V
950            SELECT CASE ( srcv(jpr_itx1)%clgrid )
951            CASE( 'U' )
952               p_taui(:,:) = frcv(:,:,jpr_itx1)                   ! (U,V) ==> (U,V)
953               p_tauj(:,:) = frcv(:,:,jpr_ity1)
954            CASE( 'F' )
955               DO jj = 2, jpjm1                                   ! F ==> (U,V)
956                  DO ji = fs_2, fs_jpim1   ! vector opt.
957                     p_taui(ji,jj) = 0.5 * ( frcv(ji,jj,jpr_itx1) + frcv(ji  ,jj-1,jpr_itx1) )
958                     p_tauj(ji,jj) = 0.5 * ( frcv(ji,jj,jpr_ity1) + frcv(ji-1,jj  ,jpr_ity1) )
959                  END DO
960               END DO
961            CASE( 'T' )
962               DO jj = 2, jpjm1                                   ! T ==> (U,V)
963                  DO ji = fs_2, fs_jpim1   ! vector opt.
964                     p_taui(ji,jj) = 0.5 * ( frcv(ji+1,jj  ,jpr_itx1) + frcv(ji,jj,jpr_itx1) )
965                     p_tauj(ji,jj) = 0.5 * ( frcv(ji  ,jj+1,jpr_ity1) + frcv(ji,jj,jpr_ity1) )
966                  END DO
967               END DO
968            CASE( 'I' )
969               DO jj = 2, jpjm1                                   ! I ==> (U,V)
970                  DO ji = 2, jpim1   ! NO vector opt.
971                     p_taui(ji,jj) = 0.5 * ( frcv(ji+1,jj+1,jpr_itx1) + frcv(ji+1,jj  ,jpr_itx1) )
972                     p_tauj(ji,jj) = 0.5 * ( frcv(ji+1,jj+1,jpr_ity1) + frcv(ji  ,jj+1,jpr_ity1) )
973                  END DO
974               END DO
975            END SELECT
976            IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN
977               CALL lbc_lnk( p_taui, 'U',  -1. )   ;   CALL lbc_lnk( p_tauj, 'V',  -1. )
978            ENDIF
979         END SELECT
980
981         !!gm Should be useless as sbc_cpl_ice_tau only called at coupled frequency
982         ! The receive stress are transformed such that in all case frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1)
983         ! become the i-component and j-component of the stress at the right grid point
984         !!gm  frcv(:,:,jpr_itx1) = p_taui(:,:)
985         !!gm  frcv(:,:,jpr_ity1) = p_tauj(:,:)
986         !!gm
987      ENDIF
988      !   
989   END SUBROUTINE sbc_cpl_ice_tau
990   
991
992   SUBROUTINE sbc_cpl_ice_flx( p_frld  ,                                  &
993      &                        pqns_tot, pqns_ice, pqsr_tot , pqsr_ice,   &
994      &                        pemp_tot, pemp_ice, pdqns_ice, psprecip,   &
995      &                        palbi   , psst    , pist                 )
996      !!----------------------------------------------------------------------
997      !!             ***  ROUTINE sbc_cpl_ice_flx_rcv  ***
998      !!
999      !! ** Purpose :   provide the heat and freshwater fluxes of the
1000      !!              ocean-ice system.
1001      !!
1002      !! ** Method  :   transform the fields received from the atmosphere into
1003      !!             surface heat and fresh water boundary condition for the
1004      !!             ice-ocean system. The following fields are provided:
1005      !!              * total non solar, solar and freshwater fluxes (qns_tot,
1006      !!             qsr_tot and emp_tot) (total means weighted ice-ocean flux)
1007      !!             NB: emp_tot include runoffs and calving.
1008      !!              * fluxes over ice (qns_ice, qsr_ice, emp_ice) where
1009      !!             emp_ice = sublimation - solid precipitation as liquid
1010      !!             precipitation are re-routed directly to the ocean and
1011      !!             runoffs and calving directly enter the ocean.
1012      !!              * solid precipitation (sprecip), used to add to qns_tot
1013      !!             the heat lost associated to melting solid precipitation
1014      !!             over the ocean fraction.
1015      !!       ===>> CAUTION here this changes the net heat flux received from
1016      !!             the atmosphere
1017      !!
1018      !!             N.B. - fields over sea-ice are passed in argument so that
1019      !!                 the module can be compile without sea-ice.
1020      !!                  - the fluxes have been separated from the stress as
1021      !!                 (a) they are updated at each ice time step compare to
1022      !!                 an update at each coupled time step for the stress, and
1023      !!                 (b) the conservative computation of the fluxes over the
1024      !!                 sea-ice area requires the knowledge of the ice fraction
1025      !!                 after the ice advection and before the ice thermodynamics,
1026      !!                 so that the stress is updated before the ice dynamics
1027      !!                 while the fluxes are updated after it.
1028      !!
1029      !! ** Action  :   update at each nf_ice time step:
1030      !!                   pqns_tot, pqsr_tot  non-solar and solar total heat fluxes
1031      !!                   pqns_ice, pqsr_ice  non-solar and solar heat fluxes over the ice
1032      !!                   pemp_tot            total evaporation - precipitation(liquid and solid) (-runoff)(-calving)
1033      !!                   pemp_ice            ice sublimation - solid precipitation over the ice
1034      !!                   pdqns_ice           d(non-solar heat flux)/d(Temperature) over the ice
1035      !!                   sprecip             solid precipitation over the ocean 
1036      !!----------------------------------------------------------------------
1037      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpl) ::   p_frld     ! lead fraction                [0 to 1]
1038      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj    ) ::   pqns_tot   ! total non solar heat flux    [W/m2]
1039      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpl) ::   pqns_ice   ! ice   non solar heat flux    [W/m2]
1040      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj    ) ::   pqsr_tot   ! total     solar heat flux    [W/m2]
1041      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpl) ::   pqsr_ice   ! ice       solar heat flux    [W/m2]
1042      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj    ) ::   pemp_tot   ! total     freshwater budget        [Kg/m2/s]
1043      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj    ) ::   pemp_ice   ! solid freshwater budget over ice   [Kg/m2/s]
1044      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj    ) ::   psprecip   ! Net solid precipitation (=emp_ice) [Kg/m2/s]
1045      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpl) ::   pdqns_ice  ! d(Q non solar)/d(Temperature) over ice
1046      ! optional arguments, used only in 'mixed oce-ice' case
1047      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpl), OPTIONAL ::   palbi   ! ice albedo
1048      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj    ), OPTIONAL ::   psst    ! sea surface temperature     [Celcius]
1049      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpl), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin]
1050     !!
1051      INTEGER ::   ji, jj           ! dummy loop indices
1052      INTEGER ::   isec, info       ! temporary integer
1053      REAL(wp)::   zcoef, ztsurf    ! temporary scalar
1054      REAL(wp), DIMENSION(jpi,jpj    )::   zcptn    ! rcp * tn(:,:,1)
1055      REAL(wp), DIMENSION(jpi,jpj    )::   ztmp     ! temporary array
1056      REAL(wp), DIMENSION(jpi,jpj    )::   zsnow    ! snow precipitation
1057      REAL(wp), DIMENSION(jpi,jpj,jpl)::   zicefr   ! ice fraction
1058      !!----------------------------------------------------------------------
1059      zicefr(:,:,1) = 1.- p_frld(:,:,1)
1060      IF( lk_diaar5 )   zcptn(:,:) = rcp * tn(:,:,1)
1061      !
1062      !                                                      ! ========================= !
1063      !                                                      !    freshwater budget      !   (emp)
1064      !                                                      ! ========================= !
1065      !
1066      !                                                           ! total Precipitations - total Evaporation (emp_tot)
1067      !                                                           ! solid precipitation  - sublimation       (emp_ice)
1068      !                                                           ! solid Precipitation                      (sprecip)
1069      SELECT CASE( TRIM( cn_rcv_emp ) )
1070      CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
1071         pemp_tot(:,:) = frcv(:,:,jpr_tevp) - frcv(:,:,jpr_rain) - frcv(:,:,jpr_snow)
1072         pemp_ice(:,:) = frcv(:,:,jpr_ievp) - frcv(:,:,jpr_snow)
1073         zsnow   (:,:) = frcv(:,:,jpr_snow)
1074                           CALL iom_put( 'rain'         , frcv(:,:,jpr_rain)              )   ! liquid precipitation
1075         IF( lk_diaar5 )   CALL iom_put( 'hflx_rain_cea', frcv(:,:,jpr_rain) * zcptn(:,:) )   ! heat flux from liq. precip.
1076         ztmp(:,:) = frcv(:,:,jpr_tevp) - frcv(:,:,jpr_ievp) * zicefr(:,:,1)
1077                           CALL iom_put( 'evap_ao_cea'  , ztmp                            )   ! ice-free oce evap (cell average)
1078         IF( lk_diaar5 )   CALL iom_put( 'hflx_evap_cea', ztmp(:,:         ) * zcptn(:,:) )   ! heat flux from from evap (cell ave)
1079      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp
1080         pemp_tot(:,:) = p_frld(:,:,1) * frcv(:,:,jpr_oemp) + zicefr(:,:,1) * frcv(:,:,jpr_sbpr) 
1081         pemp_ice(:,:) = frcv(:,:,jpr_semp)
1082         zsnow   (:,:) = - frcv(:,:,jpr_semp) + frcv(:,:,jpr_ievp)
1083      END SELECT
1084      psprecip(:,:) = - pemp_ice(:,:)
1085      CALL iom_put( 'snowpre'    , zsnow                               )   ! Snow
1086      CALL iom_put( 'snow_ao_cea', zsnow(:,:         ) * p_frld(:,:,1) )   ! Snow        over ice-free ocean  (cell average)
1087      CALL iom_put( 'snow_ai_cea', zsnow(:,:         ) * zicefr(:,:,1) )   ! Snow        over sea-ice         (cell average)
1088      CALL iom_put( 'subl_ai_cea', frcv (:,:,jpr_ievp) * zicefr(:,:,1) )   ! Sublimation over sea-ice         (cell average)
1089      !   
1090      !                                                           ! runoffs and calving (put in emp_tot)
1091      IF( srcv(jpr_rnf)%laction ) THEN
1092         pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_rnf)
1093                           CALL iom_put( 'runoffs'      , frcv(:,:,jpr_rnf )              )   ! rivers
1094         IF( lk_diaar5 )   CALL iom_put( 'hflx_rnf_cea' , frcv(:,:,jpr_rnf ) * zcptn(:,:) )   ! heat flux from rivers
1095      ENDIF
1096      IF( srcv(jpr_cal)%laction ) THEN
1097         pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_cal)
1098         CALL iom_put( 'calving', frcv(:,:,jpr_cal) )
1099      ENDIF
1100      !
1101!!gm :  this seems to be internal cooking, not sure to need that in a generic interface
1102!!gm                                       at least should be optional...
1103!!       ! remove negative runoff                            ! sum over the global domain
1104!!       zcumulpos = SUM( MAX( frcv(:,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
1105!!       zcumulneg = SUM( MIN( frcv(:,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
1106!!       IF( lk_mpp )   CALL mpp_sum( zcumulpos )
1107!!       IF( lk_mpp )   CALL mpp_sum( zcumulneg )
1108!!       IF( zcumulpos /= 0. ) THEN                          ! distribute negative runoff on positive runoff grid points
1109!!          zcumulneg = 1.e0 + zcumulneg / zcumulpos
1110!!          frcv(:,:,jpr_rnf) = MAX( frcv(:,:,jpr_rnf), 0.e0 ) * zcumulneg
1111!!       ENDIF     
1112!!       pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_rnf)   ! add runoff to e-p
1113!!
1114!!gm  end of internal cooking
1115
1116
1117      !                                                      ! ========================= !
1118      SELECT CASE( TRIM( cn_rcv_qns ) )                      !   non solar heat fluxes   !   (qns)
1119      !                                                      ! ========================= !
1120      CASE( 'conservative' )                                      ! the required fields are directly provided
1121         pqns_tot(:,:  ) = frcv(:,:,jpr_qnsmix)
1122         pqns_ice(:,:,1) = frcv(:,:,jpr_qnsice)
1123      CASE( 'oce and ice' )       ! the total flux is computed from ocean and ice fluxes
1124         pqns_tot(:,:  ) =  p_frld(:,:,1) * frcv(:,:,jpr_qnsoce) + zicefr(:,:,1) * frcv(:,:,jpr_qnsice)
1125         pqns_ice(:,:,1) =  frcv(:,:,jpr_qnsice)
1126      CASE( 'mixed oce-ice' )     ! the ice flux is cumputed from the total flux, the SST and ice informations
1127         pqns_tot(:,:  ) = frcv(:,:,jpr_qnsmix)
1128         pqns_ice(:,:,1) = frcv(:,:,jpr_qnsmix)    &
1129            &            + frcv(:,:,jpr_dqnsdt) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:,1)   &
1130            &                                                   +          pist(:,:,1)   * zicefr(:,:,1) ) )
1131      END SELECT
1132      ztmp(:,:) = p_frld(:,:,1) * zsnow(:,:) * lfus               ! add the latent heat of solid precip. melting
1133      pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:)                   ! over free ocean
1134      IF( lk_diaar5 )   CALL iom_put( 'hflx_snow_cea', ztmp + zsnow(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average)
1135!!gm
1136!!    currently it is taken into account in leads budget but not in the qns_tot, and thus not in
1137!!    the flux that enter the ocean....
1138!!    moreover 1 - it is not diagnose anywhere....
1139!!             2 - it is unclear for me whether this heat lost is taken into account in the atmosphere or not...
1140!!
1141!! similar job should be done for snow and precipitation temperature
1142      !                                     
1143      IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting
1144         ztmp(:,:) = frcv(:,:,jpr_cal) * lfus                     ! add the latent heat of iceberg melting
1145         pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:)
1146         IF( lk_diaar5 )   CALL iom_put( 'hflx_cal_cea', ztmp + frcv(:,:,jpr_cal) * zcptn(:,:) )   ! heat flux from calving
1147      ENDIF
1148
1149      !                                                      ! ========================= !
1150      SELECT CASE( TRIM( cn_rcv_qsr ) )                      !      solar heat fluxes    !   (qsr)
1151      !                                                      ! ========================= !
1152      CASE( 'conservative' )
1153         pqsr_tot(:,:  ) = frcv(:,:,jpr_qsrmix)
1154         pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrice)
1155      CASE( 'oce and ice' )
1156         pqsr_tot(:,:  ) =  p_frld(:,:,1) * frcv(:,:,jpr_qsroce) + zicefr(:,:,1) * frcv(:,:,jpr_qsrice)
1157         pqsr_ice(:,:,1) =  frcv(:,:,jpr_qsrice)
1158      CASE( 'mixed oce-ice' )
1159         pqsr_tot(:,:  ) = frcv(:,:,jpr_qsrmix)
1160!       Create solar heat flux over ice using incoming solar heat flux and albedos
1161!       ( see OASIS3 user guide, 5th edition, p39 )
1162         pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrmix) * ( 1.- palbi(:,:,1) )   &
1163            &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:,1)   &
1164            &                     + palbi         (:,:,1) * zicefr(:,:,1) ) )
1165      END SELECT
1166      IF( ln_dm2dc ) THEN   ! modify qsr to include the diurnal cycle
1167         pqsr_tot(:,:  ) = sbc_dcy( pqsr_tot(:,:  ) )
1168         pqsr_ice(:,:,1) = sbc_dcy( pqsr_ice(:,:,1) )
1169      ENDIF
1170
1171      SELECT CASE( TRIM( cn_rcv_dqnsdt ) )
1172      CASE ('coupled')
1173          pdqns_ice(:,:,1) = frcv(:,:,jpr_dqnsdt)
1174      END SELECT
1175
1176   END SUBROUTINE sbc_cpl_ice_flx
1177   
1178   
1179   SUBROUTINE sbc_cpl_snd( kt )
1180      !!----------------------------------------------------------------------
1181      !!             ***  ROUTINE sbc_cpl_snd  ***
1182      !!
1183      !! ** Purpose :   provide the ocean-ice informations to the atmosphere
1184      !!
1185      !! ** Method  :   send to the atmosphere through a call to cpl_prism_snd
1186      !!              all the needed fields (as defined in sbc_cpl_init)
1187      !!----------------------------------------------------------------------
1188      INTEGER, INTENT(in) ::   kt
1189      !!
1190      INTEGER ::   ji, jj          ! dummy loop indices
1191      INTEGER ::   isec, info      ! temporary integer
1192      REAL(wp), DIMENSION(jpi,jpj) ::   zfr_l   ! 1. - fr_i(:,:)
1193      REAL(wp), DIMENSION(jpi,jpj) ::   ztmp1, ztmp2
1194      REAL(wp), DIMENSION(jpi,jpj) ::   zotx1 , zoty1 , zotz1, zitx1, zity1, zitz1
1195      !!----------------------------------------------------------------------
1196
1197      isec = ( kt - nit000 ) * NINT(rdttra(1))        ! date of exchanges
1198
1199      zfr_l(:,:) = 1.- fr_i(:,:)
1200
1201      !                                                      ! ------------------------- !
1202      !                                                      !    Surface temperature    !   in Kelvin
1203      !                                                      ! ------------------------- !
1204      SELECT CASE( cn_snd_temperature)
1205      CASE( 'oce only'             )   ;   ztmp1(:,:) =   tn(:,:,1) + rt0
1206      CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tn(:,:,1) + rt0 ) * zfr_l(:,:)   
1207                                           ztmp2(:,:) =   tn_ice(:,:,1)     *  fr_i(:,:)
1208      CASE( 'mixed oce-ice'        )   ;   ztmp1(:,:) = ( tn(:,:,1) + rt0 ) * zfr_l(:,:) + tn_ice(:,:,1) * fr_i(:,:)
1209      CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of cn_snd_temperature' )
1210      END SELECT
1211      IF( ssnd(jps_toce)%laction )   CALL cpl_prism_snd( jps_toce, isec, ztmp1, info )
1212      IF( ssnd(jps_tice)%laction )   CALL cpl_prism_snd( jps_tice, isec, ztmp2, info )
1213      IF( ssnd(jps_tmix)%laction )   CALL cpl_prism_snd( jps_tmix, isec, ztmp1, info )
1214      !
1215      !                                                      ! ------------------------- !
1216      !                                                      !           Albedo          !
1217      !                                                      ! ------------------------- !
1218      IF( ssnd(jps_albice)%laction ) THEN                         ! ice
1219         ztmp1(:,:) = alb_ice(:,:,1) * fr_i(:,:)
1220         CALL cpl_prism_snd( jps_albice, isec, ztmp1, info )
1221      ENDIF
1222      IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean
1223         ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) + alb_ice(:,:,1) * fr_i(:,:)
1224         CALL cpl_prism_snd( jps_albmix, isec, ztmp1, info )
1225      ENDIF
1226      !                                                      ! ------------------------- !
1227      !                                                      !  Ice fraction & Thickness !
1228      !                                                      ! ------------------------- !
1229      IF( ssnd(jps_fice)%laction )   CALL cpl_prism_snd( jps_fice, isec, fr_i                  , info )
1230      IF( ssnd(jps_hice)%laction )   CALL cpl_prism_snd( jps_hice, isec, hicif(:,:) * fr_i(:,:), info )
1231      IF( ssnd(jps_hsnw)%laction )   CALL cpl_prism_snd( jps_hsnw, isec, hsnif(:,:) * fr_i(:,:), info )
1232      !
1233#if defined key_cpl_carbon_cycle
1234      !                                                      ! ------------------------- !
1235      !                                                      !  CO2 flux from PISCES     !
1236      !                                                      ! ------------------------- !
1237      IF( ssnd(jps_co2)%laction )   CALL cpl_prism_snd( jps_co2, isec, oce_co2 , info )
1238      !
1239#endif
1240      IF( ssnd(jps_ocx1)%laction ) THEN                      !      Surface current      !
1241         !                                                   ! ------------------------- !
1242         !   
1243         !                                                  j+1   j     -----V---F
1244         ! surface velocity always sent from T point                     !       |
1245         !                                                        j      |   T   U
1246         !                                                               |       |
1247         !                                                   j    j-1   -I-------|
1248         !                                               (for I)         |       |
1249         !                                                              i-1  i   i
1250         !                                                               i      i+1 (for I)
1251         SELECT CASE( TRIM( cn_snd_crt(1) ) )
1252         CASE( 'oce only'             )      ! C-grid ==> T
1253            DO jj = 2, jpjm1
1254               DO ji = fs_2, fs_jpim1   ! vector opt.
1255                  zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) )
1256                  zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) ) 
1257               END DO
1258            END DO
1259         CASE( 'weighted oce and ice' )   
1260            SELECT CASE ( cigr_type )
1261            CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
1262               DO jj = 2, jpjm1
1263                  DO ji = fs_2, fs_jpim1   ! vector opt.
1264                     zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj) 
1265                     zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)
1266                     zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
1267                     zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
1268                  END DO
1269               END DO
1270            CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T
1271               DO jj = 2, jpjm1
1272                  DO ji = 2, jpim1   ! NO vector opt.
1273                     zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj) 
1274                     zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj) 
1275                     zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     &
1276                        &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
1277                     zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     &
1278                        &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
1279                  END DO
1280               END DO
1281            CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T
1282               DO jj = 2, jpjm1
1283                  DO ji = 2, jpim1   ! NO vector opt.
1284                     zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj) 
1285                     zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj) 
1286                     zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &
1287                        &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
1288                     zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &
1289                        &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
1290                  END DO
1291               END DO
1292            END SELECT
1293            CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. )
1294         CASE( 'mixed oce-ice'        )
1295            SELECT CASE ( cigr_type )
1296            CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
1297               DO jj = 2, jpjm1
1298                  DO ji = fs_2, fs_jpim1   ! vector opt.
1299                     zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   &
1300                        &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
1301                     zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   &
1302                        &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
1303                  END DO
1304               END DO
1305            CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T
1306               DO jj = 2, jpjm1
1307                  DO ji = 2, jpim1   ! NO vector opt.
1308                     zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &   
1309                        &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     &
1310                        &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
1311                     zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
1312                        &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     &
1313                        &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
1314                  END DO
1315               END DO
1316            CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T
1317               DO jj = 2, jpjm1
1318                  DO ji = 2, jpim1   ! NO vector opt.
1319                     zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &   
1320                        &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &
1321                        &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
1322                     zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
1323                        &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &
1324                        &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
1325                  END DO
1326               END DO
1327            END SELECT
1328         END SELECT
1329         CALL lbc_lnk( zotx1, 'T', -1. )   ;   CALL lbc_lnk( zoty1, 'T', -1. )
1330         !
1331         !
1332         IF( TRIM( cn_snd_crt(3) ) == 'eastward-northward' ) THEN             ! Rotation of the components
1333            !                                                                     ! Ocean component
1334            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component
1335            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component
1336            zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components
1337            zoty1(:,:) = ztmp2(:,:)
1338            IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component
1339               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component
1340               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component
1341               zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components
1342               zity1(:,:) = ztmp2(:,:)
1343            ENDIF
1344         ENDIF
1345         !
1346         ! spherical coordinates to cartesian -> 2 components to 3 components
1347         IF( TRIM( cn_snd_crt(2) ) == 'cartesian' ) THEN
1348            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents
1349            ztmp2(:,:) = zoty1(:,:)
1350            CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
1351            !
1352            IF( ssnd(jps_ivx1)%laction ) THEN           ! ice velocities
1353               ztmp1(:,:) = zitx1(:,:)
1354               ztmp1(:,:) = zity1(:,:)
1355               CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
1356            ENDIF
1357         ENDIF
1358         !
1359         IF( ssnd(jps_ocx1)%laction )   CALL cpl_prism_snd( jps_ocx1, isec, zotx1, info )   ! ocean x current 1st grid
1360         IF( ssnd(jps_ocy1)%laction )   CALL cpl_prism_snd( jps_ocy1, isec, zoty1, info )   ! ocean y current 1st grid
1361         IF( ssnd(jps_ocz1)%laction )   CALL cpl_prism_snd( jps_ocz1, isec, zotz1, info )   ! ocean z current 1st grid
1362         !
1363         IF( ssnd(jps_ivx1)%laction )   CALL cpl_prism_snd( jps_ivx1, isec, zitx1, info )   ! ice   x current 1st grid
1364         IF( ssnd(jps_ivy1)%laction )   CALL cpl_prism_snd( jps_ivy1, isec, zity1, info )   ! ice   y current 1st grid
1365         IF( ssnd(jps_ivz1)%laction )   CALL cpl_prism_snd( jps_ivz1, isec, zitz1, info )   ! ice   z current 1st grid
1366         !
1367      ENDIF
1368   !
1369   END SUBROUTINE sbc_cpl_snd
1370   
1371#else
1372   !!----------------------------------------------------------------------
1373   !!   Dummy module                                            NO coupling
1374   !!----------------------------------------------------------------------
1375   USE par_kind        ! kind definition
1376CONTAINS
1377   SUBROUTINE sbc_cpl_snd( kt )
1378      WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt
1379   END SUBROUTINE sbc_cpl_snd
1380   !
1381   SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )     
1382      WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt, k_fsbc, k_ice
1383   END SUBROUTINE sbc_cpl_rcv
1384   !
1385   SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )     
1386      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2]
1387      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid)
1388      p_taui(:,:) = 0.   ;   p_tauj(:,:) = 0. ! stupid definition to avoid warning message when compiling...
1389      WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?'
1390   END SUBROUTINE sbc_cpl_ice_tau
1391   !
1392   SUBROUTINE sbc_cpl_ice_flx( p_frld  ,                                  &
1393      &                        pqns_tot, pqns_ice, pqsr_tot , pqsr_ice,   &
1394      &                        pemp_tot, pemp_ice, pdqns_ice, psprecip,   &
1395      &                        palbi   , psst    , pist                )
1396      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   p_frld     ! lead fraction                [0 to 1]
1397      REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqns_tot   ! total non solar heat flux    [W/m2]
1398      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqns_ice   ! ice   non solar heat flux    [W/m2]
1399      REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqsr_tot   ! total     solar heat flux    [W/m2]
1400      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqsr_ice   ! ice       solar heat flux    [W/m2]
1401      REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_tot   ! total     freshwater budget  [Kg/m2/s]
1402      REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_ice   ! ice solid freshwater budget  [Kg/m2/s]
1403      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pdqns_ice  ! d(Q non solar)/d(Temperature) over ice
1404      REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   psprecip   ! solid precipitation          [Kg/m2/s]
1405      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo
1406      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature      [Celcius]
1407      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature      [Kelvin]
1408      WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1,1), palbi(1,1,1), psst(1,1), pist(1,1,1) 
1409      ! stupid definition to avoid warning message when compiling...
1410      pqns_tot(:,:) = 0. ; pqns_ice(:,:,:) = 0. ; pdqns_ice(:,:,:) = 0.
1411      pqsr_tot(:,:) = 0. ; pqsr_ice(:,:,:) = 0. 
1412      pemp_tot(:,:) = 0. ; pemp_ice(:,:)   = 0. ; psprecip(:,:) = 0.
1413   END SUBROUTINE sbc_cpl_ice_flx
1414   
1415#endif
1416
1417   !!======================================================================
1418END MODULE sbccpl
Note: See TracBrowser for help on using the repository browser.