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

source: trunk/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 2090

Last change on this file since 2090 was 2090, checked in by smasson, 14 years ago

minor bugfixes in the coupled interface, see ticket:719

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