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.
Changeset 13655 for NEMO – NEMO

Changeset 13655 for NEMO


Ignore:
Timestamp:
2020-10-21T16:15:13+02:00 (3 years ago)
Author:
laurent
Message:

Commit all my dev of 2020!

Location:
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice
Files:
6 added
24 edited
1 moved

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ABL/ablmod.F90

    r13295 r13655  
    1919   USE sbc_oce, ONLY  : ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1, rhoa 
    2020   USE sbcblk         ! use rn_efac, cdn_oce 
    21    USE sbcblk_phy     ! use some physical constants for flux computation 
     21   USE sbc_phy        ! use some physical constants for flux computation 
    2222   ! 
    2323   USE prtctl         ! Print control                    (prt_ctl routine) 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ABL/sbcabl.F90

    r13214 r13655  
    2222   USE sbc_oce        ! Surface boundary condition: ocean fields 
    2323   USE sbcblk         ! Surface boundary condition: bulk formulae 
    24    USE sbcblk_phy     ! Surface boundary condition: bulk formulae 
     24   USE sbc_phy        ! Surface boundary condition: bulk formulae 
    2525   USE dom_oce, ONLY  : tmask 
    2626   ! 
    … …  
    320320      INTEGER ,         INTENT(in) ::   kt   ! ocean time step 
    321321      !! 
    322       REAL(wp), DIMENSION(jpi,jpj) ::   zssq, zcd_du, zsen, zevp 
     322      REAL(wp), DIMENSION(jpi,jpj) ::   zssq, zcd_du, zsen, zlat, zevp 
    323323#if defined key_si3 
    324324      REAL(wp), DIMENSION(jpi,jpj) ::   zssqi, zcd_dui, zseni, zevpi 
    … …  
    344344            &                sf(jp_uoatm)%fnow(:,:,1), sf(jp_voatm)%fnow(:,:,1),   &   !   <<= in 
    345345            &                sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1) ,   &   !   <<= in 
    346             &                tsk_m, zssq, zcd_du, zsen, zevp                       )   !   =>> out 
     346            &                tsk_m, zssq, zcd_du, zsen, zlat, zevp                 )   !   =>> out 
    347347 
    348348#if defined key_si3 
    … …  
    375375         !!------------------------------------------------------------------------------------------- 
    376376 
    377          CALL blk_oce_2( tq_abl(:,:,2,nt_n,jp_ta),                            & 
    378             &            sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1),   & 
     377         CALL blk_oce_2( tq_abl(:,:,2,nt_n,jp_ta), sf(jp_qlw )%fnow(:,:,1),   & 
    379378            &            sf(jp_prec)%fnow(:,:,1) , sf(jp_snow)%fnow(:,:,1),   & 
    380             &            tsk_m, zsen, zevp                                ) 
     379            &            tsk_m, zsen, zlat, zevp                                ) 
    381380    
    382381         CALL abl_rst_opn( kt )                       ! Open abl restart file (if necessary) 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icesbc.F90

    r13472 r13655  
    5959      !! 
    6060      INTEGER  ::   ji, jj                 ! dummy loop index 
    61       REAL(wp), DIMENSION(jpi,jpj) ::   zutau_ice, zvtau_ice  
     61      REAL(wp), DIMENSION(jpi,jpj) ::   zutau_ice, zvtau_ice 
    6262      !!------------------------------------------------------------------- 
    6363      ! 
    … …  
    7171      ! 
    7272      SELECT CASE( ksbc ) 
    73          CASE( jp_usr     )   ;    CALL usrdef_sbc_ice_tau( kt )                 ! user defined formulation 
    74          CASE( jp_blk     )   ;    CALL blk_ice_1( sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   & 
    75             &                                      sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),   & 
     73         ! 
     74      CASE( jp_usr     ) 
     75         CALL usrdef_sbc_ice_tau( kt )                 ! user defined formulation 
     76         ! 
     77      CASE( jp_blk     ) 
     78         CALL blk_ice_1( sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   & 
     79            &                                      theta_air_zt(:,:), q_air_zt(:,:),   &   ! #LB: known from "sbc_oce" module... 
    7680            &                                      sf(jp_slp )%fnow(:,:,1), u_ice, v_ice, tm_su    ,   &   ! inputs 
    77             &                                      putaui = utau_ice, pvtaui = vtau_ice            )       ! outputs                              
    78  !        CASE( jp_abl     )    utau_ice & vtau_ice are computed in ablmod 
    79          CASE( jp_purecpl )   ;    CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled      formulation 
     81            &                                      putaui = utau_ice, pvtaui = vtau_ice            )       ! outputs 
     82         !        CASE( jp_abl     )    utau_ice & vtau_ice are computed in ablmod 
     83      CASE( jp_purecpl ) 
     84         CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled      formulation 
    8085      END SELECT 
    8186      ! 
    8287      IF( ln_mixcpl) THEN                                                        ! Case of a mixed Bulk/Coupled formulation 
    83                                    CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
     88         CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
    8489         DO_2D( 0, 0, 0, 0 ) 
    85             utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
    86             vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
     90         utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
     91         vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
    8792         END_2D 
    8893         CALL lbc_lnk_multi( 'icesbc', utau_ice, 'U', -1.0_wp, vtau_ice, 'V', -1.0_wp ) 
    … …  
    9398   END SUBROUTINE ice_sbc_tau 
    9499 
    95     
     100 
    96101   SUBROUTINE ice_sbc_flx( kt, ksbc ) 
    97102      !!------------------------------------------------------------------- 
    … …  
    108113      !!                dqns_ice                                 = non solar  heat sensistivity                  [W/m2] 
    109114      !!                qemp_oce, qemp_ice, qprec_ice, qevap_ice = sensible heat (associated with evap & precip) [W/m2] 
    110       !!            + some fields that are not used outside this module:  
     115      !!            + some fields that are not used outside this module: 
    111116      !!                qla_ice                                  = latent heat flux over ice                     [W/m2] 
    112117      !!                dqla_ice                                 = latent heat sensistivity                      [W/m2] 
    … …  
    118123      ! 
    119124      INTEGER  ::   ji, jj, jl      ! dummy loop index 
    120       REAL(wp) ::   zmiss_val       ! missing value retrieved from xios  
     125      REAL(wp) ::   zmiss_val       ! missing value retrieved from xios 
    121126      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zalb, zmsk00      ! 2D workspace 
    122127      !!-------------------------------------------------------------------- 
    … …  
    138143      ! 
    139144      SELECT CASE( ksbc )   !== fluxes over sea ice ==! 
    140       ! 
     145         ! 
    141146      CASE( jp_usr )              !--- user defined formulation 
    142                                   CALL usrdef_sbc_ice_flx( kt, h_s, h_i ) 
     147         CALL usrdef_sbc_ice_flx( kt, h_s, h_i ) 
     148         ! 
    143149      CASE( jp_blk, jp_abl )  !--- bulk formulation & ABL formulation 
    144                                   CALL blk_ice_2    ( t_su, h_s, h_i, alb_ice, sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),    & 
    145             &                                           sf(jp_slp)%fnow(:,:,1), sf(jp_qlw)%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1), sf(jp_snow)%fnow(:,:,1) )    !  
     150         CALL blk_ice_2    ( t_su, h_s, h_i, alb_ice, & 
     151            &                theta_air_zt(:,:), q_air_zt(:,:),    &   ! #LB: known from "sbc_oce" module... 
     152            &                sf(jp_slp)%fnow(:,:,1), sf(jp_qlw)%fnow(:,:,1), & 
     153            &                sf(jp_prec)%fnow(:,:,1), sf(jp_snow)%fnow(:,:,1) ) 
     154         ! 
    146155         IF( ln_mixcpl        )   CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i ) 
    147156         IF( nn_flxdist /= -1 )   CALL ice_flx_dist   ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist ) 
    … …  
    150159            &                     CALL blk_ice_qcn    ( ln_virtual_itd, t_su, t_bo, h_s, h_i ) 
    151160      CASE ( jp_purecpl )         !--- coupled formulation 
    152                                   CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i ) 
     161         CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i ) 
    153162         IF( nn_flxdist /= -1 )   CALL ice_flx_dist   ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist ) 
    154163      END SELECT 
    … …  
    163172            zalb  (:,:) = rn_alb_oce 
    164173         ELSEWHERE 
    165             zmsk00(:,:) = 1._wp             
     174            zmsk00(:,:) = 1._wp 
    166175            zalb  (:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 
    167176         END WHERE 
    … …  
    185194      !!                  ***  ROUTINE ice_flx_dist  *** 
    186195      !! 
    187       !! ** Purpose :   update the ice surface boundary condition by averaging  
     196      !! ** Purpose :   update the ice surface boundary condition by averaging 
    188197      !!              and/or redistributing fluxes on ice categories 
    189198      !! 
    … …  
    192201      !! ** Action  :   depends on k_flxdist 
    193202      !!                = -1  Do nothing (needs N(cat) fluxes) 
    194       !!                =  0  Average N(cat) fluxes then apply the average over the N(cat) ice  
     203      !!                =  0  Average N(cat) fluxes then apply the average over the N(cat) ice 
    195204      !!                =  1  Average N(cat) fluxes then redistribute over the N(cat) ice 
    196205      !!                                                 using T-ice and albedo sensitivity 
    … …  
    219228      !!---------------------------------------------------------------------- 
    220229      ! 
    221       WHERE ( at_i (:,:) > 0._wp )   ; z1_at_i(:,:) = 1._wp / at_i (:,:) 
    222       ELSEWHERE                      ; z1_at_i(:,:) = 0._wp 
     230      WHERE ( at_i (:,:) > 0._wp ) 
     231         z1_at_i(:,:) = 1._wp / at_i (:,:) 
     232      ELSEWHERE 
     233         z1_at_i(:,:) = 0._wp 
    223234      END WHERE 
    224        
     235 
    225236      SELECT CASE( k_flxdist )       !==  averaged on all ice categories  ==! 
    226       ! 
     237         ! 
    227238      CASE( 0 , 1 ) 
    228239         ! 
    229          ALLOCATE( z_qns_m(jpi,jpj), z_qsr_m(jpi,jpj), z_dqn_m(jpi,jpj), z_evap_m(jpi,jpj), z_devap_m(jpi,jpj) )   
     240         ALLOCATE( z_qns_m(jpi,jpj), z_qsr_m(jpi,jpj), z_dqn_m(jpi,jpj), z_evap_m(jpi,jpj), z_devap_m(jpi,jpj) ) 
    230241         ! 
    231242         z_qns_m  (:,:) = SUM( a_i(:,:,:) * pqns_ice  (:,:,:) , dim=3 ) * z1_at_i(:,:) 
    … …  
    242253         END DO 
    243254         ! 
    244          DEALLOCATE( z_qns_m, z_qsr_m, z_dqn_m, z_evap_m, z_devap_m )   
     255         DEALLOCATE( z_qns_m, z_qsr_m, z_dqn_m, z_evap_m, z_devap_m ) 
    245256         ! 
    246257      END SELECT 
    247258      ! 
    248259      SELECT CASE( k_flxdist )       !==  redistribution on all ice categories  ==! 
    249       ! 
     260         ! 
    250261      CASE( 1 , 2 ) 
    251262         ! 
    252          ALLOCATE( zalb_m(jpi,jpj), ztem_m(jpi,jpj) )   
     263         ALLOCATE( zalb_m(jpi,jpj), ztem_m(jpi,jpj) ) 
    253264         ! 
    254265         zalb_m(:,:) = SUM( a_i(:,:,:) * palb_ice(:,:,:) , dim=3 ) * z1_at_i(:,:) 
    … …  
    260271         END DO 
    261272         ! 
    262          DEALLOCATE( zalb_m, ztem_m )   
     273         DEALLOCATE( zalb_m, ztem_m ) 
    263274         ! 
    264275      END SELECT 
    … …  
    272283      !! 
    273284      !! ** Purpose :   Physical constants and parameters linked to the ice dynamics 
    274       !!       
     285      !! 
    275286      !! ** Method  :   Read the namsbc namelist and check the ice-dynamic 
    276287      !!              parameter values called at the first timestep (nit000) 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icestp.F90

    r13641 r13655  
    88   !!                        aka Sea Ice cube for its nickname 
    99   !! 
    10    !!    is originally based on LIM3, developed in Louvain-la-Neuve by:  
     10   !!    is originally based on LIM3, developed in Louvain-la-Neuve by: 
    1111   !!       * Martin Vancoppenolle (UCL-ASTR, Belgium) 
    1212   !!       * Sylvain Bouillon (UCL-ASTR, Belgium) 
    … …  
    140140         IF( .NOT. Agrif_Root() )       nbstep_ice = MOD( nbstep_ice, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) + 1 
    141141         !                              ! these calls must remain here for restartability purposes 
    142                                         CALL agrif_interp_ice( 'T' )  
     142                                        CALL agrif_interp_ice( 'T' ) 
    143143                                        CALL agrif_interp_ice( 'U' ) 
    144144                                        CALL agrif_interp_ice( 'V' ) 
    … …  
    152152         !    utau_ice, vtau_ice = surface ice stress [N/m2] 
    153153         !------------------------------------------------! 
    154                                         CALL ice_sbc_tau( kt, ksbc, utau_ice, vtau_ice )           
     154                                        CALL ice_sbc_tau( kt, ksbc, utau_ice, vtau_ice ) 
    155155         !-------------------------------------! 
    156156         ! --- ice dynamics and advection  --- ! 
    157157         !-------------------------------------! 
    158158                                        CALL diag_set0                ! set diag of mass, heat and salt fluxes to 0 
    159                                         CALL ice_rst_opn( kt )        ! Open Ice restart file (if necessary)  
     159                                        CALL ice_rst_opn( kt )        ! Open Ice restart file (if necessary) 
    160160         ! 
    161161         IF( ln_icedyn .AND. .NOT.lk_c1d )   & 
    … …  
    169169         !                          !==  previous lead fraction and ice volume for flux calculations 
    170170                                        CALL ice_var_glo2eqv          ! h_i and h_s for ice albedo calculation 
    171                                         CALL ice_var_agg(1)           ! at_i for coupling  
     171                                        CALL ice_var_agg(1)           ! at_i for coupling 
    172172                                        CALL store_fields             ! Store now ice values 
    173173         ! 
    … …  
    189189         ! --- ice thermodynamics --- ! 
    190190         !----------------------------! 
    191          IF( ln_icethd )                CALL ice_thd( kt )            ! -- Ice thermodynamics       
     191         IF( ln_icethd )                CALL ice_thd( kt )            ! -- Ice thermodynamics 
    192192         ! 
    193193                                        CALL diag_trends( 2 )         ! record thermo trends 
    … …  
    197197                                        CALL ice_update_flx( kt )     ! -- Update ocean surface mass, heat and salt fluxes 
    198198         ! 
    199          IF( ln_icediahsb )             CALL ice_dia( kt )            ! -- Diagnostics outputs  
    200          ! 
    201          IF( ln_icediachk )             CALL ice_drift_wri( kt )      ! -- Diagnostics outputs for conservation  
    202          ! 
    203                                         CALL ice_wri( kt )            ! -- Ice outputs  
    204          ! 
    205          IF( lrst_ice )                 CALL ice_rst_write( kt )      ! -- Ice restart file  
     199         IF( ln_icediahsb )             CALL ice_dia( kt )            ! -- Diagnostics outputs 
     200         ! 
     201         IF( ln_icediachk )             CALL ice_drift_wri( kt )      ! -- Diagnostics outputs for conservation 
     202         ! 
     203                                        CALL ice_wri( kt )            ! -- Ice outputs 
     204         ! 
     205         IF( lrst_ice )                 CALL ice_rst_write( kt )      ! -- Ice restart file 
    206206         ! 
    207207         IF( ln_icectl )                CALL ice_ctl( kt )            ! -- Control checks 
    … …  
    231231      !!---------------------------------------------------------------------- 
    232232      IF(lwp) WRITE(numout,*) 
    233       IF(lwp) WRITE(numout,*) 'Sea Ice Model: SI3 (Sea Ice modelling Integrated Initiative)'  
     233      IF(lwp) WRITE(numout,*) 'Sea Ice Model: SI3 (Sea Ice modelling Integrated Initiative)' 
    234234      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 
    235235      IF(lwp) WRITE(numout,*) 
    236       IF(lwp) WRITE(numout,*) 'ice_init: Arrays allocation & Initialization of all routines & init state'  
     236      IF(lwp) WRITE(numout,*) 'ice_init: Arrays allocation & Initialization of all routines & init state' 
    237237      IF(lwp) WRITE(numout,*) '~~~~~~~~' 
    238238      ! 
    … …  
    250250      !                                ! Allocate the ice arrays (sbc_ice already allocated in sbc_init) 
    251251      ierr =        ice_alloc        ()      ! ice variables 
    252       ierr = ierr + sbc_ice_alloc    ()      ! surface boundary conditions  
     252      ierr = ierr + sbc_ice_alloc    ()      ! surface boundary conditions 
    253253      ierr = ierr + ice1D_alloc      ()      ! thermodynamics 
    254254      ! 
    … …  
    330330         WRITE(numout,*) '         Ice dynamics       (T) or not (F)                   ln_icedyn = ', ln_icedyn 
    331331         WRITE(numout,*) '         Ice thermodynamics (T) or not (F)                   ln_icethd = ', ln_icethd 
    332          WRITE(numout,*) '         maximum ice concentration for NH                              = ', rn_amax_n  
     332         WRITE(numout,*) '         maximum ice concentration for NH                              = ', rn_amax_n 
    333333         WRITE(numout,*) '         maximum ice concentration for SH                              = ', rn_amax_s 
    334334      ENDIF 
    … …  
    412412         wfx_bom(ji,jj) = 0._wp   ;   wfx_sum(ji,jj) = 0._wp 
    413413         wfx_res(ji,jj) = 0._wp   ;   wfx_sub(ji,jj) = 0._wp 
    414          wfx_spr(ji,jj) = 0._wp   ;   wfx_lam(ji,jj) = 0._wp   
     414         wfx_spr(ji,jj) = 0._wp   ;   wfx_lam(ji,jj) = 0._wp 
    415415         wfx_snw_dyn(ji,jj) = 0._wp ; wfx_snw_sum(ji,jj) = 0._wp 
    416416         wfx_snw_sub(ji,jj) = 0._wp ; wfx_ice_sub(ji,jj) = 0._wp 
    417          wfx_snw_sni(ji,jj) = 0._wp  
     417         wfx_snw_sni(ji,jj) = 0._wp 
    418418         wfx_pnd(ji,jj) = 0._wp 
    419419 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/DOM/phycst.F90

    r12489 r13655  
    77   !!             8.1  !  1991-11  (G. Madec, M. Imbard)  cosmetic changes 
    88   !!   NEMO      1.0  !  2002-08  (G. Madec, C. Ethe)  F90, add ice constants 
    9    !!              -   !  2006-08  (G. Madec)  style  
    10    !!             3.2  !  2006-08  (S. Masson, G. Madec)  suppress useless variables + style  
    11    !!             3.4  !  2011-11  (C. Harris)  minor changes for CICE constants  
     9   !!              -   !  2006-08  (G. Madec)  style 
     10   !!             3.2  !  2006-08  (S. Masson, G. Madec)  suppress useless variables + style 
     11   !!             3.4  !  2011-11  (C. Harris)  minor changes for CICE constants 
    1212   !!---------------------------------------------------------------------- 
    1313 
    … …  
    2626   REAL(wp), PUBLIC ::   rad      = 3.141592653589793_wp / 180._wp   !: conversion from degre into radian 
    2727   REAL(wp), PUBLIC ::   rsmall   = 0.5 * EPSILON( 1.e0 )            !: smallest real computer value 
    28     
     28 
    2929   REAL(wp), PUBLIC ::   rday     = 24.*60.*60.      !: day                                [s] 
    3030   REAL(wp), PUBLIC ::   rsiyea                      !: sideral year                       [s] 
    … …  
    3636   REAL(wp), PUBLIC ::   omega                       !: earth rotation parameter           [s-1] 
    3737   REAL(wp), PUBLIC ::   ra       = 6371229._wp      !: earth radius                       [m] 
    38    REAL(wp), PUBLIC ::   grav     = 9.80665_wp       !: gravity                            [m/s2]    
     38   REAL(wp), PUBLIC ::   grav     = 9.80665_wp       !: gravity                            [m/s2] 
    3939   REAL(wp), PUBLIC ::   rt0      = 273.15_wp        !: freezing point of fresh water [Kelvin] 
    4040 
    … …  
    4343   REAL(wp), PUBLIC ::   rcp                         !: ocean specific heat           [J/Kelvin] 
    4444   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J] 
    45    REAL(wp), PUBLIC ::   rho0_rcp                    !: = rho0 * rcp  
     45   REAL(wp), PUBLIC ::   rho0_rcp                    !: = rho0 * rcp 
    4646   REAL(wp), PUBLIC ::   r1_rho0_rcp                 !: = 1. / ( rho0 * rcp ) 
    4747 
    … …  
    5252   REAL(wp), PUBLIC ::   rLevap   =    2.5e+6_wp     !: latent heat of evaporation (water) 
    5353   REAL(wp), PUBLIC ::   vkarmn   =    0.4_wp        !: von Karman constant 
    54    REAL(wp), PUBLIC ::   stefan   =    5.67e-8_wp    !: Stefan-Boltzmann constant  
     54   REAL(wp), PUBLIC ::   vkarmn2  =    0.4_wp*0.4_wp !: square of von Karman constant 
     55   REAL(wp), PUBLIC ::   stefan   =    5.67e-8_wp    !: Stefan-Boltzmann constant 
    5556 
    5657   REAL(wp), PUBLIC ::   rhos     =  330._wp         !: volumic mass of snow                                  [kg/m3] 
    … …  
    6869   !!---------------------------------------------------------------------- 
    6970   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    70    !! $Id$  
     71   !! $Id$ 
    7172   !! Software governed by the CeCILL license (see ./LICENSE) 
    7273   !!---------------------------------------------------------------------- 
    73     
     74 
    7475CONTAINS 
    75     
     76 
    7677   SUBROUTINE phy_cst 
    7778      !!---------------------------------------------------------------------- 
    … …  
    8687      omega  = 7.292116e-05 
    8788#else 
    88       omega  = 2._wp * rpi / rsiday  
     89      omega  = 2._wp * rpi / rsiday 
    8990#endif 
    9091 
    … …  
    125126         WRITE(numout,*) '      salinity of ice (for pisces)              = ', sice    , ' psu' 
    126127         WRITE(numout,*) '      salinity of sea (for pisces and isf)      = ', soce    , ' psu' 
    127          WRITE(numout,*) '      latent heat of evaporation (water)        = ', rLevap  , ' J/m^3'  
    128          WRITE(numout,*) '      von Karman constant                       = ', vkarmn  
     128         WRITE(numout,*) '      latent heat of evaporation (water)        = ', rLevap  , ' J/m^3' 
     129         WRITE(numout,*) '      von Karman constant                       = ', vkarmn 
    129130         WRITE(numout,*) '      Stefan-Boltzmann constant                 = ', stefan  , ' J/s/m^2/K^4' 
    130131         WRITE(numout,*) 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbc_ice.F90

    r13472 r13655  
    9999#endif 
    100100 
    101    REAL(wp), PUBLIC, SAVE ::   pp_cldf = 0.81    !: cloud fraction over sea ice, summer CLIO value   [-] 
     101   !#LB: REAL(wp), PUBLIC, SAVE ::   pp_cldf = 0.81    !: cloud fraction over sea ice, summer CLIO value   [-] !#LB => moved to sbc_phy.F90 !!! 
    102102 
    103103   !! arrays relating to embedding ice in the ocean 
    … …  
    168168   LOGICAL         , PUBLIC, PARAMETER ::   lk_si3     = .FALSE.  !: no SI3 ice model 
    169169   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE ice model 
    170    REAL(wp)        , PUBLIC, PARAMETER ::   pp_cldf    = 0.81     !: cloud fraction over sea ice, summer CLIO value   [-] 
     170   !#LB: REAL(wp)        , PUBLIC, PARAMETER ::   pp_cldf    = 0.81     !: cloud fraction over sea ice, summer CLIO value   [-] !#LB => moved to sbc_phy.F90 !!!   
    171171   INTEGER         , PUBLIC, PARAMETER ::   jpl = 1  
    172172   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice                        ! jpi, jpj 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbc_oce.F90

    r13472 r13655  
    159159   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frq_m     !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-] 
    160160 
     161   !#LB: 
     162   !!---------------------------------------------------------------------- 
     163   !!                     Surface atmospheric fields 
     164   !!---------------------------------------------------------------------- 
     165   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_air_zt       !: specific humidity of air at z=zt [kg/kg]ww 
     166   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: theta_air_zt   !: potential temperature of air at z=zt [K] 
     167   !#LB. 
     168 
     169    
    161170   !! * Substitutions 
    162171#  include "do_loop_substitute.h90" 
    … …  
    172181      !!                  ***  FUNCTION sbc_oce_alloc  *** 
    173182      !!--------------------------------------------------------------------- 
    174       INTEGER :: ierr(5) 
     183      INTEGER :: ierr(6) 
    175184      !!--------------------------------------------------------------------- 
    176185      ierr(:) = 0 
    … …  
    194203      ! 
    195204      ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) ) 
     205      ! 
     206      ALLOCATE( q_air_zt(jpi,jpj) , theta_air_zt(jpi,jpj) , STAT=ierr(6) ) !#LB 
    196207      ! 
    197208      sbc_oce_alloc = MAXVAL( ierr ) 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbc_phy.F90

    r13654 r13655  
    1 MODULE sbcblk_phy 
     1MODULE sbc_phy 
    22   !!====================================================================== 
    3    !!                       ***  MODULE  sbcblk_phy  *** 
     3   !!                       ***  MODULE  sbc_phy  *** 
    44   !! A set of functions to compute air themodynamics parameters 
    55   !!                     needed by Aerodynamic Bulk Formulas 
    66   !!===================================================================== 
    7    !!            4.0  !  2019 L. Brodeau from AeroBulk package (https://github.com/brodeau/aerobulk/) 
     7   !!            4.x  !  2020 L. Brodeau from AeroBulk package (https://github.com/brodeau/aerobulk/) 
    88   !!---------------------------------------------------------------------- 
    99 
    … …  
    1414   !!   cp_air        : specific heat of (moist) air (depends spec. hum. q_air) 
    1515   !!   gamma_moist   : adiabatic lapse-rate of moist air 
    16    !!   One_on_L      : 1. / ( Monin-Obukhov length ) 
     16   !!   One_on_L      : 1. / ( Obukhov length ) 
    1717   !!   Ri_bulk       : bulk Richardson number aka BRN 
    1818   !!   q_sat         : saturation humidity as a function of SLP and temperature 
    … …  
    2424   IMPLICIT NONE 
    2525   PRIVATE 
     26 
     27   INTEGER , PARAMETER, PUBLIC  :: nb_iter0 = 5 ! Default number of itterations in bulk-param algorithms (can be overriden b.m.o `nb_iter` optional argument) 
    2628 
    2729   !!  (mainly removed from sbcblk.F90) 
    … …  
    3335   REAL(wp), PARAMETER, PUBLIC :: rctv0   = R_vap/R_dry - 1._wp  !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 
    3436   REAL(wp), PARAMETER, PUBLIC :: rCp_air = 1000.5_wp   !: specific heat of air (only used for ice fluxes now...) 
    35    REAL(wp), PARAMETER, PUBLIC :: rCd_ice = 1.4e-3_wp   !: transfer coefficient over ice 
    3637   REAL(wp), PARAMETER, PUBLIC :: albo    = 0.066_wp    !: ocean albedo assumed to be constant 
    3738   ! 
    … …  
    4445   REAL(wp), PARAMETER, PUBLIC :: rk0_w   = 0.6_wp      !: thermal conductivity of water (at 20C)          [W/m/K] 
    4546   ! 
    46    REAL(wp), PARAMETER, PUBLIC :: emiss_w = 1._wp       !: Surface emissivity (black-body long-wave radiation) of sea-water [] 
    47    !                                                    !: Theoretically close to 0.97! Yet, taken equal as 1 to account for 
    48    !                                                    !: the small fraction of downwelling longwave reflected at the 
    49    !                                                    !: surface (Lind & Katsaros, 1986) 
     47   REAL(wp), PARAMETER, PUBLIC :: emiss_w = 0.98_wp     !: Long-wave (thermal) emissivity of sea-water [] 
     48   ! 
     49   REAL(wp), PARAMETER, PUBLIC :: emiss_i = 0.996_wp    !:  "   for ice and snow => but Rees 1993 suggests can be lower in winter on fresh snow... 0.72 ... 
     50 
     51   REAL(wp), PARAMETER, PUBLIC :: wspd_thrshld_ice = 0.2_wp !: minimum scalar wind speed accepted over sea-ice... [m/s] 
     52 
     53   ! 
    5054   REAL(wp), PARAMETER, PUBLIC :: rdct_qsat_salt = 0.98_wp  !: reduction factor on specific humidity at saturation (q_sat(T_s)) due to salt 
    5155   REAL(wp), PARAMETER, PUBLIC :: rtt0 = 273.16_wp        !: triple point of temperature    [K] 
    … …  
    5458   !                              => see eq.(14) in Fairall et al. 1996   (eq.(6) of Zeng aand Beljaars is WRONG! (typo?) 
    5559 
     60   REAL(wp), PARAMETER, PUBLIC :: z0_sea_max = 0.0025_wp   !: maximum realistic value for roughness length of sea-surface... [m] 
     61 
     62   REAL(wp), PUBLIC, SAVE ::   pp_cldf = 0.81    !: cloud fraction over sea ice, summer CLIO value   [-] 
     63 
     64 
     65   REAL(wp), PARAMETER, PUBLIC :: Cx_min = 0.1E-3_wp ! smallest value allowed for bulk transfer coefficients (usually in stable conditions with now wind) 
     66 
     67   REAL(wp), PARAMETER :: & 
     68                                !! Constants for Goff formula in the presence of ice: 
     69      &      rAg_i = -9.09718_wp, & 
     70      &      rBg_i = -3.56654_wp, & 
     71      &      rCg_i = 0.876793_wp, & 
     72      &      rDg_i = LOG10(6.1071_wp) 
     73 
     74   REAL(wp), PARAMETER :: rc_louis  = 5._wp 
     75   REAL(wp), PARAMETER :: rc2_louis = rc_louis * rc_louis 
     76   REAL(wp), PARAMETER :: ram_louis = 2. * rc_louis 
     77   REAL(wp), PARAMETER :: rah_louis = 3. * rc_louis 
     78 
     79 
     80   INTERFACE virt_temp 
     81      MODULE PROCEDURE virt_temp_vctr, virt_temp_sclr 
     82   END INTERFACE virt_temp 
     83 
     84   INTERFACE visc_air 
     85      MODULE PROCEDURE visc_air_vctr, visc_air_sclr 
     86   END INTERFACE visc_air 
    5687 
    5788   INTERFACE gamma_moist 
    … …  
    6394   END INTERFACE e_sat 
    6495 
     96   INTERFACE e_sat_ice 
     97      MODULE PROCEDURE e_sat_ice_vctr, e_sat_ice_sclr 
     98   END INTERFACE e_sat_ice 
     99   INTERFACE de_sat_dt_ice 
     100      MODULE PROCEDURE de_sat_dt_ice_vctr, de_sat_dt_ice_sclr 
     101   END INTERFACE de_sat_dt_ice 
     102 
     103   INTERFACE Ri_bulk 
     104      MODULE PROCEDURE Ri_bulk_vctr, Ri_bulk_sclr 
     105   END INTERFACE Ri_bulk 
     106 
     107   INTERFACE q_sat 
     108      MODULE PROCEDURE q_sat_vctr, q_sat_sclr 
     109   END INTERFACE q_sat 
     110 
     111   INTERFACE dq_sat_dt_ice 
     112      MODULE PROCEDURE dq_sat_dt_ice_vctr, dq_sat_dt_ice_sclr 
     113   END INTERFACE dq_sat_dt_ice 
     114 
    65115   INTERFACE L_vap 
    66116      MODULE PROCEDURE L_vap_vctr, L_vap_sclr 
    … …  
    83133   END INTERFACE bulk_formula 
    84134 
     135   INTERFACE qlw_net 
     136      MODULE PROCEDURE qlw_net_vctr, qlw_net_sclr 
     137   END INTERFACE qlw_net 
     138 
     139   INTERFACE f_m_louis 
     140      MODULE PROCEDURE f_m_louis_vctr, f_m_louis_sclr 
     141   END INTERFACE f_m_louis 
     142 
     143   INTERFACE f_h_louis 
     144      MODULE PROCEDURE f_h_louis_vctr, f_h_louis_sclr 
     145   END INTERFACE f_h_louis 
    85146 
    86147 
    … …  
    95156   PUBLIC q_sat 
    96157   PUBLIC q_air_rh 
     158   PUBLIC dq_sat_dt_ice 
    97159   !: 
    98160   PUBLIC update_qnsol_tau 
    99161   PUBLIC alpha_sw 
    100162   PUBLIC bulk_formula 
     163   PUBLIC qlw_net 
     164   ! 
     165   PUBLIC f_m_louis, f_h_louis 
     166   PUBLIC z0_from_Cd 
     167   PUBLIC Cd_from_z0 
     168   PUBLIC UN10_from_ustar 
     169   PUBLIC UN10_from_CD 
     170   PUBLIC z0tq_LKB 
    101171 
    102172   !! * Substitutions 
    … …  
    109179CONTAINS 
    110180 
    111    FUNCTION virt_temp( pta, pqa ) 
     181 
     182   FUNCTION virt_temp_sclr( pta, pqa ) 
    112183      !!------------------------------------------------------------------------ 
    113184      !! 
    114       !! Compute the (absolute/potential) virtual temperature, knowing the 
     185      !! Compute the (absolute/potential) VIRTUAL temperature, based on the 
    115186      !! (absolute/potential) temperature and specific humidity 
    116187      !! 
    117       !! If input temperature is absolute then output vitual temperature is absolute 
    118       !! If input temperature is potential then output vitual temperature is potential 
     188      !! If input temperature is absolute then output virtual temperature is absolute 
     189      !! If input temperature is potential then output virtual temperature is potential 
    119190      !! 
    120191      !! Author: L. Brodeau, June 2019 / AeroBulk 
    121192      !!         (https://github.com/brodeau/aerobulk/) 
    122193      !!------------------------------------------------------------------------ 
    123       REAL(wp), DIMENSION(jpi,jpj)             :: virt_temp         !: 1./(Monin Obukhov length) [m^-1] 
    124       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pta,  &  !: absolute or potetntial air temperature [K] 
    125          &                                        pqa      !: specific humidity of air   [kg/kg] 
     194      REAL(wp)             :: virt_temp_sclr !: virtual temperature [K] 
     195      REAL(wp), INTENT(in) :: pta       !: absolute or potential air temperature [K] 
     196      REAL(wp), INTENT(in) :: pqa       !: specific humidity of air   [kg/kg] 
    126197      !!------------------------------------------------------------------- 
    127198      ! 
    128       virt_temp(:,:) = pta(:,:) * (1._wp + rctv0*pqa(:,:)) 
    129       !! 
    130       !! This is exactly the same sing that: 
    131       !! virt_temp = pta * ( pwa + reps0) / (reps0*(1.+pwa)) 
     199      virt_temp_sclr = pta * (1._wp + rctv0*pqa) 
     200      !! 
     201      !! This is exactly the same thing as: 
     202      !! virt_temp_sclr = pta * ( pwa + reps0) / (reps0*(1.+pwa)) 
    132203      !! with wpa (mixing ration) defined as : pwa = pqa/(1.-pqa) 
    133204      ! 
    134    END FUNCTION virt_temp 
    135  
    136    FUNCTION rho_air_vctr( ptak, pqa, pslp ) 
     205   END FUNCTION virt_temp_sclr 
     206   !! 
     207   FUNCTION virt_temp_vctr( pta, pqa ) 
     208      REAL(wp), DIMENSION(jpi,jpj)             :: virt_temp_vctr !: virtual temperature [K] 
     209      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pta !: absolute or potential air temperature [K] 
     210      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa !: specific humidity of air   [kg/kg] 
     211      virt_temp_vctr(:,:) = pta(:,:) * (1._wp + rctv0*pqa(:,:)) 
     212   END FUNCTION virt_temp_vctr 
     213   !=============================================================================================== 
     214 
     215 
     216   FUNCTION rho_air_vctr( ptak, pqa, ppa ) 
    137217      !!------------------------------------------------------------------------------- 
    138218      !!                           ***  FUNCTION rho_air_vctr  *** 
    … …  
    144224      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak      ! air temperature             [K] 
    145225      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa       ! air specific humidity   [kg/kg] 
    146       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp      ! pressure in                [Pa] 
     226      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ppa      ! pressure in                [Pa] 
    147227      REAL(wp), DIMENSION(jpi,jpj)             ::   rho_air_vctr   ! density of moist air   [kg/m^3] 
    148228      !!------------------------------------------------------------------------------- 
    149       rho_air_vctr = MAX( pslp / (R_dry*ptak * ( 1._wp + rctv0*pqa )) , 0.8_wp ) 
     229      rho_air_vctr = MAX( ppa / (R_dry*ptak * ( 1._wp + rctv0*pqa )) , 0.8_wp ) 
    150230   END FUNCTION rho_air_vctr 
    151231 
    152    FUNCTION rho_air_sclr( ptak, pqa, pslp ) 
     232   FUNCTION rho_air_sclr( ptak, pqa, ppa ) 
    153233      !!------------------------------------------------------------------------------- 
    154234      !!                           ***  FUNCTION rho_air_sclr  *** 
    … …  
    160240      REAL(wp), INTENT(in) :: ptak           ! air temperature             [K] 
    161241      REAL(wp), INTENT(in) :: pqa            ! air specific humidity   [kg/kg] 
    162       REAL(wp), INTENT(in) :: pslp           ! pressure in                [Pa] 
     242      REAL(wp), INTENT(in) :: ppa           ! pressure in                [Pa] 
    163243      REAL(wp)             :: rho_air_sclr   ! density of moist air   [kg/m^3] 
    164244      !!------------------------------------------------------------------------------- 
    165       rho_air_sclr = MAX( pslp / (R_dry*ptak * ( 1._wp + rctv0*pqa )) , 0.8_wp ) 
     245      rho_air_sclr = MAX( ppa / (R_dry*ptak * ( 1._wp + rctv0*pqa )) , 0.8_wp ) 
    166246   END FUNCTION rho_air_sclr 
    167247 
    168248 
    169249 
    170    FUNCTION visc_air(ptak) 
    171       !!---------------------------------------------------------------------------------- 
    172       !! Air kinetic viscosity (m^2/s) given from temperature in degrees... 
     250 
     251   FUNCTION visc_air_sclr(ptak) 
     252      !!---------------------------------------------------------------------------------- 
     253      !! Air kinetic viscosity (m^2/s) given from air temperature in Kelvin 
    173254      !! 
    174255      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    175256      !!---------------------------------------------------------------------------------- 
    176       REAL(wp), DIMENSION(jpi,jpj)             ::   visc_air   ! 
     257      REAL(wp)             :: visc_air_sclr   ! kinetic viscosity (m^2/s) 
     258      REAL(wp), INTENT(in) :: ptak       ! air temperature in (K) 
     259      ! 
     260      REAL(wp) ::   ztc, ztc2   ! local scalar 
     261      !!---------------------------------------------------------------------------------- 
     262      ! 
     263      ztc  = ptak - rt0   ! air temp, in deg. C 
     264      ztc2 = ztc*ztc 
     265      visc_air_sclr = 1.326e-5*(1. + 6.542E-3*ztc + 8.301e-6*ztc2 - 4.84e-9*ztc2*ztc) 
     266      ! 
     267   END FUNCTION visc_air_sclr 
     268 
     269   FUNCTION visc_air_vctr(ptak) 
     270      REAL(wp), DIMENSION(jpi,jpj)             ::   visc_air_vctr   ! kinetic viscosity (m^2/s) 
    177271      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak       ! air temperature in (K) 
    178       ! 
    179272      INTEGER  ::   ji, jj      ! dummy loop indices 
    180       REAL(wp) ::   ztc, ztc2   ! local scalar 
    181       !!---------------------------------------------------------------------------------- 
    182       ! 
    183       DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    184          ztc  = ptak(ji,jj) - rt0   ! air temp, in deg. C 
    185          ztc2 = ztc*ztc 
    186          visc_air(ji,jj) = 1.326e-5*(1. + 6.542E-3*ztc + 8.301e-6*ztc2 - 4.84e-9*ztc2*ztc) 
    187       END_2D 
    188       ! 
    189    END FUNCTION visc_air 
     273      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     274      visc_air_vctr(ji,jj) = visc_air_sclr( ptak(ji,jj) ) 
     275      END_2D 
     276   END FUNCTION visc_air_vctr 
     277 
    190278 
    191279   FUNCTION L_vap_vctr( psst ) 
    … …  
    252340 
    253341 
    254  
    255  
    256    FUNCTION gamma_moist_vctr( ptak, pqa ) 
    257       !!---------------------------------------------------------------------------------- 
    258       !!                           ***  FUNCTION gamma_moist_vctr  *** 
    259       !! 
     342   !=============================================================================================== 
     343   FUNCTION gamma_moist_sclr( ptak, pqa ) 
     344      !!---------------------------------------------------------------------------------- 
    260345      !! ** Purpose : Compute the moist adiabatic lapse-rate. 
    261346      !!     => http://glossary.ametsoc.org/wiki/Moist-adiabatic_lapse_rate 
    262347      !!     => http://www.geog.ucsb.edu/~joel/g266_s10/lecture_notes/chapt03/oh10_3_01/oh10_3_01.html 
    263348      !! 
    264       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    265       !!---------------------------------------------------------------------------------- 
    266       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak          ! air temperature       [K] 
    267       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa           ! specific humidity [kg/kg] 
    268       REAL(wp), DIMENSION(jpi,jpj)             ::   gamma_moist_vctr   ! moist adiabatic lapse-rate 
    269       ! 
    270       INTEGER  ::   ji, jj         ! dummy loop indices 
    271       !!---------------------------------------------------------------------------------- 
    272       DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    273          gamma_moist_vctr(ji,jj) = gamma_moist_sclr( ptak(ji,jj), pqa(ji,jj) ) 
    274       END_2D 
    275    END FUNCTION gamma_moist_vctr 
    276  
    277    FUNCTION gamma_moist_sclr( ptak, pqa ) 
    278       !!---------------------------------------------------------------------------------- 
    279       !! ** Purpose : Compute the moist adiabatic lapse-rate. 
    280       !!     => http://glossary.ametsoc.org/wiki/Moist-adiabatic_lapse_rate 
    281       !!     => http://www.geog.ucsb.edu/~joel/g266_s10/lecture_notes/chapt03/oh10_3_01/oh10_3_01.html 
    282       !! 
    283349      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    284350      !!---------------------------------------------------------------------------------- 
    285       REAL(wp)             :: gamma_moist_sclr 
    286       REAL(wp), INTENT(in) :: ptak, pqa ! air temperature (K) and specific humidity (kg/kg) 
    287       ! 
    288       REAL(wp) :: zta, zqa, zwa, ziRT        ! local scalar 
     351      REAL(wp)             :: gamma_moist_sclr !                           [K/m] 
     352      REAL(wp), INTENT(in) ::   ptak           ! absolute air temperature  [K] !#LB: double check it's absolute !!! 
     353      REAL(wp), INTENT(in) ::   pqa            ! specific humidity     [kg/kg] 
     354      ! 
     355      REAL(wp) :: zta, zqa, zwa, ziRT, zLvap        ! local scalars 
    289356      !!---------------------------------------------------------------------------------- 
    290357      zta = MAX( ptak,  180._wp) ! prevents screw-up over masked regions where field == 0. 
    … …  
    293360      zwa = zqa / (1._wp - zqa)   ! w is mixing ratio w = q/(1-q) | q = w/(1+w) 
    294361      ziRT = 1._wp / (R_dry*zta)    ! 1/RT 
    295       gamma_moist_sclr = grav * ( 1._wp + rLevap*zwa*ziRT ) / ( rCp_dry + rLevap*rLevap*zwa*reps0*ziRT/zta ) 
     362      zLvap = L_vap_sclr( ptak ) 
     363      !! 
     364      gamma_moist_sclr = grav * ( 1._wp + zLvap*zwa*ziRT ) / ( rCp_dry + zLvap*zLvap*zwa*reps0*ziRT/zta ) 
    296365      !! 
    297366   END FUNCTION gamma_moist_sclr 
     367   !! 
     368   FUNCTION gamma_moist_vctr( ptak, pqa ) 
     369      REAL(wp), DIMENSION(jpi,jpj)             ::   gamma_moist_vctr 
     370      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak 
     371      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa 
     372      INTEGER  :: ji, jj 
     373      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     374      gamma_moist_vctr(ji,jj) = gamma_moist_sclr( ptak(ji,jj), pqa(ji,jj) ) 
     375      END_2D 
     376   END FUNCTION gamma_moist_vctr 
     377   !=============================================================================================== 
     378 
    298379 
    299380   FUNCTION One_on_L( ptha, pqa, pus, pts, pqs ) 
    300381      !!------------------------------------------------------------------------ 
    301382      !! 
    302       !! Evaluates the 1./(Monin Obukhov length) from air temperature and 
    303       !! specific humidity, and frictional scales u*, t* and q* 
    304       !! 
    305       !! Author: L. Brodeau, June 2016 / AeroBulk 
     383      !! Evaluates the 1./(Obukhov length) from air temperature, 
     384      !! air specific humidity, and frictional scales u*, t* and q* 
     385      !! 
     386      !! Author: L. Brodeau, June 2019 / AeroBulk 
    306387      !!         (https://github.com/brodeau/aerobulk/) 
    307388      !!------------------------------------------------------------------------ 
    308       REAL(wp), DIMENSION(jpi,jpj)             :: One_on_L         !: 1./(Monin Obukhov length) [m^-1] 
    309       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptha,  &  !: average potetntial air temperature [K] 
    310          &                                        pqa,   &  !: average specific humidity of air   [kg/kg] 
    311          &                                      pus, pts, pqs   !: frictional velocity, temperature and humidity 
     389      REAL(wp), DIMENSION(jpi,jpj)             :: One_on_L     !: 1./(Obukhov length) [m^-1] 
     390      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptha         !: reference potential temperature of air [K] 
     391      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa          !: reference specific humidity of air   [kg/kg] 
     392      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus          !: u*: friction velocity [m/s] 
     393      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pts, pqs     !: \theta* and q* friction aka turb. scales for temp. and spec. hum. 
    312394      ! 
    313395      INTEGER  ::   ji, jj         ! dummy loop indices 
    … …  
    316398      ! 
    317399      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    318          ! 
    319          zqa = (1._wp + rctv0*pqa(ji,jj)) 
    320          ! 
    321          ! The main concern is to know whether, the vertical turbulent flux of virtual temperature, < u' theta_v' > is estimated with: 
    322          !  a/  -u* [ theta* (1 + 0.61 q) + 0.61 theta q* ] => this is the one that seems correct! chose this one! 
    323          !                      or 
    324          !  b/  -u* [ theta*              + 0.61 theta q* ] 
    325          ! 
    326          One_on_L(ji,jj) = grav*vkarmn*( pts(ji,jj)*zqa + rctv0*ptha(ji,jj)*pqs(ji,jj) ) & 
    327             &               / MAX( pus(ji,jj)*pus(ji,jj)*ptha(ji,jj)*zqa , 1.E-9_wp ) 
    328          ! 
     400      ! 
     401      zqa = (1._wp + rctv0*pqa(ji,jj)) 
     402      ! 
     403      ! The main concern is to know whether, the vertical turbulent flux of virtual temperature, < u' theta_v' > is estimated with: 
     404      !  a/  -u* [ theta* (1 + 0.61 q) + 0.61 theta q* ] => this is the one that seems correct! chose this one! 
     405      !                      or 
     406      !  b/  -u* [ theta*              + 0.61 theta q* ] 
     407      ! 
     408      One_on_L(ji,jj) = grav*vkarmn*( pts(ji,jj)*zqa + rctv0*ptha(ji,jj)*pqs(ji,jj) ) & 
     409         &               / MAX( pus(ji,jj)*pus(ji,jj)*ptha(ji,jj)*zqa , 1.E-9_wp ) 
     410      ! 
    329411      END_2D 
    330412      ! 
    … …  
    333415   END FUNCTION One_on_L 
    334416 
    335    FUNCTION Ri_bulk( pz, psst, ptha, pssq, pqa, pub ) 
     417 
     418   !=============================================================================================== 
     419   FUNCTION Ri_bulk_sclr( pz, psst, ptha, pssq, pqa, pub,  pta_layer, pqa_layer ) 
    336420      !!---------------------------------------------------------------------------------- 
    337421      !! Bulk Richardson number according to "wide-spread equation"... 
    338422      !! 
     423      !!    Reminder: the Richardson number is the ratio "buoyancy" / "shear" 
     424      !! 
    339425      !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    340426      !!---------------------------------------------------------------------------------- 
    341       REAL(wp), DIMENSION(jpi,jpj)             :: Ri_bulk 
     427      REAL(wp)             :: Ri_bulk_sclr 
     428      REAL(wp), INTENT(in) :: pz    ! height above the sea (aka "delta z")  [m] 
     429      REAL(wp), INTENT(in) :: psst  ! SST                                   [K] 
     430      REAL(wp), INTENT(in) :: ptha  ! pot. air temp. at height "pz"         [K] 
     431      REAL(wp), INTENT(in) :: pssq  ! 0.98*q_sat(SST)                   [kg/kg] 
     432      REAL(wp), INTENT(in) :: pqa   ! air spec. hum. at height "pz"     [kg/kg] 
     433      REAL(wp), INTENT(in) :: pub   ! bulk wind speed                     [m/s] 
     434      REAL(wp), INTENT(in), OPTIONAL :: pta_layer ! when possible, a better guess of absolute temperature WITHIN the layer [K] 
     435      REAL(wp), INTENT(in), OPTIONAL :: pqa_layer ! when possible, a better guess of specific humidity    WITHIN the layer [kg/kg] 
     436      !! 
     437      LOGICAL  :: l_ptqa_l_prvd = .FALSE. 
     438      REAL(wp) :: zqa, zta, zgamma, zdthv, ztv, zsstv  ! local scalars 
     439      !!------------------------------------------------------------------- 
     440      IF( PRESENT(pta_layer) .AND. PRESENT(pqa_layer) ) l_ptqa_l_prvd=.TRUE. 
     441      ! 
     442      zsstv = virt_temp_sclr( psst, pssq )          ! virtual SST (absolute==potential because z=0!) 
     443      ! 
     444      zdthv = virt_temp_sclr( ptha, pqa  ) - zsstv  ! air-sea delta of "virtual potential temperature" 
     445      ! 
     446      !! ztv: estimate of the ABSOLUTE virtual temp. within the layer 
     447      IF( l_ptqa_l_prvd ) THEN 
     448         ztv = virt_temp_sclr( pta_layer, pqa_layer ) 
     449      ELSE 
     450         zqa = 0.5_wp*( pqa  + pssq )                             ! ~ mean q within the layer... 
     451         zta = 0.5_wp*( psst + ptha - gamma_moist(ptha, zqa)*pz ) ! ~ mean absolute temperature of air within the layer 
     452         zta = 0.5_wp*( psst + ptha - gamma_moist( zta, zqa)*pz ) ! ~ mean absolute temperature of air within the layer 
     453         zgamma =  gamma_moist(zta, zqa)                          ! Adiabatic lapse-rate for moist air within the layer 
     454         ztv = 0.5_wp*( zsstv + virt_temp_sclr( ptha-zgamma*pz, pqa ) ) 
     455      END IF 
     456      ! 
     457      Ri_bulk_sclr = grav*zdthv*pz / ( ztv*pub*pub )      ! the usual definition of Ri_bulk_sclr 
     458      ! 
     459   END FUNCTION Ri_bulk_sclr 
     460   !! 
     461   FUNCTION Ri_bulk_vctr( pz, psst, ptha, pssq, pqa, pub,  pta_layer, pqa_layer ) 
     462      REAL(wp), DIMENSION(jpi,jpj)             :: Ri_bulk_vctr 
    342463      REAL(wp)                    , INTENT(in) :: pz    ! height above the sea (aka "delta z")  [m] 
    343464      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psst  ! SST                                   [K] 
    … …  
    346467      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa   ! air spec. hum. at height "pz"     [kg/kg] 
    347468      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pub   ! bulk wind speed                     [m/s] 
    348       ! 
    349       INTEGER  ::   ji, jj                                ! dummy loop indices 
    350       REAL(wp) ::   zqa, zta, zgamma, zdth_v, ztv, zsstv  ! local scalars 
    351       !!------------------------------------------------------------------- 
    352       ! 
    353       DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    354          ! 
    355          zqa = 0.5_wp*(pqa(ji,jj)+pssq(ji,jj))                                        ! ~ mean q within the layer... 
    356          zta = 0.5_wp*( psst(ji,jj) + ptha(ji,jj) - gamma_moist(ptha(ji,jj),zqa)*pz ) ! ~ mean absolute temperature of air within the layer 
    357          zta = 0.5_wp*( psst(ji,jj) + ptha(ji,jj) - gamma_moist(zta,        zqa)*pz ) ! ~ mean absolute temperature of air within the layer 
    358          zgamma =  gamma_moist(zta, zqa)                                              ! Adiabatic lapse-rate for moist air within the layer 
    359          ! 
    360          zsstv = psst(ji,jj)*(1._wp + rctv0*pssq(ji,jj)) ! absolute==potential virtual SST (absolute==potential because z=0!) 
    361          ! 
    362          zdth_v = ptha(ji,jj)*(1._wp + rctv0*pqa(ji,jj)) - zsstv ! air-sea delta of "virtual potential temperature" 
    363          ! 
    364          ztv = 0.5_wp*( zsstv + (ptha(ji,jj) - zgamma*pz)*(1._wp + rctv0*pqa(ji,jj)) )  ! ~ mean absolute virtual temp. within the layer 
    365          ! 
    366          Ri_bulk(ji,jj) = grav*zdth_v*pz / ( ztv*pub(ji,jj)*pub(ji,jj) )                            ! the usual definition of Ri_bulk 
    367          ! 
    368       END_2D 
    369    END FUNCTION Ri_bulk 
    370  
    371  
    372    FUNCTION e_sat_vctr(ptak) 
    373       !!************************************************** 
    374       !! ptak:     air temperature [K] 
    375       !! e_sat:  water vapor at saturation [Pa] 
    376       !! 
    377       !! Recommended by WMO 
    378       !! 
    379       !! Goff, J. A., 1957: Saturation pressure of water on the new kelvin 
    380       !! temperature scale. Transactions of the American society of heating 
    381       !! and ventilating engineers, 347–354. 
    382       !! 
    383       !! rt0 should be 273.16 (triple point of water) and not 273.15 like here 
    384       !!************************************************** 
    385  
    386       REAL(wp), DIMENSION(jpi,jpj)             :: e_sat_vctr !: vapour pressure at saturation  [Pa] 
    387       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak    !: temperature (K) 
    388  
    389       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztmp 
    390  
    391       ALLOCATE ( ztmp(jpi,jpj) ) 
    392  
    393       ztmp(:,:) = rtt0/ptak(:,:) 
    394  
    395       e_sat_vctr = 100.*( 10.**(10.79574*(1. - ztmp) - 5.028*LOG10(ptak/rtt0)         & 
    396          &       + 1.50475*10.**(-4)*(1. - 10.**(-8.2969*(ptak/rtt0 - 1.)) )   & 
    397          &       + 0.42873*10.**(-3)*(10.**(4.76955*(1. - ztmp)) - 1.) + 0.78614) ) 
    398  
    399       DEALLOCATE ( ztmp ) 
    400  
    401    END FUNCTION e_sat_vctr 
    402  
    403  
     469      REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pta_layer ! when possible, a better guess of absolute temperature WITHIN the layer [K] 
     470      REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pqa_layer ! when possible, a better guess of specific humidity    WITHIN the layer [kg/kg] 
     471      !! 
     472      LOGICAL  :: l_ptqa_l_prvd = .FALSE. 
     473      INTEGER  ::   ji, jj 
     474      IF( PRESENT(pta_layer) .AND. PRESENT(pqa_layer) ) l_ptqa_l_prvd=.TRUE. 
     475      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     476      IF( l_ptqa_l_prvd ) THEN 
     477         Ri_bulk_vctr(ji,jj) = Ri_bulk_sclr( pz, psst(ji,jj), ptha(ji,jj), pssq(ji,jj), pqa(ji,jj), pub(ji,jj), & 
     478            &                                pta_layer=pta_layer(ji,jj ),  pqa_layer=pqa_layer(ji,jj ) ) 
     479      ELSE 
     480         Ri_bulk_vctr(ji,jj) = Ri_bulk_sclr( pz, psst(ji,jj), ptha(ji,jj), pssq(ji,jj), pqa(ji,jj), pub(ji,jj) ) 
     481      END IF 
     482      END_2D 
     483   END FUNCTION Ri_bulk_vctr 
     484   !=============================================================================================== 
     485 
     486   !=============================================================================================== 
    404487   FUNCTION e_sat_sclr( ptak ) 
    405488      !!---------------------------------------------------------------------------------- 
    … …  
    413496      !!    Note: what rt0 should be here, is 273.16 (triple point of water) and not 273.15 like here 
    414497      !!---------------------------------------------------------------------------------- 
     498      REAL(wp)             ::   e_sat_sclr   ! water vapor at saturation   [kg/kg] 
    415499      REAL(wp), INTENT(in) ::   ptak    ! air temperature                  [K] 
    416       REAL(wp)             ::   e_sat_sclr   ! water vapor at saturation   [kg/kg] 
    417       ! 
    418500      REAL(wp) ::   zta, ztmp   ! local scalar 
    419501      !!---------------------------------------------------------------------------------- 
    420       ! 
    421502      zta = MAX( ptak , 180._wp )   ! air temp., prevents fpe0 errors dute to unrealistically low values over masked regions... 
    422       ztmp = rt0 / zta 
     503      ztmp = rt0 / zta   !#LB: rt0 or rtt0 ???? (273.15 vs 273.16 ) 
    423504      ! 
    424505      ! Vapour pressure at saturation [Pa] : WMO, (Goff, 1957) 
    … …  
    428509      ! 
    429510   END FUNCTION e_sat_sclr 
    430  
    431  
    432    FUNCTION q_sat( ptak, pslp ) 
    433       !!---------------------------------------------------------------------------------- 
    434       !!                           ***  FUNCTION q_sat  *** 
    435       !! 
    436       !! ** Purpose : Specific humidity at saturation in [kg/kg] 
    437       !!              Based on accurate estimate of "e_sat" 
    438       !!              aka saturation water vapor (Goff, 1957) 
     511   !! 
     512   FUNCTION e_sat_vctr(ptak) 
     513      REAL(wp), DIMENSION(jpi,jpj)             :: e_sat_vctr !: vapour pressure at saturation  [Pa] 
     514      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak    !: temperature (K) 
     515      INTEGER  ::   ji, jj         ! dummy loop indices 
     516      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     517      e_sat_vctr(ji,jj) = e_sat_sclr(ptak(ji,jj)) 
     518      END_2D 
     519   END FUNCTION e_sat_vctr 
     520   !=============================================================================================== 
     521 
     522   !=============================================================================================== 
     523   FUNCTION e_sat_ice_sclr(ptak) 
     524      !!--------------------------------------------------------------------------------- 
     525      !! Same as "e_sat" but over ice rather than water! 
     526      !!--------------------------------------------------------------------------------- 
     527      REAL(wp)             :: e_sat_ice_sclr !: vapour pressure at saturation in presence of ice [Pa] 
     528      REAL(wp), INTENT(in) :: ptak 
     529      !! 
     530      REAL(wp) :: zta, zle, ztmp 
     531      !!--------------------------------------------------------------------------------- 
     532      zta = MAX( ptak , 180._wp )   ! air temp., prevents fpe0 errors dute to unrealistically low values over masked regions... 
     533      ztmp = rtt0/zta 
     534      !! 
     535      zle  = rAg_i*(ztmp - 1._wp) + rBg_i*LOG10(ztmp) + rCg_i*(1._wp - zta/rtt0) + rDg_i 
     536      !! 
     537      e_sat_ice_sclr = 100._wp * 10._wp**zle 
     538   END FUNCTION e_sat_ice_sclr 
     539   !! 
     540   FUNCTION e_sat_ice_vctr(ptak) 
     541      !! Same as "e_sat" but over ice rather than water! 
     542      REAL(wp), DIMENSION(jpi,jpj) :: e_sat_ice_vctr !: vapour pressure at saturation in presence of ice [Pa] 
     543      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak 
     544      INTEGER  :: ji, jj 
     545      !!---------------------------------------------------------------------------------- 
     546      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     547      e_sat_ice_vctr(ji,jj) = e_sat_ice_sclr( ptak(ji,jj) ) 
     548      END_2D 
     549   END FUNCTION e_sat_ice_vctr 
     550   !! 
     551   FUNCTION de_sat_dt_ice_sclr(ptak) 
     552      !!--------------------------------------------------------------------------------- 
     553      !! d [ e_sat_ice ] / dT   (derivative / temperature) 
     554      !! Analytical exact formulation: double checked!!! 
     555      !!  => DOUBLE-check possible / finite-difference version with "./bin/test_phymbl.x" 
     556      !!--------------------------------------------------------------------------------- 
     557      REAL(wp)             :: de_sat_dt_ice_sclr !:  [Pa/K] 
     558      REAL(wp), INTENT(in) :: ptak 
     559      !! 
     560      REAL(wp) :: zta, zde 
     561      !!--------------------------------------------------------------------------------- 
     562      zta = MAX( ptak , 180._wp )   ! air temp., prevents fpe0 errors dute to unrealistically low values over masked regions... 
     563      !! 
     564      zde = -(rAg_i*rtt0)/(zta*zta) - rBg_i/(zta*LOG(10._wp)) - rCg_i/rtt0 
     565      !! 
     566      de_sat_dt_ice_sclr = LOG(10._wp) * zde * e_sat_ice_sclr(zta) 
     567   END FUNCTION de_sat_dt_ice_sclr 
     568   !! 
     569   FUNCTION de_sat_dt_ice_vctr(ptak) 
     570      !! Same as "e_sat" but over ice rather than water! 
     571      REAL(wp), DIMENSION(jpi,jpj) :: de_sat_dt_ice_vctr !: vapour pressure at saturation in presence of ice [Pa] 
     572      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak 
     573      INTEGER  :: ji, jj 
     574      !!---------------------------------------------------------------------------------- 
     575      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     576      de_sat_dt_ice_vctr(ji,jj) = de_sat_dt_ice_sclr( ptak(ji,jj) ) 
     577      END_2D 
     578   END FUNCTION de_sat_dt_ice_vctr 
     579 
     580 
     581 
     582   !=============================================================================================== 
     583 
     584   !=============================================================================================== 
     585   FUNCTION q_sat_sclr( pta, ppa,  l_ice ) 
     586      !!--------------------------------------------------------------------------------- 
     587      !!                           ***  FUNCTION q_sat_sclr  *** 
     588      !! 
     589      !! ** Purpose : Conputes specific humidity of air at saturation 
    439590      !! 
    440591      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    441592      !!---------------------------------------------------------------------------------- 
    442       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak    ! air temperature                       [K] 
    443       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp    ! sea level atmospheric pressure       [Pa] 
    444       REAL(wp), DIMENSION(jpi,jpj)             ::   q_sat   ! Specific humidity at saturation   [kg/kg] 
    445       ! 
    446       INTEGER  ::   ji, jj         ! dummy loop indices 
    447       REAL(wp) ::   ze_sat   ! local scalar 
    448       !!---------------------------------------------------------------------------------- 
    449       ! 
    450       DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    451          ! 
    452          ze_sat =  e_sat_sclr( ptak(ji,jj) ) 
    453          ! 
    454          q_sat(ji,jj) = reps0 * ze_sat/( pslp(ji,jj) - (1._wp - reps0)*ze_sat ) 
    455          ! 
    456       END_2D 
    457       ! 
    458    END FUNCTION q_sat 
    459  
    460    FUNCTION q_air_rh(prha, ptak, pslp) 
     593      REAL(wp) :: q_sat_sclr 
     594      REAL(wp), INTENT(in) :: pta  !: absolute temperature of air [K] 
     595      REAL(wp), INTENT(in) :: ppa  !: atmospheric pressure        [Pa] 
     596      LOGICAL,  INTENT(in), OPTIONAL :: l_ice  !: we are above ice 
     597      REAL(wp) :: ze_s 
     598      LOGICAL  :: lice 
     599      !!---------------------------------------------------------------------------------- 
     600      lice = .FALSE. 
     601      IF( PRESENT(l_ice) ) lice = l_ice 
     602      IF( lice ) THEN 
     603         ze_s = e_sat_ice( pta ) 
     604      ELSE 
     605         ze_s = e_sat( pta ) ! Vapour pressure at saturation (Goff) : 
     606      END IF 
     607      q_sat_sclr = reps0*ze_s/(ppa - (1._wp - reps0)*ze_s) 
     608   END FUNCTION q_sat_sclr 
     609   !! 
     610   FUNCTION q_sat_vctr( pta, ppa,  l_ice ) 
     611      REAL(wp), DIMENSION(jpi,jpj) :: q_sat_vctr 
     612      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pta  !: absolute temperature of air [K] 
     613      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppa  !: atmospheric pressure        [Pa] 
     614      LOGICAL,  INTENT(in), OPTIONAL :: l_ice  !: we are above ice 
     615      LOGICAL  :: lice 
     616      INTEGER  :: ji, jj 
     617      !!---------------------------------------------------------------------------------- 
     618      lice = .FALSE. 
     619      IF( PRESENT(l_ice) ) lice = l_ice 
     620      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     621      q_sat_vctr(ji,jj) = q_sat_sclr( pta(ji,jj) , ppa(ji,jj), l_ice=lice ) 
     622      END_2D 
     623   END FUNCTION q_sat_vctr 
     624   !=============================================================================================== 
     625 
     626 
     627   !=============================================================================================== 
     628   FUNCTION dq_sat_dt_ice_sclr( pta, ppa ) 
     629      !!--------------------------------------------------------------------------------- 
     630      !!     ***  FUNCTION dq_sat_dt_ice_sclr  *** 
     631      !!    => d [ q_sat_ice(T) ] / dT 
     632      !! Analytical exact formulation: double checked!!! 
     633      !!  => DOUBLE-check possible / finite-difference version with "./bin/test_phymbl.x" 
     634      !!---------------------------------------------------------------------------------- 
     635      REAL(wp) :: dq_sat_dt_ice_sclr 
     636      REAL(wp), INTENT(in) :: pta  !: absolute temperature of air [K] 
     637      REAL(wp), INTENT(in) :: ppa  !: atmospheric pressure        [Pa] 
     638      REAL(wp) :: ze_s, zde_s_dt, ztmp 
     639      !!---------------------------------------------------------------------------------- 
     640      ze_s     =  e_sat_ice_sclr( pta ) ! Vapour pressure at saturation  in presence of ice (Goff) 
     641      zde_s_dt = de_sat_dt_ice(   pta ) 
     642      ! 
     643      ztmp = (reps0 - 1._wp)*ze_s + ppa 
     644      ! 
     645      dq_sat_dt_ice_sclr = reps0*ppa*zde_s_dt / ( ztmp*ztmp ) 
     646      ! 
     647   END FUNCTION dq_sat_dt_ice_sclr 
     648   !! 
     649   FUNCTION dq_sat_dt_ice_vctr( pta, ppa ) 
     650      REAL(wp), DIMENSION(jpi,jpj) :: dq_sat_dt_ice_vctr 
     651      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pta  !: absolute temperature of air [K] 
     652      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppa  !: atmospheric pressure        [Pa] 
     653      INTEGER  :: ji, jj 
     654      !!---------------------------------------------------------------------------------- 
     655      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     656      dq_sat_dt_ice_vctr(ji,jj) = dq_sat_dt_ice_sclr( pta(ji,jj) , ppa(ji,jj) ) 
     657      END_2D 
     658   END FUNCTION dq_sat_dt_ice_vctr 
     659   !=============================================================================================== 
     660 
     661 
     662   !=============================================================================================== 
     663   FUNCTION q_air_rh(prha, ptak, ppa) 
    461664      !!---------------------------------------------------------------------------------- 
    462665      !! Specific humidity of air out of Relative Humidity 
    … …  
    467670      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: prha        !: relative humidity      [fraction, not %!!!] 
    468671      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak        !: air temperature        [K] 
    469       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pslp        !: atmospheric pressure   [Pa] 
     672      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppa        !: atmospheric pressure   [Pa] 
    470673      ! 
    471674      INTEGER  ::   ji, jj      ! dummy loop indices 
    … …  
    474677      ! 
    475678      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    476          ze = prha(ji,jj)*e_sat_sclr(ptak(ji,jj)) 
    477          q_air_rh(ji,jj) = ze*reps0/(pslp(ji,jj) - (1. - reps0)*ze) 
     679      ze = prha(ji,jj)*e_sat_sclr(ptak(ji,jj)) 
     680      q_air_rh(ji,jj) = ze*reps0/(ppa(ji,jj) - (1. - reps0)*ze) 
    478681      END_2D 
    479682      ! 
    … …  
    481684 
    482685 
    483    SUBROUTINE UPDATE_QNSOL_TAU( pzu, pTs, pqs, pTa, pqa, pust, ptst, pqst, pwnd, pUb, pslp, prlw, & 
     686   SUBROUTINE UPDATE_QNSOL_TAU( pzu, pTs, pqs, pTa, pqa, pust, ptst, pqst, pwnd, pUb, ppa, prlw, & 
    484687      &                         pQns, pTau,  & 
    485688      &                         Qlat) 
    … …  
    499702      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pwnd ! wind speed module at z=pzu [m/s] 
    500703      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pUb  ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s] 
    501       REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pslp ! sea-level atmospheric pressure [Pa] 
     704      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: ppa ! sea-level atmospheric pressure [Pa] 
    502705      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: prlw ! downwelling longwave radiative flux [W/m^2] 
    503706      ! 
    … …  
    507710      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(out) :: Qlat 
    508711      ! 
    509       REAL(wp) :: zdt, zdq, zCd, zCh, zCe, zTs2, zz0, & 
    510          &        zQlat, zQsen, zQlw 
     712      REAL(wp) :: zdt, zdq, zCd, zCh, zCe, zz0, zQlat, zQsen, zQlw 
    511713      INTEGER  ::   ji, jj     ! dummy loop indices 
    512714      !!---------------------------------------------------------------------------------- 
    513715      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    514  
    515          zdt = pTa(ji,jj) - pTs(ji,jj) ;  zdt = SIGN( MAX(ABS(zdt),1.E-6_wp), zdt ) 
    516          zdq = pqa(ji,jj) - pqs(ji,jj) ;  zdq = SIGN( MAX(ABS(zdq),1.E-9_wp), zdq ) 
    517          zz0 = pust(ji,jj)/pUb(ji,jj) 
    518          zCd = zz0*zz0 
    519          zCh = zz0*ptst(ji,jj)/zdt 
    520          zCe = zz0*pqst(ji,jj)/zdq 
    521  
    522          CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & 
    523             &                    zCd, zCh, zCe,                                       & 
    524             &                    pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj),                & 
    525             &                    pTau(ji,jj), zQsen, zQlat ) 
    526           
    527          zTs2  = pTs(ji,jj)*pTs(ji,jj) 
    528          zQlw  = emiss_w*(prlw(ji,jj) - stefan*zTs2*zTs2) ! Net longwave flux 
    529  
    530          pQns(ji,jj) = zQlat + zQsen + zQlw 
    531  
    532          IF( PRESENT(Qlat) ) Qlat(ji,jj) = zQlat 
     716      zdt = pTa(ji,jj) - pTs(ji,jj) ;  zdt = SIGN( MAX(ABS(zdt),1.E-6_wp), zdt ) 
     717      zdq = pqa(ji,jj) - pqs(ji,jj) ;  zdq = SIGN( MAX(ABS(zdq),1.E-9_wp), zdq ) 
     718      zz0 = pust(ji,jj)/pUb(ji,jj) 
     719      zCd = zz0*zz0 
     720      zCh = zz0*ptst(ji,jj)/zdt 
     721      zCe = zz0*pqst(ji,jj)/zdq 
     722 
     723      CALL BULK_FORMULA( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), zCd, zCh, zCe, & 
     724         &              pwnd(ji,jj), pUb(ji,jj), ppa(ji,jj), & 
     725         &              pTau(ji,jj), zQsen, zQlat ) 
     726 
     727      zQlw = qlw_net_sclr( prlw(ji,jj), pTs(ji,jj) ) ! Net longwave flux 
     728 
     729      pQns(ji,jj) = zQlat + zQsen + zQlw 
     730 
     731      IF( PRESENT(Qlat) ) Qlat(ji,jj) = zQlat 
    533732      END_2D 
    534733   END SUBROUTINE UPDATE_QNSOL_TAU 
    … …  
    537736   SUBROUTINE BULK_FORMULA_SCLR( pzu, pTs, pqs, pTa, pqa, & 
    538737      &                          pCd, pCh, pCe,           & 
    539       &                          pwnd, pUb, pslp,         & 
     738      &                          pwnd, pUb, ppa,         & 
    540739      &                          pTau, pQsen, pQlat,      & 
    541740      &                          pEvap, prhoa, pfact_evap ) 
    … …  
    551750      REAL(wp), INTENT(in)  :: pwnd ! wind speed module at z=pzu [m/s] 
    552751      REAL(wp), INTENT(in)  :: pUb  ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s] 
    553       REAL(wp), INTENT(in)  :: pslp ! sea-level atmospheric pressure [Pa] 
     752      REAL(wp), INTENT(in)  :: ppa ! sea-level atmospheric pressure [Pa] 
    554753      !! 
    555754      REAL(wp), INTENT(out) :: pTau  ! module of the wind stress [N/m^2] 
    … …  
    566765      zfact_evap = 1._wp 
    567766      IF( PRESENT(pfact_evap) ) zfact_evap = pfact_evap 
    568        
     767 
    569768      !! Need ztaa, absolute temperature at pzu (formula to estimate rho_air needs absolute temperature, not the potential temperature "pTa") 
    570769      ztaa = pTa ! first guess... 
    571770      DO jq = 1, 4 
    572          zgamma = gamma_moist( 0.5*(ztaa+pTs) , pqa )  !LOLO: why not "0.5*(pqs+pqa)" rather then "pqa" ??? 
     771         zgamma = gamma_moist( 0.5*(ztaa+pTs) , pqa )  !#LB: why not "0.5*(pqs+pqa)" rather then "pqa" ??? 
    573772         ztaa = pTa - zgamma*pzu   ! Absolute temp. is slightly colder... 
    574773      END DO 
    575       zrho = rho_air(ztaa, pqa, pslp) 
    576       zrho = rho_air(ztaa, pqa, pslp-zrho*grav*pzu) ! taking into account that we are pzu m above the sea level where SLP is given! 
     774      zrho = rho_air(ztaa, pqa, ppa) 
     775      zrho = rho_air(ztaa, pqa, ppa-zrho*grav*pzu) ! taking into account that we are pzu m above the sea level where SLP is given! 
    577776 
    578777      zUrho = pUb*MAX(zrho, 1._wp)     ! rho*U10 
    … …  
    588787 
    589788   END SUBROUTINE BULK_FORMULA_SCLR 
    590  
     789   !! 
    591790   SUBROUTINE BULK_FORMULA_VCTR( pzu, pTs, pqs, pTa, pqa, & 
    592791      &                          pCd, pCh, pCe,           & 
    593       &                          pwnd, pUb, pslp,         & 
    594       &                          pTau, pQsen, pQlat,      &  
    595       &                          pEvap, prhoa, pfact_evap )       
     792      &                          pwnd, pUb, ppa,         & 
     793      &                          pTau, pQsen, pQlat,      & 
     794      &                          pEvap, prhoa, pfact_evap ) 
    596795      !!---------------------------------------------------------------------------------- 
    597796      REAL(wp),                     INTENT(in)  :: pzu  ! height above the sea-level where all this takes place (normally 10m) 
    … …  
    605804      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pwnd ! wind speed module at z=pzu [m/s] 
    606805      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pUb  ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s] 
    607       REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: pslp ! sea-level atmospheric pressure [Pa] 
     806      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: ppa ! sea-level atmospheric pressure [Pa] 
    608807      !! 
    609808      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pTau  ! module of the wind stress [N/m^2] 
    … …  
    623822      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    624823 
    625          CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & 
    626             &                    pCd(ji,jj), pCh(ji,jj), pCe(ji,jj),                  & 
    627             &                    pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj),                & 
    628             &                    pTau(ji,jj), pQsen(ji,jj), pQlat(ji,jj),             & 
    629             &                    pEvap=zevap, prhoa=zrho, pfact_evap=zfact_evap       ) 
    630  
    631          IF( PRESENT(pEvap) ) pEvap(ji,jj) = zevap 
    632          IF( PRESENT(prhoa) ) prhoa(ji,jj) = zrho 
    633     
     824      CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & 
     825         &                    pCd(ji,jj), pCh(ji,jj), pCe(ji,jj),                  & 
     826         &                    pwnd(ji,jj), pUb(ji,jj), ppa(ji,jj),                & 
     827         &                    pTau(ji,jj), pQsen(ji,jj), pQlat(ji,jj),             & 
     828         &                    pEvap=zevap, prhoa=zrho, pfact_evap=zfact_evap       ) 
     829 
     830      IF( PRESENT(pEvap) ) pEvap(ji,jj) = zevap 
     831      IF( PRESENT(prhoa) ) prhoa(ji,jj) = zrho 
    634832      END_2D 
    635833   END SUBROUTINE BULK_FORMULA_VCTR 
    … …  
    640838      !!                           ***  FUNCTION alpha_sw_vctr  *** 
    641839      !! 
    642       !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface (i.e. P =~ 101000 Pa) 
     840      !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface (P =~ 1010 hpa) 
    643841      !! 
    644842      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    … …  
    654852      !!                           ***  FUNCTION alpha_sw_sclr  *** 
    655853      !! 
    656       !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface (i.e. P =~ 101000 Pa) 
     854      !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface (P =~ 1010 hpa) 
    657855      !! 
    658856      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    … …  
    665863 
    666864 
     865   !=============================================================================================== 
     866   FUNCTION qlw_net_sclr( pdwlw, pts,  l_ice ) 
     867      !!--------------------------------------------------------------------------------- 
     868      !!                           ***  FUNCTION qlw_net_sclr  *** 
     869      !! 
     870      !! ** Purpose : Estimate of the net longwave flux at the surface 
     871      !!---------------------------------------------------------------------------------- 
     872      REAL(wp) :: qlw_net_sclr 
     873      REAL(wp), INTENT(in) :: pdwlw !: downwelling longwave (aka infrared, aka thermal) radiation [W/m^2] 
     874      REAL(wp), INTENT(in) :: pts   !: surface temperature [K] 
     875      LOGICAL,  INTENT(in), OPTIONAL :: l_ice  !: we are above ice 
     876      REAL(wp) :: zemiss, zt2 
     877      LOGICAL  :: lice 
     878      !!---------------------------------------------------------------------------------- 
     879      lice = .FALSE. 
     880      IF( PRESENT(l_ice) ) lice = l_ice 
     881      IF( lice ) THEN 
     882         zemiss = emiss_i 
     883      ELSE 
     884         zemiss = emiss_w 
     885      END IF 
     886      zt2 = pts*pts 
     887      qlw_net_sclr = zemiss*( pdwlw - stefan*zt2*zt2)  ! zemiss used both as the IR albedo and IR emissivity... 
     888   END FUNCTION qlw_net_sclr 
     889   !! 
     890   FUNCTION qlw_net_vctr( pdwlw, pts,  l_ice ) 
     891      REAL(wp), DIMENSION(jpi,jpj) :: qlw_net_vctr 
     892      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pdwlw !: downwelling longwave (aka infrared, aka thermal) radiation [W/m^2] 
     893      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pts   !: surface temperature [K] 
     894      LOGICAL,  INTENT(in), OPTIONAL :: l_ice  !: we are above ice 
     895      LOGICAL  :: lice 
     896      INTEGER  :: ji, jj 
     897      !!---------------------------------------------------------------------------------- 
     898      lice = .FALSE. 
     899      IF( PRESENT(l_ice) ) lice = l_ice 
     900      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     901      qlw_net_vctr(ji,jj) = qlw_net_sclr( pdwlw(ji,jj) , pts(ji,jj), l_ice=lice ) 
     902      END_2D 
     903   END FUNCTION qlw_net_vctr 
     904   !=============================================================================================== 
     905 
     906   FUNCTION z0_from_Cd( pzu, pCd,  ppsi ) 
     907      REAL(wp), DIMENSION(jpi,jpj) :: z0_from_Cd        !: roughness length [m] 
     908      REAL(wp)                    , INTENT(in) :: pzu   !: reference height zu [m] 
     909      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pCd   !: (neutral or non-neutral) drag coefficient [] 
     910      REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum [] 
     911      !! 
     912      !! If pCd is the NEUTRAL-STABILITY drag coefficient then ppsi must be 0 or not given 
     913      !! If pCd is the drag coefficient (in stable or unstable conditions) then pssi must be provided 
     914      !!---------------------------------------------------------------------------------- 
     915      IF( PRESENT(ppsi) ) THEN 
     916         !! Cd provided is the actual Cd (not the neutral-stability CdN) : 
     917         z0_from_Cd = pzu * EXP( - ( vkarmn/SQRT(pCd(:,:)) + ppsi(:,:) ) ) !LB: ok, double-checked! 
     918      ELSE 
     919         !! Cd provided is the neutral-stability Cd, aka CdN : 
     920         z0_from_Cd = pzu * EXP( - vkarmn/SQRT(pCd(:,:)) )            !LB: ok, double-checked! 
     921      END IF 
     922   END FUNCTION z0_from_Cd 
     923 
     924   FUNCTION Cd_from_z0( pzu, pz0,  ppsi ) 
     925      REAL(wp), DIMENSION(jpi,jpj) :: Cd_from_z0        !: (neutral or non-neutral) drag coefficient [] 
     926      REAL(wp)                    , INTENT(in) :: pzu   !: reference height zu [m] 
     927      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0   !: roughness length [m] 
     928      REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum [] 
     929      !! 
     930      !! If we want to return the NEUTRAL-STABILITY drag coefficient then ppsi must be 0 or not given 
     931      !! If we want to return the stability-corrected Cd (i.e. in stable or unstable conditions) then pssi must be provided 
     932      !!---------------------------------------------------------------------------------- 
     933      IF( PRESENT(ppsi) ) THEN 
     934         !! The Cd we return is the actual Cd (not the neutral-stability CdN) : 
     935         Cd_from_z0 = 1._wp / ( LOG( pzu / pz0(:,:) ) - ppsi(:,:) ) 
     936      ELSE 
     937         !! The Cd we return is the neutral-stability Cd, aka CdN : 
     938         Cd_from_z0 = 1._wp /   LOG( pzu / pz0(:,:) ) 
     939      END IF 
     940      Cd_from_z0 = vkarmn2 * Cd_from_z0 * Cd_from_z0 
     941   END FUNCTION Cd_from_z0 
     942 
     943 
     944   FUNCTION f_m_louis_sclr( pzu, pRib, pCdn, pz0 ) 
     945      !!---------------------------------------------------------------------------------- 
     946      !!  Stability correction function for MOMENTUM 
     947      !!                 Louis (1979) 
     948      !!---------------------------------------------------------------------------------- 
     949      REAL(wp)             :: f_m_louis_sclr ! term "f_m" in Eq.(6) when option "Louis" rather than "Psi(zeta) is chosen, Lupkes & Gryanik (2015), 
     950      REAL(wp), INTENT(in) :: pzu     ! reference height (height for pwnd)  [m] 
     951      REAL(wp), INTENT(in) :: pRib    ! Bulk Richardson number 
     952      REAL(wp), INTENT(in) :: pCdn    ! neutral drag coefficient 
     953      REAL(wp), INTENT(in) :: pz0     ! roughness length                      [m] 
     954      !!---------------------------------------------------------------------------------- 
     955      REAL(wp) :: ztu, zts, zstab 
     956      !!---------------------------------------------------------------------------------- 
     957      zstab = 0.5 + SIGN(0.5_wp, pRib) ; ! Unstable (Ri<0) => zstab = 0 | Stable (Ri>0) => zstab = 1 
     958      ! 
     959      ztu = pRib / ( 1._wp + 3._wp * rc2_louis * pCdn * SQRT( ABS( -pRib * ( pzu / pz0 + 1._wp) ) ) ) ! ABS is just here for when it's stable conditions and ztu is not used anyways 
     960      zts = pRib / SQRT( ABS( 1._wp + pRib ) ) ! ABS is just here for when it's UNstable conditions and zts is not used anyways 
     961      ! 
     962      f_m_louis_sclr = (1._wp - zstab) *         ( 1._wp - ram_louis * ztu )  &  ! Unstable Eq.(A6) 
     963         &               +      zstab  * 1._wp / ( 1._wp + ram_louis * zts )     ! Stable   Eq.(A7) 
     964      ! 
     965   END FUNCTION f_m_louis_sclr 
     966   !! 
     967   FUNCTION f_m_louis_vctr( pzu, pRib, pCdn, pz0 ) 
     968      REAL(wp), DIMENSION(jpi,jpj)             :: f_m_louis_vctr 
     969      REAL(wp),                     INTENT(in) :: pzu 
     970      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pRib 
     971      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pCdn 
     972      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0 
     973      INTEGER  :: ji, jj 
     974      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     975      f_m_louis_vctr(ji,jj) = f_m_louis_sclr( pzu, pRib(ji,jj), pCdn(ji,jj), pz0(ji,jj) ) 
     976      END_2D 
     977   END FUNCTION f_m_louis_vctr 
     978 
     979 
     980   FUNCTION f_h_louis_sclr( pzu, pRib, pChn, pz0 ) 
     981      !!---------------------------------------------------------------------------------- 
     982      !!  Stability correction function for HEAT 
     983      !!                 Louis (1979) 
     984      !!---------------------------------------------------------------------------------- 
     985      REAL(wp)             :: f_h_louis_sclr ! term "f_h" in Eq.(6) when option "Louis" rather than "Psi(zeta) is chosen, Lupkes & Gryanik (2015), 
     986      REAL(wp), INTENT(in) :: pzu     ! reference height (height for pwnd)  [m] 
     987      REAL(wp), INTENT(in) :: pRib    ! Bulk Richardson number 
     988      REAL(wp), INTENT(in) :: pChn    ! neutral heat transfer coefficient 
     989      REAL(wp), INTENT(in) :: pz0     ! roughness length                      [m] 
     990      !!---------------------------------------------------------------------------------- 
     991      REAL(wp) :: ztu, zts, zstab 
     992      !!---------------------------------------------------------------------------------- 
     993      zstab = 0.5 + SIGN(0.5_wp, pRib) ; ! Unstable (Ri<0) => zstab = 0 | Stable (Ri>0) => zstab = 1 
     994      ! 
     995      ztu = pRib / ( 1._wp + 3._wp * rc2_louis * pChn * SQRT( ABS(-pRib * ( pzu / pz0 + 1._wp) ) ) ) 
     996      zts = pRib / SQRT( ABS( 1._wp + pRib ) ) 
     997      ! 
     998      f_h_louis_sclr = (1._wp - zstab) *         ( 1._wp - rah_louis * ztu )  &  ! Unstable Eq.(A6) 
     999         &              +       zstab  * 1._wp / ( 1._wp + rah_louis * zts )     ! Stable   Eq.(A7)  !#LB: in paper it's "ram_louis" and not "rah_louis" typo or what???? 
     1000      ! 
     1001   END FUNCTION f_h_louis_sclr 
     1002   !! 
     1003   FUNCTION f_h_louis_vctr( pzu, pRib, pChn, pz0 ) 
     1004      REAL(wp), DIMENSION(jpi,jpj)             :: f_h_louis_vctr 
     1005      REAL(wp),                     INTENT(in) :: pzu 
     1006      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pRib 
     1007      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pChn 
     1008      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0 
     1009      INTEGER  :: ji, jj 
     1010      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     1011      f_h_louis_vctr(ji,jj) = f_h_louis_sclr( pzu, pRib(ji,jj), pChn(ji,jj), pz0(ji,jj) ) 
     1012      END_2D 
     1013   END FUNCTION f_h_louis_vctr 
     1014 
     1015   FUNCTION UN10_from_ustar( pzu, pUzu, pus, ppsi ) 
     1016      !!---------------------------------------------------------------------------------- 
     1017      !!  Provides the neutral-stability wind speed at 10 m 
     1018      !!---------------------------------------------------------------------------------- 
     1019      REAL(wp), DIMENSION(jpi,jpj)             :: UN10_from_ustar  !: neutral stability wind speed at 10m [m/s] 
     1020      REAL(wp),                     INTENT(in) :: pzu   !: measurement heigh of wind speed   [m] 
     1021      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pUzu  !: bulk wind speed at height pzu m   [m/s] 
     1022      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus   !: friction velocity                 [m/s] 
     1023      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum [] 
     1024      !!---------------------------------------------------------------------------------- 
     1025      UN10_from_ustar(:,:) = pUzu(:,:) - pus(:,:)/vkarmn * ( LOG(pzu/10._wp) - ppsi(:,:) ) 
     1026      !! 
     1027   END FUNCTION UN10_from_ustar 
     1028 
     1029 
     1030   FUNCTION UN10_from_CD( pzu, pUb, pCd, ppsi ) 
     1031      !!---------------------------------------------------------------------------------- 
     1032      !!  Provides the neutral-stability wind speed at 10 m 
     1033      !!---------------------------------------------------------------------------------- 
     1034      REAL(wp), DIMENSION(jpi,jpj)             :: UN10_from_CD  !: [m/s] 
     1035      REAL(wp),                     INTENT(in) :: pzu  !: measurement heigh of bulk wind speed 
     1036      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pUb  !: bulk wind speed at height pzu m   [m/s] 
     1037      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pCd  !: drag coefficient 
     1038      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum [] 
     1039      !!---------------------------------------------------------------------------------- 
     1040      !! Reminder: UN10 = u*/vkarmn * log(10/z0) 
     1041      !!     and: u* = sqrt(Cd) * Ub 
     1042      !!                                  u*/vkarmn * log(   10   /       z0    ) 
     1043      UN10_from_CD(:,:) = SQRT(pCd(:,:))*pUb/vkarmn * LOG( 10._wp / z0_from_Cd( pzu, pCd(:,:), ppsi=ppsi(:,:) ) ) 
     1044      !! 
     1045   END FUNCTION UN10_from_CD 
     1046 
     1047 
     1048   FUNCTION z0tq_LKB( iflag, pRer, pz0 ) 
     1049      !!--------------------------------------------------------------------------------- 
     1050      !!       ***  FUNCTION z0tq_LKB  *** 
     1051      !! 
     1052      !! ** Purpose : returns the "temperature/humidity roughness lengths" 
     1053      !!              * iflag==1 => temperature => returns: z_{0t} 
     1054      !!              * iflag==2 => humidity    => returns: z_{0q} 
     1055      !!              from roughness reynold number "pRer" (i.e. [z_0 u*]/Nu_{air}) 
     1056      !!              between 0 and 1000. Out of range "pRer" indicated by prt=-999. 
     1057      !!              and roughness length (for momentum) 
     1058      !! 
     1059      !!              Based on Liu et al. (1979) JAS 36 1722-1723s 
     1060      !! 
     1061      !!              Note: this is what is used into COARE 2.5 to estimate z_{0t} and z_{0q} 
     1062      !! 
     1063      !! ** Author: L. Brodeau, April 2020 / AeroBulk (https://github.com/brodeau/aerobulk/) 
     1064      !!---------------------------------------------------------------------------------- 
     1065      REAL(wp), DIMENSION(jpi,jpj)             :: z0tq_LKB 
     1066      INTEGER,                      INTENT(in) :: iflag     !: 1 => dealing with temperature; 2 => dealing with humidity 
     1067      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pRer      !: roughness Reynolds number  [z_0 u*]/Nu_{air} 
     1068      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0       !: roughness length (for momentum) [m] 
     1069      !------------------------------------------------------------------- 
     1070      ! Scalar Re_r relation from Liu et al. 
     1071      REAL(wp), DIMENSION(8,2), PARAMETER :: & 
     1072         & XA = (/ 0.177, 1.376, 1.026, 1.625, 4.661, 34.904, 1667.19, 5.88e5,  & 
     1073         &         0.292, 1.808, 1.393, 1.956, 4.994, 30.709, 1448.68, 2.98e5 /) 
     1074      !! 
     1075      REAL(wp), DIMENSION(8,2), PARAMETER :: & 
     1076         & XB = (/ 0., 0.929, -0.599, -1.018, -1.475, -2.067, -2.907, -3.935,  & 
     1077         &         0., 0.826, -0.528, -0.870, -1.297, -1.845, -2.682, -3.616 /) 
     1078      !! 
     1079      REAL(wp), DIMENSION(0:8),   PARAMETER :: & 
     1080         & XRAN = (/ 0., 0.11, 0.825, 3.0, 10.0, 30.0, 100., 300., 1000. /) 
     1081      !------------------------------------------------------------------- 
     1082      ! 
     1083      !------------------------------------------------------------------- 
     1084      ! Scalar Re_r relation from Moana Wave data. 
     1085      ! 
     1086      !      real*8 A(9,2),B(9,2),RAN(9),pRer,prt 
     1087      !      integer iflag 
     1088      !      DATA A/0.177,2.7e3,1.03,1.026,1.625,4.661,34.904,1667.19,5.88E5, 
     1089      !     &       0.292,3.7e3,1.4,1.393,1.956,4.994,30.709,1448.68,2.98E5/ 
     1090      !      DATA B/0.,4.28,0,-0.599,-1.018,-1.475,-2.067,-2.907,-3.935, 
     1091      !     &       0.,4.28,0,-0.528,-0.870,-1.297,-1.845,-2.682,-3.616/ 
     1092      !      DATA RAN/0.11,.16,1.00,3.0,10.0,30.0,100.,300.,1000./ 
     1093      !------------------------------------------------------------------- 
     1094 
     1095      LOGICAL  :: lfound=.FALSE. 
     1096      REAL(wp) :: zrr 
     1097      INTEGER  :: ji, jj, jm 
     1098 
     1099      z0tq_LKB(:,:) = -999._wp 
     1100 
     1101      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     1102 
     1103      zrr    = pRer(ji,jj) 
     1104      lfound = .FALSE. 
     1105 
     1106      IF( (zrr > 0.).AND.(zrr < 1000.) ) THEN 
     1107         jm = 0 
     1108         DO WHILE ( .NOT. lfound ) 
     1109            jm = jm + 1 
     1110            lfound = ( (zrr > XRAN(jm-1)) .AND. (zrr <= XRAN(jm)) ) 
     1111         END DO 
     1112 
     1113         z0tq_LKB(ji,jj) = XA(jm,iflag)*zrr**XB(jm,iflag) * pz0(ji,jj)/zrr 
     1114 
     1115      END IF 
     1116 
     1117      END_2D 
     1118 
     1119      z0tq_LKB(:,:) = MIN( MAX(ABS(z0tq_LKB(:,:)), 1.E-9) , 0.05_wp ) 
     1120 
     1121   END FUNCTION z0tq_LKB 
     1122 
    6671123 
    6681124   !!====================================================================== 
    669 END MODULE sbcblk_phy 
     1125END MODULE sbc_phy 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk.F90

    r13501 r13655  
    3030   !!   blk_ice_2   : provide the heat and mass fluxes at air-ice interface 
    3131   !!   blk_ice_qcn   : provide ice surface temperature and snow/ice conduction flux (emulating conduction flux) 
    32    !!   Cdn10_Lupkes2012 : Lupkes et al. (2012) air-ice drag 
    33    !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag 
    3432   !!---------------------------------------------------------------------- 
    3533   USE oce            ! ocean dynamics and tracers 
    … …  
    4139   USE sbcdcy         ! surface boundary condition: diurnal cycle 
    4240   USE sbcwave , ONLY :   cdn_wave ! wave module 
    43    USE sbc_ice        ! Surface boundary condition: ice fields 
    4441   USE lib_fortran    ! to use key_nosignedzero 
     42   ! 
    4543#if defined key_si3 
     44   USE sbc_ice        ! Surface boundary condition: ice fields #LB? ok to be in 'key_si3' ??? 
    4645   USE ice     , ONLY :   u_ice, v_ice, jpl, a_i_b, at_i_b, t_su, rn_cnd_s, hfx_err_dif, nn_qtrice 
    4746   USE icevar         ! for CALL ice_var_snwblow 
    48 #endif 
    49    USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009) 
     47   USE sbcblk_algo_ice_lu12 
     48   USE sbcblk_algo_ice_lg15 
     49#endif 
     50   USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - (formerly known as CORE, Large & Yeager, 2009) 
    5051   USE sbcblk_algo_coare3p0 ! => turb_coare3p0 : COAREv3.0 (Fairall et al. 2003) 
    5152   USE sbcblk_algo_coare3p6 ! => turb_coare3p6 : COAREv3.6 (Fairall et al. 2018 + Edson et al. 2013) 
    5253   USE sbcblk_algo_ecmwf    ! => turb_ecmwf    : ECMWF (IFS cycle 45r1) 
     54   USE sbcblk_algo_andreas  ! => turb_andreas  : Andreas et al. 2015 
     55   ! 
     56 
    5357   ! 
    5458   USE iom            ! I/O manager library 
    … …  
    5862   USE prtctl         ! Print control 
    5963 
    60    USE sbcblk_phy     ! a catalog of functions for physical/meteorological parameters in the marine boundary layer, rho_air, q_sat, etc... 
     64   USE sbc_phy        ! a catalog of functions for physical/meteorological parameters in the marine boundary layer, rho_air, q_sat, etc... 
    6165 
    6266 
    … …  
    100104   LOGICAL  ::   ln_COARE_3p6   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
    101105   LOGICAL  ::   ln_ECMWF       ! "ECMWF"     algorithm   (IFS cycle 45r1) 
     106   LOGICAL  ::   ln_ANDREAS     ! "ANDREAS"   algorithm   (Andreas et al. 2015) 
    102107   ! 
    103    LOGICAL  ::   ln_Cd_L12      ! ice-atm drag = F( ice concentration )                        (Lupkes et al. JGR2012) 
    104    LOGICAL  ::   ln_Cd_L15      ! ice-atm drag = F( ice concentration, atmospheric stability ) (Lupkes et al. JGR2015) 
     108   !#LB: 
     109   LOGICAL  ::   ln_Cx_ice_cst      ! use constant ice-air bulk transfer coefficients (value given in namelist's rn_Cd_i, rn_Ce_i & rn_Ch_i) 
     110   REAL(wp) ::   rn_Cd_i, rn_Ce_i, rn_Ch_i 
     111   LOGICAL  ::   ln_Cx_ice_LU12      ! ice-atm drag = F( ice concentration )                        (Lupkes et al. JGR2012) 
     112   LOGICAL  ::   ln_Cx_ice_LG15      ! ice-atm drag = F( ice concentration, atmospheric stability ) (Lupkes et al. JGR2015) 
     113   !#LB. 
    105114   ! 
    106115   LOGICAL  ::   ln_crt_fbk     ! Add surface current feedback to the wind stress computation  (Renault et al. 2020) 
    107116   REAL(wp) ::   rn_stau_a      ! Alpha and Beta coefficients of Renault et al. 2020, eq. 10: Stau = Alpha * Wnd + Beta 
    108    REAL(wp) ::   rn_stau_b      !  
     117   REAL(wp) ::   rn_stau_b      ! 
    109118   ! 
    110119   REAL(wp)         ::   rn_pfac   ! multiplication factor for precipitation 
    … …  
    113122   REAL(wp)         ::   rn_zu     ! z(u)   : height of wind measurements 
    114123   ! 
    115    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   Cdn_oce, Chn_oce, Cen_oce  ! neutral coeffs over ocean (L15 bulk scheme and ABL) 
    116    REAL(wp),         ALLOCATABLE, DIMENSION(:,:) ::   Cd_ice , Ch_ice , Ce_ice   ! transfert coefficients over ice 
    117    REAL(wp),         ALLOCATABLE, DIMENSION(:,:) ::   t_zu, q_zu                 ! air temp. and spec. hum. at wind speed height (L15 bulk scheme) 
     124   INTEGER          :: nn_iter_algo   !  Number of iterations in bulk param. algo ("stable ABL + weak wind" requires more) 
     125 
     126   REAL(wp),         ALLOCATABLE, DIMENSION(:,:) ::   theta_zu, q_zu                 ! air temp. and spec. hum. at wind speed height (L15 bulk scheme) 
     127 
     128#if defined key_si3 
     129   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: Cd_ice , Ch_ice , Ce_ice   !#LB transfert coefficients over ice 
     130   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: theta_zu_i, q_zu_i         !#LB fixme ! air temp. and spec. hum. over ice at wind speed height (L15 bulk scheme) 
     131#endif 
     132 
    118133 
    119134   LOGICAL  ::   ln_skin_cs     ! use the cool-skin (only available in ECMWF and COARE algorithms) !LB 
    … …  
    136151   INTEGER, PARAMETER ::   np_COARE_3p6 = 3   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
    137152   INTEGER, PARAMETER ::   np_ECMWF     = 4   ! "ECMWF" algorithm       (IFS cycle 45r1) 
     153   INTEGER, PARAMETER ::   np_ANDREAS   = 5   ! "ANDREAS" algorithm       (Andreas et al. 2015) 
     154 
     155   !#LB: 
     156#if defined key_si3 
     157   ! Same, over sea-ice: 
     158   INTEGER  ::   nblk_ice           ! choice of the bulk algorithm 
     159   !                            ! associated indices: 
     160   INTEGER, PARAMETER ::   np_ice_cst  = 1   ! constant transfer coefficients 
     161   INTEGER, PARAMETER ::   np_ice_lu12 = 2   ! Lupkes, 2012 
     162   INTEGER, PARAMETER ::   np_ice_lg15 = 3   ! Lupkes & Gryanik, 2015 
     163#endif 
     164   !LB. 
     165 
     166 
    138167 
    139168   !! * Substitutions 
    … …  
    150179      !!             ***  ROUTINE sbc_blk_alloc *** 
    151180      !!------------------------------------------------------------------- 
    152       ALLOCATE( t_zu(jpi,jpj)   , q_zu(jpi,jpj)   ,                                      & 
    153          &      Cdn_oce(jpi,jpj), Chn_oce(jpi,jpj), Cen_oce(jpi,jpj),                    & 
    154          &      Cd_ice (jpi,jpj), Ch_ice (jpi,jpj), Ce_ice (jpi,jpj), STAT=sbc_blk_alloc ) 
    155       ! 
     181      ALLOCATE( theta_zu(jpi,jpj), q_zu(jpi,jpj),  STAT=sbc_blk_alloc ) 
    156182      CALL mpp_sum ( 'sbcblk', sbc_blk_alloc ) 
    157183      IF( sbc_blk_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_alloc: failed to allocate arrays' ) 
    158184   END FUNCTION sbc_blk_alloc 
     185    
     186#if defined key_si3 
     187   INTEGER FUNCTION sbc_blk_ice_alloc() 
     188      !!------------------------------------------------------------------- 
     189      !!             ***  ROUTINE sbc_blk_ice_alloc *** 
     190      !!------------------------------------------------------------------- 
     191      ALLOCATE( Cd_ice (jpi,jpj), Ch_ice (jpi,jpj), Ce_ice (jpi,jpj),         & 
     192         &      theta_zu_i(jpi,jpj), q_zu_i(jpi,jpj),  STAT=sbc_blk_ice_alloc ) 
     193      CALL mpp_sum ( 'sbcblk', sbc_blk_ice_alloc ) 
     194      IF( sbc_blk_ice_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_ice_alloc: failed to allocate arrays' ) 
     195   END FUNCTION sbc_blk_ice_alloc 
     196#endif 
    159197 
    160198 
    … …  
    178216      TYPE(FLD_N) ::   sn_cc, sn_hpgi, sn_hpgj                 !       "                        " 
    179217      INTEGER     ::   ipka                                    ! number of levels in the atmospheric variable 
    180       NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw ,                &   ! input fields 
    181          &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_uoatm, sn_voatm,     & 
    182          &                 sn_cc, sn_hpgi, sn_hpgj,                                   & 
    183          &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p6, ln_ECMWF,             &   ! bulk algorithm 
    184          &                 cn_dir , rn_zqt, rn_zu,                                    & 
    185          &                 rn_pfac, rn_efac, ln_Cd_L12, ln_Cd_L15, ln_tpot,           & 
    186          &                 ln_crt_fbk, rn_stau_a, rn_stau_b,                          &   ! current feedback 
    187          &                 ln_skin_cs, ln_skin_wl, ln_humi_sph, ln_humi_dpt, ln_humi_rlh  ! cool-skin / warm-layer !LB 
     218      NAMELIST/namsbc_blk/ ln_NCAR, ln_COARE_3p0, ln_COARE_3p6, ln_ECMWF, ln_ANDREAS, &   ! bulk algorithm 
     219         &                 rn_zqt, rn_zu, nn_iter_algo, ln_skin_cs, ln_skin_wl,       & 
     220         &                 rn_pfac, rn_efac,                                & 
     221         &                 ln_crt_fbk, rn_stau_a, rn_stau_b,                &   ! current feedback 
     222         &                 ln_humi_sph, ln_humi_dpt, ln_humi_rlh, ln_tpot,  & 
     223         &                 ln_Cx_ice_cst, rn_Cd_i, rn_Ce_i, rn_Ch_i,        & 
     224         &                 ln_Cx_ice_LU12, ln_Cx_ice_LG15,                  & 
     225         &                 cn_dir,                                          & 
     226         &                 sn_wndi, sn_wndj, sn_qsr, sn_qlw ,               &   ! input fields 
     227         &                 sn_tair, sn_humi, sn_prec, sn_snow, sn_slp,      & 
     228         &                 sn_uoatm, sn_voatm, sn_cc, sn_hpgi, sn_hpgj 
     229 
     230      ! cool-skin / warm-layer !LB 
    188231      !!--------------------------------------------------------------------- 
    189232      ! 
    190233      !                                      ! allocate sbc_blk_core array 
    191       IF( sbc_blk_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk : unable to allocate standard arrays' ) 
     234      IF( sbc_blk_alloc()     /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk : unable to allocate standard arrays' ) 
     235      ! 
     236#if defined key_si3 
     237      IF( sbc_blk_ice_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk : unable to allocate standard ice arrays' ) 
     238#endif 
    192239      ! 
    193240      !                             !** read bulk namelist 
    … …  
    215262         nblk =  np_ECMWF       ;   ioptio = ioptio + 1 
    216263      ENDIF 
     264      IF( ln_ANDREAS     ) THEN 
     265         nblk =  np_ANDREAS       ;   ioptio = ioptio + 1 
     266      ENDIF 
    217267      IF( ioptio /= 1 )   CALL ctl_stop( 'sbc_blk_init: Choose one and only one bulk algorithm' ) 
    218268 
    … …  
    222272         IF( ln_NCAR )      & 
    223273            & CALL ctl_stop( 'sbc_blk_init: Cool-skin/warm-layer param. not compatible with NCAR algorithm' ) 
     274         IF( ln_ANDREAS )      & 
     275            & CALL ctl_stop( 'sbc_blk_init: Cool-skin/warm-layer param. not compatible with ANDREAS algorithm' ) 
    224276         IF( nn_fsbc /= 1 ) & 
    225277            & CALL ctl_stop( 'sbc_blk_init: Please set "nn_fsbc" to 1 when using cool-skin/warm-layer param.') 
    … …  
    254306         ENDIF 
    255307      ENDIF 
     308 
     309#if defined key_si3 
     310      ioptio = 0 
     311      IF( ln_Cx_ice_cst ) THEN 
     312         nblk_ice =  np_ice_cst     ;   ioptio = ioptio + 1 
     313      ENDIF 
     314      IF( ln_Cx_ice_LU12 ) THEN 
     315         nblk_ice =  np_ice_lu12    ;   ioptio = ioptio + 1 
     316      ENDIF 
     317      IF( ln_Cx_ice_LG15 ) THEN 
     318         nblk_ice =  np_ice_lg15   ;   ioptio = ioptio + 1 
     319      ENDIF 
     320      IF( ioptio /= 1 )   CALL ctl_stop( 'sbc_blk_init: Choose one and only one ice-atm bulk algorithm' ) 
     321#endif 
     322 
     323 
    256324      !                                   !* set the bulk structure 
    257325      !                                      !- store namelist information in an array 
    … …  
    310378            ! 
    311379            IF( sf(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * sf(jfpr)%freqh), nn_fsbc * NINT(rn_Dt) ) /= 0 )   & 
    312          &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rn_Dt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   & 
    313          &                 '               This is not ideal. You should consider changing either rn_Dt or nn_fsbc value...' ) 
     380               &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rn_Dt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   & 
     381               &                 '               This is not ideal. You should consider changing either rn_Dt or nn_fsbc value...' ) 
    314382         ENDIF 
    315383      END DO 
    … …  
    321389            !drag coefficient read from wave model definable only with mfs bulk formulae and core 
    322390         ELSEIF(ln_cdgw .AND. .NOT. ln_NCAR )       THEN 
    323             CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR and CORE bulk formulae') 
     391            CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR bulk formulae') 
    324392         ELSEIF(ln_stcor .AND. .NOT. ln_sdw)                             THEN 
    325393            CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') 
    … …  
    341409      ENDIF 
    342410      ! 
    343       ! set transfer coefficients to default sea-ice values 
    344       Cd_ice(:,:) = rCd_ice 
    345       Ch_ice(:,:) = rCd_ice 
    346       Ce_ice(:,:) = rCd_ice 
    347411      ! 
    348412      IF(lwp) THEN                     !** Control print 
    … …  
    350414         WRITE(numout,*)                  !* namelist 
    351415         WRITE(numout,*) '   Namelist namsbc_blk (other than data information):' 
    352          WRITE(numout,*) '      "NCAR"      algorithm   (Large and Yeager 2008)     ln_NCAR      = ', ln_NCAR 
     416         WRITE(numout,*) '      "NCAR"      algorithm   (Large and Yeager 2008)      ln_NCAR      = ', ln_NCAR 
    353417         WRITE(numout,*) '      "COARE 3.0" algorithm   (Fairall et al. 2003)       ln_COARE_3p0 = ', ln_COARE_3p0 
    354          WRITE(numout,*) '      "COARE 3.6" algorithm (Fairall 2018 + Edson al 2013)ln_COARE_3p6 = ', ln_COARE_3p6 
    355          WRITE(numout,*) '      "ECMWF"     algorithm   (IFS cycle 45r1)            ln_ECMWF     = ', ln_ECMWF 
     418         WRITE(numout,*) '      "COARE 3.6" algorithm (Fairall 2018 + Edson al 2013) ln_COARE_3p6 = ', ln_COARE_3p6 
     419         WRITE(numout,*) '      "ECMWF"     algorithm   (IFS cycle 45r1)             ln_ECMWF     = ', ln_ECMWF 
     420         WRITE(numout,*) '      "ANDREAS"   algorithm   (Andreas et al. 2015)       ln_ANDREAS   = ', ln_ANDREAS 
    356421         WRITE(numout,*) '      Air temperature and humidity reference height (m)   rn_zqt       = ', rn_zqt 
    357422         WRITE(numout,*) '      Wind vector reference height (m)                    rn_zu        = ', rn_zu 
    … …  
    359424         WRITE(numout,*) '      factor applied on evaporation                       rn_efac      = ', rn_efac 
    360425         WRITE(numout,*) '         (form absolute (=0) to relative winds(=1))' 
    361          WRITE(numout,*) '      use ice-atm drag from Lupkes2012                    ln_Cd_L12    = ', ln_Cd_L12 
    362          WRITE(numout,*) '      use ice-atm drag from Lupkes2015                    ln_Cd_L15    = ', ln_Cd_L15 
    363426         WRITE(numout,*) '      use surface current feedback on wind stress         ln_crt_fbk   = ', ln_crt_fbk 
    364427         IF(ln_crt_fbk) THEN 
    365          WRITE(numout,*) '         Renault et al. 2020, eq. 10: Stau = Alpha * Wnd + Beta' 
    366          WRITE(numout,*) '            Alpha                                         rn_stau_a    = ', rn_stau_a 
    367          WRITE(numout,*) '            Beta                                          rn_stau_b    = ', rn_stau_b 
     428            WRITE(numout,*) '         Renault et al. 2020, eq. 10: Stau = Alpha * Wnd + Beta' 
     429            WRITE(numout,*) '            Alpha                                         rn_stau_a    = ', rn_stau_a 
     430            WRITE(numout,*) '            Beta                                          rn_stau_b    = ', rn_stau_b 
    368431         ENDIF 
    369432         ! 
    … …  
    374437         CASE( np_COARE_3p6 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.6" algorithm (Fairall 2018+Edson et al. 2013)' 
    375438         CASE( np_ECMWF     )   ;   WRITE(numout,*) '   ==>>>   "ECMWF" algorithm       (IFS cycle 45r1)' 
     439         CASE( np_ANDREAS   )   ;   WRITE(numout,*) '   ==>>>   "ANDREAS" algorithm (Andreas et al. 2015)' 
    376440         END SELECT 
    377441         ! 
    … …  
    386450         CASE( np_humi_rlh )   ;   WRITE(numout,*) '   ==>>>   air humidity is RELATIVE HUMIDITY     [%]' 
    387451         END SELECT 
     452         ! 
     453         !#LB: 
     454#if defined key_si3 
     455         IF( nn_ice > 0 ) THEN 
     456            WRITE(numout,*) 
     457            WRITE(numout,*) '      use constant ice-atm bulk transfer coeff.           ln_Cx_ice_cst  = ', ln_Cx_ice_cst 
     458            WRITE(numout,*) '      use ice-atm bulk coeff. from Lupkes, 2012           ln_Cx_ice_LU12 = ', ln_Cx_ice_LU12 
     459            WRITE(numout,*) '      use ice-atm bulk coeff. from Lupkes & Gryanik, 2015 ln_Cx_ice_LG15 = ', ln_Cx_ice_LG15 
     460         ENDIF 
     461         WRITE(numout,*) 
     462         SELECT CASE( nblk_ice )              !* Print the choice of bulk algorithm 
     463         CASE( np_ice_cst  ) 
     464            WRITE(numout,*) '   ==>>>   Constant bulk transfer coefficients over sea-ice:' 
     465            WRITE(numout,*) '      => Cd_ice, Ce_ice, Ch_ice =', REAL(rn_Cd_i,4), REAL(rn_Ce_i,4), REAL(rn_Ch_i,4) 
     466            IF( (rn_Cd_i<0._wp).OR.(rn_Cd_i>1.E-2_wp).OR.(rn_Ce_i<0._wp).OR.(rn_Ce_i>1.E-2_wp).OR.(rn_Ch_i<0._wp).OR.(rn_Ch_i>1.E-2_wp) ) & 
     467               & CALL ctl_stop( 'Be realistic in your pick of Cd_ice, Ce_ice & Ch_ice ! (0 < Cx < 1.E-2)') 
     468         CASE( np_ice_lu12 )   ;   WRITE(numout,*) '   ==>>> bulk algo over ice: Lupkes et al, 2012' 
     469         CASE( np_ice_lg15 )   ;   WRITE(numout,*) '   ==>>> bulk algo over ice: Lupkes & Gryanik, 2015' 
     470         END SELECT 
     471#endif 
     472         !#LB. 
    388473         ! 
    389474      ENDIF 
    … …  
    428513      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    429514      !!---------------------------------------------------------------------- 
    430       REAL(wp), DIMENSION(jpi,jpj) ::   zssq, zcd_du, zsen, zevp 
     515      REAL(wp), DIMENSION(jpi,jpj) ::   zssq, zcd_du, zsen, zlat, zevp 
    431516      REAL(wp) :: ztmp 
    432517      !!---------------------------------------------------------------------- 
    … …  
    465550      !                                            ! compute the surface ocean fluxes using bulk formulea 
    466551      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
     552 
     553         ! Specific humidity of air at z=rn_zqt ! 
     554         SELECT CASE( nhumi ) 
     555         CASE( np_humi_sph ) 
     556            q_air_zt(:,:) = sf(jp_humi )%fnow(:,:,1)      ! what we read in file is already a spec. humidity! 
     557         CASE( np_humi_dpt ) 
     558            IF((kt==nit000).AND.lwp) WRITE(numout,*) ' *** sbc_blk() => computing q_air out of dew-point and P !' 
     559            q_air_zt(:,:) = q_sat( sf(jp_humi )%fnow(:,:,1), sf(jp_slp  )%fnow(:,:,1) ) 
     560         CASE( np_humi_rlh ) 
     561            IF((kt==nit000).AND.lwp) WRITE(numout,*) ' *** sbc_blk() => computing q_air out of RH, t_air and slp !' !LBrm 
     562            q_air_zt(:,:) = q_air_rh( 0.01_wp*sf(jp_humi )%fnow(:,:,1), & 
     563               &                      sf(jp_tair )%fnow(:,:,1), sf(jp_slp  )%fnow(:,:,1) ) !#LB: 0.01 => RH is % percent in file 
     564         END SELECT 
     565 
     566         ! POTENTIAL temperature of air at z=rn_zqt 
     567         !      based on adiabatic lapse-rate (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2 
     568         !      (most reanalysis products provide absolute temp., not potential temp.) 
     569         IF( ln_tpot ) THEN 
     570            ! temperature read into file is ABSOLUTE temperature (that's the case for ECMWF products for example...) 
     571            IF((kt==nit000).AND.lwp) WRITE(numout,*) ' *** sbc_blk() => computing air POTENTIAL temperature out of ABSOLUTE temperature!' 
     572            theta_air_zt(:,:) = sf(jp_tair )%fnow(:,:,1) + gamma_moist( sf(jp_tair )%fnow(:,:,1), q_air_zt(:,:) ) * rn_zqt 
     573         ELSE 
     574            ! temperature read into file is already potential temperature 
     575            theta_air_zt(:,:) = sf(jp_tair )%fnow(:,:,1) 
     576         ENDIF 
     577         ! 
    467578         CALL blk_oce_1( kt, sf(jp_wndi )%fnow(:,:,1), sf(jp_wndj )%fnow(:,:,1),   &   !   <<= in 
    468             &                sf(jp_tair )%fnow(:,:,1), sf(jp_humi )%fnow(:,:,1),   &   !   <<= in 
     579            &                theta_air_zt(:,:), q_air_zt(:,:),                     &   !   <<= in 
    469580            &                sf(jp_slp  )%fnow(:,:,1), sst_m, ssu_m, ssv_m,        &   !   <<= in 
    470581            &                sf(jp_uoatm)%fnow(:,:,1), sf(jp_voatm)%fnow(:,:,1),   &   !   <<= in 
    471582            &                sf(jp_qsr  )%fnow(:,:,1), sf(jp_qlw  )%fnow(:,:,1),   &   !   <<= in (wl/cs) 
    472             &                tsk_m, zssq, zcd_du, zsen, zevp )                         !   =>> out 
    473  
    474          CALL blk_oce_2(     sf(jp_tair )%fnow(:,:,1), sf(jp_qsr  )%fnow(:,:,1),   &   !   <<= in 
     583            &                tsk_m, zssq, zcd_du, zsen, zlat, zevp )                   !   =>> out 
     584          
     585         CALL blk_oce_2(     theta_air_zt(:,:),                                    &   !   <<= in 
    475586            &                sf(jp_qlw  )%fnow(:,:,1), sf(jp_prec )%fnow(:,:,1),   &   !   <<= in 
    476587            &                sf(jp_snow )%fnow(:,:,1), tsk_m,                      &   !   <<= in 
    477             &                zsen, zevp )                                              !   <=> in out 
     588            &                zsen, zlat, zevp )                                        !   <=> in out 
    478589      ENDIF 
    479590      ! 
    … …  
    486597            qsr_ice(:,:,1) =          sf(jp_qsr)%fnow(:,:,1) 
    487598         ENDIF 
    488          tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1) 
    489  
    490          SELECT CASE( nhumi ) 
    491          CASE( np_humi_sph ) 
    492             qatm_ice(:,:) =           sf(jp_humi)%fnow(:,:,1) 
    493          CASE( np_humi_dpt ) 
    494             qatm_ice(:,:) = q_sat(    sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) ) 
    495          CASE( np_humi_rlh ) 
    496             qatm_ice(:,:) = q_air_rh( 0.01_wp*sf(jp_humi)%fnow(:,:,1), sf(jp_tair)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) !LB: 0.01 => RH is % percent in file 
    497          END SELECT 
     599         tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)    !#LB: should it be POTENTIAL temperature instead ???? 
     600         !tatm_ice(:,:) = theta_air_zt(:,:)         !#LB: THIS! ? 
     601 
     602         qatm_ice(:,:) = q_air_zt(:,:) !#LB: 
    498603 
    499604         tprecip(:,:)     = sf(jp_prec)%fnow(:,:,1) * rn_pfac 
    … …  
    507612 
    508613 
    509    SUBROUTINE blk_oce_1( kt, pwndi, pwndj, ptair, phumi,         &  ! inp 
     614   SUBROUTINE blk_oce_1( kt, pwndi, pwndj, ptair, pqair,         &  ! inp 
    510615      &                      pslp , pst  , pu   , pv,            &  ! inp 
    511       &                      puatm, pvatm, pqsr , pqlw ,         &  ! inp 
    512       &                      ptsk , pssq , pcd_du, psen, pevp   )  ! out 
     616      &                      puatm, pvatm, pdqsr , pdqlw ,       &  ! inp 
     617      &                      ptsk , pssq , pcd_du, psen, plat, pevp ) ! out 
    513618      !!--------------------------------------------------------------------- 
    514619      !!                     ***  ROUTINE blk_oce_1  *** 
    … …  
    523628      !! ** Outputs : - pssq    : surface humidity used to compute latent heat flux (kg/kg) 
    524629      !!              - pcd_du  : Cd x |dU| at T-points  (m/s) 
    525       !!              - psen    : Ch x |dU| at T-points  (m/s) 
    526       !!              - pevp    : Ce x |dU| at T-points  (m/s) 
     630      !!              - psen    : sensible heat flux (W/m^2) 
     631      !!              - plat    : latent heat flux   (W/m^2) 
     632      !!              - pevp    : evaporation        (mm/s) #lolo 
    527633      !!--------------------------------------------------------------------- 
    528634      INTEGER , INTENT(in   )                 ::   kt     ! time step index 
    529635      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndi  ! atmospheric wind at U-point              [m/s] 
    530636      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndj  ! atmospheric wind at V-point              [m/s] 
    531       REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   phumi  ! specific humidity at T-points            [kg/kg] 
     637      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqair  ! specific humidity at T-points            [kg/kg] 
    532638      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   ptair  ! potential temperature at T-points        [Kelvin] 
    533639      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pslp   ! sea-level pressure                       [Pa] 
    … …  
    537643      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   puatm  ! surface current seen by the atm at T-point (i-component) [m/s] 
    538644      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pvatm  ! surface current seen by the atm at T-point (j-component) [m/s] 
    539       REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqsr   ! 
    540       REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqlw   ! 
     645      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pdqsr  ! downwelling solar (shortwave) radiation at surface [W/m^2] 
     646      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pdqlw  ! downwelling longwave radiation at surface [W/m^2] 
    541647      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   ptsk   ! skin temp. (or SST if CS & WL not used)  [Celsius] 
    542648      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pssq   ! specific humidity at pst                 [kg/kg] 
    543       REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pcd_du ! Cd x |dU| at T-points                    [m/s] 
    544       REAL(wp), INTENT(  out), DIMENSION(:,:) ::   psen   ! Ch x |dU| at T-points                    [m/s] 
    545       REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pevp   ! Ce x |dU| at T-points                    [m/s] 
     649      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pcd_du 
     650      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   psen 
     651      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   plat 
     652      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pevp 
    546653      ! 
    547654      INTEGER  ::   ji, jj               ! dummy loop indices 
    … …  
    553660      REAL(wp), DIMENSION(jpi,jpj) ::   ztau_i, ztau_j    ! wind stress components at T-point 
    554661      REAL(wp), DIMENSION(jpi,jpj) ::   zU_zu             ! bulk wind speed at height zu  [m/s] 
    555       REAL(wp), DIMENSION(jpi,jpj) ::   ztpot             ! potential temperature of air at z=rn_zqt [K] 
    556       REAL(wp), DIMENSION(jpi,jpj) ::   zqair             ! specific humidity     of air at z=rn_zqt [kg/kg] 
    557662      REAL(wp), DIMENSION(jpi,jpj) ::   zcd_oce           ! momentum transfert coefficient over ocean 
    558663      REAL(wp), DIMENSION(jpi,jpj) ::   zch_oce           ! sensible heat transfert coefficient over ocean 
    559664      REAL(wp), DIMENSION(jpi,jpj) ::   zce_oce           ! latent   heat transfert coefficient over ocean 
    560       REAL(wp), DIMENSION(jpi,jpj) ::   zqla              ! latent heat flux 
    561665      REAL(wp), DIMENSION(jpi,jpj) ::   zztmp1, zztmp2 
    562666      !!--------------------------------------------------------------------- 
    … …  
    579683      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012) 
    580684      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    581          zwnd_i(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj) 
    582          zwnd_j(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj) 
    583          ! ... scalar wind at T-point (not masked) 
    584          wndm(ji,jj) = SQRT( zwnd_i(ji,jj) * zwnd_i(ji,jj) + zwnd_j(ji,jj) * zwnd_j(ji,jj) ) 
     685      zwnd_i(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj) 
     686      zwnd_j(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj) 
     687      ! ... scalar wind at T-point (not masked) 
     688      wndm(ji,jj) = SQRT( zwnd_i(ji,jj) * zwnd_i(ji,jj) + zwnd_j(ji,jj) * zwnd_j(ji,jj) ) 
    585689      END_2D 
    586690#else 
    587691      ! ... scalar wind module at T-point (not masked) 
    588692      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    589          wndm(ji,jj) = SQRT(  pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj)  ) 
     693      wndm(ji,jj) = SQRT(  pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj)  ) 
    590694      END_2D 
    591695#endif 
    … …  
    597701      zztmp = 1. - albo 
    598702      IF( ln_dm2dc ) THEN 
    599          qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 
     703         qsr(:,:) = zztmp * sbc_dcy( pdqsr(:,:) ) * tmask(:,:,1) 
    600704      ELSE 
    601          qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1) 
     705         qsr(:,:) = zztmp *          pdqsr(:,:)   * tmask(:,:,1) 
    602706      ENDIF 
    603707 
    … …  
    616720      ENDIF 
    617721 
    618       ! specific humidity of air at "rn_zqt" m above the sea 
    619       SELECT CASE( nhumi ) 
    620       CASE( np_humi_sph ) 
    621          zqair(:,:) = phumi(:,:)      ! what we read in file is already a spec. humidity! 
    622       CASE( np_humi_dpt ) 
    623          !IF(lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of d_air and slp !' !LBrm 
    624          zqair(:,:) = q_sat( phumi(:,:), pslp(:,:) ) 
    625       CASE( np_humi_rlh ) 
    626          !IF(lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of RH, t_air and slp !' !LBrm 
    627          zqair(:,:) = q_air_rh( 0.01_wp*phumi(:,:), ptair(:,:), pslp(:,:) ) !LB: 0.01 => RH is % percent in file 
    628       END SELECT 
    629       ! 
    630       ! potential temperature of air at "rn_zqt" m above the sea 
    631       IF( ln_abl ) THEN 
    632          ztpot = ptair(:,:) 
    633       ELSE 
    634          ! Estimate of potential temperature at z=rn_zqt, based on adiabatic lapse-rate 
    635          !    (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2 
    636          !    (since reanalysis products provide T at z, not theta !) 
    637          !#LB: because AGRIF hates functions that return something else than a scalar, need to 
    638          !     use scalar version of gamma_moist() ... 
    639          IF( ln_tpot ) THEN 
    640             DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    641                ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt 
    642             END_2D 
    643          ELSE 
    644             ztpot = ptair(:,:) 
    645          ENDIF 
    646       ENDIF 
    647  
    648722      !! Time to call the user-selected bulk parameterization for 
    649723      !!  ==  transfer coefficients  ==!   Cd, Ch, Ce at T-point, and more... 
    … …  
    651725 
    652726      CASE( np_NCAR      ) 
    653          CALL turb_ncar    ( rn_zqt, rn_zu, ptsk, ztpot, pssq, zqair, wndm,                              & 
    654             &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    655  
     727         CALL turb_ncar    (     rn_zqt, rn_zu, ptsk, ptair, pssq, pqair, wndm, & 
     728            &                zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu , & 
     729            &                nb_iter=nn_iter_algo ) 
     730         ! 
    656731      CASE( np_COARE_3p0 ) 
    657          CALL turb_coare3p0 ( kt, rn_zqt, rn_zu, ptsk, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, & 
    658             &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
    659             &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
    660  
     732         CALL turb_coare3p0( kt, rn_zqt, rn_zu, ptsk, ptair, pssq, pqair, wndm, & 
     733            &                ln_skin_cs, ln_skin_wl,                            & 
     734            &                zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu,  & 
     735            &                nb_iter=nn_iter_algo,                              & 
     736            &                Qsw=qsr(:,:), rad_lw=pdqlw(:,:), slp=pslp(:,:) ) 
     737         ! 
    661738      CASE( np_COARE_3p6 ) 
    662          CALL turb_coare3p6 ( kt, rn_zqt, rn_zu, ptsk, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, & 
    663             &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
    664             &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
    665  
     739         CALL turb_coare3p6( kt, rn_zqt, rn_zu, ptsk, ptair, pssq, pqair, wndm, & 
     740            &                ln_skin_cs, ln_skin_wl,                            & 
     741            &                zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu,  & 
     742            &                nb_iter=nn_iter_algo,                              & 
     743            &                Qsw=qsr(:,:), rad_lw=pdqlw(:,:), slp=pslp(:,:) ) 
     744         ! 
    666745      CASE( np_ECMWF     ) 
    667          CALL turb_ecmwf   ( kt, rn_zqt, rn_zu, ptsk, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl,  & 
    668             &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
    669             &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
    670  
     746         CALL turb_ecmwf   ( kt, rn_zqt, rn_zu, ptsk, ptair, pssq, pqair, wndm, & 
     747            &                ln_skin_cs, ln_skin_wl,                            & 
     748            &                zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu,  & 
     749            &                nb_iter=nn_iter_algo,                              & 
     750            &                Qsw=qsr(:,:), rad_lw=pdqlw(:,:), slp=pslp(:,:) ) 
     751         ! 
     752      CASE( np_ANDREAS   ) 
     753         CALL turb_andreas (     rn_zqt, rn_zu, ptsk, ptair, pssq, pqair, wndm, & 
     754            &                zcd_oce, zch_oce, zce_oce, theta_zu, q_zu, zU_zu , & 
     755            &                nb_iter=nn_iter_algo   ) 
     756         ! 
    671757      CASE DEFAULT 
    672          CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' ) 
    673  
     758         CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk parameterizaton selected' ) 
     759         ! 
    674760      END SELECT 
    675        
     761 
    676762      IF( iom_use('Cd_oce') )   CALL iom_put("Cd_oce",   zcd_oce * tmask(:,:,1)) 
    677763      IF( iom_use('Ce_oce') )   CALL iom_put("Ce_oce",   zce_oce * tmask(:,:,1)) 
    678764      IF( iom_use('Ch_oce') )   CALL iom_put("Ch_oce",   zch_oce * tmask(:,:,1)) 
    679765      !! LB: mainly here for debugging purpose: 
    680       IF( iom_use('theta_zt') ) CALL iom_put("theta_zt", (ztpot-rt0) * tmask(:,:,1)) ! potential temperature at z=zt 
    681       IF( iom_use('q_zt') )     CALL iom_put("q_zt",     zqair       * tmask(:,:,1)) ! specific humidity       " 
    682       IF( iom_use('theta_zu') ) CALL iom_put("theta_zu", (t_zu -rt0) * tmask(:,:,1)) ! potential temperature at z=zu 
     766      IF( iom_use('theta_zt') ) CALL iom_put("theta_zt", (ptair-rt0) * tmask(:,:,1)) ! potential temperature at z=zt 
     767      IF( iom_use('q_zt') )     CALL iom_put("q_zt",     pqair       * tmask(:,:,1)) ! specific humidity       " 
     768      IF( iom_use('theta_zu') ) CALL iom_put("theta_zu", (theta_zu -rt0) * tmask(:,:,1)) ! potential temperature at z=zu 
    683769      IF( iom_use('q_zu') )     CALL iom_put("q_zu",     q_zu        * tmask(:,:,1)) ! specific humidity       " 
    684770      IF( iom_use('ssq') )      CALL iom_put("ssq",      pssq        * tmask(:,:,1)) ! saturation specific humidity at z=0 
    685771      IF( iom_use('wspd_blk') ) CALL iom_put("wspd_blk", zU_zu       * tmask(:,:,1)) ! bulk wind speed at z=zu 
    686        
     772 
    687773      IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
    688774         !! ptsk and pssq have been updated!!! 
    … …  
    696782      END IF 
    697783 
    698       !  Turbulent fluxes over ocean  => BULK_FORMULA @ sbcblk_phy.F90 
     784      !  Turbulent fluxes over ocean  => BULK_FORMULA @ sbc_phy.F90 
    699785      ! ------------------------------------------------------------- 
    700786 
    701787      IF( ln_abl ) THEN         !==  ABL formulation  ==!   multiplication by rho_air and turbulent fluxes computation done in ablstp 
    702788         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    703             zztmp = zU_zu(ji,jj) 
    704             wndm(ji,jj)   = zztmp                   ! Store zU_zu in wndm to compute ustar2 in ablmod 
    705             pcd_du(ji,jj) = zztmp * zcd_oce(ji,jj) 
    706             psen(ji,jj)   = zztmp * zch_oce(ji,jj) 
    707             pevp(ji,jj)   = zztmp * zce_oce(ji,jj) 
    708             rhoa(ji,jj)   = rho_air( ptair(ji,jj), phumi(ji,jj), pslp(ji,jj) ) 
     789         zztmp = zU_zu(ji,jj) 
     790         wndm(ji,jj)   = zztmp                   ! Store zU_zu in wndm to compute ustar2 in ablmod 
     791         pcd_du(ji,jj) = zztmp * zcd_oce(ji,jj) 
     792         psen(ji,jj)   = zztmp * zch_oce(ji,jj) 
     793         pevp(ji,jj)   = zztmp * zce_oce(ji,jj) 
     794         rhoa(ji,jj)   = rho_air( ptair(ji,jj), pqair(ji,jj), pslp(ji,jj) ) 
    709795         END_2D 
    710796      ELSE                      !==  BLK formulation  ==!   turbulent fluxes computation 
    711          CALL BULK_FORMULA( rn_zu, ptsk(:,:), pssq(:,:), t_zu(:,:), q_zu(:,:), & 
     797         CALL BULK_FORMULA( rn_zu, ptsk(:,:), pssq(:,:), theta_zu(:,:), q_zu(:,:), & 
    712798            &               zcd_oce(:,:), zch_oce(:,:), zce_oce(:,:),          & 
    713799            &               wndm(:,:), zU_zu(:,:), pslp(:,:),                  & 
    714             &               taum(:,:), psen(:,:), zqla(:,:),                   & 
     800            &               taum(:,:), psen(:,:), plat(:,:),                   & 
    715801            &               pEvap=pevp(:,:), prhoa=rhoa(:,:), pfact_evap=rn_efac ) 
    716802 
    717          zqla(:,:) = zqla(:,:) * tmask(:,:,1) 
    718803         psen(:,:) = psen(:,:) * tmask(:,:,1) 
     804         plat(:,:) = plat(:,:) * tmask(:,:,1) 
    719805         taum(:,:) = taum(:,:) * tmask(:,:,1) 
    720806         pevp(:,:) = pevp(:,:) * tmask(:,:,1) 
    721807 
    722808         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    723             IF( wndm(ji,jj) > 0._wp ) THEN 
    724                zztmp = taum(ji,jj) / wndm(ji,jj) 
     809         IF( wndm(ji,jj) > 0._wp ) THEN 
     810            zztmp = taum(ji,jj) / wndm(ji,jj) 
    725811#if defined key_cyclone 
    726                ztau_i(ji,jj) = zztmp * zwnd_i(ji,jj) 
    727                ztau_j(ji,jj) = zztmp * zwnd_j(ji,jj) 
     812            ztau_i(ji,jj) = zztmp * zwnd_i(ji,jj) 
     813            ztau_j(ji,jj) = zztmp * zwnd_j(ji,jj) 
    728814#else 
    729                ztau_i(ji,jj) = zztmp * pwndi(ji,jj) 
    730                ztau_j(ji,jj) = zztmp * pwndj(ji,jj) 
    731 #endif 
    732             ELSE 
    733                ztau_i(ji,jj) = 0._wp 
    734                ztau_j(ji,jj) = 0._wp                  
    735             ENDIF 
     815            ztau_i(ji,jj) = zztmp * pwndi(ji,jj) 
     816            ztau_j(ji,jj) = zztmp * pwndj(ji,jj) 
     817#endif 
     818         ELSE 
     819            ztau_i(ji,jj) = 0._wp 
     820            ztau_j(ji,jj) = 0._wp 
     821         ENDIF 
    736822         END_2D 
    737823 
    … …  
    739825            zstmax = MIN( rn_stau_a * 3._wp + rn_stau_b, 0._wp )   ! set the max value of Stau corresponding to a wind of 3 m/s (<0) 
    740826            DO_2D( 0, 1, 0, 1 )   ! end at jpj and jpi, as ztau_j(ji,jj+1) ztau_i(ji+1,jj) used in the next loop 
    741                zstau = MIN( rn_stau_a * wndm(ji,jj) + rn_stau_b, zstmax )   ! stau (<0) must be smaller than zstmax 
    742                ztau_i(ji,jj) = ztau_i(ji,jj) + zstau * ( 0.5_wp * ( pu(ji-1,jj  ) + pu(ji,jj) ) - puatm(ji,jj) ) 
    743                ztau_j(ji,jj) = ztau_j(ji,jj) + zstau * ( 0.5_wp * ( pv(ji  ,jj-1) + pv(ji,jj) ) - pvatm(ji,jj) ) 
    744                taum(ji,jj) = SQRT( ztau_i(ji,jj) * ztau_i(ji,jj) + ztau_j(ji,jj) * ztau_j(ji,jj) ) 
     827            zstau = MIN( rn_stau_a * wndm(ji,jj) + rn_stau_b, zstmax )   ! stau (<0) must be smaller than zstmax 
     828            ztau_i(ji,jj) = ztau_i(ji,jj) + zstau * ( 0.5_wp * ( pu(ji-1,jj  ) + pu(ji,jj) ) - puatm(ji,jj) ) 
     829            ztau_j(ji,jj) = ztau_j(ji,jj) + zstau * ( 0.5_wp * ( pv(ji  ,jj-1) + pv(ji,jj) ) - pvatm(ji,jj) ) 
     830            taum(ji,jj) = SQRT( ztau_i(ji,jj) * ztau_i(ji,jj) + ztau_j(ji,jj) * ztau_j(ji,jj) ) 
    745831            END_2D 
    746832         ENDIF 
    … …  
    750836         !     Note that coastal wind stress is not used in the code... so this extra care has no effect 
    751837         DO_2D( 0, 0, 0, 0 )              ! start loop at 2, in case ln_crt_fbk = T 
    752             utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( ztau_i(ji,jj) + ztau_i(ji+1,jj  ) ) & 
    753                &              * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1)) 
    754             vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( ztau_j(ji,jj) + ztau_j(ji  ,jj+1) ) & 
    755                &              * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1)) 
     838         utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( ztau_i(ji,jj) + ztau_i(ji+1,jj  ) ) & 
     839            &              * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1)) 
     840         vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( ztau_j(ji,jj) + ztau_j(ji  ,jj+1) ) & 
     841            &              * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1)) 
    756842         END_2D 
     843 
    757844 
    758845         IF( ln_crt_fbk ) THEN 
    … …  
    762849         ENDIF 
    763850 
    764          CALL iom_put( "taum_oce", taum )   ! output wind stress module 
     851         CALL iom_put( "taum_oce", taum*tmask(:,:,1) )   ! output wind stress module 
    765852 
    766853         IF(sn_cfctl%l_prtctl) THEN 
    767             CALL prt_ctl( tab2d_1=wndm  , clinfo1=' blk_oce_1: wndm   : ') 
    768             CALL prt_ctl( tab2d_1=utau  , clinfo1=' blk_oce_1: utau   : ', mask1=umask,   & 
    769                &          tab2d_2=vtau  , clinfo2='            vtau   : ', mask2=vmask ) 
     854            CALL prt_ctl( tab2d_1=pssq   , clinfo1=' blk_oce_1: pssq   : ') 
     855            CALL prt_ctl( tab2d_1=wndm   , clinfo1=' blk_oce_1: wndm   : ') 
     856            CALL prt_ctl( tab2d_1=utau   , clinfo1=' blk_oce_1: utau   : ', mask1=umask,   & 
     857               &          tab2d_2=vtau   , clinfo2='            vtau   : ', mask2=vmask ) 
     858            CALL prt_ctl( tab2d_1=zcd_oce, clinfo1=' blk_oce_1: Cd     : ') 
    770859         ENDIF 
    771860         ! 
    772861      ENDIF !IF( ln_abl ) 
    773        
     862 
    774863      ptsk(:,:) = ( ptsk(:,:) - rt0 ) * tmask(:,:,1)  ! Back to Celsius 
    775              
     864 
    776865      IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
    777866         CALL iom_put( "t_skin" ,  ptsk        )  ! T_skin in Celsius 
    778867         CALL iom_put( "dt_skin" , ptsk - pst  )  ! T_skin - SST temperature difference... 
    779868      ENDIF 
    780  
    781       IF(sn_cfctl%l_prtctl) THEN 
    782          CALL prt_ctl( tab2d_1=pevp  , clinfo1=' blk_oce_1: pevp   : ' ) 
    783          CALL prt_ctl( tab2d_1=psen  , clinfo1=' blk_oce_1: psen   : ' ) 
    784          CALL prt_ctl( tab2d_1=pssq  , clinfo1=' blk_oce_1: pssq   : ' ) 
    785       ENDIF 
    786869      ! 
    787870   END SUBROUTINE blk_oce_1 
    788871 
    789  
    790    SUBROUTINE blk_oce_2( ptair, pqsr, pqlw, pprec,  &   ! <<= in 
    791       &                  psnow, ptsk, psen, pevp     )   ! <<= in 
     872    
     873   SUBROUTINE blk_oce_2( ptair, pdqlw, pprec, psnow, &   ! <<= in 
     874      &                   ptsk, psen, plat, pevp     )   ! <<= in 
    792875      !!--------------------------------------------------------------------- 
    793876      !!                     ***  ROUTINE blk_oce_2  *** 
    … …  
    805888      !!              - emp     : evaporation minus precipitation       (kg/m2/s) 
    806889      !!--------------------------------------------------------------------- 
    807       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptair 
    808       REAL(wp), INTENT(in), DIMENSION(:,:) ::   pqsr 
    809       REAL(wp), INTENT(in), DIMENSION(:,:) ::   pqlw 
     890      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptair   ! potential temperature of air #LB: confirm! 
     891      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pdqlw   ! downwelling longwave radiation at surface [W/m^2]  
    810892      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pprec 
    811893      REAL(wp), INTENT(in), DIMENSION(:,:) ::   psnow 
    812894      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptsk   ! SKIN surface temperature   [Celsius] 
    813895      REAL(wp), INTENT(in), DIMENSION(:,:) ::   psen 
     896      REAL(wp), INTENT(in), DIMENSION(:,:) ::   plat 
    814897      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pevp 
    815898      ! 
    816899      INTEGER  ::   ji, jj               ! dummy loop indices 
    817900      REAL(wp) ::   zztmp,zz1,zz2,zz3    ! local variable 
    818       REAL(wp), DIMENSION(jpi,jpj) ::   ztskk             ! skin temp. in Kelvin  
    819       REAL(wp), DIMENSION(jpi,jpj) ::   zqlw              ! long wave and sensible heat fluxes       
    820       REAL(wp), DIMENSION(jpi,jpj) ::   zqla              ! latent heat fluxes and evaporation 
     901      REAL(wp), DIMENSION(jpi,jpj) ::   zqlw              ! net long wave radiative heat flux 
    821902      !!--------------------------------------------------------------------- 
    822903      ! 
    823904      ! local scalars ( place there for vector optimisation purposes) 
    824905 
    825  
    826       ztskk(:,:) = ptsk(:,:) + rt0  ! => ptsk in Kelvin rather than Celsius 
    827        
    828906      ! ----------------------------------------------------------------------------- ! 
    829907      !     III    Net longwave radiative FLUX                                        ! 
    830908      ! ----------------------------------------------------------------------------- ! 
    831  
    832       !! LB: now moved after Turbulent fluxes because must use the skin temperature rather that the SST 
    833       !! (ztskk is skin temperature if ln_skin_cs==.TRUE. .OR. ln_skin_wl==.TRUE.) 
    834       zqlw(:,:) = emiss_w * ( pqlw(:,:) - stefan*ztskk(:,:)*ztskk(:,:)*ztskk(:,:)*ztskk(:,:) ) * tmask(:,:,1)   ! Net radiative longwave flux 
    835  
    836       !  Latent flux over ocean 
    837       ! ----------------------- 
    838  
    839       ! use scalar version of L_vap() for AGRIF compatibility 
    840       DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    841          zqla(ji,jj) = - L_vap( ztskk(ji,jj) ) * pevp(ji,jj)    ! Latent Heat flux !!GS: possibility to add a global qla to avoid recomputation after abl update 
    842       END_2D 
    843  
    844       IF(sn_cfctl%l_prtctl) THEN 
    845          CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce_2: zqla   : ' ) 
    846          CALL prt_ctl( tab2d_1=zqlw  , clinfo1=' blk_oce_2: zqlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' ) 
    847  
    848       ENDIF 
     909      !! #LB: now moved after Turbulent fluxes because must use the skin temperature rather than bulk SST 
     910      !! (ptsk is skin temperature if ln_skin_cs==.TRUE. .OR. ln_skin_wl==.TRUE.) 
     911      zqlw(:,:) = qlw_net( pdqlw(:,:), ptsk(:,:)+rt0 ) 
    849912 
    850913      ! ----------------------------------------------------------------------------- ! 
    … …  
    855918         &         - pprec(:,:) * rn_pfac  ) * tmask(:,:,1) 
    856919      ! 
    857       qns(:,:) = zqlw(:,:) + psen(:,:) + zqla(:,:)                   &   ! Downward Non Solar 
     920      qns(:,:) = zqlw(:,:) + psen(:,:) + plat(:,:)                   &   ! Downward Non Solar 
    858921         &     - psnow(:,:) * rn_pfac * rLfus                        &   ! remove latent melting heat for solid precip 
    859922         &     - pevp(:,:) * ptsk(:,:) * rcp                         &   ! remove evap heat content at SST 
    … …  
    865928      ! 
    866929#if defined key_si3 
    867       qns_oce(:,:) = zqlw(:,:) + psen(:,:) + zqla(:,:)                             ! non solar without emp (only needed by SI3) 
     930      qns_oce(:,:) = zqlw(:,:) + psen(:,:) + plat(:,:)                             ! non solar without emp (only needed by SI3) 
    868931      qsr_oce(:,:) = qsr(:,:) 
    869932#endif 
    … …  
    873936      CALL iom_put( "qlw_oce"  , zqlw )                    ! output downward longwave heat over the ocean 
    874937      CALL iom_put( "qsb_oce"  , psen )                    ! output downward sensible heat over the ocean 
    875       CALL iom_put( "qla_oce"  , zqla )                    ! output downward latent   heat over the ocean 
     938      CALL iom_put( "qla_oce"  , plat )                    ! output downward latent   heat over the ocean 
    876939      tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1)   ! output total precipitation [kg/m2/s] 
    877940      sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1)   ! output solid precipitation [kg/m2/s] 
    … …  
    880943      ! 
    881944      IF ( nn_ice == 0 ) THEN 
    882          CALL iom_put( "qemp_oce" , qns-zqlw-psen-zqla )   ! output downward heat content of E-P over the ocean 
     945         CALL iom_put( "qemp_oce" , qns-zqlw-psen-plat )   ! output downward heat content of E-P over the ocean 
    883946         CALL iom_put( "qns_oce"  ,   qns  )               ! output downward non solar heat over the ocean 
    884947         CALL iom_put( "qsr_oce"  ,   qsr  )               ! output downward solar heat over the ocean 
    … …  
    888951      IF(sn_cfctl%l_prtctl) THEN 
    889952         CALL prt_ctl(tab2d_1=zqlw , clinfo1=' blk_oce_2: zqlw  : ') 
    890          CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce_2: zqla  : ', tab2d_2=qsr  , clinfo2=' qsr   : ') 
     953         CALL prt_ctl(tab2d_1=psen , clinfo1=' blk_oce_2: psen  : ' ) 
     954         CALL prt_ctl(tab2d_1=plat , clinfo1=' blk_oce_2: plat  : ' ) 
     955         CALL prt_ctl(tab2d_1=qns  , clinfo1=' blk_oce_2: qns   : ' ) 
    891956         CALL prt_ctl(tab2d_1=emp  , clinfo1=' blk_oce_2: emp   : ') 
    892957      ENDIF 
    … …  
    902967   !!   blk_ice_2   : provide the heat and mass fluxes at air-ice interface 
    903968   !!   blk_ice_qcn : provide ice surface temperature and snow/ice conduction flux (emulating conduction flux) 
    904    !!   Cdn10_Lupkes2012 : Lupkes et al. (2012) air-ice drag 
    905    !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag 
    906969   !!---------------------------------------------------------------------- 
    907970 
    908    SUBROUTINE blk_ice_1( pwndi, pwndj, ptair, phumi, pslp , puice, pvice, ptsui,  &   ! inputs 
     971   SUBROUTINE blk_ice_1( pwndi, pwndj, ptair, pqair, pslp , puice, pvice, ptsui,  &   ! inputs 
    909972      &                  putaui, pvtaui, pseni, pevpi, pssqi, pcd_dui             )   ! optional outputs 
    910973      !!--------------------------------------------------------------------- 
    … …  
    921984      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndj   ! atmospheric wind at T-point [m/s] 
    922985      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   ptair   ! atmospheric wind at T-point [m/s] 
    923       REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   phumi   ! atmospheric wind at T-point [m/s] 
     986      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pqair   ! atmospheric wind at T-point [m/s] 
    924987      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   puice   ! sea-ice velocity on I or C grid [m/s] 
    925988      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pvice   ! " 
    … …  
    934997      INTEGER  ::   ji, jj    ! dummy loop indices 
    935998      REAL(wp) ::   zootm_su                      ! sea-ice surface mean temperature 
    936       REAL(wp) ::   zztmp1, zztmp2                ! temporary arrays 
    937       REAL(wp), DIMENSION(jpi,jpj) ::   zcd_dui   ! transfer coefficient for momentum      (tau) 
    938       !!--------------------------------------------------------------------- 
    939       ! 
    940  
     999      REAL(wp) ::   zztmp1, zztmp2                ! temporary scalars 
     1000      REAL(wp), DIMENSION(jpi,jpj) :: ztmp        ! temporary array 
     1001      !!--------------------------------------------------------------------- 
     1002      ! 
     1003      ! LB: ptsui is in K !!! 
     1004      ! 
    9411005      ! ------------------------------------------------------------ ! 
    9421006      !    Wind module relative to the moving ice ( U10m - U_ice )   ! 
    … …  
    9441008      ! C-grid ice dynamics :   U & V-points (same as ocean) 
    9451009      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    946          wndm_ice(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) 
     1010      wndm_ice(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) 
    9471011      END_2D 
    9481012      ! 
    9491013      ! Make ice-atm. drag dependent on ice concentration 
    950       IF    ( ln_Cd_L12 ) THEN   ! calculate new drag from Lupkes(2012) equations 
    951          CALL Cdn10_Lupkes2012( Cd_ice ) 
    952          Ch_ice(:,:) = Cd_ice(:,:)       ! momentum and heat transfer coef. are considered identical 
    953          Ce_ice(:,:) = Cd_ice(:,:) 
    954       ELSEIF( ln_Cd_L15 ) THEN   ! calculate new drag from Lupkes(2015) equations 
    955          CALL Cdn10_Lupkes2015( ptsui, pslp, Cd_ice, Ch_ice ) 
    956          Ce_ice(:,:) = Ch_ice(:,:)       ! sensible and latent heat transfer coef. are considered identical 
    957       ENDIF 
    958        
    959       IF( iom_use('Cd_ice') ) CALL iom_put("Cd_ice", Cd_ice) 
    960       IF( iom_use('Ce_ice') ) CALL iom_put("Ce_ice", Ce_ice) 
    961       IF( iom_use('Ch_ice') ) CALL iom_put("Ch_ice", Ch_ice) 
    962        
    963       ! local scalars ( place there for vector optimisation purposes) 
    964       zcd_dui(:,:) = wndm_ice(:,:) * Cd_ice(:,:) 
     1014 
     1015 
     1016      SELECT CASE( nblk_ice ) 
     1017 
     1018      CASE( np_ice_cst      ) 
     1019         ! Constant bulk transfer coefficients over sea-ice: 
     1020         Cd_ice(:,:) = rn_Cd_i 
     1021         Ch_ice(:,:) = rn_Ch_i 
     1022         Ce_ice(:,:) = rn_Ce_i 
     1023         ! no height adjustment, keeping zt values: 
     1024         theta_zu_i(:,:) = ptair(:,:) 
     1025         q_zu_i(:,:)     = pqair(:,:) 
     1026 
     1027      CASE( np_ice_lu12 ) 
     1028         ztmp(:,:) = q_sat( ptsui(:,:), pslp(:,:), l_ice=.TRUE. ) ! temporary array for SSQ 
     1029         CALL turb_ice_lu12( rn_zqt, rn_zu, ptsui, ptair, ztmp, pqair, wndm_ice, fr_i, & 
     1030            &                      Cd_ice, Ch_ice, Ce_ice, theta_zu_i, q_zu_i ) 
     1031         !! 
     1032      CASE( np_ice_lg15 )  ! calculate new drag from Lupkes(2015) equations 
     1033         ztmp(:,:) = q_sat( ptsui(:,:), pslp(:,:), l_ice=.TRUE. ) ! temporary array for SSQ 
     1034         CALL turb_ice_lg15( rn_zqt, rn_zu, ptsui, ptair, ztmp, pqair, wndm_ice, fr_i, & 
     1035            &                      Cd_ice, Ch_ice, Ce_ice, theta_zu_i, q_zu_i ) 
     1036         !! 
     1037      END SELECT 
     1038 
     1039      IF( iom_use('Cd_ice').OR.iom_use('Ce_ice').OR.iom_use('Ch_ice').OR.iom_use('taum_ai') ) & 
     1040         & ztmp(:,:) = ( 1._wp - MAX(0._wp, SIGN( 1._wp, 1.E-6_wp - fr_i )) )*tmask(:,:,1) ! mask for presence of ice ! 
     1041 
     1042      IF( iom_use('Cd_ice') ) CALL iom_put("Cd_ice", Cd_ice*ztmp) 
     1043      IF( iom_use('Ce_ice') ) CALL iom_put("Ce_ice", Ce_ice*ztmp) 
     1044      IF( iom_use('Ch_ice') ) CALL iom_put("Ch_ice", Ch_ice*ztmp) 
     1045 
    9651046 
    9661047      IF( ln_blk ) THEN 
    … …  
    9691050         ! ---------------------------------------------------- ! 
    9701051         ! supress moving ice in wind stress computation as we don't know how to do it properly... 
    971          DO_2D( 0, 1, 0, 1 )    ! at T point  
    972             putaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * pwndi(ji,jj) 
    973             pvtaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * pwndj(ji,jj) 
     1052         DO_2D( 0, 1, 0, 1 )    ! at T point 
     1053         zztmp1        = rhoa(ji,jj) * Cd_ice(ji,jj) * wndm_ice(ji,jj) 
     1054         putaui(ji,jj) =  zztmp1 * pwndi(ji,jj) 
     1055         pvtaui(ji,jj) =  zztmp1 * pwndj(ji,jj) 
    9741056         END_2D 
     1057         !#LB: saving the module of the ai wind-stress: NOT weighted by the ice concentration !!! 
     1058         IF(iom_use('taum_ai')) CALL iom_put( 'taum_ai', SQRT( putaui*putaui + pvtaui*pvtaui )*ztmp ) 
    9751059         ! 
    9761060         DO_2D( 0, 0, 0, 0 )    ! U & V-points (same as ocean). 
    977             ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology  
    978             zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) ) 
    979             zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) ) 
    980             putaui(ji,jj) = zztmp1 * ( putaui(ji,jj) + putaui(ji+1,jj  ) ) 
    981             pvtaui(ji,jj) = zztmp2 * ( pvtaui(ji,jj) + pvtaui(ji  ,jj+1) ) 
     1061         !#LB: QUESTION?? so SI3 expects wind stress vector to be provided at U & V points? Not at T-points ? 
     1062         ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology 
     1063         zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) ) 
     1064         zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) ) 
     1065         putaui(ji,jj) = zztmp1 * ( putaui(ji,jj) + putaui(ji+1,jj  ) ) 
     1066         pvtaui(ji,jj) = zztmp2 * ( pvtaui(ji,jj) + pvtaui(ji  ,jj+1) ) 
    9821067         END_2D 
    9831068         CALL lbc_lnk_multi( 'sbcblk', putaui, 'U', -1._wp, pvtaui, 'V', -1._wp ) 
    … …  
    9861071            &                               , tab2d_2=pvtaui  , clinfo2='          pvtaui : ' ) 
    9871072      ELSE ! ln_abl 
    988          zztmp1 = 11637800.0_wp 
    989          zztmp2 =    -5897.8_wp 
    9901073         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    991             pcd_dui(ji,jj) = zcd_dui (ji,jj) 
    992             pseni  (ji,jj) = wndm_ice(ji,jj) * Ch_ice(ji,jj) 
    993             pevpi  (ji,jj) = wndm_ice(ji,jj) * Ce_ice(ji,jj) 
    994             zootm_su       = zztmp2 / ptsui(ji,jj)   ! ptsui is in K (it can't be zero ??) 
    995             pssqi  (ji,jj) = zztmp1 * EXP( zootm_su ) / rhoa(ji,jj) 
     1074         pcd_dui(ji,jj) = wndm_ice(ji,jj) * Cd_ice(ji,jj) 
     1075         pseni  (ji,jj) = wndm_ice(ji,jj) * Ch_ice(ji,jj) 
     1076         pevpi  (ji,jj) = wndm_ice(ji,jj) * Ce_ice(ji,jj) 
    9961077         END_2D 
    997       ENDIF 
     1078         !#LB: 
     1079         pssqi(:,:) = q_sat( ptsui(:,:), pslp(:,:), l_ice=.TRUE. ) ; ! more accurate way to obtain ssq ! 
     1080         !#LB. 
     1081      ENDIF !IF( ln_blk ) 
    9981082      ! 
    9991083      IF(sn_cfctl%l_prtctl)  CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice: wndm_ice : ') 
    … …  
    10021086 
    10031087 
    1004    SUBROUTINE blk_ice_2( ptsu, phs, phi, palb, ptair, phumi, pslp, pqlw, pprec, psnow  ) 
     1088   SUBROUTINE blk_ice_2( ptsu, phs, phi, palb, ptair, pqair, pslp, pdqlw, pprec, psnow  ) 
    10051089      !!--------------------------------------------------------------------- 
    10061090      !!                     ***  ROUTINE blk_ice_2  *** 
    … …  
    10181102      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness 
    10191103      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   palb   ! ice albedo (all skies) 
    1020       REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   ptair 
    1021       REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   phumi 
     1104      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   ptair  ! potential temperature of air #LB: okay ??? 
     1105      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pqair  ! specific humidity of air 
    10221106      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pslp 
    1023       REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pqlw 
     1107      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pdqlw 
    10241108      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pprec 
    10251109      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   psnow 
    10261110      !! 
    10271111      INTEGER  ::   ji, jj, jl               ! dummy loop indices 
    1028       REAL(wp) ::   zst3                     ! local variable 
     1112      REAL(wp) ::   zst, zst3, zsq           ! local variable 
    10291113      REAL(wp) ::   zcoef_dqlw, zcoef_dqla   !   -      - 
    1030       REAL(wp) ::   zztmp, zztmp2, z1_rLsub  !   -      - 
    1031       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_st         ! inverse of surface temperature 
     1114      REAL(wp) ::   zztmp, zzblk, zztmp1, z1_rLsub   !   -      - 
    10321115      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_qlw         ! long wave heat flux over ice 
    10331116      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_qsb         ! sensible  heat flux over ice 
    … …  
    10351118      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_dqsb        ! sensible  heat sensitivity over ice 
    10361119      REAL(wp), DIMENSION(jpi,jpj)     ::   zevap, zsnw   ! evaporation and snw distribution after wind blowing (SI3) 
    1037       REAL(wp), DIMENSION(jpi,jpj)     ::   zqair         ! specific humidity of air at z=rn_zqt [kg/kg] !LB 
    10381120      REAL(wp), DIMENSION(jpi,jpj)     ::   ztmp, ztmp2 
    10391121      REAL(wp), DIMENSION(jpi,jpj)     ::   ztri 
    10401122      !!--------------------------------------------------------------------- 
    10411123      ! 
    1042       zcoef_dqlw = 4._wp * 0.95_wp * stefan             ! local scalars 
    1043       zcoef_dqla = -rLsub * 11637800._wp * (-5897.8_wp) !LB: BAD! 
    1044       ! 
    1045       SELECT CASE( nhumi ) 
    1046       CASE( np_humi_sph ) 
    1047          zqair(:,:) =  phumi(:,:)      ! what we read in file is already a spec. humidity! 
    1048       CASE( np_humi_dpt ) 
    1049          zqair(:,:) = q_sat( phumi(:,:), pslp ) 
    1050       CASE( np_humi_rlh ) 
    1051          zqair(:,:) = q_air_rh( 0.01_wp*phumi(:,:), ptair(:,:), pslp(:,:) ) !LB: 0.01 => RH is % percent in file 
    1052       END SELECT 
    1053       ! 
     1124      zcoef_dqlw = 4._wp * emiss_i * stefan             ! local scalars 
     1125      ! 
     1126 
    10541127      zztmp = 1. / ( 1. - albo ) 
    1055       WHERE( ptsu(:,:,:) /= 0._wp ) 
    1056          z1_st(:,:,:) = 1._wp / ptsu(:,:,:) 
    1057       ELSEWHERE 
    1058          z1_st(:,:,:) = 0._wp 
    1059       END WHERE 
     1128      dqla_ice(:,:,:) = 0._wp 
     1129 
    10601130      !                                     ! ========================== ! 
    10611131      DO jl = 1, jpl                        !  Loop over ice categories  ! 
    10621132         !                                  ! ========================== ! 
    1063          DO jj = 1 , jpj 
    1064             DO ji = 1, jpi 
    1065                ! ----------------------------! 
    1066                !      I   Radiative FLUXES   ! 
    1067                ! ----------------------------! 
    1068                zst3 = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) * ptsu(ji,jj,jl) 
    1069                ! Short Wave (sw) 
    1070                qsr_ice(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 
    1071                ! Long  Wave (lw) 
    1072                z_qlw(ji,jj,jl) = 0.95 * ( pqlw(ji,jj) - stefan * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
    1073                ! lw sensitivity 
    1074                z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3 
    1075  
    1076                ! ----------------------------! 
    1077                !     II    Turbulent FLUXES  ! 
    1078                ! ----------------------------! 
    1079  
    1080                ! ... turbulent heat fluxes with Ch_ice recalculated in blk_ice_1 
    1081                ! Sensible Heat 
    1082                z_qsb(ji,jj,jl) = rhoa(ji,jj) * rCp_air * Ch_ice(ji,jj) * wndm_ice(ji,jj) * (ptsu(ji,jj,jl) - ptair(ji,jj)) 
    1083                ! Latent Heat 
    1084                zztmp2 = EXP( -5897.8 * z1_st(ji,jj,jl) ) 
    1085                qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa(ji,jj) * rLsub  * Ce_ice(ji,jj) * wndm_ice(ji,jj) *  & 
    1086                   &                ( 11637800. * zztmp2 / rhoa(ji,jj) - zqair(ji,jj) ) ) 
    1087                ! Latent heat sensitivity for ice (Dqla/Dt) 
    1088                IF( qla_ice(ji,jj,jl) > 0._wp ) THEN 
    1089                   dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ce_ice(ji,jj) * wndm_ice(ji,jj) *  & 
    1090                      &                 z1_st(ji,jj,jl) * z1_st(ji,jj,jl) * zztmp2 
    1091                ELSE 
    1092                   dqla_ice(ji,jj,jl) = 0._wp 
    1093                ENDIF 
    1094  
    1095                ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    1096                z_dqsb(ji,jj,jl) = rhoa(ji,jj) * rCp_air * Ch_ice(ji,jj) * wndm_ice(ji,jj) 
    1097  
    1098                ! ----------------------------! 
    1099                !     III    Total FLUXES     ! 
    1100                ! ----------------------------! 
    1101                ! Downward Non Solar flux 
    1102                qns_ice (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - qla_ice (ji,jj,jl) 
    1103                ! Total non solar heat flux sensitivity for ice 
    1104                dqns_ice(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + dqla_ice(ji,jj,jl) ) 
    1105             END DO 
    1106             ! 
    1107          END DO 
     1133         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     1134 
     1135         zst = ptsu(ji,jj,jl)                           ! surface temperature of sea-ice [K] 
     1136         zsq = q_sat( zst, pslp(ji,jj), l_ice=.TRUE. )  ! surface saturation specific humidity when ice present 
     1137 
     1138         ! ----------------------------! 
     1139         !      I   Radiative FLUXES   ! 
     1140         ! ----------------------------! 
     1141         ! Short Wave (sw) 
     1142         qsr_ice(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 
     1143 
     1144         ! Long  Wave (lw) 
     1145         zst3 = zst * zst * zst 
     1146         z_qlw(ji,jj,jl)   = emiss_i * ( pdqlw(ji,jj) - stefan * zst * zst3 ) * tmask(ji,jj,1) 
     1147         ! lw sensitivity 
     1148         z_dqlw(ji,jj,jl)  = zcoef_dqlw * zst3 
     1149 
     1150         ! ----------------------------! 
     1151         !     II    Turbulent FLUXES  ! 
     1152         ! ----------------------------! 
     1153 
     1154         ! ... turbulent heat fluxes with Ch_ice recalculated in blk_ice_1 
     1155 
     1156         ! Common term in bulk F. equations... 
     1157         zzblk = rhoa(ji,jj) * wndm_ice(ji,jj) 
     1158 
     1159         ! Sensible Heat 
     1160         zztmp1 = zzblk * rCp_air * Ch_ice(ji,jj) 
     1161         z_qsb (ji,jj,jl) = zztmp1 * (zst - theta_zu_i(ji,jj)) 
     1162         z_dqsb(ji,jj,jl) = zztmp1                        ! ==> Qsens sensitivity (Dqsb_ice/Dtn_ice) 
     1163 
     1164         ! Latent Heat 
     1165         zztmp1 = zzblk * rLsub * Ce_ice(ji,jj) 
     1166         qla_ice(ji,jj,jl) = MAX( zztmp1 * (zsq - q_zu_i(ji,jj)) , 0._wp )   ! #LB: only sublimation (and not condensation) ??? 
     1167         IF(qla_ice(ji,jj,jl)>0._wp) dqla_ice(ji,jj,jl) = zztmp1*dq_sat_dt_ice(zst, pslp(ji,jj)) ! ==> Qlat sensitivity  (dQlat/dT) 
     1168         !                                                                                       !#LB: dq_sat_dt_ice() in "sbc_phy.F90" 
     1169         !#LB: without this unjustified "condensation sensure": 
     1170         !qla_ice( ji,jj,jl) = zztmp1 * (zsq - q_zu_i(ji,jj)) 
     1171         !dqla_ice(ji,jj,jl) = zztmp1 * dq_sat_dt_ice(zst, pslp(ji,jj)) ! ==> Qlat sensitivity  (dQlat/dT) 
     1172 
     1173 
     1174 
     1175         ! ----------------------------! 
     1176         !     III    Total FLUXES     ! 
     1177         ! ----------------------------! 
     1178 
     1179         ! Downward Non Solar flux 
     1180         qns_ice (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - qla_ice (ji,jj,jl) 
     1181 
     1182         ! Total non solar heat flux sensitivity for ice 
     1183         dqns_ice(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + dqla_ice(ji,jj,jl) ) !#LB: correct signs ???? 
     1184 
     1185         END_2D 
    11081186         ! 
    11091187      END DO 
    … …  
    11571235         ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm 
    11581236         DO jl = 1, jpl 
    1159             WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm   
     1237            WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm 
    11601238               qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 
    11611239            ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )     ! constant (ztri) when hi>10cm 
    11621240               qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 
    11631241            ELSEWHERE                                                         ! zero when hs>0 
    1164                qtr_ice_top(:,:,jl) = 0._wp  
     1242               qtr_ice_top(:,:,jl) = 0._wp 
    11651243            END WHERE 
    11661244         ENDDO 
    … …  
    12011279         CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice: tprecip  : ', tab2d_2=sprecip , clinfo2=' sprecip  : ') 
    12021280      ENDIF 
    1203       ! 
     1281 
     1282      !#LB: 
     1283      ! air-ice heat flux components that are not written from ice_stp()@icestp.F90: 
     1284      IF( iom_use('qla_ice') )  CALL iom_put( 'qla_ice', SUM( - qla_ice * a_i_b, dim=3 ) ) !#LB: sign consistent with what's done for ocean 
     1285      IF( iom_use('qsb_ice') )  CALL iom_put( 'qsb_ice', SUM( -   z_qsb * a_i_b, dim=3 ) ) !#LB:     ==> negative => loss of heat for sea-ice 
     1286      IF( iom_use('qlw_ice') )  CALL iom_put( 'qlw_ice', SUM(     z_qlw * a_i_b, dim=3 ) ) 
     1287      !#LB. 
     1288 
    12041289   END SUBROUTINE blk_ice_2 
    12051290 
    … …  
    12541339         DO jl = 1, jpl 
    12551340            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    1256                zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac                            ! Effective thickness 
    1257                IF( zhe >=  zfac2 )   zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor 
     1341            zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac                            ! Effective thickness 
     1342            IF( zhe >=  zfac2 )   zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor 
    12581343            END_2D 
    12591344         END DO 
    … …  
    12691354      DO jl = 1, jpl 
    12701355         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    1271             ! 
    1272             zkeff_h = zfac * zgfac(ji,jj,jl) / &                                    ! Effective conductivity of the snow-ice system divided by thickness 
    1273                &      ( rcnd_i * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) ) 
    1274             ztsu    = ptsu(ji,jj,jl)                                                ! Store current iteration temperature 
    1275             ztsu0   = ptsu(ji,jj,jl)                                                ! Store initial surface temperature 
    1276             zqa0    = qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) ! Net initial atmospheric heat flux 
    1277             ! 
    1278             DO iter = 1, nit     ! --- Iterative loop 
    1279                zqc   = zkeff_h * ( ztsu - ptb(ji,jj) )                              ! Conduction heat flux through snow-ice system (>0 downwards) 
    1280                zqnet = zqa0 + dqns_ice(ji,jj,jl) * ( ztsu - ptsu(ji,jj,jl) ) - zqc  ! Surface energy budget 
    1281                ztsu  = ztsu - zqnet / ( dqns_ice(ji,jj,jl) - zkeff_h )              ! Temperature update 
    1282             END DO 
    1283             ! 
    1284             ptsu   (ji,jj,jl) = MIN( rt0, ztsu ) 
    1285             qcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) ) 
    1286             qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) 
    1287             qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) )  & 
    1288                &   * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) ) 
    1289  
    1290             ! --- Diagnose the heat loss due to changing non-solar flux (as in icethd_zdf_bl99) --- ! 
    1291             hfx_err_dif(ji,jj) = hfx_err_dif(ji,jj) - ( dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) ) * a_i_b(ji,jj,jl) 
     1356         ! 
     1357         zkeff_h = zfac * zgfac(ji,jj,jl) / &                                    ! Effective conductivity of the snow-ice system divided by thickness 
     1358            &      ( rcnd_i * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) ) 
     1359         ztsu    = ptsu(ji,jj,jl)                                                ! Store current iteration temperature 
     1360         ztsu0   = ptsu(ji,jj,jl)                                                ! Store initial surface temperature 
     1361         zqa0    = qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) ! Net initial atmospheric heat flux 
     1362         ! 
     1363         DO iter = 1, nit     ! --- Iterative loop 
     1364            zqc   = zkeff_h * ( ztsu - ptb(ji,jj) )                              ! Conduction heat flux through snow-ice system (>0 downwards) 
     1365            zqnet = zqa0 + dqns_ice(ji,jj,jl) * ( ztsu - ptsu(ji,jj,jl) ) - zqc  ! Surface energy budget 
     1366            ztsu  = ztsu - zqnet / ( dqns_ice(ji,jj,jl) - zkeff_h )              ! Temperature update 
     1367         END DO 
     1368         ! 
     1369         ptsu   (ji,jj,jl) = MIN( rt0, ztsu ) 
     1370         qcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) ) 
     1371         qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) 
     1372         qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) )  & 
     1373            &   * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) ) 
     1374 
     1375         ! --- Diagnose the heat loss due to changing non-solar flux (as in icethd_zdf_bl99) --- ! 
     1376         hfx_err_dif(ji,jj) = hfx_err_dif(ji,jj) - ( dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) ) * a_i_b(ji,jj,jl) 
    12921377 
    12931378         END_2D 
    … …  
    12961381      ! 
    12971382   END SUBROUTINE blk_ice_qcn 
    1298  
    1299  
    1300    SUBROUTINE Cdn10_Lupkes2012( pcd ) 
    1301       !!---------------------------------------------------------------------- 
    1302       !!                      ***  ROUTINE  Cdn10_Lupkes2012  *** 
    1303       !! 
    1304       !! ** Purpose :    Recompute the neutral air-ice drag referenced at 10m 
    1305       !!                 to make it dependent on edges at leads, melt ponds and flows. 
    1306       !!                 After some approximations, this can be resumed to a dependency 
    1307       !!                 on ice concentration. 
    1308       !! 
    1309       !! ** Method :     The parameterization is taken from Lupkes et al. (2012) eq.(50) 
    1310       !!                 with the highest level of approximation: level4, eq.(59) 
    1311       !!                 The generic drag over a cell partly covered by ice can be re-written as follows: 
    1312       !! 
    1313       !!                 Cd = Cdw * (1-A) + Cdi * A + Ce * (1-A)**(nu+1/(10*beta)) * A**mu 
    1314       !! 
    1315       !!                    Ce = 2.23e-3       , as suggested by Lupkes (eq. 59) 
    1316       !!                    nu = mu = beta = 1 , as suggested by Lupkes (eq. 59) 
    1317       !!                    A is the concentration of ice minus melt ponds (if any) 
    1318       !! 
    1319       !!                 This new drag has a parabolic shape (as a function of A) starting at 
    1320       !!                 Cdw(say 1.5e-3) for A=0, reaching 1.97e-3 for A~0.5 
    1321       !!                 and going down to Cdi(say 1.4e-3) for A=1 
    1322       !! 
    1323       !!                 It is theoretically applicable to all ice conditions (not only MIZ) 
    1324       !!                 => see Lupkes et al (2013) 
    1325       !! 
    1326       !! ** References : Lupkes et al. JGR 2012 (theory) 
    1327       !!                 Lupkes et al. GRL 2013 (application to GCM) 
    1328       !! 
    1329       !!---------------------------------------------------------------------- 
    1330       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pcd 
    1331       REAL(wp), PARAMETER ::   zCe   = 2.23e-03_wp 
    1332       REAL(wp), PARAMETER ::   znu   = 1._wp 
    1333       REAL(wp), PARAMETER ::   zmu   = 1._wp 
    1334       REAL(wp), PARAMETER ::   zbeta = 1._wp 
    1335       REAL(wp)            ::   zcoef 
    1336       !!---------------------------------------------------------------------- 
    1337       zcoef = znu + 1._wp / ( 10._wp * zbeta ) 
    1338  
    1339       ! generic drag over a cell partly covered by ice 
    1340       !!Cd(:,:) = Cd_oce(:,:) * ( 1._wp - at_i_b(:,:) ) +  &                        ! pure ocean drag 
    1341       !!   &      Cd_ice      *           at_i_b(:,:)   +  &                        ! pure ice drag 
    1342       !!   &      zCe         * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**zmu   ! change due to sea-ice morphology 
    1343  
    1344       ! ice-atm drag 
    1345       pcd(:,:) = rCd_ice +  &                                                         ! pure ice drag 
    1346          &      zCe     * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)  ! change due to sea-ice morphology 
    1347  
    1348    END SUBROUTINE Cdn10_Lupkes2012 
    1349  
    1350  
    1351    SUBROUTINE Cdn10_Lupkes2015( ptm_su, pslp, pcd, pch ) 
    1352       !!---------------------------------------------------------------------- 
    1353       !!                      ***  ROUTINE  Cdn10_Lupkes2015  *** 
    1354       !! 
    1355       !! ** pUrpose :    Alternative turbulent transfert coefficients formulation 
    1356       !!                 between sea-ice and atmosphere with distinct momentum 
    1357       !!                 and heat coefficients depending on sea-ice concentration 
    1358       !!                 and atmospheric stability (no meltponds effect for now). 
    1359       !! 
    1360       !! ** Method :     The parameterization is adapted from Lupkes et al. (2015) 
    1361       !!                 and ECHAM6 atmospheric model. Compared to Lupkes2012 scheme, 
    1362       !!                 it considers specific skin and form drags (Andreas et al. 2010) 
    1363       !!                 to compute neutral transfert coefficients for both heat and 
    1364       !!                 momemtum fluxes. Atmospheric stability effect on transfert 
    1365       !!                 coefficient is also taken into account following Louis (1979). 
    1366       !! 
    1367       !! ** References : Lupkes et al. JGR 2015 (theory) 
    1368       !!                 Lupkes et al. ECHAM6 documentation 2015 (implementation) 
    1369       !! 
    1370       !!---------------------------------------------------------------------- 
    1371       ! 
    1372       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   ptm_su ! sea-ice surface temperature [K] 
    1373       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pslp   ! sea-level pressure [Pa] 
    1374       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pcd    ! momentum transfert coefficient 
    1375       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pch    ! heat transfert coefficient 
    1376       REAL(wp), DIMENSION(jpi,jpj)            ::   zst, zqo_sat, zqi_sat 
    1377       ! 
    1378       ! ECHAM6 constants 
    1379       REAL(wp), PARAMETER ::   z0_skin_ice  = 0.69e-3_wp  ! Eq. 43 [m] 
    1380       REAL(wp), PARAMETER ::   z0_form_ice  = 0.57e-3_wp  ! Eq. 42 [m] 
    1381       REAL(wp), PARAMETER ::   z0_ice       = 1.00e-3_wp  ! Eq. 15 [m] 
    1382       REAL(wp), PARAMETER ::   zce10        = 2.80e-3_wp  ! Eq. 41 
    1383       REAL(wp), PARAMETER ::   zbeta        = 1.1_wp      ! Eq. 41 
    1384       REAL(wp), PARAMETER ::   zc           = 5._wp       ! Eq. 13 
    1385       REAL(wp), PARAMETER ::   zc2          = zc * zc 
    1386       REAL(wp), PARAMETER ::   zam          = 2. * zc     ! Eq. 14 
    1387       REAL(wp), PARAMETER ::   zah          = 3. * zc     ! Eq. 30 
    1388       REAL(wp), PARAMETER ::   z1_alpha     = 1._wp / 0.2_wp  ! Eq. 51 
    1389       REAL(wp), PARAMETER ::   z1_alphaf    = z1_alpha    ! Eq. 56 
    1390       REAL(wp), PARAMETER ::   zbetah       = 1.e-3_wp    ! Eq. 26 
    1391       REAL(wp), PARAMETER ::   zgamma       = 1.25_wp     ! Eq. 26 
    1392       REAL(wp), PARAMETER ::   z1_gamma     = 1._wp / zgamma 
    1393       REAL(wp), PARAMETER ::   r1_3         = 1._wp / 3._wp 
    1394       ! 
    1395       INTEGER  ::   ji, jj         ! dummy loop indices 
    1396       REAL(wp) ::   zthetav_os, zthetav_is, zthetav_zu 
    1397       REAL(wp) ::   zrib_o, zrib_i 
    1398       REAL(wp) ::   zCdn_skin_ice, zCdn_form_ice, zCdn_ice 
    1399       REAL(wp) ::   zChn_skin_ice, zChn_form_ice 
    1400       REAL(wp) ::   z0w, z0i, zfmi, zfmw, zfhi, zfhw 
    1401       REAL(wp) ::   zCdn_form_tmp 
    1402       !!---------------------------------------------------------------------- 
    1403  
    1404       ! Momentum Neutral Transfert Coefficients (should be a constant) 
    1405       zCdn_form_tmp = zce10 * ( LOG( 10._wp / z0_form_ice + 1._wp ) / LOG( rn_zu / z0_form_ice + 1._wp ) )**2   ! Eq. 40 
    1406       zCdn_skin_ice = ( vkarmn                                      / LOG( rn_zu / z0_skin_ice + 1._wp ) )**2   ! Eq. 7 
    1407       zCdn_ice      = zCdn_skin_ice   ! Eq. 7 
    1408       !zCdn_ice     = 1.89e-3         ! old ECHAM5 value (cf Eq. 32) 
    1409  
    1410       ! Heat Neutral Transfert Coefficients 
    1411       zChn_skin_ice = vkarmn**2 / ( LOG( rn_zu / z0_ice + 1._wp ) * LOG( rn_zu * z1_alpha / z0_skin_ice + 1._wp ) )   ! Eq. 50 + Eq. 52 
    1412  
    1413       ! Atmospheric and Surface Variables 
    1414       zst(:,:)     = sst_m(:,:) + rt0                                        ! convert SST from Celcius to Kelvin 
    1415       zqo_sat(:,:) = rdct_qsat_salt * q_sat( zst(:,:)   , pslp(:,:) )   ! saturation humidity over ocean [kg/kg] 
    1416       zqi_sat(:,:) =                  q_sat( ptm_su(:,:), pslp(:,:) )   ! saturation humidity over ice   [kg/kg] 
    1417       ! 
    1418       DO_2D( 0, 0, 0, 0 ) 
    1419          ! Virtual potential temperature [K] 
    1420          zthetav_os = zst(ji,jj)    * ( 1._wp + rctv0 * zqo_sat(ji,jj) )   ! over ocean 
    1421          zthetav_is = ptm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice 
    1422          zthetav_zu = t_zu (ji,jj)  * ( 1._wp + rctv0 * q_zu(ji,jj)    )   ! at zu 
    1423  
    1424          ! Bulk Richardson Number (could use Ri_bulk function from aerobulk instead) 
    1425          zrib_o = grav / zthetav_os * ( zthetav_zu - zthetav_os ) * rn_zu / MAX( 0.5, wndm(ji,jj)     )**2   ! over ocean 
    1426          zrib_i = grav / zthetav_is * ( zthetav_zu - zthetav_is ) * rn_zu / MAX( 0.5, wndm_ice(ji,jj) )**2   ! over ice 
    1427  
    1428          ! Momentum and Heat Neutral Transfert Coefficients 
    1429          zCdn_form_ice = zCdn_form_tmp * at_i_b(ji,jj) * ( 1._wp - at_i_b(ji,jj) )**zbeta  ! Eq. 40 
    1430          zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) )               ! Eq. 53 
    1431  
    1432          ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead ?) 
    1433          z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water 
    1434          z0i = z0_skin_ice                                             ! over ice 
    1435          IF( zrib_o <= 0._wp ) THEN 
    1436             zfmw = 1._wp - zam * zrib_o / ( 1._wp + 3._wp * zc2 * Cdn_oce(ji,jj) * SQRT( -zrib_o * ( rn_zu / z0w + 1._wp ) ) )  ! Eq. 10 
    1437             zfhw = ( 1._wp + ( zbetah * ( zthetav_os - zthetav_zu )**r1_3 / ( Chn_oce(ji,jj) * MAX(0.01, wndm(ji,jj)) )   &     ! Eq. 26 
    1438                &             )**zgamma )**z1_gamma 
    1439          ELSE 
    1440             zfmw = 1._wp / ( 1._wp + zam * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 12 
    1441             zfhw = 1._wp / ( 1._wp + zah * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 28 
    1442          ENDIF 
    1443  
    1444          IF( zrib_i <= 0._wp ) THEN 
    1445             zfmi = 1._wp - zam * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq.  9 
    1446             zfhi = 1._wp - zah * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq. 25 
    1447          ELSE 
    1448             zfmi = 1._wp / ( 1._wp + zam * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 11 
    1449             zfhi = 1._wp / ( 1._wp + zah * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 27 
    1450          ENDIF 
    1451  
    1452          ! Momentum Transfert Coefficients (Eq. 38) 
    1453          pcd(ji,jj) = zCdn_skin_ice *   zfmi +  & 
    1454             &        zCdn_form_ice * ( zfmi * at_i_b(ji,jj) + zfmw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) ) 
    1455  
    1456          ! Heat Transfert Coefficients (Eq. 49) 
    1457          pch(ji,jj) = zChn_skin_ice *   zfhi +  & 
    1458             &        zChn_form_ice * ( zfhi * at_i_b(ji,jj) + zfhw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) ) 
    1459          ! 
    1460       END_2D 
    1461       CALL lbc_lnk_multi( 'sbcblk', pcd, 'T',  1.0_wp, pch, 'T', 1.0_wp ) 
    1462       ! 
    1463    END SUBROUTINE Cdn10_Lupkes2015 
    14641383 
    14651384#endif 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_coare3p0.F90

    r13460 r13655  
    77   !!   * bulk transfer coefficients C_D, C_E and C_H 
    88   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed 
    9    !!   * the effective bulk wind speed at 10m U_blk 
     9   !!   * the effective bulk wind speed at 10m Ubzu 
    1010   !!   => all these are used in bulk formulas in sbcblk.F90 
    1111   !! 
    … …  
    3737 
    3838   USE sbc_oce         ! Surface boundary condition: ocean fields 
    39    USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB 
     39   USE sbc_phy         ! all thermodynamics functions, rho_air, q_sat, etc... !LB 
    4040   USE sbcblk_skin_coare ! cool-skin/warm layer scheme (CSWL_ECMWF) !LB 
    4141 
    … …  
    5050   REAL(wp), PARAMETER :: zi0   = 600._wp     ! scale height of the atmospheric boundary layer... 
    5151   REAL(wp), PARAMETER :: Beta0 =  1.25_wp    ! gustiness parameter 
    52  
    53    INTEGER , PARAMETER ::   nb_itt = 10             ! number of itterations 
     52   REAL(wp), PARAMETER :: zeta_abs_max = 50._wp 
    5453 
    5554   !!---------------------------------------------------------------------- 
    … …  
    9089 
    9190   SUBROUTINE turb_coare3p0( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, & 
    92       &                      Cd, Ch, Ce, t_zu, q_zu, U_blk,                              & 
    93       &                      Cdn, Chn, Cen,                                              & 
     91      &                      Cd, Ch, Ce, t_zu, q_zu, Ubzu,                               & 
     92      &                      nb_iter, Cdn, Chn, Cen,                                     & ! optional output 
    9493      &                      Qsw, rad_lw, slp, pdT_cs,                                   & ! optionals for cool-skin (and warm-layer) 
    95       &                      pdT_wl, pHz_wl )                                                 ! optionals for warm-layer only 
     94      &                      pdT_wl, pHz_wl )                                              ! optionals for warm-layer only 
    9695      !!---------------------------------------------------------------------- 
    9796      !!                      ***  ROUTINE  turb_coare3p0  *** 
    … …  
    147146      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K] 
    148147      !!    *  q_zu   : specific humidity of air        //                    [kg/kg] 
    149       !!    *  U_blk  : bulk wind speed at zu                                 [m/s] 
     148      !!    *  Ubzu  : bulk wind speed at zu                                 [m/s] 
    150149      !! 
    151150      !! 
    … …  
    167166      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K] 
    168167      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg] 
    169       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s] 
    170       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients 
    171       ! 
     168      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ubzu    ! bulk wind speed at zu                     [m/s] 
     169      ! 
     170      INTEGER , INTENT(in   ), OPTIONAL                     :: nb_iter  ! number of iterations 
     171      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   CdN 
     172      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   ChN 
     173      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   CeN 
    172174      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   Qsw      !             [W/m^2] 
    173175      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   rad_lw   !             [W/m^2] 
    … …  
    177179      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pHz_wl   !             [m] 
    178180      ! 
    179       INTEGER :: j_itt 
     181      INTEGER :: nbit, jit 
    180182      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    181183      ! 
    … …  
    194196      IF( kt == nit000 ) CALL SBCBLK_ALGO_COARE3P0_INIT(l_use_cs, l_use_wl) 
    195197 
     198      nbit = nb_iter0 
     199      IF( PRESENT(nb_iter) ) nbit = nb_iter 
     200 
    196201      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    197202      IF( .NOT. l_zt_equal_zu )  ALLOCATE( zeta_t(jpi,jpj) ) 
    … …  
    211216      ENDIF 
    212217 
    213  
    214218      !! First guess of temperature and humidity at height zu: 
    215219      t_zu = MAX( t_zt ,  180._wp )   ! who knows what's given on masked-continental regions... 
    … …  
    222226      znu_a = visc_air(t_zu) ! Air viscosity (m^2/s) at zt given from temperature in (K) 
    223227 
    224       U_blk = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution 
     228      Ubzu = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution 
    225229 
    226230      ztmp0   = LOG(    zu*10000._wp) ! optimization: 10000. == 1/z0 (with z0 first guess == 0.0001) 
    227231      ztmp1   = LOG(10._wp*10000._wp) !       "                    "               " 
    228       u_star = 0.035_wp*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10) 
    229  
    230       z0     = alfa_charn_3p0(U_zu)*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
     232      u_star = 0.035_wp*Ubzu*ztmp1/ztmp0       ! (u* = 0.035*Un10) 
     233 
     234      z0     = charn_coare3p0(U_zu)*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
    231235      z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    232236 
    … …  
    234238      z0t    = MIN( MAX(ABS(z0t), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    235239 
    236       Cd     = (vkarmn/ztmp0)**2    ! first guess of Cd 
    237  
    238       ztmp0 = vkarmn*vkarmn/LOG(zt/z0t)/Cd 
    239  
    240       ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN) 
     240      Cd     = MAX( (vkarmn/ztmp0)**2 , Cx_min )    ! first guess of Cd 
     241 
     242      ztmp0 = vkarmn2/LOG(zt/z0t)/Cd 
     243 
     244      ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, Ubzu ) ! Bulk Richardson Number (BRN) 
    241245 
    242246      !! First estimate of zeta_u, depending on the stability, ie sign of BRN (ztmp2): 
    243247      ztmp1 = 0.5 + SIGN( 0.5_wp , ztmp2 ) 
    244       ztmp0 = ztmp0*ztmp2 
    245       zeta_u = (1._wp-ztmp1) * (ztmp0/(1._wp+ztmp2/(-zu/(zi0*0.004_wp*Beta0**3)))) & !  BRN < 0 
    246          &  +     ztmp1   * (ztmp0*(1._wp + 27._wp/9._wp*ztmp2/ztmp0))               !  BRN > 0 
    247       !#LB: should make sure that the "ztmp0" of "27./9.*ztmp2/ztmp0" is "ztmp0*ztmp2" and not "ztmp0==vkarmn*vkarmn/LOG(zt/z0t)/Cd" ! 
    248  
     248      zeta_u = (1._wp - ztmp1) *   ztmp0*ztmp2 / (1._wp - ztmp2*zi0*0.004_wp*Beta0**3/zu) & !  BRN < 0 
     249         &  +       ztmp1      * ( ztmp0*ztmp2 + 27._wp/9._wp*ztmp2*ztmp2 )                 !  BRN > 0 
     250       
    249251      !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L 
    250252      ztmp0  = vkarmn/(LOG(zu/z0t) - psi_h_coare(zeta_u)) 
    251253 
    252       u_star = MAX ( U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
     254      u_star = MAX ( Ubzu*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
    253255      t_star = dt_zu*ztmp0 
    254256      q_star = dq_zu*ztmp0 
    … …  
    269271 
    270272      !! ITERATION BLOCK 
    271       DO j_itt = 1, nb_itt 
    272  
    273          !!Inverse of Monin-Obukov length (1/L) : 
    274          ztmp0 = One_on_L(t_zu, q_zu, u_star, t_star, q_star)  ! 1/L == 1/[Monin-Obukhov length] 
    275          ztmp0 = SIGN( MIN(ABS(ztmp0),200._wp), ztmp0 ) ! (prevents FPE from stupid values from masked region later on...) 
     273      DO jit = 1, nbit 
     274 
     275         !!Inverse of Obukov length (1/L) : 
     276         ztmp0 = One_on_L(t_zu, q_zu, u_star, t_star, q_star)  ! 1/L == 1/[Obukhov length] 
     277         ztmp0 = SIGN( MIN(ABS(ztmp0),200._wp), ztmp0 ) ! 1/L (prevents FPE from stupid values from masked region later on...) 
    276278 
    277279         ztmp1 = u_star*u_star   ! u*^2 
    … …  
    280282         ztmp2 = Beta0*Beta0*ztmp1*(MAX(-zi0*ztmp0/vkarmn,0._wp))**(2._wp/3._wp) ! square of wind gustiness contribution, ztmp2 == Ug^2 
    281283         !!   ! Only true when unstable (L<0) => when ztmp0 < 0 => explains "-" before zi0 
    282          U_blk = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed 
    283          ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0. 
     284         Ubzu = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed 
     285         ! => 0.2 prevents Ubzu to be 0 in stable case when U_zu=0. 
    284286 
    285287         !! Stability parameters: 
    286288         zeta_u = zu*ztmp0 
    287          zeta_u = SIGN( MIN(ABS(zeta_u),50.0_wp), zeta_u ) 
     289         zeta_u = SIGN( MIN(ABS(zeta_u),zeta_abs_max), zeta_u ) 
    288290         IF( .NOT. l_zt_equal_zu ) THEN 
    289291            zeta_t = zt*ztmp0 
    290             zeta_t = SIGN( MIN(ABS(zeta_t),50.0_wp), zeta_t ) 
     292            zeta_t = SIGN( MIN(ABS(zeta_t),zeta_abs_max), zeta_t ) 
    291293         ENDIF 
    292294 
    … …  
    296298         !! Roughness lengthes z0, z0t (z0q = z0t) : 
    297299         ztmp2 = u_star/vkarmn*LOG(10./z0)                                 ! Neutral wind speed at 10m 
    298          z0    = alfa_charn_3p0(ztmp2)*ztmp1/grav + 0.11_wp*znu_a/u_star   ! Roughness length (eq.6) [ ztmp1==u*^2 ] 
     300         z0    = charn_coare3p0(ztmp2)*ztmp1/grav + 0.11_wp*znu_a/u_star   ! Roughness length (eq.6) [ ztmp1==u*^2 ] 
    299301         z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    300302 
    … …  
    309311         t_star = dt_zu*ztmp1 
    310312         q_star = dq_zu*ztmp1 
    311          u_star = MAX( U_blk*vkarmn/(LOG(zu) - LOG(z0) - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
     313         u_star = MAX( Ubzu*vkarmn/(LOG(zu) - LOG(z0) - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
    312314 
    313315         IF( .NOT. l_zt_equal_zu ) THEN 
    … …  
    318320         ENDIF 
    319321 
    320  
    321322         IF( l_use_cs ) THEN 
    322323            !! Cool-skin contribution 
    323324 
    324             CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 
     325            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, Ubzu, slp, rad_lw, & 
    325326               &                   ztmp1, zeta_u,  Qlat=ztmp2)  ! Qnsol -> ztmp1 / Tau -> zeta_u 
    326327 
    … …  
    330331            IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1) 
    331332            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:)) 
    332  
    333333         ENDIF 
    334334 
    335335         IF( l_use_wl ) THEN 
    336336            !! Warm-layer contribution 
    337             CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 
     337            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, Ubzu, slp, rad_lw, & 
    338338               &                   ztmp1, zeta_u)  ! Qnsol -> ztmp1 / Tau -> zeta_u 
    339339            !! In WL_COARE or , Tau_ac and Qnt_ac must be updated at the final itteration step => add a flag to do this! 
    340             CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nb_itt,j_itt) ) 
     340            CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nbit,jit) ) 
    341341 
    342342            !! Updating T_s and q_s !!! 
    … …  
    351351         ENDIF 
    352352 
    353       END DO !DO j_itt = 1, nb_itt 
     353      END DO !DO jit = 1, nbit 
    354354 
    355355      ! compute transfer coefficients at zu : 
    356       ztmp0 = u_star/U_blk 
    357       Cd   = ztmp0*ztmp0 
    358       Ch   = ztmp0*t_star/dt_zu 
    359       Ce   = ztmp0*q_star/dq_zu 
    360  
    361       ztmp1 = zu + z0 
    362       Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 )) 
    363       Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t)) 
    364       Cen = Chn 
     356      ztmp0 = u_star/Ubzu 
     357      Cd   = MAX( ztmp0*ztmp0        , Cx_min ) 
     358      Ch   = MAX( ztmp0*t_star/dt_zu , Cx_min ) 
     359      Ce   = MAX( ztmp0*q_star/dq_zu , Cx_min ) 
    365360 
    366361      IF( .NOT. l_zt_equal_zu ) DEALLOCATE( zeta_t ) 
     362 
     363      IF(PRESENT(Cdn)) Cdn = MAX( vkarmn2 / (LOG(zu/z0 )*LOG(zu/z0 )) , Cx_min ) 
     364      IF(PRESENT(Chn)) Chn = MAX( vkarmn2 / (LOG(zu/z0t)*LOG(zu/z0t)) , Cx_min ) 
     365      IF(PRESENT(Cen)) Cen = MAX( vkarmn2 / (LOG(zu/z0t)*LOG(zu/z0t)) , Cx_min ) 
    367366 
    368367      IF( l_use_cs .AND. PRESENT(pdT_cs) ) pdT_cs = dT_cs 
    … …  
    375374 
    376375 
    377    FUNCTION alfa_charn_3p0( pwnd ) 
     376   FUNCTION charn_coare3p0( pwnd ) 
    378377      !!------------------------------------------------------------------- 
    379378      !! Compute the Charnock parameter as a function of the wind speed 
    … …  
    387386      !! Author: L. Brodeau, June 2016 / AeroBulk  (https://github.com/brodeau/aerobulk/) 
    388387      !!------------------------------------------------------------------- 
    389       REAL(wp), DIMENSION(jpi,jpj) :: alfa_charn_3p0 
     388      REAL(wp), DIMENSION(jpi,jpj) :: charn_coare3p0 
    390389      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwnd   ! wind speed 
    391390      ! 
    … …  
    393392      REAL(wp) :: zw, zgt10, zgt18 
    394393      !!------------------------------------------------------------------- 
    395       ! 
    396394      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    397       ! 
    398       zw = pwnd(ji,jj)   ! wind speed 
    399       ! 
    400       ! Charnock's constant, increases with the wind : 
    401       zgt10 = 0.5 + SIGN(0.5_wp,(zw - 10))  ! If zw<10. --> 0, else --> 1 
    402       zgt18 = 0.5 + SIGN(0.5_wp,(zw - 18.)) ! If zw<18. --> 0, else --> 1 
    403       ! 
    404       alfa_charn_3p0(ji,jj) =  (1. - zgt10)*0.011    &    ! wind is lower than 10 m/s 
    405          &     + zgt10*((1. - zgt18)*(0.011 + (0.018 - 0.011) & 
    406          &      *(zw - 10.)/(18. - 10.)) + zgt18*( 0.018 ) )    ! Hare et al. (1999) 
    407       ! 
     395            ! 
     396            zw = pwnd(ji,jj)   ! wind speed 
     397            ! 
     398            ! Charnock's constant, increases with the wind : 
     399            zgt10 = 0.5 + SIGN(0.5_wp,(zw - 10))  ! If zw<10. --> 0, else --> 1 
     400            zgt18 = 0.5 + SIGN(0.5_wp,(zw - 18.)) ! If zw<18. --> 0, else --> 1 
     401            ! 
     402            charn_coare3p0(ji,jj) =  (1. - zgt10)*0.011    &    ! wind is lower than 10 m/s 
     403               &     + zgt10*((1. - zgt18)*(0.011 + (0.018 - 0.011) & 
     404               &      *(zw - 10.)/(18. - 10.)) + zgt18*( 0.018 ) )    ! Hare et al. (1999) 
     405            ! 
    408406      END_2D 
    409       ! 
    410    END FUNCTION alfa_charn_3p0 
     407   END FUNCTION charn_coare3p0 
    411408 
    412409   FUNCTION psi_m_coare( pzeta ) 
    … …  
    429426      REAL(wp) :: zta, zphi_m, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab 
    430427      !!---------------------------------------------------------------------------------- 
    431       ! 
    432428      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    433       ! 
    434       zta = pzeta(ji,jj) 
    435       ! 
    436       zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable 
    437       ! 
    438       zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   & 
    439          & - 2.*ATAN(zphi_m) + 0.5*rpi 
    440       ! 
    441       zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective 
    442       ! 
    443       zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
    444          &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
    445       ! 
    446       zf = zta*zta 
    447       zf = zf/(1. + zf) 
    448       zc = MIN(50._wp, 0.35_wp*zta) 
    449       zstab = 0.5 + SIGN(0.5_wp, zta) 
    450       ! 
    451       psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 
    452          &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0) 
    453          &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     " 
    454       ! 
     429            ! 
     430            zta = pzeta(ji,jj) 
     431            ! 
     432            zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable 
     433            ! 
     434            zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   & 
     435               & - 2.*ATAN(zphi_m) + 0.5*rpi 
     436            ! 
     437            zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective 
     438            ! 
     439            zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
     440               &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
     441            ! 
     442            zf = zta*zta 
     443            zf = zf/(1. + zf) 
     444            zc = MIN(50._wp, 0.35_wp*zta) 
     445            zstab = 0.5 + SIGN(0.5_wp, zta) 
     446            ! 
     447            psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 
     448               &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0) 
     449               &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )  !     " 
    455450      END_2D 
    456       ! 
    457451   END FUNCTION psi_m_coare 
    458452 
    … …  
    474468      !!         (https://github.com/brodeau/aerobulk/) 
    475469      !!---------------------------------------------------------------- 
    476       !! 
    477470      REAL(wp), DIMENSION(jpi,jpj) :: psi_h_coare 
    478471      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta 
    … …  
    480473      INTEGER  ::   ji, jj     ! dummy loop indices 
    481474      REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab 
    482       ! 
     475      !!---------------------------------------------------------------- 
    483476      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    484       ! 
    485       zta = pzeta(ji,jj) 
    486       ! 
    487       zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 
    488       ! 
    489       zpsi_k = 2.*LOG((1. + zphi_h)/2.) 
    490       ! 
    491       zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective 
    492       ! 
    493       zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
    494          &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
    495       ! 
    496       zf = zta*zta 
    497       zf = zf/(1. + zf) 
    498       zc = MIN(50._wp,0.35_wp*zta) 
    499       zstab = 0.5 + SIGN(0.5_wp, zta) 
    500       ! 
    501       psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 
    502          &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     & 
    503          &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 
    504       ! 
     477            ! 
     478            zta = pzeta(ji,jj) 
     479            ! 
     480            zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 
     481            ! 
     482            zpsi_k = 2.*LOG((1. + zphi_h)/2.) 
     483            ! 
     484            zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective 
     485            ! 
     486            zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
     487               &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
     488            ! 
     489            zf = zta*zta 
     490            zf = zf/(1. + zf) 
     491            zc = MIN(50._wp,0.35_wp*zta) 
     492            zstab = 0.5 + SIGN(0.5_wp, zta) 
     493            ! 
     494            psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 
     495               &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     & 
     496               &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 
    505497      END_2D 
    506       ! 
    507498   END FUNCTION psi_h_coare 
    508499 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_coare3p6.F90

    r13460 r13655  
    77   !!   * bulk transfer coefficients C_D, C_E and C_H 
    88   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed 
    9    !!   * the effective bulk wind speed at 10m U_blk 
     9   !!   * the effective bulk wind speed at 10m Ubzu 
    1010   !!   => all these are used in bulk formulas in sbcblk.F90 
    1111   !! 
    … …  
    2323   !!                   returns the effective bulk wind speed at 10m 
    2424   !!---------------------------------------------------------------------- 
    25    USE oce             ! ocean dynamics and tracers 
    2625   USE dom_oce         ! ocean space and time domain 
    2726   USE phycst          ! physical constants 
    28    USE iom             ! I/O manager library 
    29    USE lib_mpp         ! distribued memory computing library 
    30    USE in_out_manager  ! I/O manager 
    31    USE prtctl          ! Print control 
    32    USE sbcwave, ONLY   :  cdn_wave ! wave module 
    33 #if defined key_si3 || defined key_cice 
    34    USE sbc_ice         ! Surface boundary condition: ice fields 
    35 #endif 
    36    USE lib_fortran     ! to use key_nosignedzero 
    37  
    38    USE sbc_oce         ! Surface boundary condition: ocean fields 
    39    USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB 
     27   USE lib_mpp,        ONLY: ctl_stop         ! distribued memory computing library 
     28   USE in_out_manager, ONLY: nit000  ! I/O manager 
     29   USE sbc_phy         ! all thermodynamics functions, rho_air, q_sat, etc... !LB 
    4030   USE sbcblk_skin_coare ! cool-skin/warm layer scheme (CSWL_ECMWF) !LB 
    4131 
    … …  
    5040   REAL(wp), PARAMETER :: zi0   = 600._wp     ! scale height of the atmospheric boundary layer... 
    5141   REAL(wp), PARAMETER :: Beta0 =  1.2_wp     ! gustiness parameter 
    52  
    53    INTEGER , PARAMETER ::   nb_itt = 10             ! number of itterations 
     42   REAL(wp), PARAMETER :: zeta_abs_max = 50._wp 
    5443 
    5544   !!---------------------------------------------------------------------- 
    … …  
    9079 
    9180   SUBROUTINE turb_coare3p6( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, & 
    92       &                      Cd, Ch, Ce, t_zu, q_zu, U_blk,                              & 
    93       &                      Cdn, Chn, Cen,                                              & 
     81      &                      Cd, Ch, Ce, t_zu, q_zu, Ubzu,                               & 
     82      &                      nb_iter, Cdn, Chn, Cen,                                     & ! optional output 
    9483      &                      Qsw, rad_lw, slp, pdT_cs,                                   & ! optionals for cool-skin (and warm-layer) 
    95       &                      pdT_wl, pHz_wl )                                                 ! optionals for warm-layer only 
     84      &                      pdT_wl, pHz_wl )                                              ! optionals for warm-layer only 
    9685      !!---------------------------------------------------------------------- 
    9786      !!                      ***  ROUTINE  turb_coare3p6  *** 
    … …  
    147136      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K] 
    148137      !!    *  q_zu   : specific humidity of air        //                    [kg/kg] 
    149       !!    *  U_blk  : bulk wind speed at zu                                 [m/s] 
     138      !!    *  Ubzu  : bulk wind speed at zu                                 [m/s] 
    150139      !! 
    151140      !! 
    … …  
    167156      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K] 
    168157      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg] 
    169       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s] 
    170       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients 
    171       ! 
     158      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ubzu    ! bulk wind speed at zu                     [m/s] 
     159      ! 
     160      INTEGER , INTENT(in   ), OPTIONAL                     :: nb_iter  ! number of iterations 
     161      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   CdN 
     162      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   ChN 
     163      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   CeN 
    172164      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   Qsw      !             [W/m^2] 
    173165      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   rad_lw   !             [W/m^2] 
    … …  
    177169      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pHz_wl   !             [m] 
    178170      ! 
    179       INTEGER :: j_itt 
     171      INTEGER :: nbit, jit 
    180172      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    181173      ! 
    … …  
    194186      IF( kt == nit000 ) CALL SBCBLK_ALGO_COARE3P6_INIT(l_use_cs, l_use_wl) 
    195187 
     188      nbit = nb_iter0 
     189      IF( PRESENT(nb_iter) ) nbit = nb_iter 
     190 
    196191      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    197192      IF( .NOT. l_zt_equal_zu )  ALLOCATE( zeta_t(jpi,jpj) ) 
    … …  
    211206      ENDIF 
    212207 
    213  
    214208      !! First guess of temperature and humidity at height zu: 
    215209      t_zu = MAX( t_zt ,  180._wp )   ! who knows what's given on masked-continental regions... 
    … …  
    222216      znu_a = visc_air(t_zu) ! Air viscosity (m^2/s) at zt given from temperature in (K) 
    223217 
    224       U_blk = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution 
     218      Ubzu = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution 
    225219 
    226220      ztmp0   = LOG(    zu*10000._wp) ! optimization: 10000. == 1/z0 (with z0 first guess == 0.0001) 
    227221      ztmp1   = LOG(10._wp*10000._wp) !       "                    "               " 
    228       u_star = 0.035_wp*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10) 
    229  
    230       z0     = alfa_charn_3p6(U_zu)*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
     222      u_star = 0.035_wp*Ubzu*ztmp1/ztmp0       ! (u* = 0.035*Un10) 
     223 
     224      z0     = charn_coare3p6(U_zu)*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
    231225      z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    232226 
    … …  
    234228      z0t    = MIN( MAX(ABS(z0t), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    235229 
    236       Cd     = (vkarmn/ztmp0)**2    ! first guess of Cd 
    237  
    238       ztmp0 = vkarmn*vkarmn/LOG(zt/z0t)/Cd 
    239  
    240       ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN) 
     230      Cd     = MAX( (vkarmn/ztmp0)**2 , Cx_min )    ! first guess of Cd 
     231 
     232      ztmp0 = vkarmn2/LOG(zt/z0t)/Cd 
     233 
     234      ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, Ubzu ) ! Bulk Richardson Number (BRN) 
    241235 
    242236      !! First estimate of zeta_u, depending on the stability, ie sign of BRN (ztmp2): 
    243237      ztmp1 = 0.5 + SIGN( 0.5_wp , ztmp2 ) 
    244       ztmp0 = ztmp0*ztmp2 
    245       zeta_u = (1._wp-ztmp1) * (ztmp0/(1._wp+ztmp2/(-zu/(zi0*0.004_wp*Beta0**3)))) & !  BRN < 0 
    246          &  +     ztmp1   * (ztmp0*(1._wp + 27._wp/9._wp*ztmp2/ztmp0))               !  BRN > 0 
    247       !#LB: should make sure that the "ztmp0" of "27./9.*ztmp2/ztmp0" is "ztmp0*ztmp2" and not "ztmp0==vkarmn*vkarmn/LOG(zt/z0t)/Cd" ! 
    248  
     238      zeta_u = (1._wp - ztmp1) *   ztmp0*ztmp2 / (1._wp - ztmp2*zi0*0.004_wp*Beta0**3/zu) & !  BRN < 0 
     239         &  +       ztmp1      * ( ztmp0*ztmp2 + 27._wp/9._wp*ztmp2*ztmp2 )                 !  BRN > 0 
     240       
    249241      !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L 
    250242      ztmp0  = vkarmn/(LOG(zu/z0t) - psi_h_coare(zeta_u)) 
    251243 
    252       u_star = MAX ( U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
     244      u_star = MAX ( Ubzu*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
    253245      t_star = dt_zu*ztmp0 
    254246      q_star = dq_zu*ztmp0 
    … …  
    269261 
    270262      !! ITERATION BLOCK 
    271       DO j_itt = 1, nb_itt 
    272  
    273          !!Inverse of Monin-Obukov length (1/L) : 
    274          ztmp0 = One_on_L(t_zu, q_zu, u_star, t_star, q_star)  ! 1/L == 1/[Monin-Obukhov length] 
    275          ztmp0 = SIGN( MIN(ABS(ztmp0),200._wp), ztmp0 ) ! (prevents FPE from stupid values from masked region later on...) 
     263      DO jit = 1, nbit 
     264 
     265         !!Inverse of Obukov length (1/L) : 
     266         ztmp0 = One_on_L(t_zu, q_zu, u_star, t_star, q_star)  ! 1/L == 1/[Obukhov length] 
     267         ztmp0 = SIGN( MIN(ABS(ztmp0),200._wp), ztmp0 ) ! 1/L (prevents FPE from stupid values from masked region later on...) 
    276268 
    277269         ztmp1 = u_star*u_star   ! u*^2 
    … …  
    280272         ztmp2 = Beta0*Beta0*ztmp1*(MAX(-zi0*ztmp0/vkarmn,0._wp))**(2._wp/3._wp) ! square of wind gustiness contribution, ztmp2 == Ug^2 
    281273         !!   ! Only true when unstable (L<0) => when ztmp0 < 0 => explains "-" before zi0 
    282          U_blk = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed 
    283          ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0. 
     274         Ubzu = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed 
     275         ! => 0.2 prevents Ubzu to be 0 in stable case when U_zu=0. 
    284276 
    285277         !! Stability parameters: 
    286278         zeta_u = zu*ztmp0 
    287          zeta_u = SIGN( MIN(ABS(zeta_u),50.0_wp), zeta_u ) 
     279         zeta_u = SIGN( MIN(ABS(zeta_u),zeta_abs_max), zeta_u ) 
    288280         IF( .NOT. l_zt_equal_zu ) THEN 
    289281            zeta_t = zt*ztmp0 
    290             zeta_t = SIGN( MIN(ABS(zeta_t),50.0_wp), zeta_t ) 
     282            zeta_t = SIGN( MIN(ABS(zeta_t),zeta_abs_max), zeta_t ) 
    291283         ENDIF 
    292284 
    … …  
    296288         !! Roughness lengthes z0, z0t (z0q = z0t) : 
    297289         ztmp2 = u_star/vkarmn*LOG(10./z0)                                 ! Neutral wind speed at 10m 
    298          z0    = alfa_charn_3p6(ztmp2)*ztmp1/grav + 0.11_wp*znu_a/u_star   ! Roughness length (eq.6) [ ztmp1==u*^2 ] 
     290         z0    = charn_coare3p6(ztmp2)*ztmp1/grav + 0.11_wp*znu_a/u_star   ! Roughness length (eq.6) [ ztmp1==u*^2 ] 
    299291         z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    300292 
    … …  
    309301         t_star = dt_zu*ztmp1 
    310302         q_star = dq_zu*ztmp1 
    311          u_star = MAX( U_blk*vkarmn/(LOG(zu) - LOG(z0) - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
     303         u_star = MAX( Ubzu*vkarmn/(LOG(zu) - LOG(z0) - psi_m_coare(zeta_u)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
    312304 
    313305         IF( .NOT. l_zt_equal_zu ) THEN 
    … …  
    318310         ENDIF 
    319311 
    320  
    321312         IF( l_use_cs ) THEN 
    322313            !! Cool-skin contribution 
    323314 
    324             CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 
     315            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, Ubzu, slp, rad_lw, & 
    325316               &                   ztmp1, zeta_u,  Qlat=ztmp2)  ! Qnsol -> ztmp1 / Tau -> zeta_u 
    326317 
    … …  
    330321            IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1) 
    331322            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:)) 
    332  
    333323         ENDIF 
    334324 
    335325         IF( l_use_wl ) THEN 
    336326            !! Warm-layer contribution 
    337             CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 
     327            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, Ubzu, slp, rad_lw, & 
    338328               &                   ztmp1, zeta_u)  ! Qnsol -> ztmp1 / Tau -> zeta_u 
    339329            !! In WL_COARE or , Tau_ac and Qnt_ac must be updated at the final itteration step => add a flag to do this! 
    340             CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nb_itt,j_itt) ) 
     330            CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nbit,jit) ) 
    341331 
    342332            !! Updating T_s and q_s !!! 
    … …  
    351341         ENDIF 
    352342 
    353       END DO !DO j_itt = 1, nb_itt 
     343      END DO !DO jit = 1, nbit 
    354344 
    355345      ! compute transfer coefficients at zu : 
    356       ztmp0 = u_star/U_blk 
    357       Cd   = ztmp0*ztmp0 
    358       Ch   = ztmp0*t_star/dt_zu 
    359       Ce   = ztmp0*q_star/dq_zu 
    360  
    361       ztmp1 = zu + z0 
    362       Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 )) 
    363       Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t)) 
    364       Cen = Chn 
     346      ztmp0 = u_star/Ubzu 
     347      Cd   = MAX( ztmp0*ztmp0        , Cx_min ) 
     348      Ch   = MAX( ztmp0*t_star/dt_zu , Cx_min ) 
     349      Ce   = MAX( ztmp0*q_star/dq_zu , Cx_min ) 
    365350 
    366351      IF( .NOT. l_zt_equal_zu ) DEALLOCATE( zeta_t ) 
     352 
     353      IF(PRESENT(Cdn)) Cdn = MAX( vkarmn2 / (LOG(zu/z0 )*LOG(zu/z0 )) , Cx_min ) 
     354      IF(PRESENT(Chn)) Chn = MAX( vkarmn2 / (LOG(zu/z0t)*LOG(zu/z0t)) , Cx_min ) 
     355      IF(PRESENT(Cen)) Cen = MAX( vkarmn2 / (LOG(zu/z0t)*LOG(zu/z0t)) , Cx_min ) 
    367356 
    368357      IF( l_use_cs .AND. PRESENT(pdT_cs) ) pdT_cs = dT_cs 
    … …  
    375364 
    376365 
    377    FUNCTION alfa_charn_3p6( pwnd ) 
     366   FUNCTION charn_coare3p6( pwnd ) 
    378367      !!------------------------------------------------------------------- 
    379368      !! Computes the Charnock parameter as a function of the Neutral wind speed at 10m 
    … …  
    383372      !! Author: L. Brodeau, July 2019 / AeroBulk  (https://github.com/brodeau/aerobulk/) 
    384373      !!------------------------------------------------------------------- 
    385       REAL(wp), DIMENSION(jpi,jpj) :: alfa_charn_3p6 
     374      REAL(wp), DIMENSION(jpi,jpj) :: charn_coare3p6 
    386375      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwnd   ! neutral wind speed at 10m 
    387376      ! 
    388377      REAL(wp), PARAMETER :: charn0_max = 0.028  !: value above which the Charnock parameter levels off for winds > 18 m/s 
    389378      !!------------------------------------------------------------------- 
    390       alfa_charn_3p6 = MAX( MIN( 0.0017_wp*pwnd - 0.005_wp , charn0_max) , 0._wp ) 
    391       !! 
    392    END FUNCTION alfa_charn_3p6 
    393  
    394    FUNCTION alfa_charn_3p6_wave( pus, pwsh, pwps ) 
     379      charn_coare3p6 = MAX( MIN( 0.0017_wp*pwnd - 0.005_wp , charn0_max) , 0._wp ) 
     380      !! 
     381   END FUNCTION charn_coare3p6 
     382 
     383   FUNCTION charn_coare3p6_wave( pus, pwsh, pwps ) 
    395384      !!------------------------------------------------------------------- 
    396385      !! Computes the Charnock parameter as a function of wave information and u* 
    … …  
    400389      !! Author: L. Brodeau, October 2019 / AeroBulk  (https://github.com/brodeau/aerobulk/) 
    401390      !!------------------------------------------------------------------- 
    402       REAL(wp), DIMENSION(jpi,jpj) :: alfa_charn_3p6_wave 
     391      REAL(wp), DIMENSION(jpi,jpj) :: charn_coare3p6_wave 
    403392      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus   ! friction velocity             [m/s] 
    404393      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwsh  ! significant wave height       [m] 
    405394      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwps  ! phase speed of dominant waves [m/s] 
    406395      !!------------------------------------------------------------------- 
    407       alfa_charn_3p6_wave = ( pwsh*0.2_wp*(pus/pwps)**2.2_wp ) * grav/(pus*pus) 
    408       !! 
    409    END FUNCTION alfa_charn_3p6_wave 
     396      charn_coare3p6_wave = ( pwsh*0.2_wp*(pus/pwps)**2.2_wp ) * grav/(pus*pus) 
     397      !! 
     398   END FUNCTION charn_coare3p6_wave 
    410399 
    411400 
    … …  
    429418      REAL(wp) :: zta, zphi_m, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab 
    430419      !!---------------------------------------------------------------------------------- 
    431       ! 
    432420      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    433       ! 
    434       zta = pzeta(ji,jj) 
    435       ! 
    436       zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable 
    437       ! 
    438       zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   & 
    439          & - 2.*ATAN(zphi_m) + 0.5*rpi 
    440       ! 
    441       zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective 
    442       ! 
    443       zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
    444          &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
    445       ! 
    446       zf = zta*zta 
    447       zf = zf/(1. + zf) 
    448       zc = MIN(50._wp, 0.35_wp*zta) 
    449       zstab = 0.5 + SIGN(0.5_wp, zta) 
    450       ! 
    451       psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 
    452          &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0) 
    453          &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     " 
    454       ! 
     421            ! 
     422            zta = pzeta(ji,jj) 
     423            ! 
     424            zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable 
     425            ! 
     426            zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   & 
     427               & - 2.*ATAN(zphi_m) + 0.5*rpi 
     428            ! 
     429            zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective 
     430            ! 
     431            zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
     432               &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
     433            ! 
     434            zf = zta*zta 
     435            zf = zf/(1. + zf) 
     436            zc = MIN(50._wp, 0.35_wp*zta) 
     437            zstab = 0.5 + SIGN(0.5_wp, zta) 
     438            ! 
     439            psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 
     440               &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0) 
     441               &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )  !     " 
    455442      END_2D 
    456       ! 
    457443   END FUNCTION psi_m_coare 
    458444 
    … …  
    474460      !!         (https://github.com/brodeau/aerobulk/) 
    475461      !!---------------------------------------------------------------- 
    476       !! 
    477462      REAL(wp), DIMENSION(jpi,jpj) :: psi_h_coare 
    478463      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta 
    … …  
    480465      INTEGER  ::   ji, jj     ! dummy loop indices 
    481466      REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab 
    482       ! 
     467      !!---------------------------------------------------------------- 
    483468      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    484       ! 
    485       zta = pzeta(ji,jj) 
    486       ! 
    487       zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 
    488       ! 
    489       zpsi_k = 2.*LOG((1. + zphi_h)/2.) 
    490       ! 
    491       zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective 
    492       ! 
    493       zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
    494          &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
    495       ! 
    496       zf = zta*zta 
    497       zf = zf/(1. + zf) 
    498       zc = MIN(50._wp,0.35_wp*zta) 
    499       zstab = 0.5 + SIGN(0.5_wp, zta) 
    500       ! 
    501       psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 
    502          &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     & 
    503          &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 
    504       ! 
     469            ! 
     470            zta = pzeta(ji,jj) 
     471            ! 
     472            zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 
     473            ! 
     474            zpsi_k = 2.*LOG((1. + zphi_h)/2.) 
     475            ! 
     476            zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective 
     477            ! 
     478            zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
     479               &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
     480            ! 
     481            zf = zta*zta 
     482            zf = zf/(1. + zf) 
     483            zc = MIN(50._wp,0.35_wp*zta) 
     484            zstab = 0.5 + SIGN(0.5_wp, zta) 
     485            ! 
     486            psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 
     487               &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     & 
     488               &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 
    505489      END_2D 
    506       ! 
    507490   END FUNCTION psi_h_coare 
    508491 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_ecmwf.F90

    r13460 r13655  
    55   !!   * bulk transfer coefficients C_D, C_E and C_H 
    66   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed 
    7    !!   * the effective bulk wind speed at 10m U_blk 
     7   !!   * the effective bulk wind speed at 10m Ubzu 
    88   !!   => all these are used in bulk formulas in sbcblk.F90 
    99   !! 
    … …  
    2424   !!                   returns the effective bulk wind speed at 10m 
    2525   !!---------------------------------------------------------------------- 
    26    USE oce             ! ocean dynamics and tracers 
    2726   USE dom_oce         ! ocean space and time domain 
    2827   USE phycst          ! physical constants 
    29    USE iom             ! I/O manager library 
    30    USE lib_mpp         ! distribued memory computing library 
    31    USE in_out_manager  ! I/O manager 
    32    USE prtctl          ! Print control 
    33    USE sbcwave, ONLY   :  cdn_wave ! wave module 
    34 #if defined key_si3 || defined key_cice 
    35    USE sbc_ice         ! Surface boundary condition: ice fields 
    36 #endif 
    37    USE lib_fortran     ! to use key_nosignedzero 
    38  
    39    USE sbc_oce         ! Surface boundary condition: ocean fields 
    40    USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB 
     28   USE lib_mpp,        ONLY: ctl_stop         ! distribued memory computing library 
     29   USE in_out_manager, ONLY: nit000  ! I/O manager 
     30   USE sbc_phy         ! all thermodynamics functions, rho_air, q_sat, etc... !LB 
    4131   USE sbcblk_skin_ecmwf ! cool-skin/warm layer scheme !LB 
    4232 
    … …  
    4535 
    4636   PUBLIC :: SBCBLK_ALGO_ECMWF_INIT, TURB_ECMWF 
    47    !! * Substitutions 
    48 #  include "do_loop_substitute.h90" 
    4937 
    5038   !! ECMWF own values for given constants, taken form IFS documentation... 
    51    REAL(wp), PARAMETER ::   charn0 = 0.018    ! Charnock constant (pretty high value here !!! 
     39   REAL(wp), PARAMETER, PUBLIC :: charn0_ecmwf = 0.018_wp    ! Charnock constant (pretty high value here !!! 
    5240   !                                          !    =>  Usually 0.011 for moderate winds) 
    5341   REAL(wp), PARAMETER ::   zi0     = 1000.   ! scale height of the atmospheric boundary layer...1 
    … …  
    5745   REAL(wp), PARAMETER ::   alpha_Q = 0.62    ! 
    5846 
    59    INTEGER , PARAMETER ::   nb_itt = 10             ! number of itterations 
     47   !! * Substitutions 
     48#  include "do_loop_substitute.h90" 
    6049 
    6150   !!---------------------------------------------------------------------- 
    … …  
    9483 
    9584   SUBROUTINE turb_ecmwf( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, & 
    96       &                      Cd, Ch, Ce, t_zu, q_zu, U_blk,                           & 
    97       &                      Cdn, Chn, Cen,                                           & 
     85      &                      Cd, Ch, Ce, t_zu, q_zu, Ubzu,                            & 
     86      &                      nb_iter, Cdn, Chn, Cen,                                           & ! optional output 
    9887      &                      Qsw, rad_lw, slp, pdT_cs,                                & ! optionals for cool-skin (and warm-layer) 
    9988      &                      pdT_wl, pHz_wl )                                           ! optionals for warm-layer only 
    … …  
    151140      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K] 
    152141      !!    *  q_zu   : specific humidity of air        //                    [kg/kg] 
    153       !!    *  U_blk  : bulk wind speed at zu                                 [m/s] 
     142      !!    *  Ubzu   : bulk wind speed at zu                                 [m/s] 
    154143      !! 
    155144      !! 
    … …  
    171160      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K] 
    172161      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg] 
    173       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s] 
    174       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients 
    175       ! 
     162      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ubzu    ! bulk wind speed at zu                     [m/s] 
     163      ! 
     164      INTEGER , INTENT(in   ), OPTIONAL                     :: nb_iter  ! number of iterations 
     165      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   CdN 
     166      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   ChN 
     167      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   CeN 
    176168      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   Qsw      !             [W/m^2] 
    177169      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   rad_lw   !             [W/m^2] 
    … …  
    181173      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pHz_wl   !             [m] 
    182174      ! 
    183       INTEGER :: j_itt 
     175      INTEGER :: nbit, jit 
    184176      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    185177      ! 
    … …  
    197189      !!---------------------------------------------------------------------------------- 
    198190      IF( kt == nit000 ) CALL SBCBLK_ALGO_ECMWF_INIT(l_use_cs, l_use_wl) 
     191 
     192      nbit = nb_iter0 
     193      IF( PRESENT(nb_iter) ) nbit = nb_iter 
    199194 
    200195      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    … …  
    227222      znu_a = visc_air(t_zu) ! Air viscosity (m^2/s) at zt given from temperature in (K) 
    228223 
    229       U_blk = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution 
     224      Ubzu = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution 
    230225 
    231226      ztmp0   = LOG(    zu*10000._wp) ! optimization: 10000. == 1/z0 (with z0 first guess == 0.0001) 
    232227      ztmp1   = LOG(10._wp*10000._wp) !       "                    "               " 
    233       u_star = 0.035_wp*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10) 
    234  
    235       z0     = charn0*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
     228      u_star = 0.035_wp*Ubzu*ztmp1/ztmp0       ! (u* = 0.035*Un10) 
     229 
     230      z0     = charn0_ecmwf*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
    236231      z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    237232 
    … …  
    239234      z0t    = MIN( MAX(ABS(z0t), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    240235 
    241       Cd     = (vkarmn/ztmp0)**2    ! first guess of Cd 
    242  
    243       ztmp0 = vkarmn*vkarmn/LOG(zt/z0t)/Cd 
    244  
    245       ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN) 
     236      Cd     = MAX( (vkarmn/ztmp0)**2 , Cx_min )   ! first guess of Cd 
     237 
     238      ztmp0 = vkarmn2/LOG(zt/z0t)/Cd 
     239 
     240      ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, Ubzu ) ! Bulk Richardson Number (BRN) 
    246241 
    247242      !! First estimate of zeta_u, depending on the stability, ie sign of BRN (ztmp2): 
    248243      ztmp1 = 0.5 + SIGN( 0.5_wp , ztmp2 ) 
    249       func_m = ztmp0*ztmp2 ! temporary array !! 
    250       func_h = (1._wp-ztmp1) * (func_m/(1._wp+ztmp2/(-zu/(zi0*0.004_wp*Beta0**3)))) & !  BRN < 0 ! temporary array !!! func_h == zeta_u 
    251          &  +     ztmp1   * (func_m*(1._wp + 27._wp/9._wp*ztmp2/func_m))              !  BRN > 0 
    252       !#LB: should make sure that the "func_m" of "27./9.*ztmp2/func_m" is "ztmp0*ztmp2" and not "ztmp0==vkarmn*vkarmn/LOG(zt/z0t)/Cd" ! 
    253  
     244      func_h = (1._wp - ztmp1) *   ztmp0*ztmp2 / (1._wp - ztmp2*zi0*0.004_wp*Beta0**3/zu) & !  BRN < 0 
     245         &  +       ztmp1      * ( ztmp0*ztmp2 + 27._wp/9._wp*ztmp2*ztmp2 )                 !  BRN > 0 
     246       
    254247      !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L 
    255248      ztmp0  = vkarmn/(LOG(zu/z0t) - psi_h_ecmwf(func_h)) 
    256249 
    257       u_star = MAX ( U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_ecmwf(func_h)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
     250      u_star = MAX ( Ubzu*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_ecmwf(func_h)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
    258251      t_star = dt_zu*ztmp0 
    259252      q_star = dq_zu*ztmp0 
    … …  
    276269 
    277270 
    278       !! First guess of inverse of Monin-Obukov length (1/L) : 
     271      !! First guess of inverse of Obukov length (1/L) : 
    279272      Linv = One_on_L( t_zu, q_zu, u_star, t_star, q_star ) 
    280273 
    281       !! Functions such as  u* = U_blk*vkarmn/func_m 
     274      !! Functions such as  u* = Ubzu*vkarmn/func_m 
    282275      ztmp0 = zu*Linv 
    283276      func_m = LOG(zu) - LOG(z0)  - psi_m_ecmwf(ztmp0) + psi_m_ecmwf( z0*Linv) 
    … …  
    285278 
    286279      !! ITERATION BLOCK 
    287       DO j_itt = 1, nb_itt 
     280      DO jit = 1, nbit 
    288281 
    289282         !! Bulk Richardson Number at z=zu (Eq. 3.25) 
    290          ztmp0 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN) 
    291  
    292          !! New estimate of the inverse of the Monin-Obukhon length (Linv == zeta/zu) : 
     283         ztmp0 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, Ubzu ) ! Bulk Richardson Number (BRN) 
     284 
     285         !! New estimate of the inverse of the Obukhon length (Linv == zeta/zu) : 
    293286         Linv = ztmp0*func_m*func_m/func_h / zu     ! From Eq. 3.23, Chap.3.2.3, IFS doc - Cy40r1 
    294287         !! Note: it is slightly different that the L we would get with the usual 
    … …  
    299292 
    300293         !! Need to update roughness lengthes: 
    301          u_star = U_blk*vkarmn/func_m 
     294         u_star = Ubzu*vkarmn/func_m 
    302295         ztmp2  = u_star*u_star 
    303296         ztmp1  = znu_a/u_star 
    304          z0     = MIN( ABS( alpha_M*ztmp1 + charn0*ztmp2/grav ) , 0.001_wp) 
    305          z0t    = MIN( ABS( alpha_H*ztmp1                     ) , 0.001_wp)   ! eq.3.26, Chap.3, p.34, IFS doc - Cy31r1 
    306          z0q    = MIN( ABS( alpha_Q*ztmp1                     ) , 0.001_wp) 
     297         z0     = MIN( ABS( alpha_M*ztmp1 + charn0_ecmwf*ztmp2/grav ) , 0.001_wp) 
     298         z0t    = MIN( ABS( alpha_H*ztmp1                           ) , 0.001_wp)   ! eq.3.26, Chap.3, p.34, IFS doc - Cy31r1 
     299         z0q    = MIN( ABS( alpha_Q*ztmp1                           ) , 0.001_wp) 
    307300 
    308301         !! Update wind at zu with convection-related wind gustiness in unstable conditions (Chap. 3.2, IFS doc - Cy40r1, Eq.3.17 and Eq.3.18 + Eq.3.8) 
    309302         ztmp2 = Beta0*Beta0*ztmp2*(MAX(-zi0*Linv/vkarmn,0._wp))**(2._wp/3._wp) ! square of wind gustiness contribution  (combining Eq. 3.8 and 3.18, hap.3, IFS doc - Cy31r1) 
    310303         !!   ! Only true when unstable (L<0) => when ztmp0 < 0 => explains "-" before zi0 
    311          U_blk = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed 
    312          ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0. 
     304         Ubzu = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed 
     305         ! => 0.2 prevents Ubzu to be 0 in stable case when U_zu=0. 
    313306 
    314307 
    … …  
    346339            !! Cool-skin contribution 
    347340 
    348             CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 
     341            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, Ubzu, slp, rad_lw, & 
    349342               &                   ztmp1, ztmp0,  Qlat=ztmp2)  ! Qnsol -> ztmp1 / Tau -> ztmp0 
    350343 
    … …  
    359352         IF( l_use_wl ) THEN 
    360353            !! Warm-layer contribution 
    361             CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 
     354            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, Ubzu, slp, rad_lw, & 
    362355               &                   ztmp1, ztmp2)  ! Qnsol -> ztmp1 / Tau -> ztmp2 
    363356            CALL WL_ECMWF( Qsw, ztmp1, u_star, zsst ) 
    … …  
    373366         ENDIF 
    374367 
    375       END DO !DO j_itt = 1, nb_itt 
    376  
    377       Cd = vkarmn*vkarmn/(func_m*func_m) 
    378       Ch = vkarmn*vkarmn/(func_m*func_h) 
    379       ztmp2 = log(zu/z0q) - psi_h_ecmwf(zu*Linv) + psi_h_ecmwf(z0q*Linv)   ! func_q 
    380       Ce = vkarmn*vkarmn/(func_m*ztmp2) 
    381  
    382       Cdn = vkarmn*vkarmn / (log(zu/z0 )*log(zu/z0 )) 
    383       Chn = vkarmn*vkarmn / (log(zu/z0t)*log(zu/z0t)) 
    384       Cen = vkarmn*vkarmn / (log(zu/z0q)*log(zu/z0q)) 
     368      END DO !DO jit = 1, nbit 
     369 
     370      Cd = MAX( vkarmn2/(func_m*func_m) , Cx_min ) 
     371      Ch = MAX( vkarmn2/(func_m*func_h) , Cx_min ) 
     372      ztmp2 = LOG(zu/z0q) - psi_h_ecmwf(zu*Linv) + psi_h_ecmwf(z0q*Linv)   ! func_q 
     373      Ce = MAX( vkarmn2/(func_m*ztmp2)  , Cx_min ) 
     374 
     375      IF(PRESENT(Cdn)) Cdn = MAX( vkarmn2 / (LOG(zu/z0 )*LOG(zu/z0 )) , Cx_min ) 
     376      IF(PRESENT(Chn)) Chn = MAX( vkarmn2 / (LOG(zu/z0t)*LOG(zu/z0t)) , Cx_min ) 
     377      IF(PRESENT(Cen)) Cen = MAX( vkarmn2 / (LOG(zu/z0q)*LOG(zu/z0q)) , Cx_min ) 
    385378 
    386379      IF( l_use_cs .AND. PRESENT(pdT_cs) ) pdT_cs = dT_cs 
    … …  
    408401      ! 
    409402      INTEGER  ::   ji, jj    ! dummy loop indices 
    410       REAL(wp) :: zzeta, zx, ztmp, psi_unst, psi_stab, stab 
    411       !!---------------------------------------------------------------------------------- 
     403      REAL(wp) :: zta, zx2, zx, ztmp, zpsi_unst, zpsi_stab, zstab, zc 
     404      !!---------------------------------------------------------------------------------- 
     405      zc = 5._wp/0.35_wp 
    412406      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    413       ! 
    414       zzeta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!): 
    415       ! 
    416       ! Unstable (Paulson 1970): 
    417       !   eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
    418       zx = SQRT(ABS(1._wp - 16._wp*zzeta)) 
    419       ztmp = 1._wp + SQRT(zx) 
    420       ztmp = ztmp*ztmp 
    421       psi_unst = LOG( 0.125_wp*ztmp*(1._wp + zx) )   & 
    422          &       -2._wp*ATAN( SQRT(zx) ) + 0.5_wp*rpi 
    423       ! 
    424       ! Unstable: 
    425       ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 
    426       psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & 
    427          &       - zzeta - 2._wp/3._wp*5._wp/0.35_wp 
    428       ! 
    429       ! Combining: 
    430       stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 
    431       ! 
    432       psi_m_ecmwf(ji,jj) = (1._wp - stab) * psi_unst & ! (zzeta < 0) Unstable 
    433          &                +      stab  * psi_stab      ! (zzeta > 0) Stable 
    434       ! 
     407            ! 
     408            zta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!): 
     409 
     410            ! *** Unstable (Paulson 1970)    [eq.3.20, Chap.3, p.33, IFS doc - Cy31r1] : 
     411            zx2 = SQRT( ABS(1._wp - 16._wp*zta) )  ! (1 - 16z)^0.5 
     412            zx  = SQRT(zx2)                          ! (1 - 16z)^0.25 
     413            ztmp = 1._wp + zx 
     414            zpsi_unst = LOG( 0.125_wp*ztmp*ztmp*(1._wp + zx2) ) - 2._wp*ATAN( zx ) + 0.5_wp*rpi 
     415 
     416            ! *** Stable                   [eq.3.22, Chap.3, p.33, IFS doc - Cy31r1] : 
     417            zpsi_stab = -2._wp/3._wp*(zta - zc)*EXP(-0.35_wp*zta) & 
     418               &       - zta - 2._wp/3._wp*zc 
     419            ! 
     420            zstab = 0.5_wp + SIGN(0.5_wp, zta) ! zta > 0 => zstab = 1 
     421            ! 
     422            psi_m_ecmwf(ji,jj) =         zstab  * zpsi_stab &  ! (zta > 0) Stable 
     423               &              + (1._wp - zstab) * zpsi_unst    ! (zta < 0) Unstable 
     424            ! 
    435425      END_2D 
    436426   END FUNCTION psi_m_ecmwf 
    … …  
    452442      ! 
    453443      INTEGER  ::   ji, jj     ! dummy loop indices 
    454       REAL(wp) ::  zzeta, zx, psi_unst, psi_stab, stab 
    455       !!---------------------------------------------------------------------------------- 
     444      REAL(wp) ::  zta, zx2, zpsi_unst, zpsi_stab, zstab, zc 
     445      !!---------------------------------------------------------------------------------- 
     446      zc = 5._wp/0.35_wp 
    456447      ! 
    457448      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    458       ! 
    459       zzeta = MIN(pzeta(ji,jj) , 5._wp)   ! Very stable conditions (L positif and big!): 
    460       ! 
    461       zx  = ABS(1._wp - 16._wp*zzeta)**.25        ! this is actually (1/phi_m)**2  !!! 
    462       !                                     ! eq.3.19, Chap.3, p.33, IFS doc - Cy31r1 
    463       ! Unstable (Paulson 1970) : 
    464       psi_unst = 2._wp*LOG(0.5_wp*(1._wp + zx*zx))   ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
    465       ! 
    466       ! Stable: 
    467       psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 
    468          &       - ABS(1._wp + 2._wp/3._wp*zzeta)**1.5_wp - 2._wp/3._wp*5._wp/0.35_wp + 1._wp 
    469       ! LB: added ABS() to avoid NaN values when unstable, which contaminates the unstable solution... 
    470       ! 
    471       stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 
    472       ! 
    473       ! 
    474       psi_h_ecmwf(ji,jj) = (1._wp - stab) * psi_unst &   ! (zzeta < 0) Unstable 
    475          &                +    stab    * psi_stab        ! (zzeta > 0) Stable 
    476       ! 
     449            ! 
     450            zta = MIN(pzeta(ji,jj) , 5._wp)   ! Very stable conditions (L positif and big!): 
     451            ! 
     452            ! *** Unstable (Paulson 1970)   [eq.3.20, Chap.3, p.33, IFS doc - Cy31r1] : 
     453            zx2 = SQRT( ABS(1._wp - 16._wp*zta) )  ! (1 -16z)^0.5 
     454            zpsi_unst = 2._wp*LOG( 0.5_wp*(1._wp + zx2) ) 
     455            ! 
     456            ! *** Stable [eq.3.22, Chap.3, p.33, IFS doc - Cy31r1] : 
     457            zpsi_stab = -2._wp/3._wp*(zta - zc)*EXP(-0.35_wp*zta) & 
     458               &       - ABS(1._wp + 2._wp/3._wp*zta)**1.5_wp - 2._wp/3._wp*zc + 1._wp 
     459            ! 
     460            ! LB: added ABS() to avoid NaN values when unstable, which contaminates the unstable solution... 
     461            ! 
     462            zstab = 0.5_wp + SIGN(0.5_wp, zta) ! zta > 0 => zstab = 1 
     463            ! 
     464            psi_h_ecmwf(ji,jj) =         zstab  * zpsi_stab &  ! (zta > 0) Stable 
     465               &              + (1._wp - zstab) * zpsi_unst    ! (zta < 0) Unstable             
     466            ! 
    477467      END_2D 
    478468   END FUNCTION psi_h_ecmwf 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_ncar.F90

    r13460 r13655  
    55   !!   * bulk transfer coefficients C_D, C_E and C_H 
    66   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed 
    7    !!   * the effective bulk wind speed at 10m U_blk 
     7   !!   * the effective bulk wind speed at 10m Ubzu 
    88   !!   => all these are used in bulk formulas in sbcblk.F90 
    99   !! 
    … …  
    2323   !!                   returns the effective bulk wind speed at 10m 
    2424   !!---------------------------------------------------------------------- 
    25    USE oce             ! ocean dynamics and tracers 
    2625   USE dom_oce         ! ocean space and time domain 
     26   USE sbc_oce, ONLY: ln_cdgw 
     27   USE sbcwave, ONLY: cdn_wave ! wave module 
    2728   USE phycst          ! physical constants 
    28    USE sbc_oce         ! Surface boundary condition: ocean fields 
    29    USE sbcwave, ONLY   :  cdn_wave ! wave module 
    30 #if defined key_si3 || defined key_cice 
    31    USE sbc_ice         ! Surface boundary condition: ice fields 
    32 #endif 
    33    ! 
    34    USE iom             ! I/O manager library 
    35    USE lib_mpp         ! distribued memory computing library 
    36    USE in_out_manager  ! I/O manager 
    37    USE prtctl          ! Print control 
    38    USE lib_fortran     ! to use key_nosignedzero 
    39  
    40    USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB 
     29   USE sbc_phy         ! all thermodynamics functions, rho_air, q_sat, etc... !LB 
    4130 
    4231   IMPLICIT NONE 
    … …  
    4534   PUBLIC :: TURB_NCAR   ! called by sbcblk.F90 
    4635 
    47    INTEGER , PARAMETER ::   nb_itt = 5        ! number of itterations 
    4836   !! * Substitutions 
    4937#  include "do_loop_substitute.h90" 
    … …  
    5240CONTAINS 
    5341 
    54    SUBROUTINE turb_ncar( zt, zu, sst, t_zt, ssq, q_zt, U_zu, & 
    55       &                  Cd, Ch, Ce, t_zu, q_zu, U_blk,      & 
    56       &                  Cdn, Chn, Cen                       ) 
     42   SUBROUTINE turb_ncar(    zt, zu, sst, t_zt, ssq, q_zt, U_zu, & 
     43      &                     Cd, Ch, Ce, t_zu, q_zu, Ubzu,       & 
     44      &                     nb_iter, CdN, ChN, CeN               ) 
    5745      !!---------------------------------------------------------------------------------- 
    5846      !!                      ***  ROUTINE  turb_ncar  *** 
    … …  
    6149      !!                fluxes according to Large & Yeager (2004) and Large & Yeager (2008) 
    6250      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu 
    63       !!                Returns the effective bulk wind speed at 10m to be used in the bulk formulas 
    64       !! 
     51      !!                Returns the effective bulk wind speed at zu to be used in the bulk formulas 
    6552      !! 
    6653      !! INPUT : 
    … …  
    8269      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K] 
    8370      !!    *  q_zu   : specific humidity of air        //                    [kg/kg] 
    84       !!    *  U_blk  : bulk wind speed at zu                                 [m/s] 
    85       !! 
     71      !!    *  Ubzu   : bulk wind speed at zu                                 [m/s] 
     72      !! 
     73      !! OPTIONAL OUTPUT: 
     74      !! ---------------- 
     75      !!    * CdN      : neutral-stability drag coefficient 
     76      !!    * ChN      : neutral-stability sensible heat coefficient 
     77      !!    * CeN      : neutral-stability evaporation coefficient 
    8678      !! 
    8779      !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    … …  
    9991      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K] 
    10092      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg] 
    101       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s] 
    102       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients 
    103       ! 
    104       INTEGER :: j_itt 
     93      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ubzu    ! bulk wind speed at zu                     [m/s] 
     94      ! 
     95      INTEGER , INTENT(in   ), OPTIONAL                     :: nb_iter  ! number of iterations 
     96      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   CdN 
     97      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   ChN 
     98      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   CeN 
     99      ! 
     100      INTEGER :: nbit, jit                    ! iterations... 
    105101      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    106102      ! 
    107       REAL(wp), DIMENSION(jpi,jpj) ::   Cx_n10        ! 10m neutral latent/sensible coefficient 
    108       REAL(wp), DIMENSION(jpi,jpj) ::   sqrt_Cd_n10   ! root square of Cd_n10 
     103      REAL(wp), DIMENSION(jpi,jpj) ::   zCdN, zCeN, zChN        ! 10m neutral latent/sensible coefficient 
     104      REAL(wp), DIMENSION(jpi,jpj) ::   zsqrt_Cd, zsqrt_CdN   ! root square of Cd and Cd_neutral 
    109105      REAL(wp), DIMENSION(jpi,jpj) ::   zeta_u        ! stability parameter at height zu 
    110       REAL(wp), DIMENSION(jpi,jpj) ::   zpsi_h_u 
    111106      REAL(wp), DIMENSION(jpi,jpj) ::   ztmp0, ztmp1, ztmp2 
    112       REAL(wp), DIMENSION(jpi,jpj) ::   stab          ! stability test integer 
    113       !!---------------------------------------------------------------------------------- 
     107      !!---------------------------------------------------------------------------------- 
     108      nbit = nb_iter0 
     109      IF( PRESENT(nb_iter) ) nbit = nb_iter 
     110 
    114111      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    115112 
    116       U_blk = MAX( 0.5_wp , U_zu )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s 
     113      Ubzu = MAX( 0.5_wp , U_zu )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s 
    117114 
    118115      !! First guess of stability: 
    119116      ztmp0 = virt_temp(t_zt, q_zt) - virt_temp(sst, ssq) ! air-sea difference of virtual pot. temp. at zt 
    120       stab  = 0.5_wp + sign(0.5_wp,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable 
     117      ztmp1 = 0.5_wp + SIGN(0.5_wp,ztmp0)                 ! ztmp1 = 1 if dTv > 0  => STABLE, 0 if unstable 
    121118 
    122119      !! Neutral coefficients at 10m: 
    123120      IF( ln_cdgw ) THEN      ! wave drag case 
    124121         cdn_wave(:,:) = cdn_wave(:,:) + rsmall * ( 1._wp - tmask(:,:,1) ) 
    125          ztmp0   (:,:) = cdn_wave(:,:) 
     122         zCdN   (:,:) = cdn_wave(:,:) 
    126123      ELSE 
    127       ztmp0 = cd_neutral_10m( U_blk ) 
     124      zCdN = cd_n10_ncar( Ubzu ) 
    128125      ENDIF 
    129126 
    130       sqrt_Cd_n10 = SQRT( ztmp0 ) 
     127      zsqrt_CdN = SQRT( zCdN ) 
    131128 
    132129      !! Initializing transf. coeff. with their first guess neutral equivalents : 
    133       Cd = ztmp0 
    134       Ce = 1.e-3_wp*( 34.6_wp * sqrt_Cd_n10 ) 
    135       Ch = 1.e-3_wp*sqrt_Cd_n10*(18._wp*stab + 32.7_wp*(1._wp - stab)) 
    136       stab = sqrt_Cd_n10   ! Temporaty array !!! stab == SQRT(Cd) 
    137   
     130      Cd = zCdN 
     131      Ce = ce_n10_ncar( zsqrt_CdN ) 
     132      Ch = ch_n10_ncar( zsqrt_CdN , ztmp1 )   ! ztmp1 is stability (1/0) 
     133      zsqrt_Cd = zsqrt_CdN 
     134 
    138135      IF( ln_cdgw ) THEN 
    139    Cen = Ce 
    140    Chn = Ch 
     136         zCeN = Ce 
     137         zChN = Ch 
    141138      ENDIF 
    142139 
    143       !! First guess of temperature and humidity at height zu: 
     140      !! Initializing values at z_u with z_t values: 
    144141      t_zu = MAX( t_zt ,  180._wp )   ! who knows what's given on masked-continental regions... 
    145142      q_zu = MAX( q_zt , 1.e-6_wp )   !               " 
    146143 
     144 
    147145      !! ITERATION BLOCK 
    148       DO j_itt = 1, nb_itt 
     146      DO jit = 1, nbit 
    149147         ! 
    150148         ztmp1 = t_zu - sst   ! Updating air/sea differences 
    151149         ztmp2 = q_zu - ssq 
    152150 
    153          ! Updating turbulent scales :   (L&Y 2004 eq. (7)) 
    154          ztmp0 = stab*U_blk       ! u*       (stab == SQRT(Cd)) 
    155          ztmp1 = Ch/stab*ztmp1    ! theta*   (stab == SQRT(Cd)) 
    156          ztmp2 = Ce/stab*ztmp2    ! q*       (stab == SQRT(Cd)) 
    157  
    158          ! Estimate the inverse of Monin-Obukov length (1/L) at height zu: 
     151         ! Updating turbulent scales :   (L&Y 2004 Eq. (7)) 
     152         ztmp0 = zsqrt_Cd*Ubzu       ! u* 
     153         ztmp1 = Ch/zsqrt_Cd*ztmp1    ! theta* 
     154         ztmp2 = Ce/zsqrt_Cd*ztmp2    ! q* 
     155 
     156         ! Estimate the inverse of Obukov length (1/L) at height zu: 
    159157         ztmp0 = One_on_L( t_zu, q_zu, ztmp0, ztmp1, ztmp2 ) 
    160           
     158 
    161159         !! Stability parameters : 
    162160         zeta_u   = zu*ztmp0 
    163          zeta_u = sign( min(abs(zeta_u),10._wp), zeta_u ) 
    164          zpsi_h_u = psi_h( zeta_u ) 
    165  
    166          !! Shifting temperature and humidity at zu (L&Y 2004 eq. (9b-9c)) 
     161         zeta_u   = sign( min(abs(zeta_u),10._wp), zeta_u ) 
     162 
     163         !! Shifting temperature and humidity at zu (L&Y 2004 Eq. (9b-9c)) 
    167164         IF( .NOT. l_zt_equal_zu ) THEN 
    168             !! Array 'stab' is free for the moment so using it to store 'zeta_t' 
    169             stab = zt*ztmp0 
    170             stab = SIGN( MIN(ABS(stab),10._wp), stab )  ! Temporaty array stab == zeta_t !!! 
    171             stab = LOG(zt/zu) + zpsi_h_u - psi_h(stab)                   ! stab just used as temp array again! 
    172             t_zu = t_zt - ztmp1/vkarmn*stab    ! ztmp1 is still theta*  L&Y 2004 eq.(9b) 
    173             q_zu = q_zt - ztmp2/vkarmn*stab    ! ztmp2 is still q*      L&Y 2004 eq.(9c) 
    174             q_zu = max(0._wp, q_zu) 
    175          ENDIF 
    176  
    177          ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)... 
     165            ztmp0 = zt*ztmp0 ! zeta_t ! 
     166            ztmp0 = SIGN( MIN(ABS(ztmp0),10._wp), ztmp0 )  ! Temporaty array ztmp0 == zeta_t !!! 
     167            ztmp0 = LOG(zt/zu) + psi_h_ncar(zeta_u) - psi_h_ncar(ztmp0)                   ! ztmp0 just used as temp array again! 
     168            t_zu = t_zt - ztmp1/vkarmn*ztmp0    ! ztmp1 is still theta*  L&Y 2004 Eq. (9b) 
     169            !! 
     170            q_zu = q_zt - ztmp2/vkarmn*ztmp0    ! ztmp2 is still q*      L&Y 2004 Eq. (9c) 
     171            q_zu = MAX(0._wp, q_zu) 
     172         END IF 
     173 
     174         ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 Eq. 9a)... 
    178175         !   In very rare low-wind conditions, the old way of estimating the 
    179176         !   neutral wind speed at 10m leads to a negative value that causes the code 
    180177         !   to crash. To prevent this a threshold of 0.25m/s is imposed. 
    181          ztmp2 = psi_m(zeta_u) 
     178         ztmp2 = psi_m_ncar(zeta_u) 
    182179         IF( ln_cdgw ) THEN      ! surface wave case 
    183             stab = vkarmn / ( vkarmn / sqrt_Cd_n10 - ztmp2 )  ! (stab == SQRT(Cd)) 
    184             Cd   = stab * stab 
    185             ztmp0 = (LOG(zu/10._wp) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 
    186             ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd)) 
    187             ztmp1 = 1._wp + Chn * ztmp0      
    188             Ch    = Chn * ztmp2 / ztmp1  ! L&Y 2004 eq. (10b) 
    189             ztmp1 = 1._wp + Cen * ztmp0 
    190             Ce    = Cen * ztmp2 / ztmp1  ! L&Y 2004 eq. (10c) 
     180            zsqrt_Cd = vkarmn / ( vkarmn / zsqrt_CdN - ztmp2 ) 
     181            Cd   = zsqrt_Cd * zsqrt_Cd 
     182            ztmp0 = (LOG(zu/10._wp) - psi_h_ncar(zeta_u)) / vkarmn / zsqrt_CdN 
     183            ztmp2 = zsqrt_Cd / zsqrt_CdN 
     184            ztmp1 = 1._wp + zChN * ztmp0 
     185            Ch    = zChN * ztmp2 / ztmp1  ! L&Y 2004 eq. (10b) 
     186            ztmp1 = 1._wp + zCeN * ztmp0 
     187            Ce    = zCeN * ztmp2 / ztmp1  ! L&Y 2004 eq. (10c) 
    191188 
    192189         ELSE 
    193          ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)... 
    194          !   In very rare low-wind conditions, the old way of estimating the 
    195          !   neutral wind speed at 10m leads to a negative value that causes the code 
    196          !   to crash. To prevent this a threshold of 0.25m/s is imposed. 
    197          ztmp0 = MAX( 0.25_wp , U_blk/(1._wp + sqrt_Cd_n10/vkarmn*(LOG(zu/10._wp) - ztmp2)) ) ! U_n10 (ztmp2 == psi_m(zeta_u)) 
    198          ztmp0 = cd_neutral_10m(ztmp0)                                               ! Cd_n10 
    199          Cdn(:,:) = ztmp0 
    200          sqrt_Cd_n10 = sqrt(ztmp0) 
    201  
    202          stab    = 0.5_wp + sign(0.5_wp,zeta_u)                        ! update stability 
    203          Cx_n10  = 1.e-3_wp*sqrt_Cd_n10*(18._wp*stab + 32.7_wp*(1._wp - stab))  ! L&Y 2004 eq. (6c-6d)    (Cx_n10 == Ch_n10) 
    204          Chn(:,:) = Cx_n10 
     190         ztmp0 = MAX( 0.25_wp , UN10_from_CD(zu, Ubzu, Cd, ppsi=ztmp2) ) ! U_n10 (ztmp2 == psi_m_ncar(zeta_u)) 
     191 
     192         zCdN = cd_n10_ncar(ztmp0) 
     193         zsqrt_CdN = sqrt(zCdN) 
    205194 
    206195         !! Update of transfer coefficients: 
    207          ztmp1 = 1._wp + sqrt_Cd_n10/vkarmn*(LOG(zu/10._wp) - ztmp2)   ! L&Y 2004 eq. (10a) (ztmp2 == psi_m(zeta_u)) 
    208          Cd      = ztmp0 / ( ztmp1*ztmp1 ) 
    209          stab = SQRT( Cd ) ! Temporary array !!! (stab == SQRT(Cd)) 
    210  
    211          ztmp0 = (LOG(zu/10._wp) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 
    212          ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd)) 
    213          ztmp1 = 1._wp + Cx_n10*ztmp0    ! (Cx_n10 == Ch_n10) 
    214          Ch  = Cx_n10*ztmp2 / ztmp1   ! L&Y 2004 eq. (10b) 
    215  
    216          Cx_n10  = 1.e-3_wp * (34.6_wp * sqrt_Cd_n10)  ! L&Y 2004 eq. (6b)    ! Cx_n10 == Ce_n10 
    217          Cen(:,:) = Cx_n10 
    218          ztmp1 = 1._wp + Cx_n10*ztmp0 
    219          Ce  = Cx_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c) 
     196 
     197         !! C_D 
     198         ztmp1  = 1._wp + zsqrt_CdN/vkarmn*(LOG(zu/10._wp) - ztmp2)   ! L&Y 2004 Eq. (10a) (ztmp2 == psi_m(zeta_u)) 
     199         Cd     = MAX( zCdN / ( ztmp1*ztmp1 ), Cx_min ) 
     200 
     201         !! C_H and C_E 
     202         zsqrt_Cd = SQRT( Cd ) 
     203         ztmp0 = ( LOG(zu/10._wp) - psi_h_ncar(zeta_u) ) / vkarmn / zsqrt_CdN 
     204         ztmp2 = zsqrt_Cd / zsqrt_CdN 
     205 
     206         ztmp1 = 0.5_wp + SIGN(0.5_wp,zeta_u)                                ! update stability 
     207         zChN  = 1.e-3_wp * zsqrt_CdN*(18._wp*ztmp1 + 32.7_wp*(1._wp - ztmp1))  ! L&Y 2004 eq. (6c-6d) 
     208         zCeN  = 1.e-3_wp * (34.6_wp * zsqrt_CdN)                             ! L&Y 2004 eq. (6b) 
     209 
     210         Ch    = MAX( zChN*ztmp2 / ( 1._wp + zChN*ztmp0 ) , Cx_min ) ! L&Y 2004 eq. (10b) 
     211         Ce    = MAX( zCeN*ztmp2 / ( 1._wp + zCeN*ztmp0 ) , Cx_min ) ! L&Y 2004 eq. (10c) 
     212 
    220213         ENDIF 
    221  
    222       END DO !DO j_itt = 1, nb_itt 
     214          
     215      END DO !DO jit = 1, nbit 
     216       
     217      IF(PRESENT(CdN)) CdN(:,:) = zCdN(:,:) 
     218      IF(PRESENT(CeN)) CeN(:,:) = zCeN(:,:) 
     219      IF(PRESENT(ChN)) ChN(:,:) = zChN(:,:) 
    223220 
    224221   END SUBROUTINE turb_ncar 
    225222 
    226223 
    227    FUNCTION cd_neutral_10m( pw10 ) 
    228       !!----------------------------------------------------------------------------------       
     224   FUNCTION cd_n10_ncar( pw10 ) 
     225      !!---------------------------------------------------------------------------------- 
    229226      !! Estimate of the neutral drag coefficient at 10m as a function 
    230227      !! of neutral wind  speed at 10m 
    231228      !! 
    232       !! Origin: Large & Yeager 2008 eq.(11a) and eq.(11b) 
     229      !! Origin: Large & Yeager 2008, Eq. (11) 
    233230      !! 
    234231      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    235232      !!---------------------------------------------------------------------------------- 
    236233      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pw10           ! scalar wind speed at 10m (m/s) 
    237       REAL(wp), DIMENSION(jpi,jpj)             :: cd_neutral_10m 
     234      REAL(wp), DIMENSION(jpi,jpj)             :: cd_n10_ncar 
    238235      ! 
    239236      INTEGER  ::     ji, jj     ! dummy loop indices 
    … …  
    242239      ! 
    243240      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    244          ! 
    245          zw  = pw10(ji,jj) 
    246          zw6 = zw*zw*zw 
    247          zw6 = zw6*zw6 
    248          ! 
    249          ! When wind speed > 33 m/s => Cyclone conditions => special treatment 
    250          zgt33 = 0.5_wp + SIGN( 0.5_wp, (zw - 33._wp) )   ! If pw10 < 33. => 0, else => 1 
    251          ! 
    252          cd_neutral_10m(ji,jj) = 1.e-3_wp * ( & 
    253             &       (1._wp - zgt33)*( 2.7_wp/zw + 0.142_wp + zw/13.09_wp - 3.14807E-10_wp*zw6) & ! wind <  33 m/s 
    254             &      +    zgt33   *      2.34_wp )                                                 ! wind >= 33 m/s 
    255          ! 
    256          cd_neutral_10m(ji,jj) = MAX(cd_neutral_10m(ji,jj), 1.E-6_wp) 
    257          ! 
     241            ! 
     242            zw  = pw10(ji,jj) 
     243            zw6 = zw*zw*zw 
     244            zw6 = zw6*zw6 
     245            ! 
     246            ! When wind speed > 33 m/s => Cyclone conditions => special treatment 
     247            zgt33 = 0.5_wp + SIGN( 0.5_wp, (zw - 33._wp) )   ! If pw10 < 33. => 0, else => 1 
     248            ! 
     249            cd_n10_ncar(ji,jj) = 1.e-3_wp * ( & 
     250               &       (1._wp - zgt33)*( 2.7_wp/zw + 0.142_wp + zw/13.09_wp - 3.14807E-10_wp*zw6) & ! wind <  33 m/s 
     251               &      +    zgt33   *      2.34_wp )                                                 ! wind >= 33 m/s 
     252            ! 
     253            cd_n10_ncar(ji,jj) = MAX( cd_n10_ncar(ji,jj), Cx_min ) 
     254            ! 
    258255      END_2D 
    259256      ! 
    260    END FUNCTION cd_neutral_10m 
    261  
    262  
    263    FUNCTION psi_m( pzeta ) 
     257   END FUNCTION cd_n10_ncar 
     258 
     259 
     260   FUNCTION ch_n10_ncar( psqrtcdn10 , pstab ) 
     261      !!---------------------------------------------------------------------------------- 
     262      !! Estimate of the neutral heat transfer coefficient at 10m      !! 
     263      !! Origin: Large & Yeager 2008, Eq. (9) and (12) 
     264 
     265      !!---------------------------------------------------------------------------------- 
     266      REAL(wp), DIMENSION(jpi,jpj)             :: ch_n10_ncar 
     267      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psqrtcdn10 ! sqrt( CdN10 ) 
     268      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pstab      ! stable ABL => 1 / unstable ABL => 0 
     269      !!---------------------------------------------------------------------------------- 
     270      IF( ANY(pstab < -0.00001) .OR. ANY(pstab >  1.00001) ) THEN 
     271         PRINT *, 'ERROR: ch_n10_ncar@mod_blk_ncar.f90: pstab =' 
     272         PRINT *, pstab 
     273         STOP 
     274      END IF 
     275      ! 
     276      ch_n10_ncar = MAX( 1.e-3_wp * psqrtcdn10*( 18._wp*pstab + 32.7_wp*(1._wp - pstab) )  , Cx_min )   ! Eq. (9) & (12) Large & Yeager, 2008 
     277      ! 
     278   END FUNCTION ch_n10_ncar 
     279 
     280   FUNCTION ce_n10_ncar( psqrtcdn10 ) 
     281      !!---------------------------------------------------------------------------------- 
     282      !! Estimate of the neutral heat transfer coefficient at 10m      !! 
     283      !! Origin: Large & Yeager 2008, Eq. (9) and (13) 
     284      !!---------------------------------------------------------------------------------- 
     285      REAL(wp), DIMENSION(jpi,jpj)             :: ce_n10_ncar 
     286      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psqrtcdn10 ! sqrt( CdN10 ) 
     287      !!---------------------------------------------------------------------------------- 
     288      ce_n10_ncar = MAX( 1.e-3_wp * ( 34.6_wp * psqrtcdn10 ) , Cx_min ) 
     289      ! 
     290   END FUNCTION ce_n10_ncar 
     291 
     292 
     293   FUNCTION psi_m_ncar( pzeta ) 
    264294      !!---------------------------------------------------------------------------------- 
    265295      !! Universal profile stability function for momentum 
    266       !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e) 
     296      !!    !! Psis, L&Y 2004, Eq. (8c), (8d), (8e) 
    267297      !! 
    268298      !! pzeta : stability paramenter, z/L where z is altitude measurement 
    … …  
    271301      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    272302      !!---------------------------------------------------------------------------------- 
    273       REAL(wp), DIMENSION(jpi,jpj) :: psi_m 
     303      REAL(wp), DIMENSION(jpi,jpj) :: psi_m_ncar 
    274304      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta 
    275305      ! 
    276306      INTEGER  ::   ji, jj    ! dummy loop indices 
    277       REAL(wp) :: zx2, zx, zstab   ! local scalars 
     307      REAL(wp) :: zta, zx2, zx, zpsi_unst, zpsi_stab, zstab   ! local scalars 
    278308      !!---------------------------------------------------------------------------------- 
    279309      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    280          zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) ) 
    281          zx2 = MAX( zx2 , 1._wp ) 
    282          zx  = SQRT( zx2 ) 
    283          zstab = 0.5_wp + SIGN( 0.5_wp , pzeta(ji,jj) ) 
    284          ! 
    285          psi_m(ji,jj) =        zstab  * (-5._wp*pzeta(ji,jj))       &          ! Stable 
    286             &          + (1._wp - zstab) * (2._wp*LOG((1._wp + zx)*0.5_wp)   &          ! Unstable 
    287             &               + LOG((1._wp + zx2)*0.5_wp) - 2._wp*ATAN(zx) + rpi*0.5_wp)  !    " 
    288          ! 
     310            zta = pzeta(ji,jj) 
     311            ! 
     312            zx2 = SQRT( ABS(1._wp - 16._wp*zta) )  ! (1 - 16z)^0.5 
     313            zx2 = MAX( zx2 , 1._wp ) 
     314            zx  = SQRT(zx2)                          ! (1 - 16z)^0.25 
     315            zpsi_unst = 2._wp*LOG( (1._wp + zx )*0.5_wp )   & 
     316               &            + LOG( (1._wp + zx2)*0.5_wp )   & 
     317               &          - 2._wp*ATAN(zx) + rpi*0.5_wp 
     318            ! 
     319            zpsi_stab = -5._wp*zta 
     320            ! 
     321            zstab = 0.5_wp + SIGN(0.5_wp, zta) ! zta > 0 => zstab = 1 
     322            ! 
     323            psi_m_ncar(ji,jj) =          zstab  * zpsi_stab &  ! (zta > 0) Stable 
     324               &              + (1._wp - zstab) * zpsi_unst    ! (zta < 0) Unstable 
     325            ! 
     326            ! 
    289327      END_2D 
    290    END FUNCTION psi_m 
    291  
    292  
    293    FUNCTION psi_h( pzeta ) 
     328   END FUNCTION psi_m_ncar 
     329 
     330 
     331   FUNCTION psi_h_ncar( pzeta ) 
    294332      !!---------------------------------------------------------------------------------- 
    295333      !! Universal profile stability function for temperature and humidity 
    296       !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e) 
     334      !!    !! Psis, L&Y 2004, Eq. (8c), (8d), (8e) 
    297335      !! 
    298336      !! pzeta : stability paramenter, z/L where z is altitude measurement 
    … …  
    301339      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    302340      !!---------------------------------------------------------------------------------- 
    303       REAL(wp), DIMENSION(jpi,jpj) :: psi_h 
     341      REAL(wp), DIMENSION(jpi,jpj) :: psi_h_ncar 
    304342      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta 
    305343      ! 
    306344      INTEGER  ::   ji, jj     ! dummy loop indices 
    307       REAL(wp) :: zx2, zstab  ! local scalars 
     345      REAL(wp) :: zta, zx2, zpsi_unst, zpsi_stab, zstab  ! local scalars 
    308346      !!---------------------------------------------------------------------------------- 
    309347      ! 
    310348      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    311          zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) ) 
    312          zx2 = MAX( zx2 , 1._wp ) 
    313          zstab = 0.5_wp + SIGN( 0.5_wp , pzeta(ji,jj) ) 
    314          ! 
    315          psi_h(ji,jj) =         zstab  * (-5._wp*pzeta(ji,jj))        &  ! Stable 
    316             &           + (1._wp - zstab) * (2._wp*LOG( (1._wp + zx2)*0.5_wp ))   ! Unstable 
    317          ! 
     349            ! 
     350            zta = pzeta(ji,jj) 
     351            ! 
     352            zx2 = SQRT( ABS(1._wp - 16._wp*zta) )  ! (1 -16z)^0.5 
     353            zx2 = MAX( zx2 , 1._wp ) 
     354            zpsi_unst = 2._wp*LOG( 0.5_wp*(1._wp + zx2) ) 
     355            ! 
     356            zpsi_stab = -5._wp*zta 
     357            ! 
     358            zstab = 0.5_wp + SIGN(0.5_wp, zta) ! zta > 0 => zstab = 1 
     359            ! 
     360            psi_h_ncar(ji,jj) =          zstab  * zpsi_stab &  ! (zta > 0) Stable 
     361               &              + (1._wp - zstab) * zpsi_unst    ! (zta < 0) Unstable 
     362            ! 
    318363      END_2D 
    319    END FUNCTION psi_h 
     364   END FUNCTION psi_h_ncar 
    320365 
    321366   !!====================================================================== 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_skin_coare.F90

    r13460 r13655  
    2020   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2121 
    22    USE sbcblk_phy      ! misc. functions for marine ABL physics (rho_air, q_sat, bulk_formula, etc) 
     22   USE sbc_phy         ! misc. functions for marine ABL physics (rho_air, q_sat, bulk_formula, etc) 
    2323 
    2424   USE sbcdcy          !#LB: to know hour of dawn and dusk: rdawn_dcy and rdusk_dcy (needed in WL_COARE) 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_skin_ecmwf.F90

    r13460 r13655  
    3535   USE sbc_oce         ! Surface boundary condition: ocean fields 
    3636 
    37    USE sbcblk_phy      ! misc. functions for marine ABL physics (rho_air, q_sat, bulk_formula, etc) 
     37   USE sbc_phy         ! misc. functions for marine ABL physics (rho_air, q_sat, bulk_formula, etc) 
    3838 
    3939   USE lib_mpp         ! distribued memory computing library 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbccpl.F90

    r13497 r13655  
    3232#endif 
    3333   USE cpl_oasis3     ! OASIS3 coupling 
    34    USE geo2ocean      !  
     34   USE geo2ocean      ! 
    3535   USE oce     , ONLY : ts, uu, vv, ssh, fraqsr_1lev 
    36    USE ocealb         !  
    37    USE eosbn2         !  
     36   USE ocealb         ! 
     37   USE eosbn2         ! 
    3838   USE sbcrnf  , ONLY : l_rnfcpl 
    3939#if defined key_cice 
    … …  
    4949   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    5050 
    51 #if defined key_oasis3  
    52    USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut  
    53 #endif  
     51#if defined key_oasis3 
     52   USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut 
     53#endif 
     54 
     55   USE sbc_phy, ONLY : pp_cldf 
    5456 
    5557   IMPLICIT NONE 
    … …  
    6466 
    6567   INTEGER, PARAMETER ::   jpr_otx1   =  1   ! 3 atmosphere-ocean stress components on grid 1 
    66    INTEGER, PARAMETER ::   jpr_oty1   =  2   !  
    67    INTEGER, PARAMETER ::   jpr_otz1   =  3   !  
     68   INTEGER, PARAMETER ::   jpr_oty1   =  2   ! 
     69   INTEGER, PARAMETER ::   jpr_otz1   =  3   ! 
    6870   INTEGER, PARAMETER ::   jpr_otx2   =  4   ! 3 atmosphere-ocean stress components on grid 2 
    69    INTEGER, PARAMETER ::   jpr_oty2   =  5   !  
    70    INTEGER, PARAMETER ::   jpr_otz2   =  6   !  
     71   INTEGER, PARAMETER ::   jpr_oty2   =  5   ! 
     72   INTEGER, PARAMETER ::   jpr_otz2   =  6   ! 
    7173   INTEGER, PARAMETER ::   jpr_itx1   =  7   ! 3 atmosphere-ice   stress components on grid 1 
    72    INTEGER, PARAMETER ::   jpr_ity1   =  8   !  
    73    INTEGER, PARAMETER ::   jpr_itz1   =  9   !  
     74   INTEGER, PARAMETER ::   jpr_ity1   =  8   ! 
     75   INTEGER, PARAMETER ::   jpr_itz1   =  9   ! 
    7476   INTEGER, PARAMETER ::   jpr_itx2   = 10   ! 3 atmosphere-ice   stress components on grid 2 
    75    INTEGER, PARAMETER ::   jpr_ity2   = 11   !  
    76    INTEGER, PARAMETER ::   jpr_itz2   = 12   !  
     77   INTEGER, PARAMETER ::   jpr_ity2   = 11   ! 
     78   INTEGER, PARAMETER ::   jpr_itz2   = 12   ! 
    7779   INTEGER, PARAMETER ::   jpr_qsroce = 13   ! Qsr above the ocean 
    7880   INTEGER, PARAMETER ::   jpr_qsrice = 14   ! Qsr above the ice 
    79    INTEGER, PARAMETER ::   jpr_qsrmix = 15  
     81   INTEGER, PARAMETER ::   jpr_qsrmix = 15 
    8082   INTEGER, PARAMETER ::   jpr_qnsoce = 16   ! Qns above the ocean 
    8183   INTEGER, PARAMETER ::   jpr_qnsice = 17   ! Qns above the ice 
    … …  
    102104   INTEGER, PARAMETER ::   jpr_ocy1   = 38   ! 
    103105   INTEGER, PARAMETER ::   jpr_ssh    = 39   ! sea surface height 
    104    INTEGER, PARAMETER ::   jpr_fice   = 40   ! ice fraction           
    105    INTEGER, PARAMETER ::   jpr_e3t1st = 41   ! first T level thickness  
     106   INTEGER, PARAMETER ::   jpr_fice   = 40   ! ice fraction 
     107   INTEGER, PARAMETER ::   jpr_e3t1st = 41   ! first T level thickness 
    106108   INTEGER, PARAMETER ::   jpr_fraqsr = 42   ! fraction of solar net radiation absorbed in the first ocean level 
    107    INTEGER, PARAMETER ::   jpr_mslp   = 43   ! mean sea level pressure  
    108    INTEGER, PARAMETER ::   jpr_hsig   = 44   ! Hsig  
    109    INTEGER, PARAMETER ::   jpr_phioc  = 45   ! Wave=>ocean energy flux  
    110    INTEGER, PARAMETER ::   jpr_sdrftx = 46   ! Stokes drift on grid 1  
    111    INTEGER, PARAMETER ::   jpr_sdrfty = 47   ! Stokes drift on grid 2  
     109   INTEGER, PARAMETER ::   jpr_mslp   = 43   ! mean sea level pressure 
     110   INTEGER, PARAMETER ::   jpr_hsig   = 44   ! Hsig 
     111   INTEGER, PARAMETER ::   jpr_phioc  = 45   ! Wave=>ocean energy flux 
     112   INTEGER, PARAMETER ::   jpr_sdrftx = 46   ! Stokes drift on grid 1 
     113   INTEGER, PARAMETER ::   jpr_sdrfty = 47   ! Stokes drift on grid 2 
    112114   INTEGER, PARAMETER ::   jpr_wper   = 48   ! Mean wave period 
    113115   INTEGER, PARAMETER ::   jpr_wnum   = 49   ! Mean wavenumber 
    … …  
    121123   INTEGER, PARAMETER ::   jpr_ts_ice = 57   ! Sea ice surface temp 
    122124 
    123    INTEGER, PARAMETER ::   jprcv      = 57   ! total number of fields received   
     125   INTEGER, PARAMETER ::   jprcv      = 57   ! total number of fields received 
    124126 
    125127   INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere 
    … …  
    145147   INTEGER, PARAMETER ::   jps_sflx   = 21   ! salt flux 
    146148   INTEGER, PARAMETER ::   jps_otx1   = 22   ! 2 atmosphere-ocean stress components on grid 1 
    147    INTEGER, PARAMETER ::   jps_oty1   = 23   !  
     149   INTEGER, PARAMETER ::   jps_oty1   = 23   ! 
    148150   INTEGER, PARAMETER ::   jps_rnf    = 24   ! runoffs 
    149151   INTEGER, PARAMETER ::   jps_taum   = 25   ! wind stress module 
    … …  
    151153   INTEGER, PARAMETER ::   jps_e3t1st = 27   ! first level depth (vvl) 
    152154   INTEGER, PARAMETER ::   jps_fraqsr = 28   ! fraction of solar net radiation absorbed in the first ocean level 
    153    INTEGER, PARAMETER ::   jps_ficet  = 29   ! total ice fraction   
    154    INTEGER, PARAMETER ::   jps_ocxw   = 30   ! currents on grid 1   
     155   INTEGER, PARAMETER ::   jps_ficet  = 29   ! total ice fraction 
     156   INTEGER, PARAMETER ::   jps_ocxw   = 30   ! currents on grid 1 
    155157   INTEGER, PARAMETER ::   jps_ocyw   = 31   ! currents on grid 2 
    156    INTEGER, PARAMETER ::   jps_wlev   = 32   ! water level  
     158   INTEGER, PARAMETER ::   jps_wlev   = 32   ! water level 
    157159   INTEGER, PARAMETER ::   jps_fice1  = 33   ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes) 
    158160   INTEGER, PARAMETER ::   jps_a_p    = 34   ! meltpond area fraction 
    … …  
    162164   INTEGER, PARAMETER ::   jps_ttilyr = 38   ! sea ice top layer temp 
    163165 
    164    INTEGER, PARAMETER ::   jpsnd      = 38   ! total number of fields sent  
    165  
    166 #if ! defined key_oasis3  
    167    ! Dummy variables to enable compilation when oasis3 is not being used  
    168    INTEGER                    ::   OASIS_Sent        = -1  
    169    INTEGER                    ::   OASIS_SentOut     = -1  
    170    INTEGER                    ::   OASIS_ToRest      = -1  
    171    INTEGER                    ::   OASIS_ToRestOut   = -1  
    172 #endif  
     166   INTEGER, PARAMETER ::   jpsnd      = 38   ! total number of fields sent 
     167 
     168#if ! defined key_oasis3 
     169   ! Dummy variables to enable compilation when oasis3 is not being used 
     170   INTEGER                    ::   OASIS_Sent        = -1 
     171   INTEGER                    ::   OASIS_SentOut     = -1 
     172   INTEGER                    ::   OASIS_ToRest      = -1 
     173   INTEGER                    ::   OASIS_ToRestOut   = -1 
     174#endif 
    173175 
    174176   !                                  !!** namelist namsbc_cpl ** 
    175    TYPE ::   FLD_C                     !    
     177   TYPE ::   FLD_C                     ! 
    176178      CHARACTER(len = 32) ::   cldes      ! desciption of the coupling strategy 
    177179      CHARACTER(len = 32) ::   clcat      ! multiple ice categories strategy 
    … …  
    180182      CHARACTER(len = 32) ::   clvgrd     ! grids on which is located the vector fields 
    181183   END TYPE FLD_C 
    182    !                                   ! Send to the atmosphere   
     184   !                                   ! Send to the atmosphere 
    183185   TYPE(FLD_C) ::   sn_snd_temp  , sn_snd_alb , sn_snd_thick, sn_snd_crt   , sn_snd_co2,  & 
    184186      &             sn_snd_thick1, sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_ttilyr 
    … …  
    187189      &             sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf, sn_rcv_ts_ice 
    188190   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf 
    189    ! Send to waves  
    190    TYPE(FLD_C) ::   sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev  
    191    ! Received from waves  
     191   ! Send to waves 
     192   TYPE(FLD_C) ::   sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev 
     193   ! Received from waves 
    192194   TYPE(FLD_C) ::   sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, sn_rcv_tauwoc, & 
    193195                    sn_rcv_wdrag, sn_rcv_wfreq 
    … …  
    196198   LOGICAL     ::   ln_usecplmask         !  use a coupling mask file to merge data received from several models 
    197199                                          !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    198    LOGICAL     ::   ln_scale_ice_flux     !  use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration)  
    199  
    200    TYPE ::   DYNARR      
    201       REAL(wp), POINTER, DIMENSION(:,:,:) ::   z3    
     200   LOGICAL     ::   ln_scale_ice_flux     !  use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 
     201 
     202   TYPE ::   DYNARR 
     203      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z3 
    202204   END TYPE DYNARR 
    203205 
    … …  
    209211#endif 
    210212 
    211    REAL(wp) ::   rpref = 101000._wp   ! reference atmospheric pressure[N/m2]  
    212    REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rho0)  
     213   REAL(wp) ::   rpref = 101000._wp   ! reference atmospheric pressure[N/m2] 
     214   REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rho0) 
    213215 
    214216   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   nrcvinfo           ! OASIS info argument 
    … …  
    223225   !!---------------------------------------------------------------------- 
    224226CONTAINS 
    225    
     227 
    226228   INTEGER FUNCTION sbc_cpl_alloc() 
    227229      !!---------------------------------------------------------------------- 
    … …  
    233235      ! 
    234236      ALLOCATE( alb_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) ) 
    235        
     237 
    236238#if ! defined key_si3 && ! defined key_cice 
    237239      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 
    … …  
    251253 
    252254 
    253    SUBROUTINE sbc_cpl_init( k_ice )      
     255   SUBROUTINE sbc_cpl_init( k_ice ) 
    254256      !!---------------------------------------------------------------------- 
    255257      !!             ***  ROUTINE sbc_cpl_init  *** 
    … …  
    258260      !!                the atmospheric component 
    259261      !! 
    260       !! ** Method  : * Read namsbc_cpl namelist  
     262      !! ** Method  : * Read namsbc_cpl namelist 
    261263      !!              * define the receive interface 
    262264      !!              * define the send    interface 
    … …  
    270272      !! 
    271273      NAMELIST/namsbc_cpl/  nn_cplmodel  , ln_usecplmask, nn_cats_cpl , ln_scale_ice_flux,             & 
    272          &                  sn_snd_temp  , sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2   ,  &  
    273          &                  sn_snd_ttilyr, sn_snd_cond  , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1,  &  
    274          &                  sn_snd_ifrac , sn_snd_crtw  , sn_snd_wlev , sn_rcv_hsig  , sn_rcv_phioc ,  &  
    275          &                  sn_rcv_w10m  , sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr   ,  &  
     274         &                  sn_snd_temp  , sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2   ,  & 
     275         &                  sn_snd_ttilyr, sn_snd_cond  , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1,  & 
     276         &                  sn_snd_ifrac , sn_snd_crtw  , sn_snd_wlev , sn_rcv_hsig  , sn_rcv_phioc ,  & 
     277         &                  sn_rcv_w10m  , sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr   ,  & 
    276278         &                  sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum  , sn_rcv_tauwoc,  & 
    277279         &                  sn_rcv_wdrag , sn_rcv_qns   , sn_rcv_emp  , sn_rcv_rnf   , sn_rcv_cal   ,  & 
    … …  
    319321         WRITE(numout,*)'      sea ice heat fluxes             = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 
    320322         WRITE(numout,*)'      atm co2                         = ', TRIM(sn_rcv_co2%cldes   ), ' (', TRIM(sn_rcv_co2%clcat   ), ')' 
    321          WRITE(numout,*)'      significant wave heigth         = ', TRIM(sn_rcv_hsig%cldes  ), ' (', TRIM(sn_rcv_hsig%clcat  ), ')'  
    322          WRITE(numout,*)'      wave to oce energy flux         = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')'  
    323          WRITE(numout,*)'      Surface Stokes drift grid u     = ', TRIM(sn_rcv_sdrfx%cldes ), ' (', TRIM(sn_rcv_sdrfx%clcat ), ')'  
    324          WRITE(numout,*)'      Surface Stokes drift grid v     = ', TRIM(sn_rcv_sdrfy%cldes ), ' (', TRIM(sn_rcv_sdrfy%clcat ), ')'  
    325          WRITE(numout,*)'      Mean wave period                = ', TRIM(sn_rcv_wper%cldes  ), ' (', TRIM(sn_rcv_wper%clcat  ), ')'  
    326          WRITE(numout,*)'      Mean wave number                = ', TRIM(sn_rcv_wnum%cldes  ), ' (', TRIM(sn_rcv_wnum%clcat  ), ')'  
     323         WRITE(numout,*)'      significant wave heigth         = ', TRIM(sn_rcv_hsig%cldes  ), ' (', TRIM(sn_rcv_hsig%clcat  ), ')' 
     324         WRITE(numout,*)'      wave to oce energy flux         = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')' 
     325         WRITE(numout,*)'      Surface Stokes drift grid u     = ', TRIM(sn_rcv_sdrfx%cldes ), ' (', TRIM(sn_rcv_sdrfx%clcat ), ')' 
     326         WRITE(numout,*)'      Surface Stokes drift grid v     = ', TRIM(sn_rcv_sdrfy%cldes ), ' (', TRIM(sn_rcv_sdrfy%clcat ), ')' 
     327         WRITE(numout,*)'      Mean wave period                = ', TRIM(sn_rcv_wper%cldes  ), ' (', TRIM(sn_rcv_wper%clcat  ), ')' 
     328         WRITE(numout,*)'      Mean wave number                = ', TRIM(sn_rcv_wnum%cldes  ), ' (', TRIM(sn_rcv_wnum%clcat  ), ')' 
    327329         WRITE(numout,*)'      Wave peak frequency             = ', TRIM(sn_rcv_wfreq%cldes ), ' (', TRIM(sn_rcv_wfreq%clcat ), ')' 
    328          WRITE(numout,*)'      Stress frac adsorbed by waves   = ', TRIM(sn_rcv_tauwoc%cldes), ' (', TRIM(sn_rcv_tauwoc%clcat ), ')'  
     330         WRITE(numout,*)'      Stress frac adsorbed by waves   = ', TRIM(sn_rcv_tauwoc%cldes), ' (', TRIM(sn_rcv_tauwoc%clcat ), ')' 
    329331         WRITE(numout,*)'      Stress components by waves      = ', TRIM(sn_rcv_tauw%cldes  ), ' (', TRIM(sn_rcv_tauw%clcat  ), ')' 
    330          WRITE(numout,*)'      Neutral surf drag coefficient   = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')'  
    331          WRITE(numout,*)'      Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')'  
     332         WRITE(numout,*)'      Neutral surf drag coefficient   = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')' 
     333         WRITE(numout,*)'      Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')' 
    332334         WRITE(numout,*)'  sent fields (multiple ice categories)' 
    333335         WRITE(numout,*)'      surface temperature             = ', TRIM(sn_snd_temp%cldes  ), ' (', TRIM(sn_snd_temp%clcat  ), ')' 
    … …  
    335337         WRITE(numout,*)'      albedo                          = ', TRIM(sn_snd_alb%cldes   ), ' (', TRIM(sn_snd_alb%clcat   ), ')' 
    336338         WRITE(numout,*)'      ice/snow thickness              = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')' 
    337          WRITE(numout,*)'      total ice fraction              = ', TRIM(sn_snd_ifrac%cldes ), ' (', TRIM(sn_snd_ifrac%clcat ), ')'  
     339         WRITE(numout,*)'      total ice fraction              = ', TRIM(sn_snd_ifrac%cldes ), ' (', TRIM(sn_snd_ifrac%clcat ), ')' 
    338340         WRITE(numout,*)'      surface current                 = ', TRIM(sn_snd_crt%cldes   ), ' (', TRIM(sn_snd_crt%clcat   ), ')' 
    339          WRITE(numout,*)'                      - referential   = ', sn_snd_crt%clvref  
     341         WRITE(numout,*)'                      - referential   = ', sn_snd_crt%clvref 
    340342         WRITE(numout,*)'                      - orientation   = ', sn_snd_crt%clvor 
    341343         WRITE(numout,*)'                      - mesh          = ', sn_snd_crt%clvgrd 
    … …  
    344346         WRITE(numout,*)'      meltponds fraction and depth    = ', TRIM(sn_snd_mpnd%cldes  ), ' (', TRIM(sn_snd_mpnd%clcat  ), ')' 
    345347         WRITE(numout,*)'      sea surface freezing temp       = ', TRIM(sn_snd_sstfrz%cldes), ' (', TRIM(sn_snd_sstfrz%clcat), ')' 
    346          WRITE(numout,*)'      water level                     = ', TRIM(sn_snd_wlev%cldes  ), ' (', TRIM(sn_snd_wlev%clcat  ), ')'  
    347          WRITE(numout,*)'      mean sea level pressure         = ', TRIM(sn_rcv_mslp%cldes  ), ' (', TRIM(sn_rcv_mslp%clcat  ), ')'  
    348          WRITE(numout,*)'      surface current to waves        = ', TRIM(sn_snd_crtw%cldes  ), ' (', TRIM(sn_snd_crtw%clcat  ), ')'  
    349          WRITE(numout,*)'                      - referential   = ', sn_snd_crtw%clvref  
    350          WRITE(numout,*)'                      - orientation   = ', sn_snd_crtw%clvor  
    351          WRITE(numout,*)'                      - mesh          = ', sn_snd_crtw%clvgrd  
     348         WRITE(numout,*)'      water level                     = ', TRIM(sn_snd_wlev%cldes  ), ' (', TRIM(sn_snd_wlev%clcat  ), ')' 
     349         WRITE(numout,*)'      mean sea level pressure         = ', TRIM(sn_rcv_mslp%cldes  ), ' (', TRIM(sn_rcv_mslp%clcat  ), ')' 
     350         WRITE(numout,*)'      surface current to waves        = ', TRIM(sn_snd_crtw%cldes  ), ' (', TRIM(sn_snd_crtw%clcat  ), ')' 
     351         WRITE(numout,*)'                      - referential   = ', sn_snd_crtw%clvref 
     352         WRITE(numout,*)'                      - orientation   = ', sn_snd_crtw%clvor 
     353         WRITE(numout,*)'                      - mesh          = ', sn_snd_crtw%clvgrd 
    352354      ENDIF 
    353355 
    354356      !                                   ! allocate sbccpl arrays 
    355357      IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
    356       
     358 
    357359      ! ================================ ! 
    358360      !   Define the receive interface   ! 
    359361      ! ================================ ! 
    360       nrcvinfo(:) = OASIS_idle   ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress  
     362      nrcvinfo(:) = OASIS_idle   ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress 
    361363 
    362364      ! for each field: define the OASIS name                              (srcv(:)%clname) 
    … …  
    368370 
    369371      !                                                      ! ------------------------- ! 
    370       !                                                      ! ice and ocean wind stress !    
    371       !                                                      ! ------------------------- ! 
    372       !                                                           ! Name  
     372      !                                                      ! ice and ocean wind stress ! 
     373      !                                                      ! ------------------------- ! 
     374      !                                                           ! Name 
    373375      srcv(jpr_otx1)%clname = 'O_OTaux1'      ! 1st ocean component on grid ONE (T or U) 
    374       srcv(jpr_oty1)%clname = 'O_OTauy1'      ! 2nd   -      -         -     -  
    375       srcv(jpr_otz1)%clname = 'O_OTauz1'      ! 3rd   -      -         -     -  
     376      srcv(jpr_oty1)%clname = 'O_OTauy1'      ! 2nd   -      -         -     - 
     377      srcv(jpr_otz1)%clname = 'O_OTauz1'      ! 3rd   -      -         -     - 
    376378      srcv(jpr_otx2)%clname = 'O_OTaux2'      ! 1st ocean component on grid TWO (V) 
    377       srcv(jpr_oty2)%clname = 'O_OTauy2'      ! 2nd   -      -         -     -  
    378       srcv(jpr_otz2)%clname = 'O_OTauz2'      ! 3rd   -      -         -     -  
     379      srcv(jpr_oty2)%clname = 'O_OTauy2'      ! 2nd   -      -         -     - 
     380      srcv(jpr_otz2)%clname = 'O_OTauz2'      ! 3rd   -      -         -     - 
    379381      ! 
    380382      srcv(jpr_itx1)%clname = 'O_ITaux1'      ! 1st  ice  component on grid ONE (T, F, I or U) 
    381       srcv(jpr_ity1)%clname = 'O_ITauy1'      ! 2nd   -      -         -     -  
    382       srcv(jpr_itz1)%clname = 'O_ITauz1'      ! 3rd   -      -         -     -  
     383      srcv(jpr_ity1)%clname = 'O_ITauy1'      ! 2nd   -      -         -     - 
     384      srcv(jpr_itz1)%clname = 'O_ITauz1'      ! 3rd   -      -         -     - 
    383385      srcv(jpr_itx2)%clname = 'O_ITaux2'      ! 1st  ice  component on grid TWO (V) 
    384       srcv(jpr_ity2)%clname = 'O_ITauy2'      ! 2nd   -      -         -     -  
    385       srcv(jpr_itz2)%clname = 'O_ITauz2'      ! 3rd   -      -         -     -  
    386       !  
     386      srcv(jpr_ity2)%clname = 'O_ITauy2'      ! 2nd   -      -         -     - 
     387      srcv(jpr_itz2)%clname = 'O_ITauz2'      ! 3rd   -      -         -     - 
     388      ! 
    387389      ! Vectors: change of sign at north fold ONLY if on the local grid 
    388390      IF(       TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM( sn_rcv_tau%cldes ) == 'oce and ice'  & 
    … …  
    390392      ! 
    391393      IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' )   srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 
    392        
     394 
    393395      !                                                           ! Set grid and action 
    394396      SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) )      !  'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V' 
    395       CASE( 'T' )  
     397      CASE( 'T' ) 
    396398         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point 
    397          srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1  
    398          srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1  
    399       CASE( 'U,V' )  
     399         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 
     400         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 
     401      CASE( 'U,V' ) 
    400402         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point 
    401403         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point 
    … …  
    421423         srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2 
    422424         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only 
    423       CASE( 'T,I' )  
     425      CASE( 'T,I' ) 
    424426         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point 
    425427         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'I'        ! ice components given at I-point 
    426          srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1  
    427          srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1  
    428       CASE( 'T,F' )  
     428         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 
     429         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 
     430      CASE( 'T,F' ) 
    429431         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point 
    430432         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point 
    431          srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1  
    432          srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1  
     433         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 
     434         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 
    433435      CASE( 'T,U,V' ) 
    434436         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'T'        ! oce components given at T-point 
    … …  
    437439         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 only 
    438440         srcv(jpr_itx1:jpr_itz2)%laction = .TRUE.     ! receive ice components on grid 1 & 2 
    439       CASE default    
     441      CASE default 
    440442         CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' ) 
    441443      END SELECT 
    442444      ! 
    443445      IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' )   &           ! spherical: 3rd component not received 
    444          &     srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE.  
     446         &     srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE. 
    445447      ! 
    446448      IF( TRIM( sn_rcv_tau%clvor  ) == 'local grid' ) THEN        ! already on local grid -> no need of the second grid 
    447             srcv(jpr_otx2:jpr_otz2)%laction = .FALSE.  
    448             srcv(jpr_itx2:jpr_itz2)%laction = .FALSE.  
     449            srcv(jpr_otx2:jpr_otz2)%laction = .FALSE. 
     450            srcv(jpr_itx2:jpr_itz2)%laction = .FALSE. 
    449451            srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid   ! not needed but cleaner... 
    450452            srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid   ! not needed but cleaner... 
    … …  
    462464      !                                                      ! ------------------------- ! 
    463465      ! we suppose that atmosphere modele do not make the difference between precipiration (liquide or solid) 
    464       ! over ice of free ocean within the same atmospheric cell.cd  
     466      ! over ice of free ocean within the same atmospheric cell.cd 
    465467      srcv(jpr_rain)%clname = 'OTotRain'      ! Rain = liquid precipitation 
    466468      srcv(jpr_snow)%clname = 'OTotSnow'      ! Snow = solid precipitation 
    467469      srcv(jpr_tevp)%clname = 'OTotEvap'      ! total evaporation (over oce + ice sublimation) 
    468470      srcv(jpr_ievp)%clname = 'OIceEvap'      ! evaporation over ice = sublimation 
    469       srcv(jpr_sbpr)%clname = 'OSubMPre'      ! sublimation - liquid precipitation - solid precipitation  
     471      srcv(jpr_sbpr)%clname = 'OSubMPre'      ! sublimation - liquid precipitation - solid precipitation 
    470472      srcv(jpr_semp)%clname = 'OISubMSn'      ! ice solid water budget = sublimation - solid precipitation 
    471473      srcv(jpr_oemp)%clname = 'OOEvaMPr'      ! ocean water budget = ocean Evap - ocean precip 
    472474      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
    473475      CASE( 'none'          )       ! nothing to do 
    474       CASE( 'oce only'      )   ;   srcv(jpr_oemp)%laction = .TRUE.  
     476      CASE( 'oce only'      )   ;   srcv(jpr_oemp)%laction = .TRUE. 
    475477      CASE( 'conservative'  ) 
    476478         srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 
    … …  
    481483      ! 
    482484      !                                                      ! ------------------------- ! 
    483       !                                                      !     Runoffs & Calving     !    
     485      !                                                      !     Runoffs & Calving     ! 
    484486      !                                                      ! ------------------------- ! 
    485487      srcv(jpr_rnf   )%clname = 'O_Runoff' 
    … …  
    514516      CASE( 'conservative'  )   ;   srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. 
    515517      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE. 
    516       CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qnsmix   )%laction = .TRUE.  
     518      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qnsmix   )%laction = .TRUE. 
    517519      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' ) 
    518520      END SELECT 
    … …  
    531533      CASE( 'conservative'  )   ;   srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. 
    532534      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE. 
    533       CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qsrmix   )%laction = .TRUE.  
     535      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qsrmix   )%laction = .TRUE. 
    534536      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' ) 
    535537      END SELECT 
    … …  
    540542      !                                                      !   non solar sensitivity   !   d(Qns)/d(T) 
    541543      !                                                      ! ------------------------- ! 
    542       srcv(jpr_dqnsdt)%clname = 'O_dQnsdT'    
     544      srcv(jpr_dqnsdt)%clname = 'O_dQnsdT' 
    543545      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' )   srcv(jpr_dqnsdt)%laction = .TRUE. 
    544546      ! 
    … …  
    548550      ! 
    549551      !                                                      ! ------------------------- ! 
    550       !                                                      !      10m wind module      !    
    551       !                                                      ! ------------------------- ! 
    552       srcv(jpr_w10m)%clname = 'O_Wind10'   ;   IF( TRIM(sn_rcv_w10m%cldes  ) == 'coupled' )   srcv(jpr_w10m)%laction = .TRUE.  
    553       ! 
    554       !                                                      ! ------------------------- ! 
    555       !                                                      !   wind stress module      !    
     552      !                                                      !      10m wind module      ! 
     553      !                                                      ! ------------------------- ! 
     554      srcv(jpr_w10m)%clname = 'O_Wind10'   ;   IF( TRIM(sn_rcv_w10m%cldes  ) == 'coupled' )   srcv(jpr_w10m)%laction = .TRUE. 
     555      ! 
     556      !                                                      ! ------------------------- ! 
     557      !                                                      !   wind stress module      ! 
    556558      !                                                      ! ------------------------- ! 
    557559      srcv(jpr_taum)%clname = 'O_TauMod'   ;   IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' )   srcv(jpr_taum)%laction = .TRUE. 
    … …  
    560562      !                                                      !      Atmospheric CO2      ! 
    561563      !                                                      ! ------------------------- ! 
    562       srcv(jpr_co2 )%clname = 'O_AtmCO2'    
     564      srcv(jpr_co2 )%clname = 'O_AtmCO2' 
    563565      IF( TRIM(sn_rcv_co2%cldes   ) == 'coupled' )  THEN 
    564566         srcv(jpr_co2 )%laction = .TRUE. 
    … …  
    569571      ENDIF 
    570572      ! 
    571       !                                                      ! ------------------------- !  
    572       !                                                      ! Mean Sea Level Pressure   !  
    573       !                                                      ! ------------------------- !  
    574       srcv(jpr_mslp)%clname = 'O_MSLP'     ;   IF( TRIM(sn_rcv_mslp%cldes  ) == 'coupled' )    srcv(jpr_mslp)%laction = .TRUE.  
    575       ! 
    576       !                                                      ! ------------------------- ! 
    577       !                                                      !  ice topmelt and botmelt  !    
     573      !                                                      ! ------------------------- ! 
     574      !                                                      ! Mean Sea Level Pressure   ! 
     575      !                                                      ! ------------------------- ! 
     576      srcv(jpr_mslp)%clname = 'O_MSLP'     ;   IF( TRIM(sn_rcv_mslp%cldes  ) == 'coupled' )    srcv(jpr_mslp)%laction = .TRUE. 
     577      ! 
     578      !                                                      ! ------------------------- ! 
     579      !                                                      !  ice topmelt and botmelt  ! 
    578580      !                                                      ! ------------------------- ! 
    579581      srcv(jpr_topm )%clname = 'OTopMlt' 
    … …  
    588590      ENDIF 
    589591      !                                                      ! ------------------------- ! 
    590       !                                                      !    ice skin temperature   !    
     592      !                                                      !    ice skin temperature   ! 
    591593      !                                                      ! ------------------------- ! 
    592594      srcv(jpr_ts_ice)%clname = 'OTsfIce'    ! needed by Met Office 
    … …  
    596598 
    597599#if defined key_si3 
    598       IF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN  
     600      IF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN 
    599601         IF( .NOT.srcv(jpr_ts_ice)%laction )  & 
    600             &   CALL ctl_stop( 'sbc_cpl_init: srcv(jpr_ts_ice)%laction should be set to true when ln_cndflx=T' )      
     602            &   CALL ctl_stop( 'sbc_cpl_init: srcv(jpr_ts_ice)%laction should be set to true when ln_cndflx=T' ) 
    601603      ENDIF 
    602604#endif 
    603605      !                                                      ! ------------------------- ! 
    604       !                                                      !      Wave breaking        !     
    605       !                                                      ! ------------------------- !  
     606      !                                                      !      Wave breaking        ! 
     607      !                                                      ! ------------------------- ! 
    606608      srcv(jpr_hsig)%clname  = 'O_Hsigwa'    ! significant wave height 
    607609      IF( TRIM(sn_rcv_hsig%cldes  ) == 'coupled' )  THEN 
    … …  
    629631         cpl_wper = .TRUE. 
    630632      ENDIF 
    631       srcv(jpr_wfreq)%clname = 'O_WFreq'     ! wave peak frequency  
     633      srcv(jpr_wfreq)%clname = 'O_WFreq'     ! wave peak frequency 
    632634      IF( TRIM(sn_rcv_wfreq%cldes ) == 'coupled' )  THEN 
    633635         srcv(jpr_wfreq)%laction = .TRUE. 
    … …  
    661663      ! 
    662664      !                                                      ! ------------------------------- ! 
    663       !                                                      !   OPA-SAS coupling - rcv by opa !    
     665      !                                                      !   OPA-SAS coupling - rcv by opa ! 
    664666      !                                                      ! ------------------------------- ! 
    665667      srcv(jpr_sflx)%clname = 'O_SFLX' 
    … …  
    697699      ENDIF 
    698700      !                                                      ! -------------------------------- ! 
    699       !                                                      !   OPA-SAS coupling - rcv by sas  !    
     701      !                                                      !   OPA-SAS coupling - rcv by sas  ! 
    700702      !                                                      ! -------------------------------- ! 
    701703      srcv(jpr_toce  )%clname = 'I_SSTSST' 
    … …  
    704706      srcv(jpr_ocy1  )%clname = 'I_OCury1' 
    705707      srcv(jpr_ssh   )%clname = 'I_SSHght' 
    706       srcv(jpr_e3t1st)%clname = 'I_E3T1st'    
    707       srcv(jpr_fraqsr)%clname = 'I_FraQsr'    
     708      srcv(jpr_e3t1st)%clname = 'I_E3T1st' 
     709      srcv(jpr_fraqsr)%clname = 'I_FraQsr' 
    708710      ! 
    709711      IF( nn_components == jp_iam_sas ) THEN 
    … …  
    735737            ENDIF 
    736738            WRITE(numout,*)'               sea surface temperature (Celsius) ' 
    737             WRITE(numout,*)'               sea surface salinity '  
    738             WRITE(numout,*)'               surface currents '  
    739             WRITE(numout,*)'               sea surface height '  
    740             WRITE(numout,*)'               thickness of first ocean T level '         
     739            WRITE(numout,*)'               sea surface salinity ' 
     740            WRITE(numout,*)'               surface currents ' 
     741            WRITE(numout,*)'               sea surface height ' 
     742            WRITE(numout,*)'               thickness of first ocean T level ' 
    741743            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level' 
    742744            WRITE(numout,*) 
    743745         ENDIF 
    744746      ENDIF 
    745        
     747 
    746748      ! =================================================== ! 
    747749      ! Allocate all parts of frcv used for received fields ! 
    … …  
    769771      !                 define send or not from the namelist parameters (ssnd(:)%laction) 
    770772      !                 define the north fold type of lbc               (ssnd(:)%nsgn) 
    771        
     773 
    772774      ! default definitions of nsnd 
    773775      ssnd(:)%laction = .FALSE.   ;   ssnd(:)%clgrid = 'T'   ;   ssnd(:)%nsgn = 1.  ; ssnd(:)%nct = 1 
    774           
     776 
    775777      !                                                      ! ------------------------- ! 
    776778      !                                                      !    Surface temperature    ! 
    … …  
    789791      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 
    790792      END SELECT 
    791             
     793 
    792794      !                                                      ! ------------------------- ! 
    793795      !                                                      !          Albedo           ! 
    794796      !                                                      ! ------------------------- ! 
    795       ssnd(jps_albice)%clname = 'O_AlbIce'  
     797      ssnd(jps_albice)%clname = 'O_AlbIce' 
    796798      ssnd(jps_albmix)%clname = 'O_AlbMix' 
    797799      SELECT CASE( TRIM( sn_snd_alb%cldes ) ) 
    … …  
    804806      ! Need to calculate oceanic albedo if 
    805807      !     1. sending mixed oce-ice albedo or 
    806       !     2. receiving mixed oce-ice solar radiation  
     808      !     2. receiving mixed oce-ice solar radiation 
    807809      IF( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 
    808810         CALL oce_alb( zaos, zacs ) 
    … …  
    811813      ENDIF 
    812814      !                                                      ! ------------------------- ! 
    813       !                                                      !  Ice fraction & Thickness !  
     815      !                                                      !  Ice fraction & Thickness ! 
    814816      !                                                      ! ------------------------- ! 
    815817      ssnd(jps_fice)%clname  = 'OIceFrc' 
    816       ssnd(jps_ficet)%clname = 'OIceFrcT'  
     818      ssnd(jps_ficet)%clname = 'OIceFrcT' 
    817819      ssnd(jps_hice)%clname  = 'OIceTck' 
    818820      ssnd(jps_a_p)%clname   = 'OPndFrc' 
    … …  
    827829         IF( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl 
    828830      ENDIF 
    829        
    830       IF(TRIM( sn_snd_ifrac%cldes )  == 'coupled') ssnd(jps_ficet)%laction = .TRUE.  
     831 
     832      IF(TRIM( sn_snd_ifrac%cldes )  == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 
    831833 
    832834      SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 
    833835      CASE( 'none'         )       ! nothing to do 
    834       CASE( 'ice and snow' )  
     836      CASE( 'ice and snow' ) 
    835837         ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 
    836838         IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 
    837839            ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 
    838840         ENDIF 
    839       CASE ( 'weighted ice and snow' )  
     841      CASE ( 'weighted ice and snow' ) 
    840842         ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 
    841843         IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 
    … …  
    847849       a_i_last_couple(:,:,:) = 0._wp 
    848850#endif 
    849       !                                                      ! ------------------------- !  
    850       !                                                      !      Ice Meltponds        !  
    851       !                                                      ! ------------------------- !  
     851      !                                                      ! ------------------------- ! 
     852      !                                                      !      Ice Meltponds        ! 
     853      !                                                      ! ------------------------- ! 
    852854      ! Needed by Met Office 
    853       ssnd(jps_a_p)%clname  = 'OPndFrc'     
    854       ssnd(jps_ht_p)%clname = 'OPndTck'     
    855       SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) )  
    856       CASE ( 'none' )  
    857          ssnd(jps_a_p)%laction  = .FALSE.  
    858          ssnd(jps_ht_p)%laction = .FALSE.  
    859       CASE ( 'ice only' )   
    860          ssnd(jps_a_p)%laction  = .TRUE.  
    861          ssnd(jps_ht_p)%laction = .TRUE.  
    862          IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN  
    863             ssnd(jps_a_p)%nct  = nn_cats_cpl  
    864             ssnd(jps_ht_p)%nct = nn_cats_cpl  
    865          ELSE  
    866             IF( nn_cats_cpl > 1 ) THEN  
    867                CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' )  
    868             ENDIF  
    869          ENDIF  
    870       CASE ( 'weighted ice' )   
    871          ssnd(jps_a_p)%laction  = .TRUE.  
    872          ssnd(jps_ht_p)%laction = .TRUE.  
    873          IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN  
    874             ssnd(jps_a_p)%nct  = nn_cats_cpl   
    875             ssnd(jps_ht_p)%nct = nn_cats_cpl   
    876          ENDIF  
    877       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes; '//sn_snd_mpnd%cldes )  
    878       END SELECT  
    879   
     855      ssnd(jps_a_p)%clname  = 'OPndFrc' 
     856      ssnd(jps_ht_p)%clname = 'OPndTck' 
     857      SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) ) 
     858      CASE ( 'none' ) 
     859         ssnd(jps_a_p)%laction  = .FALSE. 
     860         ssnd(jps_ht_p)%laction = .FALSE. 
     861      CASE ( 'ice only' ) 
     862         ssnd(jps_a_p)%laction  = .TRUE. 
     863         ssnd(jps_ht_p)%laction = .TRUE. 
     864         IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
     865            ssnd(jps_a_p)%nct  = nn_cats_cpl 
     866            ssnd(jps_ht_p)%nct = nn_cats_cpl 
     867         ELSE 
     868            IF( nn_cats_cpl > 1 ) THEN 
     869               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 
     870            ENDIF 
     871         ENDIF 
     872      CASE ( 'weighted ice' ) 
     873         ssnd(jps_a_p)%laction  = .TRUE. 
     874         ssnd(jps_ht_p)%laction = .TRUE. 
     875         IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
     876            ssnd(jps_a_p)%nct  = nn_cats_cpl 
     877            ssnd(jps_ht_p)%nct = nn_cats_cpl 
     878         ENDIF 
     879      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes; '//sn_snd_mpnd%cldes ) 
     880      END SELECT 
     881 
    880882      !                                                      ! ------------------------- ! 
    881883      !                                                      !      Surface current      ! 
    … …  
    885887      ssnd(jps_ocy1)%clname = 'O_OCury1'   ;   ssnd(jps_ivy1)%clname = 'O_IVely1' 
    886888      ssnd(jps_ocz1)%clname = 'O_OCurz1'   ;   ssnd(jps_ivz1)%clname = 'O_IVelz1' 
    887       ssnd(jps_ocxw)%clname = 'O_OCurxw'  
    888       ssnd(jps_ocyw)%clname = 'O_OCuryw'  
     889      ssnd(jps_ocxw)%clname = 'O_OCurxw' 
     890      ssnd(jps_ocyw)%clname = 'O_OCuryw' 
    889891      ! 
    890892      ssnd(jps_ocx1:jps_ivz1)%nsgn = -1.   ! vectors: change of the sign at the north fold 
    … …  
    892894      IF( sn_snd_crt%clvgrd == 'U,V' ) THEN 
    893895         ssnd(jps_ocx1)%clgrid = 'U' ; ssnd(jps_ocy1)%clgrid = 'V' 
    894       ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN   
     896      ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN 
    895897         CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' ) 
    896898      ENDIF 
    897899      ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE.   ! default: all are send 
    898       IF( TRIM( sn_snd_crt%clvref ) == 'spherical' )   ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE.  
     900      IF( TRIM( sn_snd_crt%clvref ) == 'spherical' )   ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE. 
    899901      IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) ssnd(jps_ocx1:jps_ivz1)%nsgn = 1. 
    900902      SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    … …  
    906908      END SELECT 
    907909 
    908       ssnd(jps_ocxw:jps_ocyw)%nsgn = -1.   ! vectors: change of the sign at the north fold  
    909          
    910       IF( sn_snd_crtw%clvgrd == 'U,V' ) THEN  
    911          ssnd(jps_ocxw)%clgrid = 'U' ; ssnd(jps_ocyw)%clgrid = 'V'  
    912       ELSE IF( sn_snd_crtw%clvgrd /= 'T' ) THEN  
    913          CALL ctl_stop( 'sn_snd_crtw%clvgrd must be equal to T' )  
    914       ENDIF  
    915       IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) ssnd(jps_ocxw:jps_ocyw)%nsgn = 1.  
    916       SELECT CASE( TRIM( sn_snd_crtw%cldes ) )  
    917          CASE( 'none'                 )   ; ssnd(jps_ocxw:jps_ocyw)%laction = .FALSE.  
    918          CASE( 'oce only'             )   ; ssnd(jps_ocxw:jps_ocyw)%laction = .TRUE.  
    919          CASE( 'weighted oce and ice' )   !   nothing to do  
    920          CASE( 'mixed oce-ice'        )   ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.  
    921          CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crtw%cldes' )  
    922       END SELECT  
     910      ssnd(jps_ocxw:jps_ocyw)%nsgn = -1.   ! vectors: change of the sign at the north fold 
     911 
     912      IF( sn_snd_crtw%clvgrd == 'U,V' ) THEN 
     913         ssnd(jps_ocxw)%clgrid = 'U' ; ssnd(jps_ocyw)%clgrid = 'V' 
     914      ELSE IF( sn_snd_crtw%clvgrd /= 'T' ) THEN 
     915         CALL ctl_stop( 'sn_snd_crtw%clvgrd must be equal to T' ) 
     916      ENDIF 
     917      IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) ssnd(jps_ocxw:jps_ocyw)%nsgn = 1. 
     918      SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 
     919         CASE( 'none'                 )   ; ssnd(jps_ocxw:jps_ocyw)%laction = .FALSE. 
     920         CASE( 'oce only'             )   ; ssnd(jps_ocxw:jps_ocyw)%laction = .TRUE. 
     921         CASE( 'weighted oce and ice' )   !   nothing to do 
     922         CASE( 'mixed oce-ice'        )   ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 
     923         CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crtw%cldes' ) 
     924      END SELECT 
    923925 
    924926      !                                                      ! ------------------------- ! 
    … …  
    926928      !                                                      ! ------------------------- ! 
    927929      ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE. 
    928       !  
    929       !                                                      ! ------------------------- !  
    930       !                                                      ! Sea surface freezing temp !  
    931       !                                                      ! ------------------------- !  
     930      ! 
     931      !                                                      ! ------------------------- ! 
     932      !                                                      ! Sea surface freezing temp ! 
     933      !                                                      ! ------------------------- ! 
    932934      ! needed by Met Office 
    933       ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' )  ssnd(jps_sstfrz)%laction = .TRUE.  
    934       !  
    935       !                                                      ! ------------------------- !  
    936       !                                                      !    Ice conductivity       !  
    937       !                                                      ! ------------------------- !  
     935      ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' )  ssnd(jps_sstfrz)%laction = .TRUE. 
     936      ! 
     937      !                                                      ! ------------------------- ! 
     938      !                                                      !    Ice conductivity       ! 
     939      !                                                      ! ------------------------- ! 
    938940      ! needed by Met Office 
    939       ! Note that ultimately we will move to passing an ocean effective conductivity as well so there  
    940       ! will be some changes to the parts of the code which currently relate only to ice conductivity  
    941       ssnd(jps_ttilyr )%clname = 'O_TtiLyr'  
    942       SELECT CASE ( TRIM( sn_snd_ttilyr%cldes ) )  
    943       CASE ( 'none' )  
    944          ssnd(jps_ttilyr)%laction = .FALSE.  
    945       CASE ( 'ice only' )  
    946          ssnd(jps_ttilyr)%laction = .TRUE.  
    947          IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN  
    948             ssnd(jps_ttilyr)%nct = nn_cats_cpl  
    949          ELSE  
    950             IF( nn_cats_cpl > 1 ) THEN  
    951                CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' )  
    952             ENDIF  
    953          ENDIF  
    954       CASE ( 'weighted ice' )  
    955          ssnd(jps_ttilyr)%laction = .TRUE.  
    956          IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl  
    957       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes )  
    958       END SELECT  
    959  
    960       ssnd(jps_kice )%clname = 'OIceKn'  
    961       SELECT CASE ( TRIM( sn_snd_cond%cldes ) )  
    962       CASE ( 'none' )  
    963          ssnd(jps_kice)%laction = .FALSE.  
    964       CASE ( 'ice only' )  
    965          ssnd(jps_kice)%laction = .TRUE.  
    966          IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN  
    967             ssnd(jps_kice)%nct = nn_cats_cpl  
    968          ELSE  
    969             IF( nn_cats_cpl > 1 ) THEN  
    970                CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' )  
    971             ENDIF  
    972          ENDIF  
    973       CASE ( 'weighted ice' )  
    974          ssnd(jps_kice)%laction = .TRUE.  
    975          IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl  
    976       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes )  
    977       END SELECT  
    978       !  
    979       !                                                      ! ------------------------- !  
    980       !                                                      !     Sea surface height    !  
    981       !                                                      ! ------------------------- !  
    982       ssnd(jps_wlev)%clname = 'O_Wlevel' ;  IF( TRIM(sn_snd_wlev%cldes) == 'coupled' )   ssnd(jps_wlev)%laction = .TRUE.  
     941      ! Note that ultimately we will move to passing an ocean effective conductivity as well so there 
     942      ! will be some changes to the parts of the code which currently relate only to ice conductivity 
     943      ssnd(jps_ttilyr )%clname = 'O_TtiLyr' 
     944      SELECT CASE ( TRIM( sn_snd_ttilyr%cldes ) ) 
     945      CASE ( 'none' ) 
     946         ssnd(jps_ttilyr)%laction = .FALSE. 
     947      CASE ( 'ice only' ) 
     948         ssnd(jps_ttilyr)%laction = .TRUE. 
     949         IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN 
     950            ssnd(jps_ttilyr)%nct = nn_cats_cpl 
     951         ELSE 
     952            IF( nn_cats_cpl > 1 ) THEN 
     953               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' ) 
     954            ENDIF 
     955         ENDIF 
     956      CASE ( 'weighted ice' ) 
     957         ssnd(jps_ttilyr)%laction = .TRUE. 
     958         IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl 
     959      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes ) 
     960      END SELECT 
     961 
     962      ssnd(jps_kice )%clname = 'OIceKn' 
     963      SELECT CASE ( TRIM( sn_snd_cond%cldes ) ) 
     964      CASE ( 'none' ) 
     965         ssnd(jps_kice)%laction = .FALSE. 
     966      CASE ( 'ice only' ) 
     967         ssnd(jps_kice)%laction = .TRUE. 
     968         IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 
     969            ssnd(jps_kice)%nct = nn_cats_cpl 
     970         ELSE 
     971            IF( nn_cats_cpl > 1 ) THEN 
     972               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 
     973            ENDIF 
     974         ENDIF 
     975      CASE ( 'weighted ice' ) 
     976         ssnd(jps_kice)%laction = .TRUE. 
     977         IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl 
     978      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes ) 
     979      END SELECT 
     980      ! 
     981      !                                                      ! ------------------------- ! 
     982      !                                                      !     Sea surface height    ! 
     983      !                                                      ! ------------------------- ! 
     984      ssnd(jps_wlev)%clname = 'O_Wlevel' ;  IF( TRIM(sn_snd_wlev%cldes) == 'coupled' )   ssnd(jps_wlev)%laction = .TRUE. 
    983985 
    984986      !                                                      ! ------------------------------- ! 
    985       !                                                      !   OPA-SAS coupling - snd by opa !    
     987      !                                                      !   OPA-SAS coupling - snd by opa ! 
    986988      !                                                      ! ------------------------------- ! 
    987       ssnd(jps_ssh   )%clname = 'O_SSHght'  
    988       ssnd(jps_soce  )%clname = 'O_SSSal'  
    989       ssnd(jps_e3t1st)%clname = 'O_E3T1st'    
     989      ssnd(jps_ssh   )%clname = 'O_SSHght' 
     990      ssnd(jps_soce  )%clname = 'O_SSSal' 
     991      ssnd(jps_e3t1st)%clname = 'O_E3T1st' 
    990992      ssnd(jps_fraqsr)%clname = 'O_FraQsr' 
    991993      ! 
    … …  
    10051007            WRITE(numout,*)'  sent fields to SAS component ' 
    10061008            WRITE(numout,*)'               sea surface temperature (T before, Celsius) ' 
    1007             WRITE(numout,*)'               sea surface salinity '  
    1008             WRITE(numout,*)'               surface currents U,V on local grid and spherical coordinates'  
    1009             WRITE(numout,*)'               sea surface height '  
    1010             WRITE(numout,*)'               thickness of first ocean T level '         
     1009            WRITE(numout,*)'               sea surface salinity ' 
     1010            WRITE(numout,*)'               surface currents U,V on local grid and spherical coordinates' 
     1011            WRITE(numout,*)'               sea surface height ' 
     1012            WRITE(numout,*)'               thickness of first ocean T level ' 
    10111013            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level' 
    10121014            WRITE(numout,*) 
    … …  
    10141016      ENDIF 
    10151017      !                                                      ! ------------------------------- ! 
    1016       !                                                      !   OPA-SAS coupling - snd by sas !    
     1018      !                                                      !   OPA-SAS coupling - snd by sas ! 
    10171019      !                                                      ! ------------------------------- ! 
    1018       ssnd(jps_sflx  )%clname = 'I_SFLX'      
     1020      ssnd(jps_sflx  )%clname = 'I_SFLX' 
    10191021      ssnd(jps_fice2 )%clname = 'IIceFrc' 
    1020       ssnd(jps_qsroce)%clname = 'I_QsrOce'    
    1021       ssnd(jps_qnsoce)%clname = 'I_QnsOce'    
    1022       ssnd(jps_oemp  )%clname = 'IOEvaMPr'  
    1023       ssnd(jps_otx1  )%clname = 'I_OTaux1'    
    1024       ssnd(jps_oty1  )%clname = 'I_OTauy1'    
    1025       ssnd(jps_rnf   )%clname = 'I_Runoff'    
    1026       ssnd(jps_taum  )%clname = 'I_TauMod'    
     1022      ssnd(jps_qsroce)%clname = 'I_QsrOce' 
     1023      ssnd(jps_qnsoce)%clname = 'I_QnsOce' 
     1024      ssnd(jps_oemp  )%clname = 'IOEvaMPr' 
     1025      ssnd(jps_otx1  )%clname = 'I_OTaux1' 
     1026      ssnd(jps_oty1  )%clname = 'I_OTauy1' 
     1027      ssnd(jps_rnf   )%clname = 'I_Runoff' 
     1028      ssnd(jps_taum  )%clname = 'I_TauMod' 
    10271029      ! 
    10281030      IF( nn_components == jp_iam_sas ) THEN 
    … …  
    10601062 
    10611063      CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 
    1062        
    1063       IF(ln_usecplmask) THEN  
     1064 
     1065      IF(ln_usecplmask) THEN 
    10641066         xcplmask(:,:,:) = 0. 
    10651067         CALL iom_open( 'cplmask', inum ) 
    … …  
    10751077 
    10761078 
    1077    SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice, Kbb, Kmm )      
     1079   SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice, Kbb, Kmm ) 
    10781080      !!---------------------------------------------------------------------- 
    10791081      !!             ***  ROUTINE sbc_cpl_rcv  *** 
    … …  
    10891091      !! 
    10901092      !!                  - transform the received ocean stress vector from the received 
    1091       !!                 referential and grid into an atmosphere-ocean stress in  
    1092       !!                 the (i,j) ocean referencial and at the ocean velocity point.  
     1093      !!                 referential and grid into an atmosphere-ocean stress in 
     1094      !!                 the (i,j) ocean referencial and at the ocean velocity point. 
    10931095      !!                    The received stress are : 
    10941096      !!                     - defined by 3 components (if cartesian coordinate) 
    … …  
    10981100      !!                     - given at U- and V-point, resp.   if received on 2 grids 
    10991101      !!                            or at T-point               if received on 1 grid 
    1100       !!                    Therefore and if necessary, they are successively  
    1101       !!                  processed in order to obtain them  
    1102       !!                     first  as  2 components on the sphere  
     1102      !!                    Therefore and if necessary, they are successively 
     1103      !!                  processed in order to obtain them 
     1104      !!                     first  as  2 components on the sphere 
    11031105      !!                     second as  2 components oriented along the local grid 
    1104       !!                     third  as  2 components on the U,V grid  
     1106      !!                     third  as  2 components on the U,V grid 
    11051107      !! 
    1106       !!              -->  
     1108      !!              --> 
    11071109      !! 
    1108       !!              - In 'ocean only' case, non solar and solar ocean heat fluxes  
    1109       !!             and total ocean freshwater fluxes   
     1110      !!              - In 'ocean only' case, non solar and solar ocean heat fluxes 
     1111      !!             and total ocean freshwater fluxes 
    11101112      !! 
    1111       !! ** Method  :   receive all fields from the atmosphere and transform  
    1112       !!              them into ocean surface boundary condition fields  
     1113      !! ** Method  :   receive all fields from the atmosphere and transform 
     1114      !!              them into ocean surface boundary condition fields 
    11131115      !! 
    1114       !! ** Action  :   update  utau, vtau   ocean stress at U,V grid  
     1116      !! ** Action  :   update  utau, vtau   ocean stress at U,V grid 
    11151117      !!                        taum         wind stress module at T-point 
    11161118      !!                        wndm         wind speed  module at T-point over free ocean or leads in presence of sea-ice 
    … …  
    11231125      ! 
    11241126      INTEGER, INTENT(in) ::   kt          ! ocean model time step index 
    1125       INTEGER, INTENT(in) ::   k_fsbc      ! frequency of sbc (-> ice model) computation  
     1127      INTEGER, INTENT(in) ::   k_fsbc      ! frequency of sbc (-> ice model) computation 
    11261128      INTEGER, INTENT(in) ::   k_ice       ! ice management in the sbc (=0/1/2/3) 
    11271129      INTEGER, INTENT(in) ::   Kbb, Kmm    ! ocean model time level indices 
    … …  
    11301132      INTEGER  ::   ji, jj, jn             ! dummy loop indices 
    11311133      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdt did not change since nit000) 
    1132       REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars      
     1134      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars 
    11331135      REAL(wp) ::   zcoef                  ! temporary scalar 
    11341136      REAL(wp) ::   zrhoa  = 1.22          ! Air density kg/m3 
    … …  
    11451147 
    11461148         IF( ncpl_qsr_freq /= 0) ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top 
    1147           
     1149 
    11481150      ENDIF 
    11491151      ! 
    … …  
    11841186            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
    11851187               !                                                       ! (geographical to local grid -> rotate the components) 
    1186                CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )    
     1188               CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 
    11871189               IF( srcv(jpr_otx2)%laction ) THEN 
    1188                   CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )    
     1190                  CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 
    11891191               ELSE 
    1190                   CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )   
     1192                  CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 
    11911193               ENDIF 
    11921194               frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    11931195               frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid 
    11941196            ENDIF 
    1195             !                               
     1197            ! 
    11961198            IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN 
    11971199               DO_2D( 0, 0, 0, 0 )                                        ! T ==> (U,V) 
    … …  
    12081210      ELSE                                                   !   No dynamical coupling   ! 
    12091211         !                                                   ! ========================= ! 
    1210          frcv(jpr_otx1)%z3(:,:,1) = 0.e0                               ! here simply set to zero  
     1212         frcv(jpr_otx1)%z3(:,:,1) = 0.e0                               ! here simply set to zero 
    12111213         frcv(jpr_oty1)%z3(:,:,1) = 0.e0                               ! an external read in a file can be added instead 
    12121214         llnewtx = .TRUE. 
    … …  
    12161218      !                                                      !    wind stress module     !   (taum) 
    12171219      !                                                      ! ========================= ! 
    1218       IF( .NOT. srcv(jpr_taum)%laction ) THEN                    ! compute wind stress module from its components if not received  
     1220      IF( .NOT. srcv(jpr_taum)%laction ) THEN                    ! compute wind stress module from its components if not received 
    12191221         ! => need to be done only when otx1 was changed 
    12201222         IF( llnewtx ) THEN 
    … …  
    12321234         llnewtau = nrcvinfo(jpr_taum) == OASIS_Rcv 
    12331235         ! Stress module can be negative when received (interpolation problem) 
    1234          IF( llnewtau ) THEN  
     1236         IF( llnewtau ) THEN 
    12351237            frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) ) 
    12361238         ENDIF 
    … …  
    12401242      !                                                      !      10 m wind speed      !   (wndm) 
    12411243      !                                                      ! ========================= ! 
    1242       IF( .NOT. srcv(jpr_w10m)%laction ) THEN                    ! compute wind spreed from wind stress module if not received   
     1244      IF( .NOT. srcv(jpr_w10m)%laction ) THEN                    ! compute wind spreed from wind stress module if not received 
    12431245         ! => need to be done only when taumod was changed 
    1244          IF( llnewtau ) THEN  
    1245             zcoef = 1. / ( zrhoa * zcdrag )  
     1246         IF( llnewtau ) THEN 
     1247            zcoef = 1. / ( zrhoa * zcdrag ) 
    12461248            DO_2D( 1, 1, 1, 1 ) 
    12471249               frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
    … …  
    12631265      !                                                      ! ========================= ! 
    12641266      ! u(v)tau and taum will be modified by ice model 
    1265       ! -> need to be reset before each call of the ice/fsbc       
     1267      ! -> need to be reset before each call of the ice/fsbc 
    12661268      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 
    12671269         ! 
    … …  
    12781280         ENDIF 
    12791281         CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    1280          !   
     1282         ! 
    12811283      ENDIF 
    12821284 
    … …  
    12861288      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 
    12871289      ! 
    1288       !                                                      ! ========================= !  
    1289       !                                                      ! Mean Sea Level Pressure   !   (taum)  
    1290       !                                                      ! ========================= !  
    1291       IF( srcv(jpr_mslp)%laction ) THEN                    ! UKMO SHELF effect of atmospheric pressure on SSH  
    1292           IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields  
    1293  
    1294           r1_grau = 1.e0 / (grav * rho0)               !* constant for optimization  
    1295           ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau    ! equivalent ssh (inverse barometer)  
    1296           apr   (:,:) =     frcv(jpr_mslp)%z3(:,:,1)                         !atmospheric pressure  
    1297      
    1298           IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:)  ! correct this later (read from restart if possible)  
    1299       ENDIF  
     1290      !                                                      ! ========================= ! 
     1291      !                                                      ! Mean Sea Level Pressure   !   (taum) 
     1292      !                                                      ! ========================= ! 
     1293      IF( srcv(jpr_mslp)%laction ) THEN                    ! UKMO SHELF effect of atmospheric pressure on SSH 
     1294          IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields 
     1295 
     1296          r1_grau = 1.e0 / (grav * rho0)               !* constant for optimization 
     1297          ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau    ! equivalent ssh (inverse barometer) 
     1298          apr   (:,:) =     frcv(jpr_mslp)%z3(:,:,1)                         !atmospheric pressure 
     1299 
     1300          IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:)  ! correct this later (read from restart if possible) 
     1301      ENDIF 
    13001302      ! 
    13011303      IF( ln_sdw ) THEN  ! Stokes Drift correction activated 
    1302       !                                                      ! ========================= !  
     1304      !                                                      ! ========================= ! 
    13031305      !                                                      !       Stokes drift u      ! 
    1304       !                                                      ! ========================= !  
     1306      !                                                      ! ========================= ! 
    13051307         IF( srcv(jpr_sdrftx)%laction ) ut0sd(:,:) = frcv(jpr_sdrftx)%z3(:,:,1) 
    13061308      ! 
    1307       !                                                      ! ========================= !  
     1309      !                                                      ! ========================= ! 
    13081310      !                                                      !       Stokes drift v      ! 
    1309       !                                                      ! ========================= !  
     1311      !                                                      ! ========================= ! 
    13101312         IF( srcv(jpr_sdrfty)%laction ) vt0sd(:,:) = frcv(jpr_sdrfty)%z3(:,:,1) 
    13111313      ! 
    1312       !                                                      ! ========================= !  
     1314      !                                                      ! ========================= ! 
    13131315      !                                                      !      Wave mean period     ! 
    1314       !                                                      ! ========================= !  
     1316      !                                                      ! ========================= ! 
    13151317         IF( srcv(jpr_wper)%laction ) wmp(:,:) = frcv(jpr_wper)%z3(:,:,1) 
    13161318      ! 
    1317       !                                                      ! ========================= !  
     1319      !                                                      ! ========================= ! 
    13181320      !                                                      !  Significant wave height  ! 
    1319       !                                                      ! ========================= !  
     1321      !                                                      ! ========================= ! 
    13201322         IF( srcv(jpr_hsig)%laction ) hsw(:,:) = frcv(jpr_hsig)%z3(:,:,1) 
    1321       !  
    1322       !                                                      ! ========================= !   
    1323       !                                                      !    Wave peak frequency    !  
    1324       !                                                      ! ========================= !   
     1323      ! 
     1324      !                                                      ! ========================= ! 
     1325      !                                                      !    Wave peak frequency    ! 
     1326      !                                                      ! ========================= ! 
    13251327         IF( srcv(jpr_wfreq)%laction ) wfreq(:,:) = frcv(jpr_wfreq)%z3(:,:,1) 
    13261328      ! 
    1327       !                                                      ! ========================= !  
     1329      !                                                      ! ========================= ! 
    13281330      !                                                      !    Vertical mixing Qiao   ! 
    1329       !                                                      ! ========================= !  
     1331      !                                                      ! ========================= ! 
    13301332         IF( srcv(jpr_wnum)%laction .AND. ln_zdfswm ) wnum(:,:) = frcv(jpr_wnum)%z3(:,:,1) 
    13311333 
    … …  
    13361338         ENDIF 
    13371339      ENDIF 
    1338       !                                                      ! ========================= !  
     1340      !                                                      ! ========================= ! 
    13391341      !                                                      ! Stress adsorbed by waves  ! 
    1340       !                                                      ! ========================= !  
     1342      !                                                      ! ========================= ! 
    13411343      IF( srcv(jpr_tauwoc)%laction .AND. ln_tauwoc ) tauoc_wave(:,:) = frcv(jpr_tauwoc)%z3(:,:,1) 
    13421344 
    1343       !                                                      ! ========================= !   
    1344       !                                                      ! Stress component by waves !  
    1345       !                                                      ! ========================= !   
     1345      !                                                      ! ========================= ! 
     1346      !                                                      ! Stress component by waves ! 
     1347      !                                                      ! ========================= ! 
    13461348      IF( srcv(jpr_tauwx)%laction .AND. srcv(jpr_tauwy)%laction .AND. ln_tauw ) THEN 
    13471349         tauw_x(:,:) = frcv(jpr_tauwx)%z3(:,:,1) 
    … …  
    13491351      ENDIF 
    13501352 
    1351       !                                                      ! ========================= !  
     1353      !                                                      ! ========================= ! 
    13521354      !                                                      !   Wave drag coefficient   ! 
    1353       !                                                      ! ========================= !  
     1355      !                                                      ! ========================= ! 
    13541356      IF( srcv(jpr_wdrag)%laction .AND. ln_cdgw )   cdn_wave(:,:) = frcv(jpr_wdrag)%z3(:,:,1) 
    13551357 
    … …  
    13631365         CALL iom_put( 'sss_m', sss_m ) 
    13641366      ENDIF 
    1365       !                                                
     1367      ! 
    13661368      !                                                      ! ================== ! 
    13671369      !                                                      !        SST         ! 
    … …  
    14091411         CALL iom_put( 'frq_m', frq_m ) 
    14101412      ENDIF 
    1411        
     1413 
    14121414      !                                                      ! ========================= ! 
    14131415      IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN   !  heat & freshwater fluxes ! (Ocean only case) 
    … …  
    14311433         IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
    14321434         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    1433   
    1434          IF( srcv(jpr_icb)%laction )  THEN  
     1435 
     1436         IF( srcv(jpr_icb)%laction )  THEN 
    14351437             fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 
    14361438             rnf(:,:)    = rnf(:,:) + fwficb(:,:)   ! iceberg added to runfofs 
    … …  
    14391441         ! ice shelf fwf 
    14401442         IF( srcv(jpr_isf)%laction )  THEN 
    1441             fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting)   
     1443            fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting) 
    14421444         END IF 
    1443          
     1445 
    14441446         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 
    14451447         ELSE                   ;   emp(:,:) =                              zemp(:,:) 
    … …  
    14831485      ! 
    14841486   END SUBROUTINE sbc_cpl_rcv 
    1485     
    1486  
    1487    SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )      
     1487 
     1488 
     1489   SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj ) 
    14881490      !!---------------------------------------------------------------------- 
    14891491      !!             ***  ROUTINE sbc_cpl_ice_tau  *** 
    14901492      !! 
    1491       !! ** Purpose :   provide the stress over sea-ice in coupled mode  
     1493      !! ** Purpose :   provide the stress over sea-ice in coupled mode 
    14921494      !! 
    14931495      !! ** Method  :   transform the received stress from the atmosphere into 
    14941496      !!             an atmosphere-ice stress in the (i,j) ocean referencial 
    14951497      !!             and at the velocity point of the sea-ice model: 
    1496       !!                'C'-grid : i- (j-) components given at U- (V-) point  
     1498      !!                'C'-grid : i- (j-) components given at U- (V-) point 
    14971499      !! 
    14981500      !!                The received stress are : 
    … …  
    15031505      !!                 - given at U- and V-point, resp.   if received on 2 grids 
    15041506      !!                        or at a same point (T or I) if received on 1 grid 
    1505       !!                Therefore and if necessary, they are successively  
    1506       !!             processed in order to obtain them  
    1507       !!                 first  as  2 components on the sphere  
     1507      !!                Therefore and if necessary, they are successively 
     1508      !!             processed in order to obtain them 
     1509      !!                 first  as  2 components on the sphere 
    15081510      !!                 second as  2 components oriented along the local grid 
    1509       !!                 third  as  2 components on the ice grid point  
     1511      !!                 third  as  2 components on the ice grid point 
    15101512      !! 
    1511       !!                Except in 'oce and ice' case, only one vector stress field  
     1513      !!                Except in 'oce and ice' case, only one vector stress field 
    15121514      !!             is received. It has already been processed in sbc_cpl_rcv 
    15131515      !!             so that it is now defined as (i,j) components given at U- 
    1514       !!             and V-points, respectively.   
     1516      !!             and V-points, respectively. 
    15151517      !! 
    15161518      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice 
    … …  
    15221524      INTEGER ::   itx      ! index of taux over ice 
    15231525      REAL(wp)                     ::   zztmp1, zztmp2 
    1524       REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty  
     1526      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty 
    15251527      !!---------------------------------------------------------------------- 
    15261528      ! 
    1527       IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1    
     1529      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1 
    15281530      ELSE                                ;   itx =  jpr_otx1 
    15291531      ENDIF 
    … …  
    15341536         IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   ! 
    15351537            !                                                   ! ======================= ! 
    1536             !   
     1538            ! 
    15371539            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere 
    15381540               !                                                       ! (cartesian to spherical -> 3 to 2 components) 
    … …  
    15531555            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
    15541556               !                                                       ! (geographical to local grid -> rotate the components) 
    1555                CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )    
     1557               CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx ) 
    15561558               IF( srcv(jpr_itx2)%laction ) THEN 
    1557                   CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )    
     1559                  CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty ) 
    15581560               ELSE 
    1559                   CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty )   
     1561                  CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty ) 
    15601562               ENDIF 
    15611563               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    … …  
    15721574         !                                                      !     put on ice grid     ! 
    15731575         !                                                      ! ======================= ! 
    1574          !     
     1576         ! 
    15751577         !                                                  j+1   j     -----V---F 
    15761578         ! ice stress on ice velocity point                              !       | 
    … …  
    15871589         CASE( 'T' ) 
    15881590            DO_2D( 0, 0, 0, 0 )                    ! T ==> (U,V) 
    1589                ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology  
     1591               ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology 
    15901592               zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) ) 
    15911593               zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) ) 
    … …  
    15951597            CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. ) 
    15961598         END SELECT 
    1597           
     1599 
    15981600      ENDIF 
    15991601      ! 
    16001602   END SUBROUTINE sbc_cpl_ice_tau 
    1601     
     1603 
    16021604 
    16031605   SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi ) 
    … …  
    16081610      !! 
    16091611      !! ** Method  :   transform the fields received from the atmosphere into 
    1610       !!             surface heat and fresh water boundary condition for the  
     1612      !!             surface heat and fresh water boundary condition for the 
    16111613      !!             ice-ocean system. The following fields are provided: 
    1612       !!               * total non solar, solar and freshwater fluxes (qns_tot,  
     1614      !!               * total non solar, solar and freshwater fluxes (qns_tot, 
    16131615      !!             qsr_tot and emp_tot) (total means weighted ice-ocean flux) 
    16141616      !!             NB: emp_tot include runoffs and calving. 
    16151617      !!               * fluxes over ice (qns_ice, qsr_ice, emp_ice) where 
    16161618      !!             emp_ice = sublimation - solid precipitation as liquid 
    1617       !!             precipitation are re-routed directly to the ocean and  
     1619      !!             precipitation are re-routed directly to the ocean and 
    16181620      !!             calving directly enter the ocean (runoffs are read but included in trasbc.F90) 
    1619       !!               * solid precipitation (sprecip), used to add to qns_tot  
     1621      !!               * solid precipitation (sprecip), used to add to qns_tot 
    16201622      !!             the heat lost associated to melting solid precipitation 
    16211623      !!             over the ocean fraction. 
    … …  
    16491651      !!                   emp_ice           ice sublimation - solid precipitation over the ice 
    16501652      !!                   dqns_ice          d(non-solar heat flux)/d(Temperature) over the ice 
    1651       !!                   sprecip           solid precipitation over the ocean   
     1653      !!                   sprecip           solid precipitation over the ocean 
    16521654      !!---------------------------------------------------------------------- 
    16531655      REAL(wp), INTENT(in)   , DIMENSION(:,:)             ::   picefr     ! ice fraction                [0 to 1] 
    16541656      !                                                   !!           ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling 
    1655       REAL(wp), INTENT(in)   , DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo  
     1657      REAL(wp), INTENT(in)   , DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo 
    16561658      REAL(wp), INTENT(in)   , DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius] 
    16571659      REAL(wp), INTENT(inout), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin] => inout for Met-Office 
    … …  
    16901692         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 
    16911693         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 
    1692       CASE( 'none'      )       ! Not available as for now: needs additional coding below when computing zevap_oce  
     1694      CASE( 'none'      )       ! Not available as for now: needs additional coding below when computing zevap_oce 
    16931695      !                         ! since fields received are not defined with none option 
    16941696         CALL ctl_stop( 'STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_emp value in namelist namsbc_cpl' ) 
    … …  
    17371739      ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 
    17381740      zsnw(:,:) = 0._wp   ;   CALL ice_var_snwblow( ziceld, zsnw ) 
    1739        
     1741 
    17401742      ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 
    17411743      zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( picefr(:,:) - zsnw(:,:) )  ! emp_ice = A * sublimation - zsnw * sprecip 
    … …  
    17481750      ! therefore, sublimation is not redistributed over the ice categories when no subgrid scale fluxes are provided by atm. 
    17491751      zdevap_ice(:,:) = 0._wp 
    1750        
     1752 
    17511753      ! --- Continental fluxes --- ! 
    17521754      IF( srcv(jpr_rnf)%laction ) THEN   ! runoffs (included in emp later on) 
    … …  
    17621764      ENDIF 
    17631765      IF( srcv(jpr_isf)%laction ) THEN   ! iceshelf (fwfisf <0 mean melting) 
    1764         fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1)   
     1766        fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) 
    17651767      ENDIF 
    17661768 
    … …  
    17781780         emp_tot (:,:)   = zemp_tot (:,:) 
    17791781         emp_ice (:,:)   = zemp_ice (:,:) 
    1780          emp_oce (:,:)   = zemp_oce (:,:)      
     1782         emp_oce (:,:)   = zemp_oce (:,:) 
    17811783         sprecip (:,:)   = zsprecip (:,:) 
    17821784         tprecip (:,:)   = ztprecip (:,:) 
    … …  
    18251827      IF( iom_use('snowpre') )       CALL iom_put( 'snowpre'     , sprecip(:,:)                                          )  ! Snow 
    18261828      IF( iom_use('precip') )        CALL iom_put( 'precip'      , tprecip(:,:)                                          )  ! total  precipitation 
    1827       IF( iom_use('rain') )          CALL iom_put( 'rain'        , tprecip(:,:) - sprecip(:,:)                           )  ! liquid precipitation  
     1829      IF( iom_use('rain') )          CALL iom_put( 'rain'        , tprecip(:,:) - sprecip(:,:)                           )  ! liquid precipitation 
    18281830      IF( iom_use('snow_ao_cea') )   CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average) 
    18291831      IF( iom_use('snow_ai_cea') )   CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average) 
    … …  
    18411843         ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 
    18421844         ! here so the only flux is the ocean only one. 
    1843          zqns_ice(:,:,:) = 0._wp  
     1845         zqns_ice(:,:,:) = 0._wp 
    18441846      CASE( 'conservative' )     ! the required fields are directly provided 
    18451847         zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
    … …  
    18551857         IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    18561858            DO jl=1,jpl 
    1857                zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
     1859               zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) 
    18581860               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 
    18591861            ENDDO 
    … …  
    18811883         ENDIF 
    18821884      END SELECT 
    1883       !                                      
     1885      ! 
    18841886      ! --- calving (removed from qns_tot) --- ! 
    18851887      IF( srcv(jpr_cal)%laction )   zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * rLfus  ! remove latent heat of calving 
    … …  
    18881890      IF( srcv(jpr_icb)%laction )   zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus  ! remove latent heat of iceberg melting 
    18891891 
    1890 #if defined key_si3       
     1892#if defined key_si3 
    18911893      ! --- non solar flux over ocean --- ! 
    18921894      !         note: ziceld cannot be = 0 since we limit the ice concentration to amax 
    … …  
    18991901      ENDWHERE 
    19001902      ! Heat content per unit mass of rain (J/kg) 
    1901       zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) )  
     1903      zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) ) 
    19021904 
    19031905      ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
    … …  
    19161918!!    zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * picefr(:,:)      *   zcptsnw (:,:)   &        ! ice evap 
    19171919!!       &             +   zsprecip(:,:)                   * zsnw             * zqprec_ice(:,:) * r1_rhos  ! solid precip over ice 
    1918        
     1920 
    19191921      ! --- total non solar flux (including evap/precip) --- ! 
    19201922      zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:) 
    19211923 
    1922       ! --- in case both coupled/forced are active, we must mix values --- !  
     1924      ! --- in case both coupled/forced are active, we must mix values --- ! 
    19231925      IF( ln_mixcpl ) THEN 
    19241926         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 
    … …  
    19441946      zcptsnw (:,:) = zcptn(:,:) 
    19451947      zcptrain(:,:) = zcptn(:,:) 
    1946        
     1948 
    19471949      ! clem: this formulation is certainly wrong... but better than it was... 
    19481950      zqns_tot(:,:) = zqns_tot(:,:)                             &          ! zqns_tot update over free ocean with: 
    19491951         &          - (  ziceld(:,:) * zsprecip(:,:) * rLfus )  &          ! remove the latent heat flux of solid precip. melting 
    19501952         &          - (  zemp_tot(:,:)                          &          ! remove the heat content of mass flux (assumed to be at SST) 
    1951          &             - zemp_ice(:,:) ) * zcptn(:,:)  
     1953         &             - zemp_ice(:,:) ) * zcptn(:,:) 
    19521954 
    19531955     IF( ln_mixcpl ) THEN 
    … …  
    19741976      IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
    19751977           &                                                              * ( 1._wp - zsnw(:,:) )                  )               ! heat flux from snow (over ocean) 
    1976       IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &  
     1978      IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
    19771979           &                                                              *           zsnw(:,:)                    )               ! heat flux from snow (over ice) 
    19781980      ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. 
    … …  
    20002002         IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    20012003            DO jl = 1, jpl 
    2002                zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
     2004               zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) 
    20032005               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 
    20042006            END DO 
    … …  
    20272029            END DO 
    20282030         ENDIF 
    2029       CASE( 'none'      )       ! Not available as for now: needs additional coding   
     2031      CASE( 'none'      )       ! Not available as for now: needs additional coding 
    20302032      !                         ! since fields received, here zqsr_tot,  are not defined with none option 
    20312033         CALL ctl_stop( 'STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_qsr value in namelist namsbc_cpl' ) 
    … …  
    20712073            ENDDO 
    20722074         ENDIF 
    2073       CASE( 'none' )  
     2075      CASE( 'none' ) 
    20742076         zdqns_ice(:,:,:) = 0._wp 
    20752077      END SELECT 
    2076        
     2078 
    20772079      IF( ln_mixcpl ) THEN 
    20782080         DO jl=1,jpl 
    … …  
    20832085      ENDIF 
    20842086 
    2085 #if defined key_si3       
     2087#if defined key_si3 
    20862088      !                                                      ! ========================= ! 
    20872089      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !  ice topmelt and botmelt  ! 
    … …  
    21152117            ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm 
    21162118            DO jl = 1, jpl 
    2117                WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
     2119               WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )       ! linear decrease from hi=0 to 10cm 
    21182120                  zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 
    21192121               ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )       ! constant (ztri) when hi>10cm 
    21202122                  zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ztri(:,:) 
    21212123               ELSEWHERE                                                           ! zero when hs>0 
    2122                   zqtr_ice_top(:,:,jl) = 0._wp  
     2124                  zqtr_ice_top(:,:,jl) = 0._wp 
    21232125               END WHERE 
    21242126            ENDDO 
    … …  
    21292131            zqtr_ice_top(:,:,:) = 0.3_wp * zqsr_ice(:,:,:) 
    21302132         ENDIF 
    2131          !      
     2133         ! 
    21322134      ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN      !==  conduction flux as surface forcing  ==! 
    21332135         ! 
    … …  
    21492151      !                                                      ! ================== ! 
    21502152      ! needed by Met Office 
    2151       IF( srcv(jpr_ts_ice)%laction ) THEN  
    2152          WHERE    ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0  )   ;   ztsu(:,:,:) =   0. + rt0  
     2153      IF( srcv(jpr_ts_ice)%laction ) THEN 
     2154         WHERE    ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0  )   ;   ztsu(:,:,:) =   0. + rt0 
    21532155         ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. )   ;   ztsu(:,:,:) = -60. + rt0 
    21542156         ELSEWHERE                                        ;   ztsu(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:) + rt0 
    … …  
    21682170      ! 
    21692171   END SUBROUTINE sbc_cpl_ice_flx 
    2170     
    2171     
     2172 
     2173 
    21722174   SUBROUTINE sbc_cpl_snd( kt, Kbb, Kmm ) 
    21732175      !!---------------------------------------------------------------------- 
    … …  
    21862188      REAL(wp) ::   zumax, zvmax 
    21872189      REAL(wp), DIMENSION(jpi,jpj)     ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 
    2188       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   ztmp3, ztmp4    
     2190      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   ztmp3, ztmp4 
    21892191      !!---------------------------------------------------------------------- 
    21902192      ! 
    … …  
    21972199      !                                                      ! ------------------------- ! 
    21982200      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 
    2199           
     2201 
    22002202         IF( nn_components == jp_iam_opa ) THEN 
    22012203            ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm)   ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 
    22022204         ELSE 
    2203             ! we must send the surface potential temperature  
     2205            ! we must send the surface potential temperature 
    22042206            IF( l_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) ) 
    22052207            ELSE                   ;   ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) 
    … …  
    22102212            CASE( 'oce and ice'          )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0 
    22112213               SELECT CASE( sn_snd_temp%clcat ) 
    2212                CASE( 'yes' )    
     2214               CASE( 'yes' ) 
    22132215                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) 
    22142216               CASE( 'no' ) 
    … …  
    22202222               CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
    22212223               END SELECT 
    2222             CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)    
     2224            CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 
    22232225               SELECT CASE( sn_snd_temp%clcat ) 
    2224                CASE( 'yes' )    
     2226               CASE( 'yes' ) 
    22252227                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    22262228               CASE( 'no' ) 
    … …  
    22312233               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
    22322234               END SELECT 
    2233             CASE( 'oce and weighted ice')    ;   ztmp1(:,:) =   ts(:,:,1,jp_tem,Kmm) + rt0   
    2234                SELECT CASE( sn_snd_temp%clcat )  
    2235                CASE( 'yes' )     
    2236                   ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)  
    2237                CASE( 'no' )  
    2238                   ztmp3(:,:,:) = 0.0  
    2239                   DO jl=1,jpl  
    2240                      ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)  
    2241                   ENDDO  
    2242                CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )  
    2243                END SELECT  
    2244             CASE( 'mixed oce-ice'        )    
    2245                ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)  
     2235            CASE( 'oce and weighted ice')    ;   ztmp1(:,:) =   ts(:,:,1,jp_tem,Kmm) + rt0 
     2236               SELECT CASE( sn_snd_temp%clcat ) 
     2237               CASE( 'yes' ) 
     2238                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     2239               CASE( 'no' ) 
     2240                  ztmp3(:,:,:) = 0.0 
     2241                  DO jl=1,jpl 
     2242                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     2243                  ENDDO 
     2244               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     2245               END SELECT 
     2246            CASE( 'mixed oce-ice'        ) 
     2247               ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 
    22462248               DO jl=1,jpl 
    22472249                  ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
    … …  
    22632265         SELECT CASE( sn_snd_ttilyr%cldes) 
    22642266         CASE ('weighted ice') 
    2265             ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(:,:,1:jpl)  
     2267            ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    22662268         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ttilyr%cldes' ) 
    22672269         END SELECT 
    … …  
    22722274      !                                                      !           Albedo          ! 
    22732275      !                                                      ! ------------------------- ! 
    2274       IF( ssnd(jps_albice)%laction ) THEN                         ! ice  
     2276      IF( ssnd(jps_albice)%laction ) THEN                         ! ice 
    22752277          SELECT CASE( sn_snd_alb%cldes ) 
    22762278          CASE( 'ice' ) 
    22772279             SELECT CASE( sn_snd_alb%clcat ) 
    2278              CASE( 'yes' )    
     2280             CASE( 'yes' ) 
    22792281                ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 
    22802282             CASE( 'no' ) 
    … …  
    22882290          CASE( 'weighted ice' )   ; 
    22892291             SELECT CASE( sn_snd_alb%clcat ) 
    2290              CASE( 'yes' )    
     2292             CASE( 'yes' ) 
    22912293                ztmp3(:,:,1:jpl) =  alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    22922294             CASE( 'no' ) 
    … …  
    23022304 
    23032305         SELECT CASE( sn_snd_alb%clcat ) 
    2304             CASE( 'yes' )    
     2306            CASE( 'yes' ) 
    23052307               CALL cpl_snd( jps_albice, isec, ztmp3, info )      !-> MV this has never been checked in coupled mode 
    2306             CASE( 'no'  )    
    2307                CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )  
     2308            CASE( 'no'  ) 
     2309               CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    23082310         END SELECT 
    23092311      ENDIF 
    … …  
    23172319      ENDIF 
    23182320      !                                                      ! ------------------------- ! 
    2319       !                                                      !  Ice fraction & Thickness !  
     2321      !                                                      !  Ice fraction & Thickness ! 
    23202322      !                                                      ! ------------------------- ! 
    23212323      ! Send ice fraction field to atmosphere 
    … …  
    23302332 
    23312333#if defined key_si3 || defined key_cice 
    2332       ! If this coupling was successful then save ice fraction for use between coupling points.  
    2333       ! This is needed for some calculations where the ice fraction at the last coupling point  
    2334       ! is needed.  
    2335       IF(  info == OASIS_Sent    .OR. info == OASIS_ToRest .OR. &  
    2336          & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN  
    2337          IF ( sn_snd_thick%clcat == 'yes' ) THEN  
     2334      ! If this coupling was successful then save ice fraction for use between coupling points. 
     2335      ! This is needed for some calculations where the ice fraction at the last coupling point 
     2336      ! is needed. 
     2337      IF(  info == OASIS_Sent    .OR. info == OASIS_ToRest .OR. & 
     2338         & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN 
     2339         IF ( sn_snd_thick%clcat == 'yes' ) THEN 
    23382340           a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl) 
    23392341         ENDIF 
    … …  
    23492351         CALL cpl_snd( jps_fice1, isec, ztmp3, info ) 
    23502352      ENDIF 
    2351        
     2353 
    23522354      ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling) 
    23532355      IF( ssnd(jps_fice2)%laction ) THEN 
    … …  
    23562358      ENDIF 
    23572359 
    2358       ! Send ice and snow thickness field  
    2359       IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN  
     2360      ! Send ice and snow thickness field 
     2361      IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN 
    23602362         SELECT CASE( sn_snd_thick%cldes) 
    23612363         CASE( 'none'                  )       ! nothing to do 
    2362          CASE( 'weighted ice and snow' )    
     2364         CASE( 'weighted ice and snow' ) 
    23632365            SELECT CASE( sn_snd_thick%clcat ) 
    2364             CASE( 'yes' )    
     2366            CASE( 'yes' ) 
    23652367               ztmp3(:,:,1:jpl) =  h_i(:,:,1:jpl) * a_i(:,:,1:jpl) 
    23662368               ztmp4(:,:,1:jpl) =  h_s(:,:,1:jpl) * a_i(:,:,1:jpl) 
    … …  
    23732375            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
    23742376            END SELECT 
    2375          CASE( 'ice and snow'         )    
     2377         CASE( 'ice and snow'         ) 
    23762378            SELECT CASE( sn_snd_thick%clcat ) 
    23772379            CASE( 'yes' ) 
    … …  
    23962398#if defined key_si3 
    23972399      !                                                      ! ------------------------- ! 
    2398       !                                                      !      Ice melt ponds       !  
    2399       !                                                      ! ------------------------- ! 
    2400       ! needed by Met Office: 1) fraction of ponded ice 2) local/actual pond depth  
    2401       IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN  
    2402          SELECT CASE( sn_snd_mpnd%cldes)   
    2403          CASE( 'ice only' )   
    2404             SELECT CASE( sn_snd_mpnd%clcat )   
    2405             CASE( 'yes' )   
     2400      !                                                      !      Ice melt ponds       ! 
     2401      !                                                      ! ------------------------- ! 
     2402      ! needed by Met Office: 1) fraction of ponded ice 2) local/actual pond depth 
     2403      IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 
     2404         SELECT CASE( sn_snd_mpnd%cldes) 
     2405         CASE( 'ice only' ) 
     2406            SELECT CASE( sn_snd_mpnd%clcat ) 
     2407            CASE( 'yes' ) 
    24062408               ztmp3(:,:,1:jpl) =  a_ip_eff(:,:,1:jpl) 
    2407                ztmp4(:,:,1:jpl) =  h_ip(:,:,1:jpl)   
    2408             CASE( 'no' )   
    2409                ztmp3(:,:,:) = 0.0   
    2410                ztmp4(:,:,:) = 0.0   
    2411                DO jl=1,jpl   
     2409               ztmp4(:,:,1:jpl) =  h_ip(:,:,1:jpl) 
     2410            CASE( 'no' ) 
     2411               ztmp3(:,:,:) = 0.0 
     2412               ztmp4(:,:,:) = 0.0 
     2413               DO jl=1,jpl 
    24122414                 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 
    24132415                 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 
    2414                ENDDO   
    2415             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' )   
    2416             END SELECT   
    2417          CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%cldes' )      
    2418          END SELECT   
    2419          IF( ssnd(jps_a_p)%laction  )   CALL cpl_snd( jps_a_p , isec, ztmp3, info )      
    2420          IF( ssnd(jps_ht_p)%laction )   CALL cpl_snd( jps_ht_p, isec, ztmp4, info )      
    2421       ENDIF  
    2422       !  
    2423       !                                                      ! ------------------------- ! 
    2424       !                                                      !     Ice conductivity      !  
     2416               ENDDO 
     2417            CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' ) 
     2418            END SELECT 
     2419         CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%cldes' ) 
     2420         END SELECT 
     2421         IF( ssnd(jps_a_p)%laction  )   CALL cpl_snd( jps_a_p , isec, ztmp3, info ) 
     2422         IF( ssnd(jps_ht_p)%laction )   CALL cpl_snd( jps_ht_p, isec, ztmp4, info ) 
     2423      ENDIF 
     2424      ! 
     2425      !                                                      ! ------------------------- ! 
     2426      !                                                      !     Ice conductivity      ! 
    24252427      !                                                      ! ------------------------- ! 
    24262428      ! needed by Met Office 
    2427       IF( ssnd(jps_kice)%laction ) THEN  
    2428          SELECT CASE( sn_snd_cond%cldes)  
    2429          CASE( 'weighted ice' )     
    2430             SELECT CASE( sn_snd_cond%clcat )  
    2431             CASE( 'yes' )     
    2432           ztmp3(:,:,1:jpl) =  cnd_ice(:,:,1:jpl) * a_i(:,:,1:jpl)  
    2433             CASE( 'no' )  
    2434                ztmp3(:,:,:) = 0.0  
    2435                DO jl=1,jpl  
    2436                  ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(:,:,jl)  
    2437                ENDDO  
    2438             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' )  
    2439             END SELECT  
    2440          CASE( 'ice only' )     
    2441            ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl)  
    2442          CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%cldes' )      
    2443          END SELECT  
    2444          IF( ssnd(jps_kice)%laction )   CALL cpl_snd( jps_kice, isec, ztmp3, info )  
    2445       ENDIF  
     2429      IF( ssnd(jps_kice)%laction ) THEN 
     2430         SELECT CASE( sn_snd_cond%cldes) 
     2431         CASE( 'weighted ice' ) 
     2432            SELECT CASE( sn_snd_cond%clcat ) 
     2433            CASE( 'yes' ) 
     2434          ztmp3(:,:,1:jpl) =  cnd_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     2435            CASE( 'no' ) 
     2436               ztmp3(:,:,:) = 0.0 
     2437               DO jl=1,jpl 
     2438                 ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(:,:,jl) 
     2439               ENDDO 
     2440            CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' ) 
     2441            END SELECT 
     2442         CASE( 'ice only' ) 
     2443           ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) 
     2444         CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%cldes' ) 
     2445         END SELECT 
     2446         IF( ssnd(jps_kice)%laction )   CALL cpl_snd( jps_kice, isec, ztmp3, info ) 
     2447      ENDIF 
    24462448#endif 
    24472449 
    24482450      !                                                      ! ------------------------- ! 
    2449       !                                                      !  CO2 flux from PISCES     !  
    2450       !                                                      ! ------------------------- ! 
    2451       IF( ssnd(jps_co2)%laction .AND. l_co2cpl )   THEN  
     2451      !                                                      !  CO2 flux from PISCES     ! 
     2452      !                                                      ! ------------------------- ! 
     2453      IF( ssnd(jps_co2)%laction .AND. l_co2cpl )   THEN 
    24522454         ztmp1(:,:) = oce_co2(:,:) * 1000.  ! conversion in molC/m2/s 
    24532455         CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ) , info ) 
    … …  
    24572459      IF( ssnd(jps_ocx1)%laction ) THEN                      !      Surface current      ! 
    24582460         !                                                   ! ------------------------- ! 
    2459          !     
     2461         ! 
    24602462         !                                                  j+1   j     -----V---F 
    24612463         ! surface velocity always sent from T point                     !       | 
    … …  
    24672469         !                                                               i      i+1 (for I) 
    24682470         IF( nn_components == jp_iam_opa ) THEN 
    2469             zotx1(:,:) = uu(:,:,1,Kmm)   
    2470             zoty1(:,:) = vv(:,:,1,Kmm)   
    2471          ELSE         
     2471            zotx1(:,:) = uu(:,:,1,Kmm) 
     2472            zoty1(:,:) = vv(:,:,1,Kmm) 
     2473         ELSE 
    24722474            SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    24732475            CASE( 'oce only'             )      ! C-grid ==> T 
    24742476               DO_2D( 0, 0, 0, 0 ) 
    24752477                  zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj  ,1,Kmm) ) 
    2476                   zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji  ,jj-1,1,Kmm) )  
     2478                  zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji  ,jj-1,1,Kmm) ) 
    24772479               END_2D 
    2478             CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T   
     2480            CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T 
    24792481               DO_2D( 0, 0, 0, 0 ) 
    2480                   zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   
     2482                  zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj) 
    24812483                  zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 
    24822484                  zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  )     + u_ice(ji-1,jj    )     ) *  fr_i(ji,jj) 
    … …  
    24992501         IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components 
    25002502            !                                                                     ! Ocean component 
    2501             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component  
    2502             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component  
    2503             zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components  
     2503            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component 
     2504            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component 
     2505            zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components 
    25042506            zoty1(:,:) = ztmp2(:,:) 
    25052507            IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component 
    2506                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component  
    2507                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component  
    2508                zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components  
     2508               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component 
     2509               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component 
     2510               zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components 
    25092511               zity1(:,:) = ztmp2(:,:) 
    25102512            ENDIF 
    … …  
    25312533         IF( ssnd(jps_ivy1)%laction )   CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid 
    25322534         IF( ssnd(jps_ivz1)%laction )   CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid 
    2533          !  
    2534       ENDIF 
    2535       ! 
    2536       !                                                      ! ------------------------- !  
    2537       !                                                      !  Surface current to waves !  
    2538       !                                                      ! ------------------------- !  
    2539       IF( ssnd(jps_ocxw)%laction .OR. ssnd(jps_ocyw)%laction ) THEN  
    2540           !      
    2541           !                                                  j+1  j     -----V---F  
    2542           ! surface velocity always sent from T point                    !       |  
    2543           !                                                       j      |   T   U  
    2544           !                                                              |       |  
    2545           !                                                   j   j-1   -I-------|  
    2546           !                                               (for I)        |       |  
    2547           !                                                             i-1  i   i  
    2548           !                                                              i      i+1 (for I)  
    2549           SELECT CASE( TRIM( sn_snd_crtw%cldes ) )  
    2550           CASE( 'oce only'             )      ! C-grid ==> T  
     2535         ! 
     2536      ENDIF 
     2537      ! 
     2538      !                                                      ! ------------------------- ! 
     2539      !                                                      !  Surface current to waves ! 
     2540      !                                                      ! ------------------------- ! 
     2541      IF( ssnd(jps_ocxw)%laction .OR. ssnd(jps_ocyw)%laction ) THEN 
     2542          ! 
     2543          !                                                  j+1  j     -----V---F 
     2544          ! surface velocity always sent from T point                    !       | 
     2545          !                                                       j      |   T   U 
     2546          !                                                              |       | 
     2547          !                                                   j   j-1   -I-------| 
     2548          !                                               (for I)        |       | 
     2549          !                                                             i-1  i   i 
     2550          !                                                              i      i+1 (for I) 
     2551          SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 
     2552          CASE( 'oce only'             )      ! C-grid ==> T 
    25512553             DO_2D( 0, 0, 0, 0 ) 
    2552                 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj  ,1,Kmm) )  
    2553                 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) )   
     2554                zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj  ,1,Kmm) ) 
     2555                zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) ) 
    25542556             END_2D 
    2555           CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T    
     2557          CASE( 'weighted oce and ice' )      ! Ocean and Ice on C-grid ==> T 
    25562558             DO_2D( 0, 0, 0, 0 ) 
    2557                 zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)    
    2558                 zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)  
    2559                 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)  
    2560                 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)  
     2559                zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj) 
     2560                zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj) 
     2561                zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
     2562                zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
    25612563             END_2D 
    2562              CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp,  zity1, 'T', -1.0_wp )  
    2563           CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T   
     2564             CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp,  zity1, 'T', -1.0_wp ) 
     2565          CASE( 'mixed oce-ice'        )      ! Ocean and Ice on C-grid ==> T 
    25642566             DO_2D( 0, 0, 0, 0 ) 
    2565                 zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   &  
    2566                    &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)  
    2567                 zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)   &  
    2568                    &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)  
     2567                zotx1(ji,jj) = 0.5 * ( uu   (ji,jj,1,Kmm) + uu   (ji-1,jj  ,1,Kmm) ) * zfr_l(ji,jj)   & 
     2568                   &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
     2569                zoty1(ji,jj) = 0.5 * ( vv   (ji,jj,1,Kmm) + vv   (ji  ,jj-1,1,Kmm) ) * zfr_l(ji,jj)   & 
     2570                   &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
    25692571             END_2D 
    25702572          END SELECT 
    2571          CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp )  
    2572          !  
    2573          !  
    2574          IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components  
    2575          !                                                                        ! Ocean component  
    2576             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->e', ztmp1 )       ! 1st component   
    2577             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->n', ztmp2 )       ! 2nd component   
    2578             zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components   
    2579             zoty1(:,:) = ztmp2(:,:)   
    2580             IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component  
    2581                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component   
    2582                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component   
    2583                zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components   
    2584                zity1(:,:) = ztmp2(:,:)  
    2585             ENDIF  
    2586          ENDIF  
    2587          !  
    2588 !         ! spherical coordinates to cartesian -> 2 components to 3 components  
    2589 !         IF( TRIM( sn_snd_crtw%clvref ) == 'cartesian' ) THEN  
    2590 !            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents  
    2591 !            ztmp2(:,:) = zoty1(:,:)  
    2592 !            CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )  
    2593 !            !  
    2594 !            IF( ssnd(jps_ivx1)%laction ) THEN           ! ice velocities  
    2595 !               ztmp1(:,:) = zitx1(:,:)  
    2596 !               ztmp1(:,:) = zity1(:,:)  
    2597 !               CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )  
    2598 !            ENDIF  
    2599 !         ENDIF  
    2600          !  
    2601          IF( ssnd(jps_ocxw)%laction )   CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid  
    2602          IF( ssnd(jps_ocyw)%laction )   CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid  
    2603          !   
    2604       ENDIF  
    2605       !  
    2606       IF( ssnd(jps_ficet)%laction ) THEN  
    2607          CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info )  
    2608       ENDIF  
    2609       !                                                      ! ------------------------- !  
    2610       !                                                      !   Water levels to waves   !  
    2611       !                                                      ! ------------------------- !  
    2612       IF( ssnd(jps_wlev)%laction ) THEN  
    2613          IF( ln_apr_dyn ) THEN   
    2614             IF( kt /= nit000 ) THEN   
    2615                ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )   
    2616             ELSE   
    2617                ztmp1(:,:) = ssh(:,:,Kbb)   
    2618             ENDIF   
    2619          ELSE   
    2620             ztmp1(:,:) = ssh(:,:,Kmm)   
    2621          ENDIF   
    2622          CALL cpl_snd( jps_wlev  , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )  
    2623       ENDIF  
     2573         CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp ) 
     2574         ! 
     2575         ! 
     2576         IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components 
     2577         !                                                                        ! Ocean component 
     2578            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->e', ztmp1 )       ! 1st component 
     2579            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->n', ztmp2 )       ! 2nd component 
     2580            zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components 
     2581            zoty1(:,:) = ztmp2(:,:) 
     2582            IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component 
     2583               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component 
     2584               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component 
     2585               zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components 
     2586               zity1(:,:) = ztmp2(:,:) 
     2587            ENDIF 
     2588         ENDIF 
     2589         ! 
     2590!         ! spherical coordinates to cartesian -> 2 components to 3 components 
     2591!         IF( TRIM( sn_snd_crtw%clvref ) == 'cartesian' ) THEN 
     2592!            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents 
     2593!            ztmp2(:,:) = zoty1(:,:) 
     2594!            CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 ) 
     2595!            ! 
     2596!            IF( ssnd(jps_ivx1)%laction ) THEN           ! ice velocities 
     2597!               ztmp1(:,:) = zitx1(:,:) 
     2598!               ztmp1(:,:) = zity1(:,:) 
     2599!               CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 ) 
     2600!            ENDIF 
     2601!         ENDIF 
     2602         ! 
     2603         IF( ssnd(jps_ocxw)%laction )   CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid 
     2604         IF( ssnd(jps_ocyw)%laction )   CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid 
     2605         ! 
     2606      ENDIF 
     2607      ! 
     2608      IF( ssnd(jps_ficet)%laction ) THEN 
     2609         CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info ) 
     2610      ENDIF 
     2611      !                                                      ! ------------------------- ! 
     2612      !                                                      !   Water levels to waves   ! 
     2613      !                                                      ! ------------------------- ! 
     2614      IF( ssnd(jps_wlev)%laction ) THEN 
     2615         IF( ln_apr_dyn ) THEN 
     2616            IF( kt /= nit000 ) THEN 
     2617               ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     2618            ELSE 
     2619               ztmp1(:,:) = ssh(:,:,Kbb) 
     2620            ENDIF 
     2621         ELSE 
     2622            ztmp1(:,:) = ssh(:,:,Kmm) 
     2623         ENDIF 
     2624         CALL cpl_snd( jps_wlev  , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     2625      ENDIF 
    26242626      ! 
    26252627      !  Fields sent by OPA to SAS when doing OPA<->SAS coupling 
    … …  
    26382640         CALL cpl_snd( jps_soce  , isec, RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) ), info ) 
    26392641      ENDIF 
    2640       !                                                        ! first T level thickness  
     2642      !                                                        ! first T level thickness 
    26412643      IF( ssnd(jps_e3t1st )%laction )  THEN 
    26422644         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(:,:,1,Kmm)   , (/jpi,jpj,1/) ), info ) 
    … …  
    26602662#if defined key_si3 
    26612663      !                                                      ! ------------------------- ! 
    2662       !                                                      ! Sea surface freezing temp !  
     2664      !                                                      ! Sea surface freezing temp ! 
    26632665      !                                                      ! ------------------------- ! 
    26642666      ! needed by Met Office 
    … …  
    26692671      ! 
    26702672   END SUBROUTINE sbc_cpl_snd 
    2671     
     2673 
    26722674   !!====================================================================== 
    26732675END MODULE sbccpl 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcmod.F90

    r13546 r13655  
    2727   USE closea         ! closed seas 
    2828   USE phycst         ! physical constants 
     29   USE sbc_phy, ONLY : pp_cldf 
    2930   USE sbc_oce        ! Surface boundary condition: ocean fields 
    3031   USE trc_oce        ! shared ocean-passive tracers variables 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/STATION_ASF/MY_SRC/diawri.F90

    r12615 r13655  
    387387      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau              )    ! i-wind stress 
    388388      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress 
    389  
     389      ! 
     390      CALL iom_close( inum ) 
     391      ! 
    390392#if defined key_si3 
    391393      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid 
     394         CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 
    392395         CALL ice_wri_state( inum ) 
    393       ENDIF 
     396         CALL iom_close( inum ) 
     397      ENDIF 
     398      ! 
    394399#endif 
    395       ! 
    396       CALL iom_close( inum ) 
    397       ! 
    398400   END SUBROUTINE dia_wri_state 
    399401 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/STATION_ASF/MY_SRC/nemogcm.F90

    r13286 r13655  
    3030   USE step_c1d       ! Time stepping loop for the 1D configuration 
    3131   ! 
    32    USE prtctl         ! Print control 
    3332   USE in_out_manager ! I/O manager 
    3433   USE lib_mpp        ! distributed memory computing 
    … …  
    4746   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing 
    4847 
     48#if defined key_mpp_mpi 
     49   ! need MPI_Wtime 
     50   INCLUDE 'mpif.h' 
     51#endif 
     52 
    4953   !!---------------------------------------------------------------------- 
    5054   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    51    !! $Id: nemogcm.F90 12489 2020-02-28 15:55:11Z davestorkey $ 
     55   !! $Id: nemogcm.F90 13286 2020-07-09 15:48:29Z smasson $ 
    5256   !! Software governed by the CeCILL license (see ./LICENSE) 
    5357   !!---------------------------------------------------------------------- 
    … …  
    110114      ! 
    111115#if defined key_iomput 
    112                                     CALL xios_finalize  ! end mpp communications with xios 
     116      CALL xios_finalize  ! end mpp communications with xios 
    113117#else 
    114118      IF( lk_mpp )                  CALL mppstop      ! end mpp communications 
    … …  
    146150#if defined key_iomput 
    147151      IF( Agrif_Root() ) THEN 
    148             CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )   ! nemo local communicator given by xios 
     152         CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )   ! nemo local communicator given by xios 
    149153      ENDIF 
    150154      CALL mpp_start( ilocal_comm ) 
    151155#else 
    152          CALL mpp_start( ) 
     156      CALL mpp_start( ) 
    153157#endif 
    154158      ! 
    … …  
    163167      IF( lwm )   CALL ctl_opn(     numout,        'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    164168      ! open reference and configuration namelist files 
    165                   CALL load_nml( numnam_ref,        'namelist_ref',                                           -1, lwm ) 
    166                   CALL load_nml( numnam_cfg,        'namelist_cfg',                                           -1, lwm ) 
     169      CALL load_nml( numnam_ref,        'namelist_ref',                                           -1, lwm ) 
     170      CALL load_nml( numnam_cfg,        'namelist_cfg',                                           -1, lwm ) 
    167171      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    168172      ! open /dev/null file to be able to supress output write easily 
    169173      IF( Agrif_Root() ) THEN 
    170                   CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     174         CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    171175#ifdef key_agrif 
    172176      ELSE 
    173                   numnul = Agrif_Parent(numnul)    
    174 #endif 
    175       ENDIF 
    176       ! 
     177         numnul = Agrif_Parent(numnul) 
     178#endif 
     179      ENDIF 
    177180      !                             !--------------------! 
    178181      !                             ! Open listing units !  -> need sn_cfctl from namctl to define lwp 
    … …  
    215218         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 
    216219         WRITE(numout,*) 
     220 
     221         ! Print the working precision to ocean.output 
     222         IF (wp == dp) THEN 
     223            WRITE(numout,*) "Working precision = double-precision" 
     224         ELSE 
     225            WRITE(numout,*) "Working precision = single-precision" 
     226         ENDIF 
     227         WRITE(numout,*) 
    217228         ! 
    218229         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
    … …  
    229240903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 
    230241      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    231 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )    
     242904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' ) 
    232243      ! 
    233244      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
    … …  
    260271      IF( ln_timing    )   CALL timing_start( 'nemo_init') 
    261272      ! 
    262                            CALL     phy_cst         ! Physical constants 
    263                            CALL     eos_init        ! Equation of state 
     273      CALL     phy_cst         ! Physical constants 
     274      CALL     eos_init        ! Equation of state 
    264275      IF( lk_c1d       )   CALL     c1d_init        ! 1D column configuration 
    265                            CALL     dom_init( Nbb, Nnn, Naa, "OPA") ! Domain 
     276      CALL     dom_init( Nbb, Nnn, Naa, "OPA") ! Domain 
    266277      IF( sn_cfctl%l_prtctl )   & 
    267278         &                 CALL prt_ctl_init        ! Print control 
    268       ! 
    269        
    270                            CALL  istate_init( Nbb, Nnn, Naa )    ! ocean initial state (Dynamics and tracers) 
    271  
    272       !                                      ! external forcing  
    273                            CALL     sbc_init( Nbb, Nnn, Naa )    ! surface boundary conditions (including sea-ice) 
     279 
     280      CALL  istate_init( Nbb, Nnn, Naa )    ! ocean initial state (Dynamics and tracers) 
     281 
     282      !                                      ! external forcing 
     283      CALL     sbc_init( Nbb, Nnn, Naa )    ! surface boundary conditions (including sea-ice) 
     284 
     285      !#LB: 
     286#if defined key_si3 
     287      IF(lwp) WRITE(numout,*) 'LOLO: nemo_init@nemogcm.F90: shape of fr_i ==>', SIZE(fr_i,1), SIZE(fr_i,2) 
     288      fr_i(:,:) = 0._wp 
     289#endif 
     290      !#LB. 
    274291 
    275292      ! 
    … …  
    302319         WRITE(numout,*) '                              sn_cfctl%l_prttrc  = ', sn_cfctl%l_prttrc 
    303320         WRITE(numout,*) '                              sn_cfctl%l_oasout  = ', sn_cfctl%l_oasout 
    304          WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin   
    305          WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax   
    306          WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    307          WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
     321         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin 
     322         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax 
     323         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr 
     324         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr 
    308325         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    309326         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    … …  
    366383      !!---------------------------------------------------------------------- 
    367384      ! 
    368       ierr =        oce_alloc    ()    ! ocean  
     385      ierr =        oce_alloc    ()    ! ocean 
    369386      ierr = ierr + dia_wri_alloc() 
    370387      ierr = ierr + dom_oce_alloc()    ! ocean domain 
    … …  
    375392   END SUBROUTINE nemo_alloc 
    376393 
    377     
     394 
    378395   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    379396      !!---------------------------------------------------------------------- 
    … …  
    399416   !!====================================================================== 
    400417END MODULE nemogcm 
    401  

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/STATION_ASF/MY_SRC/sbcssm.F90

    r12629 r13655  
    1919   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    2020   ! 
     21#if defined key_si3 
     22   USE ice            !#LB: we need to fill the "tm_su"   array! 
     23   USE sbc_ice        !#LB: we need to fill the "alb_ice" array! 
     24#endif 
     25   ! 
    2126   USE in_out_manager ! I/O manager 
    2227   USE iom            ! I/O library 
    … …  
    4853   INTEGER     ::   jf_e3t         ! index of first T level thickness 
    4954   INTEGER     ::   jf_frq         ! index of fraction of qsr absorbed in the 1st T level 
     55#if defined key_si3 
     56   INTEGER     ::   jf_ifr         ! index of sea-ice concentration !#LB 
     57   INTEGER     ::   jf_tic         ! index of sea-ice surface temperature !#LB 
     58   INTEGER     ::   jf_ial         ! index of sea-ice surface albedo !#LB 
     59#endif 
    5060 
    5161   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_3d  ! structure of input fields (file information, fields read) 
    … …  
    5464   !!---------------------------------------------------------------------- 
    5565   !! NEMO/SAS 4.0 , NEMO Consortium (2018) 
    56    !! $Id: sbcssm.F90 12615 2020-03-26 15:18:49Z laurent $ 
     66   !! $Id: sbcssm.F90 13286 2020-07-09 15:48:29Z smasson $ 
    5767   !! Software governed by the CeCILL license (see ./LICENSE) 
    5868   !!---------------------------------------------------------------------- 
    … …  
    7383      ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
    7484      ! 
    75       INTEGER  ::   ji, jj    ! dummy loop indices 
     85      INTEGER  ::   ji, jj, jl ! dummy loop indices 
    7686      REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation 
    7787      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation 
    … …  
    8494         IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d )      !==   read data at kt time step   ==! 
    8595         ! 
    86          IF( ln_3d_uve ) THEN 
    87             IF( .NOT. ln_linssh ) THEN 
    88                e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 
    89             ELSE 
    90                e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor 
    91             ENDIF 
    92             ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
    93             ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
    94          ELSE 
    95             IF( .NOT. ln_linssh ) THEN 
    96                e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 
    97             ELSE 
    98                e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor 
    99             ENDIF 
    100             ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
    101             ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
    102          ENDIF 
    103          ! 
     96         e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor 
     97         ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
     98         ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
     99         ! 
     100         !#LB: 
     101#if defined key_si3 
     102         !IF(lwp) WRITE(numout,*) 'LOLO: sbc_ssm()@sbcssm.F90 => fill "tm_su" and other fields at kt =', kt 
     103         !IF(lwp) WRITE(numout,*) 'LOLO: sbc_ssm()@sbcssm.F90 => shape of at_i ==>', SIZE(at_i,1), SIZE(at_i,2) 
     104         at_i (:,:) = sf_ssm_2d(jf_ifr)%fnow(:,:,1) * tmask(:,:,1)    ! sea-ice concentration [fraction] 
     105         tm_su(:,:) = sf_ssm_2d(jf_tic)%fnow(:,:,1) * tmask(:,:,1)    ! sea-ice surface temperature, read in [K] !#LB 
     106         sst_m(:,:) = sf_ssm_2d(jf_ial)%fnow(:,:,1) * tmask(:,:,1)    ! !!!sst_m AS TEMPORARY ARRAY !!! sea-ice albedo [fraction] 
     107         DO jl = 1, jpl 
     108            !IF(lwp) WRITE(numout,*) 'LOLO: sbc_ssm()@sbcssm.F90 => fill "t_su" for ice cat =', jl 
     109            a_i    (:,:,jl) = at_i (:,:) 
     110            a_i_b  (:,:,jl) = at_i (:,:) 
     111            t_su   (:,:,jl) = tm_su(:,:) 
     112            alb_ice(:,:,jl) = sst_m(:,:) 
     113         END DO 
     114         !IF(lwp) WRITE(numout,*) '' 
     115#endif 
     116         !#LB. 
    104117         sst_m(:,:) = sf_ssm_2d(jf_tem)%fnow(:,:,1) * tmask(:,:,1)    ! temperature 
    105118         sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1)    ! salinity 
    106119         ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1)    ! sea surface height 
    107          IF( ln_read_frq ) THEN 
    108             frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1) ! solar penetration 
    109          ELSE 
    110             frq_m(:,:) = 1._wp 
    111          ENDIF 
     120         frq_m(:,:) = 1._wp 
    112121      ELSE 
    113122         sss_m(:,:) = 35._wp                             ! =35. to obtain a physical value for the freezing point 
    … …  
    116125         ssv_m(:,:) = 0._wp 
    117126         ssh_m(:,:) = 0._wp 
    118          IF( .NOT. ln_linssh ) e3t_m(:,:) = e3t_0(:,:,1) !clem: necessary at least for sas2D 
    119127         frq_m(:,:) = 1._wp                              !              - - 
    120128         ssh  (:,:,Kmm) = 0._wp                              !              - - 
    … …  
    136144         CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m   - : ', mask1=vmask   ) 
    137145         CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m   - : ', mask1=tmask   ) 
    138          IF( .NOT.ln_linssh )   CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m   - : ', mask1=tmask   ) 
    139          IF( ln_read_frq    )   CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m   - : ', mask1=tmask   ) 
    140146      ENDIF 
    141147      ! 
    … …  
    146152         CALL iom_put( 'sss_m', sss_m ) 
    147153         CALL iom_put( 'ssh_m', ssh_m ) 
    148          IF( .NOT.ln_linssh )   CALL iom_put( 'e3t_m', e3t_m ) 
    149          IF( ln_read_frq    )   CALL iom_put( 'frq_m', frq_m ) 
    150154      ENDIF 
    151155      ! 
    … …  
    175179      TYPE(FLD_N) ::   sn_ssh, sn_e3t, sn_frq 
    176180      !! 
     181      TYPE(FLD_N) ::   sn_ifr, sn_tic, sn_ial ! #LB 
     182      !! 
    177183      NAMELIST/namsbc_sas/ l_sasread, cn_dir, ln_3d_uve, ln_read_frq,   & 
    178          &                 sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 
     184         &                 sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq, & 
     185         &                 sn_ifr, sn_tic, sn_ial  ! #LB 
    179186      !!---------------------------------------------------------------------- 
    180187      ! 
    … …  
    196203         WRITE(numout,*) '   Namelist namsbc_sas' 
    197204         WRITE(numout,*) '      Initialisation using an input file                                 l_sasread   = ', l_sasread 
    198          WRITE(numout,*) '      Are we supplying a 3D u,v and e3 field                             ln_3d_uve   = ', ln_3d_uve 
    199          WRITE(numout,*) '      Are we reading frq (fraction of qsr absorbed in the 1st T level)   ln_read_frq = ', ln_read_frq 
    200205      ENDIF 
    201206      ! 
    … …  
    218223         IF( lwp ) WRITE(numout,*) '         ==>>>   No freshwater budget adjustment needed with StandAlone Surface scheme' 
    219224         nn_fwb = 0 
     225      ENDIF 
     226      IF( ln_closea ) THEN 
     227         IF( lwp ) WRITE(numout,*) '         ==>>>   No closed seas adjustment needed with StandAlone Surface scheme' 
     228         ln_closea = .false. 
    220229      ENDIF 
    221230 
    … …  
    230239         !! and the rest of the logic should still work 
    231240         ! 
    232          jf_tem = 1   ;   jf_ssh = 3   ! default 2D fields index 
    233          jf_sal = 2   ;   jf_frq = 4   ! 
    234          ! 
    235          IF( ln_3d_uve ) THEN 
    236             jf_usp = 1   ;   jf_vsp = 2   ;   jf_e3t = 3     ! define 3D fields index 
    237             nfld_3d  = 2 + COUNT( (/.NOT.ln_linssh/) )       ! number of 3D fields to read 
    238             nfld_2d  = 3 + COUNT( (/ln_read_frq/) )          ! number of 2D fields to read 
    239          ELSE 
    240             jf_usp = 4   ;   jf_e3t = 6                      ! update 2D fields index 
    241             jf_vsp = 5   ;   jf_frq = 6 + COUNT( (/.NOT.ln_linssh/) ) 
    242             ! 
    243             nfld_3d  = 0                                     ! no 3D fields to read 
    244             nfld_2d  = 5 + COUNT( (/.NOT.ln_linssh/) ) + COUNT( (/ln_read_frq/) )    ! number of 2D fields to read 
    245          ENDIF 
     241         !#LB: 
     242         jf_tem = 1 
     243         jf_sal = 2 
     244         jf_ssh = 3 
     245         jf_usp = 4 
     246         jf_vsp = 5 
     247         ! 
     248         nfld_3d  = 0 
     249         nfld_2d  = 5 
     250         ! 
     251#if defined key_si3 
     252         jf_ifr = jf_vsp + 1 
     253         jf_tic = jf_vsp + 2 
     254         jf_ial = jf_vsp + 3 
     255         nfld_2d = nfld_2d + 3 
     256 
     257         !IF(lwp) WRITE(numout,*) 'LOLO: nfld_2d =', nfld_2d 
     258         !IF(lwp) WRITE(numout,*) 'LOLO: jf_tem =', jf_tem 
     259         !IF(lwp) WRITE(numout,*) 'LOLO: jf_sal =', jf_sal 
     260         !IF(lwp) WRITE(numout,*) 'LOLO: jf_ssh =', jf_ssh 
     261         !IF(lwp) WRITE(numout,*) 'LOLO: jf_usp =', jf_usp 
     262         !IF(lwp) WRITE(numout,*) 'LOLO: jf_vsp =', jf_vsp 
     263         !IF(lwp) WRITE(numout,*) 'LOLO: jf_ifr =', jf_ifr 
     264         !IF(lwp) WRITE(numout,*) 'LOLO: jf_tic =', jf_tic 
     265         !IF(lwp) WRITE(numout,*) 'LOLO: jf_ial =', jf_ial 
     266         !IF(lwp) WRITE(numout,*) '' 
     267#endif 
     268         !#LB. 
    246269         ! 
    247270         IF( nfld_3d > 0 ) THEN 
    … …  
    252275            slf_3d(jf_usp) = sn_usp 
    253276            slf_3d(jf_vsp) = sn_vsp 
    254             IF( .NOT.ln_linssh )   slf_3d(jf_e3t) = sn_e3t 
    255277         ENDIF 
    256278         ! 
    … …  
    261283            ENDIF 
    262284            slf_2d(jf_tem) = sn_tem   ;   slf_2d(jf_sal) = sn_sal   ;   slf_2d(jf_ssh) = sn_ssh 
    263             IF( ln_read_frq )   slf_2d(jf_frq) = sn_frq 
    264             IF( .NOT. ln_3d_uve ) THEN 
    265                slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 
    266                IF( .NOT.ln_linssh )   slf_2d(jf_e3t) = sn_e3t 
    267             ENDIF 
     285            slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 
    268286         ENDIF 
     287         ! 
     288#if defined key_si3 
     289         slf_2d(jf_ifr) = sn_ifr   !#LB 
     290         slf_2d(jf_tic) = sn_tic   !#LB 
     291         slf_2d(jf_ial) = sn_ial   !#LB 
     292#endif 
    269293         ! 
    270294         ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false. 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/STATION_ASF/MY_SRC/step_c1d.F90

    r13226 r13655  
    77   !!             3.0  !  2008-04  (G. Madec)  redo the adaptation to include SBC 
    88   !!             4.1  !  2019-08  (A. Coward, D. Storkey) rewrite in preparation for new timestepping scheme 
    9    !!             4.1  !  2019-12  (L. Brodeau) STATION_ASF test-case 
     9   !!             4.x  !  2020-09  (L. Brodeau) STATION_ASF test-case 
    1010   !!---------------------------------------------------------------------- 
    1111#if defined key_c1d 
    … …  
    2222   PRIVATE 
    2323 
    24    PUBLIC stp_c1d   ! called by nemogcm.F90 
     24   PUBLIC stp_c1d      ! called by nemogcm.F90 
    2525 
    2626   !!---------------------------------------------------------------------- 
    2727   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    28    !! $Id: step_c1d.F90 12377 2020-02-12 14:39:06Z acc $ 
     28   !! $Id: step_c1d.F90 13237 2020-07-03 09:12:53Z smasson $ 
    2929   !! Software governed by the CeCILL license (see ./LICENSE) 
    3030   !!---------------------------------------------------------------------- 
    … …  
    5151      ! 
    5252      INTEGER ::   jk       ! dummy loop indice 
    53       INTEGER ::   indic    ! error indicator if < 0 
    5453      !! --------------------------------------------------------------------- 
    55  
    56       indic = 0                ! reset to no error condition 
    5754      IF( kstp == nit000 )   CALL iom_init( "nemo")   ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    5855      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init) 
    … …  
    6360      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    6461      CALL sbc    ( kstp, Nbb, Nnn )  ! Sea Boundary Condition (including sea-ice) 
    65  
     62      !                  #LB:  ==> calls 'sbc_ssm()' ! 
    6663      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    6764      ! diagnostics and outputs 
    … …  
    7976      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    8077      CALL stp_ctl( kstp, Nnn ) 
    81  
    8278      IF( kstp == nit000 )   CALL iom_close( numror )          ! close input  ocean restart file 
    8379      IF( lrst_oce       )   CALL rst_write( kstp, Nbb, Nnn )  ! write output ocean restart file 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/STATION_ASF/MY_SRC/stpctl.F90

    r13616 r13655  
    4343      !!---------------------------------------------------------------------- 
    4444      !!                    ***  ROUTINE stp_ctl  *** 
    45       !!                      
     45      !! 
    4646      !! ** Purpose :   Control the run 
    4747      !! 
    … …  
    6363      INTEGER , DIMENSION(4)          ::   iareasum, iareamin, iareamax 
    6464      INTEGER , DIMENSION(3,3)        ::   iloc                                  ! min/max loc indices 
    65       REAL(wp)                        ::   zzz                                   ! local real  
     65      REAL(wp)                        ::   zzz                                   ! local real 
    6666      REAL(wp), DIMENSION(4)          ::   zmax, zmaxlocal 
    6767      LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce 
    … …  
    7272      ! 
    7373      ll_wrtstp  = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
    74       ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1  
     74      ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 
    7575      ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 
    7676      ! 
    … …  
    9898            istatus = NF90_ENDDEF(nrunid) 
    9999         ENDIF 
    100          !     
     100         ! 
    101101      ENDIF 
    102102      ! 
    … …  
    158158            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid) 
    159159            ! get global loc on the min/max 
    160             CALL mpp_maxloc( 'stpctl',    taum(:,:)  , llmsk, zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
     160            CALL mpp_maxloc( 'stpctl',    taum(:,:)  , llmsk, zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F 
    161161            CALL mpp_maxloc( 'stpctl',ABS( qns(:,:) ), llmsk, zzz, iloc(1:2,2) ) 
    162162            CALL mpp_minloc( 'stpctl',ABS( emp(:,:) ), llmsk, zzz, iloc(1:2,3) ) 
    … …  
    194194         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file 
    195195         ! 
    196          IF( ll_colruns .or. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
    197             IF(lwp) THEN   ;   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
    198             ELSE           ;   nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop) 
     196         IF( ll_colruns .OR. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
     197            IF(lwp) THEN 
     198               CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     199            ELSE 
     200               nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop) 
    199201            ENDIF 
    200202         ELSE                                    ! only mpi subdomains with errors are here -> STOP now 
    … …  
    235237      !!---------------------------------------------------------------------- 
    236238      WRITE(clkt , '(i9)') kt 
    237        
     239 
    238240      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij  ,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9) 
    239       !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
     241!!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
    240242      cl4 = '(i'//clfmt//')'   ;   WRITE(clsum, cl4) ksum 
    241243      WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1    ! how many digits to we need to write ? (we decide max = 9) 
    242244      cl4 = '(i'//clfmt//')'   ;   WRITE(clmin, cl4) kmin-1 
    243                                    WRITE(clmax, cl4) kmax-1 
     245      WRITE(clmax, cl4) kmax-1 
    244246      ! 
    245247      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1      ! how many digits to we need to write jpiglo? (we decide max = 9) 
    … …  
    257259      ELSE 
    258260         WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1      ! how many digits to we need to write jpk? (we decide max = 9) 
    259          !!! WRITE(clk, '(i'//clfmt//')') kloc(3)               ! this is creating a compilation error with AGRIF 
     261!!! WRITE(clk, '(i'//clfmt//')') kloc(3)               ! this is creating a compilation error with AGRIF 
    260262         cl4 = '(i'//clfmt//')'   ;   WRITE(clk, cl4) kloc(3)   ! this is ok with AGRIF 
    261263         WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj),    TRIM(clk), TRIM(clsuff) 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90

    r13286 r13655  
    1212 
    1313   !!---------------------------------------------------------------------- 
    14    !!   usr_def_hgr   : initialize the horizontal mesh  
     14   !!   usr_def_hgr   : initialize the horizontal mesh 
    1515   !!---------------------------------------------------------------------- 
     16   USE dom_oce  , ONLY: nimpp, njmpp       ! ocean space and time domain 
    1617   USE c1d      ,  ONLY: rn_lon1d, rn_lat1d ! ocean lon/lat define by namelist 
    1718   USE par_oce        ! ocean space and time domain 
    … …  
    2122   USE in_out_manager ! I/O manager 
    2223   USE lib_mpp        ! MPP library 
    23     
     24 
    2425   IMPLICIT NONE 
    2526   PRIVATE 
    … …  
    2930   !!---------------------------------------------------------------------- 
    3031   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    31    !! $Id: usrdef_hgr.F90 12489 2020-02-28 15:55:11Z davestorkey $  
     32   !! $Id: usrdef_hgr.F90 13216 2020-07-02 09:25:49Z rblod $ 
    3233   !! Software governed by the CeCILL license (see ./LICENSE) 
    3334   !!---------------------------------------------------------------------- 
    … …  
    4849      !! 
    4950      !!                Here STATION_ASF configuration : 
    50       !!          Rectangular 3x3 domain  
     51      !!          Rectangular 3x3 domain 
    5152      !!          - Located at 150E-50N 
    52       !!          - a constant horizontal resolution   
     53      !!          - a constant horizontal resolution 
    5354      !! 
    54       !! ** Action  : - define longitude & latitude of t-, u-, v- and f-points (in degrees)  
     55      !! ** Action  : - define longitude & latitude of t-, u-, v- and f-points (in degrees) 
    5556      !!              - define coriolis parameter at f-point if the domain in not on the sphere (on beta-plane) 
    5657      !!              - define i- & j-scale factors at t-, u-, v- and f-points (in meters) 
    … …  
    6364      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1t, pe1u, pe1v, pe1f       ! i-scale factors                             [m] 
    6465      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe2t, pe2u, pe2v, pe2f       ! j-scale factors                             [m] 
    65       INTEGER                 , INTENT(out) ::   ke1e2u_v                     ! =1 u- & v-surfaces computed here, =0 otherwise  
     66      INTEGER                 , INTENT(out) ::   ke1e2u_v                     ! =1 u- & v-surfaces computed here, =0 otherwise 
    6667      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2] 
    6768      ! 
    … …  
    7778      !                       ! longitude 
    7879      plamt(:,:) = rn_lon1d 
    79       plamu(:,:) = rn_lon1d  
     80      plamu(:,:) = rn_lon1d 
    8081      plamv(:,:) = rn_lon1d 
    8182      plamf(:,:) = rn_lon1d 
    … …  
    9394      pe1f(:,:) = 100.  ;   pe2f(:,:) = 100. 
    9495      ! 
    95       !                                         ! NO reduction of grid size in some straits  
     96      !                                         ! NO reduction of grid size in some straits 
    9697      ke1e2u_v = 0                              !    ==>> u_ & v_surfaces will be computed in dom_ghr routine 
    9798      pe1e2u(:,:) = 0._wp                       !    CAUTION: set to zero to avoid error with some compilers that 
    … …  
    100101      ! 
    101102      !                       !==  Coriolis parameter  ==! 
    102       zf0   = 2._wp * omega * SIN( rad * rn_lat1d )       
     103      zf0   = 2._wp * omega * SIN( rad * rn_lat1d ) 
    103104      pff_f(:,:) = zf0 
    104       pff_t(:,:) = zf0       
     105      pff_t(:,:) = zf0 
    105106      kff = 1                 !  indicate to skip computing Coriolis parameter afterward 
    106107      ! 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/STATION_ASF/MY_SRC/usrdef_nam.F90

    r13286 r13655  
    1313   !!---------------------------------------------------------------------- 
    1414   !!   usr_def_nam   : read user defined namelist and set global domain size 
    15    !!   usr_def_hgr   : initialize the horizontal mesh  
     15   !!   usr_def_hgr   : initialize the horizontal mesh 
    1616   !!---------------------------------------------------------------------- 
     17   USE dom_oce  , ONLY: nimpp, njmpp       ! ocean space and time domain 
    1718   USE par_oce        ! ocean space and time domain 
    1819   USE phycst         ! physical constants 
    … …  
    2021   USE in_out_manager ! I/O manager 
    2122   USE lib_mpp        ! MPP library 
    22     
     23 
    2324   IMPLICIT NONE 
    2425   PRIVATE 
    … …  
    3132   !!---------------------------------------------------------------------- 
    3233   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    33    !! $Id: usrdef_nam.F90 12377 2020-02-12 14:39:06Z acc $  
     34   !! $Id: usrdef_nam.F90 13216 2020-07-02 09:25:49Z rblod $ 
    3435   !! Software governed by the CeCILL license (see ./LICENSE) 
    3536   !!---------------------------------------------------------------------- 
    … …  
    3940      !!---------------------------------------------------------------------- 
    4041      !!                     ***  ROUTINE dom_nam  *** 
    41       !!                     
     42      !! 
    4243      !! ** Purpose :   read user defined namelist and define the domain size 
    4344      !! 
    … …  
    5051      CHARACTER(len=*), INTENT(out) ::   cd_cfg          ! configuration name 
    5152      INTEGER         , INTENT(out) ::   kk_cfg          ! configuration resolution 
    52       INTEGER         , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes  
    53       INTEGER         , INTENT(out) ::   kperio          ! lateral global domain b.c.  
     53      INTEGER         , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes 
     54      INTEGER         , INTENT(out) ::   kperio          ! lateral global domain b.c. 
    5455      ! 
    5556      INTEGER ::   ios   ! Local integer 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/STATION_ASF/MY_SRC/usrdef_zgr.F90

    r12629 r13655  
    1313   !!---------------------------------------------------------------------- 
    1414   !!   usr_def_zgr   : user defined vertical coordinate system 
    15    !!      zgr_z      : reference 1D z-coordinate  
     15   !!      zgr_z      : reference 1D z-coordinate 
    1616   !!      zgr_top_bot: ocean top and bottom level indices 
    1717   !!      zgr_zco    : 3D verticl coordinate in pure z-coordinate case 
    … …  
    3131   !!---------------------------------------------------------------------- 
    3232   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    33    !! $Id: usrdef_zgr.F90 12377 2020-02-12 14:39:06Z acc $ 
     33   !! $Id: usrdef_zgr.F90 13226 2020-07-02 14:24:31Z orioltp $ 
    3434   !! Software governed by the CeCILL license (see ./LICENSE) 
    3535   !!---------------------------------------------------------------------- 
    … …  
    5454      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth        [m] 
    5555      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors  [m] 
    56       REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors  
     56      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors 
    5757      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top, k_bot                ! first & last ocean level 
    5858      !!---------------------------------------------------------------------- 
    … …  
    8585      pe3uw(:,:,1) = rn_dept1  ! LB??? 
    8686      pe3vw(:,:,1) = rn_dept1  ! LB??? 
    87        
     87 
    8888      !! 2nd level, technically useless (only for the sake of code stability) 
    8989      pdept_1d(2) = 3._wp*rn_dept1 
Note: See TracChangeset for help on using the changeset viewer.