Changeset 13655


Ignore:
Timestamp:
2020-10-21T16:15:13+02:00 (6 months 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</