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

source: tags/nemo_v3_2/nemo_v3_2/NEMO/OPA_SRC/SBC/sbccpl.F90 @ 1878

Last change on this file since 1878 was 1878, checked in by flavoni, 14 years ago

initial test for nemogcm

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