Changeset 12182 for NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE

Timestamp:

2019-12-11T12:38:43+01:00 (4 years ago)

Author:

davestorkey

Message:

2019/dev_r11943_MERGE_2019: Merge in dev_ASINTER-01-05_merge.

Location:

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE

Files:

• DIA/diawri.F90 (modified) (13 diffs)
• IOM/in_out_manager.F90 (modified) (1 diff)
• IOM/iom.F90 (modified) (10 diffs)
• IOM/iom_nf90.F90 (modified) (8 diffs)
• OBS/obs_averg_h2d.F90 (modified) (2 diffs)
• OBS/obs_oper.F90 (modified) (2 diffs)
• SBC/abl.F90 (copied) (copied from NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/abl.F90)
• SBC/cpl_oasis3.F90 (modified) (23 diffs)
• SBC/cyclone.F90 (modified) (8 diffs)
• SBC/fldread.F90 (modified) (12 diffs)
• SBC/sbc_oce.F90 (modified) (7 diffs)
• SBC/sbcabl.F90 (copied) (copied from NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcabl.F90)
• SBC/sbcapr.F90 (modified) (1 diff)
• SBC/sbcblk.F90 (modified) (46 diffs)
• SBC/sbcblk_algo_coare.F90 (deleted)
• SBC/sbcblk_algo_coare3p0.F90 (copied) (copied from NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcblk_algo_coare3p0.F90)
• SBC/sbcblk_algo_coare3p5.F90 (deleted)
• SBC/sbcblk_algo_coare3p6.F90 (copied) (copied from NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcblk_algo_coare3p6.F90)
• SBC/sbcblk_algo_ecmwf.F90 (modified) (13 diffs)
• SBC/sbcblk_algo_ncar.F90 (modified) (16 diffs)
• SBC/sbcblk_phy.F90 (copied) (copied from NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcblk_phy.F90)
• SBC/sbcblk_skin_coare.F90 (copied) (copied from NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcblk_skin_coare.F90)
• SBC/sbcblk_skin_ecmwf.F90 (copied) (copied from NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcblk_skin_ecmwf.F90)
• SBC/sbccpl.F90 (modified) (30 diffs)
• SBC/sbcdcy.F90 (modified) (8 diffs)
• SBC/sbcice_cice.F90 (modified) (19 diffs)
• SBC/sbcmod.F90 (modified) (14 diffs)
• SBC/sbcrnf.F90 (modified) (1 diff)
• SBC/sbctide.F90 (modified) (1 diff)
• SBC/tideini.F90 (modified) (2 diffs)
• ZDF/zdfiwm.F90 (modified) (1 diff)

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diawri.F90

@@ -28 +28 @@
    USE isf_oce
    USE isfcpl
+   USE abl            ! abl variables in case ln_abl = .true.
    USE dom_oce        ! ocean space and time domain
    USE phycst         ! physical constants
@@ -68 +69 @@
    PUBLIC   dia_wri_state
    PUBLIC   dia_wri_alloc           ! Called by nemogcm module
-
+#if ! defined key_iomput   
+   PUBLIC   dia_wri_alloc_abl       ! Called by sbcabl  module (if ln_abl = .true.)
+#endif
    INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file
    INTEGER ::          nb_T              , ndim_bT   ! grid_T file
@@ -74 +77 @@
    INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file
    INTEGER ::   nid_W, nz_W, nh_W                    ! grid_W file
+   INTEGER ::   nid_A, nz_A, nh_A, ndim_A, ndim_hA   ! grid_ABL file   
    INTEGER ::   ndex(1)                              ! ???
    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV
+   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL
    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V
    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT
@@ -417 +422 @@
          &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) )
          !
-      dia_wri_alloc = MAXVAL(ierr)
+     dia_wri_alloc = MAXVAL(ierr)
       CALL mpp_sum( 'diawri', dia_wri_alloc )
       !
    END FUNCTION dia_wri_alloc
+ 
+   INTEGER FUNCTION dia_wri_alloc_abl()
+      !!----------------------------------------------------------------------
+     ALLOCATE(   ndex_hA(jpi*jpj), ndex_A (jpi*jpj*jpkam1), STAT=dia_wri_alloc_abl)
+      CALL mpp_sum( 'diawri', dia_wri_alloc_abl )
+      !
+   END FUNCTION dia_wri_alloc_abl
 
    
@@ -444 +456 @@
       INTEGER  ::   ierr                                     ! error code return from allocation
       INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers
+      INTEGER  ::   ipka                                     ! ABL
       INTEGER  ::   jn, ierror                               ! local integers
       REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars
@@ -449 +462 @@
       REAL(wp), DIMENSION(jpi,jpj)   :: zw2d       ! 2D workspace
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d       ! 3D workspace
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl   ! ABL 3D workspace
       !!----------------------------------------------------------------------
       !
@@ -482 +496 @@
       ijmi = 1      ;      ijma = jpj
       ipk = jpk
+      IF(ln_abl) ipka = jpkam1
 
       ! define time axis
@@ -584 +599 @@
             &          "m", ipk, gdepw_1d, nz_W, "down" )
 
+         IF( ln_abl ) THEN 
+         ! Define the ABL grid FILE ( nid_A )
+            CALL dia_nam( clhstnam, nn_write, 'grid_ABL' )
+            IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
+            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
+               &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+               &          nit000-1, zjulian, rdt, nh_A, nid_A, domain_id=nidom, snc4chunks=snc4set )
+            CALL histvert( nid_A, "ght_abl", "Vertical T levels",      &  ! Vertical grid: gdept
+               &           "m", ipka, ght_abl(2:jpka), nz_A, "up" )
+            !                                                            ! Index of ocean points
+         ALLOCATE( zw3d_abl(jpi,jpj,ipka) ) 
+         zw3d_abl(:,:,:) = 1._wp 
+         CALL wheneq( jpi*jpj*ipka, zw3d_abl, 1, 1., ndex_A , ndim_A  )      ! volume
+            CALL wheneq( jpi*jpj     , zw3d_abl, 1, 1., ndex_hA, ndim_hA )      ! surface
+         DEALLOCATE(zw3d_abl)
+         ENDIF
 
          ! Declare all the output fields as NETCDF variables
@@ -633 +664 @@
          CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-!
+         !
+         IF( ln_abl ) THEN
+            CALL histdef( nid_A, "t_abl", "Potential Temperature"     , "K"        ,       &  ! t_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
+            CALL histdef( nid_A, "q_abl", "Humidity"                  , "kg/kg"    ,       &  ! q_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "u_abl", "Atmospheric U-wind   "     , "m/s"        ,     &  ! u_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
+            CALL histdef( nid_A, "v_abl", "Atmospheric V-wind   "     , "m/s"    ,         &  ! v_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "tke_abl", "Atmospheric TKE   "     , "m2/s2"    ,        &  ! tke_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "avm_abl", "Atmospheric turbulent viscosity", "m2/s"   ,  &  ! avm_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "avt_abl", "Atmospheric turbulent diffusivity", "m2/s2",  &  ! avt_abl
+               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
+            CALL histdef( nid_A, "pblh", "Atmospheric boundary layer height "  , "m",      &  ! pblh
+               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )                 
+#if defined key_si3
+            CALL histdef( nid_A, "oce_frac", "Fraction of open ocean"  , " ",      &  ! ato_i
+               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )
+#endif
+            CALL histend( nid_A, snc4chunks=snc4set )
+         ENDIF
+         !
          IF( ln_icebergs ) THEN
             CALL histdef( nid_T, "calving"             , "calving mass input"                       , "kg/s"   , &
@@ -791 +846 @@
       CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction   
       CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed   
-!
+      !
+      IF( ln_abl ) THEN 
+         ALLOCATE( zw3d_abl(jpi,jpj,jpka) )
+         IF( ln_mskland )   THEN 
+            DO jk=1,jpka
+               zw3d_abl(:,:,jk) = tmask(:,:,1)
+            END DO       
+         ELSE
+            zw3d_abl(:,:,:) = 1._wp     
+         ENDIF       
+         CALL histwrite( nid_A,  "pblh"   , it, pblh(:,:)                  *zw3d_abl(:,:,1     ), ndim_hA, ndex_hA )   ! pblh 
+         CALL histwrite( nid_A,  "u_abl"  , it, u_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! u_abl
+         CALL histwrite( nid_A,  "v_abl"  , it, v_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! v_abl
+         CALL histwrite( nid_A,  "t_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,1)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! t_abl
+         CALL histwrite( nid_A,  "q_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,2)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! q_abl       
+         CALL histwrite( nid_A,  "tke_abl", it, tke_abl (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! tke_abl
+         CALL histwrite( nid_A,  "avm_abl", it, avm_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avm_abl
+         CALL histwrite( nid_A,  "avt_abl", it, avt_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avt_abl 
+#if defined key_si3
+         CALL histwrite( nid_A,  "oce_frac"   , it, ato_i(:,:)                                  , ndim_hA, ndex_hA )   ! ato_i
+#endif
+         DEALLOCATE(zw3d_abl)
+      ENDIF
+      !
       IF( ln_icebergs ) THEN
          !
@@ -861 +939 @@
          CALL histclo( nid_V )
          CALL histclo( nid_W )
+         IF(ln_abl) CALL histclo( nid_A )
       ENDIF
       !
@@ -883 +962 @@
       INTEGER           , INTENT( in ) ::   Kmm              ! time level index
       CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zisfdebug
       !!
       INTEGER :: inum, jk
@@ -955 +1033 @@
          CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd            )    ! now StokesDrift k-velocity
       ENDIF
+      IF ( ln_abl ) THEN
+         CALL iom_rstput ( 0, 0, inum, "uz1_abl",   u_abl(:,:,2,nt_a  ) )   ! now first level i-wind
+         CALL iom_rstput ( 0, 0, inum, "vz1_abl",   v_abl(:,:,2,nt_a  ) )   ! now first level j-wind
+         CALL iom_rstput ( 0, 0, inum, "tz1_abl",  tq_abl(:,:,2,nt_a,1) )   ! now first level temperature
+         CALL iom_rstput ( 0, 0, inum, "qz1_abl",  tq_abl(:,:,2,nt_a,2) )   ! now first level humidity
+      ENDIF
  
 #if defined key_si3

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/IOM/in_out_manager.F90

@@ -87 +87 @@
    LOGICAL ::   lrst_oce              !: logical to control the oce restart write 
    LOGICAL ::   lrst_ice              !: logical to control the ice restart write 
+   LOGICAL ::   lrst_abl              !: logical to control the abl restart write 
    INTEGER ::   numror = 0            !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90)
    INTEGER ::   numrir                !: logical unit for ice   restart (read)
+   INTEGER ::   numrar                !: logical unit for abl   restart (read)
    INTEGER ::   numrow                !: logical unit for ocean restart (write)
    INTEGER ::   numriw                !: logical unit for ice   restart (write)
+   INTEGER ::   numraw                !: logical unit for abl   restart (write)
    INTEGER ::   nrst_lst              !: number of restart to output next
 

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/IOM/iom.F90

@@ -29 +29 @@
    USE lib_mpp           ! MPP library
 #if defined key_iomput
-   USE sbc_oce  , ONLY :   nn_fsbc         ! ocean space and time domain
+   USE sbc_oce  , ONLY :   nn_fsbc, ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1
    USE icb_oce  , ONLY :   nclasses, class_num       !  !: iceberg classes
 #if defined key_si3
@@ -111 +111 @@
       !
       REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds
+      REAL(wp), DIMENSION(2,jpkam1)         :: za_bnds   ! ABL vertical boundaries
       LOGICAL ::   ll_tmppatch = .TRUE.    !: seb: patch before we remove periodicity
       INTEGER ::   nldi_save, nlei_save    !:      and close boundaries in output files
@@ -194 +195 @@
       ! vertical grid definition
       IF(.NOT.llrst_context) THEN
-          CALL iom_set_axis_attr( "deptht",  paxis = gdept_1d )
-          CALL iom_set_axis_attr( "depthu",  paxis = gdept_1d )
-          CALL iom_set_axis_attr( "depthv",  paxis = gdept_1d )
-          CALL iom_set_axis_attr( "depthw",  paxis = gdepw_1d )
-
+          CALL iom_set_axis_attr(  "deptht", paxis = gdept_1d )
+          CALL iom_set_axis_attr(  "depthu", paxis = gdept_1d )
+          CALL iom_set_axis_attr(  "depthv", paxis = gdept_1d )
+          CALL iom_set_axis_attr(  "depthw", paxis = gdepw_1d )
+
+          ! ABL
+          IF( .NOT. ALLOCATED(ght_abl) ) THEN   ! force definition for xml files (xios) 
+             ALLOCATE( ght_abl(jpka), ghw_abl(jpka), e3t_abl(jpka), e3w_abl(jpka) )   ! default allocation needed by iom
+             ght_abl(:) = -1._wp   ;   ghw_abl(:) = -1._wp
+             e3t_abl(:) = -1._wp   ;   e3w_abl(:) = -1._wp
+          ENDIF
+          CALL iom_set_axis_attr( "ght_abl", ght_abl(2:jpka) )
+          CALL iom_set_axis_attr( "ghw_abl", ghw_abl(2:jpka) )
+          
           ! Add vertical grid bounds
           jkmin = MIN(2,jpk)  ! in case jpk=1 (i.e. sas2D)
@@ -207 +217 @@
           zw_bnds(2,1:jpkm1  ) = gdepw_1d(jkmin:jpk)
           zw_bnds(2,jpk:     ) = gdepw_1d(jpk) + e3t_1d(jpk)
-          CALL iom_set_axis_attr( "deptht", bounds=zw_bnds )
-          CALL iom_set_axis_attr( "depthu", bounds=zw_bnds )
-          CALL iom_set_axis_attr( "depthv", bounds=zw_bnds )
-          CALL iom_set_axis_attr( "depthw", bounds=zt_bnds )
+          CALL iom_set_axis_attr(  "deptht", bounds=zw_bnds )
+          CALL iom_set_axis_attr(  "depthu", bounds=zw_bnds )
+          CALL iom_set_axis_attr(  "depthv", bounds=zw_bnds )
+          CALL iom_set_axis_attr(  "depthw", bounds=zt_bnds )
+
+          ! ABL
+          za_bnds(1,:) = ghw_abl(1:jpkam1)
+          za_bnds(2,:) = ghw_abl(2:jpka  )
+          CALL iom_set_axis_attr( "ght_abl", bounds=za_bnds )
+          za_bnds(1,:) = ght_abl(2:jpka  )
+          za_bnds(2,:) = ght_abl(2:jpka  ) + e3w_abl(2:jpka)
+          CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds )
+
           CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) )
 # if defined key_si3
@@ -682 +701 @@
       clname   = trim(cdname)
       IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN
-!FUS         iln    = INDEX(clname,'/') 
-         iln    = INDEX(clname,'/',BACK=.true.)  ! FUS: to insert the nest index at the right location within the string, the last / has to be found (search from the right to left)
+         iln    = INDEX(clname,'/') 
          cltmpn = clname(1:iln)
          clname = clname(iln+1:LEN_TRIM(clname))
@@ -1128 +1146 @@
             WRITE(cldmspc , fmt='(i1)') idmspc
             !
-            IF(     idmspc <  irankpv ) THEN 
-               CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   &
-                  &                         'it is impossible to read a '//clrankpv//'D array from this file...' )
-            ELSEIF( idmspc == irankpv ) THEN
+            !!GS: we consider 2D data as 3D data with vertical dim size = 1
+            !IF(     idmspc <  irankpv ) THEN 
+            !   CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   &
+            !      &                         'it is impossible to read a '//clrankpv//'D array from this file...' )
+            !ELSEIF( idmspc == irankpv ) THEN
+            IF( idmspc == irankpv ) THEN
                IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   &
                   &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' )
@@ -1929 +1949 @@
       !
       INTEGER :: ji, jj, jn, ni, nj
-      INTEGER :: icnr, jcnr                                    ! Offset such that the vertex coordinate (i+icnr,j+jcnr)
-      !                                                        ! represents the bottom-left corner of cell (i,j)
+      INTEGER :: icnr, jcnr                             ! Offset such that the vertex coordinate (i+icnr,j+jcnr)
+      !                                                 ! represents the bottom-left corner of cell (i,j)
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j)
       REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_fld       ! Working array to determine where to rotate cells
@@ -2101 +2121 @@
       f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of)
       f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of)
-      f_op%timestep = 1        ;  f_of%timestep =  0  ; CALL iom_set_field_attr('ptrc_T'          , freq_op=f_op, freq_offset=f_of)
-      f_op%timestep = 1        ;  f_of%timestep =  0  ; CALL iom_set_field_attr('diad_T'          , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('ABL'             , freq_op=f_op, freq_offset=f_of)
 
       ! output file names (attribut: name)
@@ -2227 +2246 @@
       CHARACTER(LEN=20)  ::   clfreq
       CHARACTER(LEN=20)  ::   cldate
-      CHARACTER(LEN=256) ::   cltmpn                 !FUS needed for correct path with AGRIF
-      INTEGER            ::   iln                    !FUS needed for correct path with AGRIF
       INTEGER            ::   idx
       INTEGER            ::   jn
@@ -2311 +2328 @@
             END DO
             !
-!FUS            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
-!FUS see comment line 700 
-            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) THEN
-             iln    = INDEX(clname,'/',BACK=.true.)
-             cltmpn = clname(1:iln)
-             clname = clname(iln+1:LEN_TRIM(clname))
-             clname = TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
-            ENDIF
-!FUS 
+            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
             IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname )
             IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname )

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/IOM/iom_nf90.F90

@@ -19 +19 @@
    !!----------------------------------------------------------------------
    USE dom_oce         ! ocean space and time domain
+   USE sbc_oce, ONLY: jpka, ght_abl ! abl vertical level number and height
    USE lbclnk          ! lateal boundary condition / mpp exchanges
    USE iom_def         ! iom variables definitions
@@ -56 +57 @@
       LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence 
       INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters: 
-      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the third dimension
+      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the ice/abl third dimension
 
       CHARACTER(LEN=256) ::   clinfo           ! info character
@@ -69 +70 @@
       INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5
       LOGICAL            ::   llclobber        ! local definition of ln_clobber
-      INTEGER            ::   ilevels           ! vertical levels
+      INTEGER            ::   ilevels          ! vertical levels
       !---------------------------------------------------------------------
       !
@@ -76 +77 @@
       !
       !                 !number of vertical levels
-      IF( PRESENT(kdlev) ) THEN   ;   ilevels = kdlev    ! use input value (useful for sea-ice)
-      ELSE                        ;   ilevels = jpk      ! by default jpk
+      IF( PRESENT(kdlev) )   THEN   ;   ilevels = kdlev    ! use input value (useful for sea-ice and abl)
+      ELSE                          ;   ilevels = jpk      ! by default jpk
       ENDIF
       !
@@ -126 +127 @@
             CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo)
             CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), idmy ), clinfo)
-            CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',            jpk, idmy ), clinfo)
-            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo)
-            IF( PRESENT(kdlev) )   &
-               CALL iom_nf90_check(NF90_DEF_DIM( if90id,    'numcat',          kdlev, idmy ), clinfo)
+            IF( PRESENT(kdlev) ) THEN
+              IF( kdlev == jpka ) THEN
+                 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev',          kdlev, idmy ), clinfo)
+                 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo)
+              ELSE
+                 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev',            jpk, idmy ), clinfo)
+                 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo)
+                 CALL iom_nf90_check(NF90_DEF_DIM( if90id,  'numcat',          kdlev, idmy ), clinfo)
+              ENDIF
+            ELSE
+               CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev',            jpk, idmy ), clinfo)
+               CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo)
+            ENDIF
             ! global attributes
             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo)
@@ -196 +206 @@
       CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
       INTEGER              , INTENT(in   )           ::   kiv   ! 
-      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
-      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions
+      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of each dimension
+      INTEGER              , INTENT(  out), OPTIONAL ::   kndims   ! number of dimensions
       LOGICAL              , INTENT(  out), OPTIONAL ::   lduld    ! true if the last dimension is unlimited (time)
       !
@@ -584 +594 @@
          IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0
          ELSEIF( PRESENT(pv_r1d) ) THEN
-            IF( SIZE(pv_r1d,1) == jpk ) THEN   ;   idim3 = 3
-            ELSE                               ;   idim3 = 5
+            IF(( SIZE(pv_r1d,1) == jpk ).OR.( SIZE(pv_r1d,1) == jpka )) THEN   ;   idim3 = 3
+            ELSE                                                               ;   idim3 = 5
             ENDIF
                                               idims = 2   ;   idimid(1:idims) = (/idim3,4/)
          ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/)
          ELSEIF( PRESENT(pv_r3d) ) THEN
-            IF( SIZE(pv_r3d,3) == jpk ) THEN   ;   idim3 = 3
-            ELSE                               ;   idim3 = 5
+            IF(( SIZE(pv_r3d,3) == jpk ).OR.( SIZE(pv_r3d,3) == jpka )) THEN   ;   idim3 = 3
+            ELSE                                                               ;   idim3 = 5
             ENDIF
                                               idims = 4   ;   idimid(1:idims) = (/1,2,idim3,4/)
@@ -674 +684 @@
                CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo )
                CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo )
-               CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gdept_1d       ), clinfo )
+               IF (iom_file(kiomid)%nlev == jpka) THEN   ;   CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy,  ght_abl), clinfo )
+               ELSE                                      ;   CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gdept_1d), clinfo )
+               ENDIF
                IF( NF90_INQ_VARID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN
                   CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, (/ (idlv, idlv = 1,iom_file(kiomid)%nlev) /)), clinfo )

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/OBS/obs_averg_h2d.F90

@@ -52 +52 @@
    SUBROUTINE obs_avg_h2d_init( kpk, kpk2, kmaxifp, kmaxjfp, k2dint, plam,  pphi, &
       &                         pglam, pgphi, pglamf, pgphif, pmask, plamscl, pphiscl, lindegrees, &
-      &                         pweig, pobsmask, iminpoints )
+      &                         pweig, iminpoints )
       !!-----------------------------------------------------------------------
       !!
@@ -98 +98 @@
       REAL(KIND=wp), DIMENSION(kmaxifp,kmaxjfp,kpk2), INTENT(OUT) ::  &
          & pweig                ! Weights for averaging
-      REAL(KIND=wp), DIMENSION(kpk2), INTENT(OUT) ::  &
-         & pobsmask             ! Vertical mask for observations
       INTEGER, INTENT(IN), OPTIONAL :: &
          & iminpoints           ! Reject point which is not surrounded

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/OBS/obs_oper.F90

@@ -342 +342 @@
             CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,     &
                &                   zglam2(:,:,iobs), zgphi2(:,:,iobs), &
-               &                   zmask2(:,:,1,iobs), zweig2, zmsk_2 )
+               &                   zmask2(:,:,1,iobs), zweig2, zmsk_2)
  
          ENDIF
@@ -924 +924 @@
                &                   zglamf(:,:,iobs), zgphif(:,:,iobs), &
                &                   zmask(:,:,iobs), plamscl, pphiscl, &
-               &                   lindegrees, zweig, zobsmask )
+               &                   lindegrees, zweig )
 
             ! Average the model SST to the observation footprint

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/cpl_oasis3.F90

@@ -114 +114 @@
       !------------------------------------------------------------------
       CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror )
-      IF ( nerror /= OASIS_Ok ) &
+      IF( nerror /= OASIS_Ok ) &
          CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp')
 
@@ -122 +122 @@
 
       CALL oasis_get_localcomm ( kl_comm, nerror )
-      IF ( nerror /= OASIS_Ok ) &
+      IF( nerror /= OASIS_Ok ) &
          CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' )
       !
@@ -149 +149 @@
 
       ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define
-      IF ( ltmp_wapatch ) THEN
+      IF( ltmp_wapatch ) THEN
          nldi_save = nldi   ;   nlei_save = nlei
          nldj_save = nldj   ;   nlej_save = nlej
@@ -217 +217 @@
       !
       DO ji = 1, ksnd
-         IF ( ssnd(ji)%laction ) THEN
+         IF( ssnd(ji)%laction ) THEN
 
             IF( ssnd(ji)%nct > nmaxcat ) THEN
@@ -228 +228 @@
                DO jm = 1, kcplmodel
 
-                  IF ( ssnd(ji)%nct .GT. 1 ) THEN
+                  IF( ssnd(ji)%nct .GT. 1 ) THEN
                      WRITE(cli2,'(i2.2)') jc
                      zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2
@@ -234 +234 @@
                      zclname = ssnd(ji)%clname
                   ENDIF
-                  IF ( kcplmodel  > 1 ) THEN
+                  IF( kcplmodel  > 1 ) THEN
                      WRITE(cli2,'(i2.2)') jm
                      zclname = 'model'//cli2//'_'//TRIM(zclname)
@@ -241 +241 @@
                   IF( agrif_fixed() /= 0 ) THEN 
                      zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
-                  END IF
+                  ENDIF
 #endif
                   IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out
                   CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 1 /),   &
                      &                OASIS_Out          , ishape , OASIS_REAL, nerror )
-                  IF ( nerror /= OASIS_Ok ) THEN
+                  IF( nerror /= OASIS_Ok ) THEN
                      WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
                      CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
@@ -262 +262 @@
       !
       DO ji = 1, krcv
-         IF ( srcv(ji)%laction ) THEN 
+         IF( srcv(ji)%laction ) THEN 
             
             IF( srcv(ji)%nct > nmaxcat ) THEN
@@ -273 +273 @@
                DO jm = 1, kcplmodel
                   
-                  IF ( srcv(ji)%nct .GT. 1 ) THEN
+                  IF( srcv(ji)%nct .GT. 1 ) THEN
                      WRITE(cli2,'(i2.2)') jc
                      zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2
@@ -279 +279 @@
                      zclname = srcv(ji)%clname
                   ENDIF
-                  IF ( kcplmodel  > 1 ) THEN
+                  IF( kcplmodel  > 1 ) THEN
                      WRITE(cli2,'(i2.2)') jm
                      zclname = 'model'//cli2//'_'//TRIM(zclname)
@@ -286 +286 @@
                   IF( agrif_fixed() /= 0 ) THEN 
                      zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
-                  END IF
+                  ENDIF
 #endif
                   IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In
                   CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 1 /),   &
                      &                OASIS_In           , ishape , OASIS_REAL, nerror )
-                  IF ( nerror /= OASIS_Ok ) THEN
+                  IF( nerror /= OASIS_Ok ) THEN
                      WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
                      CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
@@ -310 +310 @@
       IF( nerror /= OASIS_Ok )   CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef')
       !
-      IF ( ltmp_wapatch ) THEN
+      IF( ltmp_wapatch ) THEN
          nldi = nldi_save   ;   nlei = nlei_save
          nldj = nldj_save   ;   nlej = nlej_save
@@ -332 +332 @@
       !!--------------------------------------------------------------------
       ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define
-      IF ( ltmp_wapatch ) THEN
+      IF( ltmp_wapatch ) THEN
          nldi_save = nldi   ;   nlei_save = nlei
          nldj_save = nldj   ;   nlej_save = nlej
@@ -349 +349 @@
                CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo )
                
-               IF ( ln_ctl ) THEN        
-                  IF ( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   &
+               IF( ln_ctl ) THEN        
+                  IF( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   &
                      & kinfo == OASIS_SentOut  .OR. kinfo == OASIS_ToRestOut ) THEN
                      WRITE(numout,*) '****************'
@@ -368 +368 @@
          ENDDO
       ENDDO
-      IF ( ltmp_wapatch ) THEN
+      IF( ltmp_wapatch ) THEN
          nldi = nldi_save   ;   nlei = nlei_save
          nldj = nldj_save   ;   nlej = nlej_save
@@ -393 +393 @@
       !!--------------------------------------------------------------------
       ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define
-      IF ( ltmp_wapatch ) THEN
+      IF( ltmp_wapatch ) THEN
          nldi_save = nldi   ;   nlei_save = nlei
          nldj_save = nldj   ;   nlej_save = nlej
@@ -403 +403 @@
       !
       DO jc = 1, srcv(kid)%nct
-         IF ( ltmp_wapatch ) THEN
+         IF( ltmp_wapatch ) THEN
             IF( nimpp           ==      1 ) nldi = 1
             IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi
@@ -420 +420 @@
                   &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut
                
-               IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)
+               IF( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)
                
-               IF ( llaction ) THEN
+               IF( llaction ) THEN
                   
                   kinfo = OASIS_Rcv
@@ -432 +432 @@
                   ENDIF
                   
-                  IF ( ln_ctl ) THEN        
+                  IF( ln_ctl ) THEN        
                      WRITE(numout,*) '****************'
                      WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname
@@ -450 +450 @@
          ENDDO
 
-         IF ( ltmp_wapatch ) THEN
+         IF( ltmp_wapatch ) THEN
             nldi = nldi_save   ;   nlei = nlei_save
             nldj = nldj_save   ;   nlej = nlej_save
@@ -483 +483 @@
       !
       DO ji = 1, nsnd
-         IF (ssnd(ji)%laction ) THEN
+         IF(ssnd(ji)%laction ) THEN
             DO jm = 1, ncplmodel
                IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN
@@ -495 +495 @@
       ENDDO
       DO ji = 1, nrcv
-         IF (srcv(ji)%laction ) THEN
+         IF(srcv(ji)%laction ) THEN
             DO jm = 1, ncplmodel
                IF( srcv(ji)%nid(1,jm) /= -1 ) THEN
@@ -529 +529 @@
       !
       DEALLOCATE( exfld )
-      IF (nstop == 0) THEN
+      IF(nstop == 0) THEN
          CALL oasis_terminate( nerror )         
       ELSE

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/cyclone.F90

@@ -137 +137 @@
             zhemi = SIGN( 1. , zrlat )
             zinfl = 15.* rad                             ! clim inflow angle in Tropical Cyclones
-         IF ( vortex == 0 ) THEN
+         IF( vortex == 0 ) THEN
 
             ! Vortex Holland reconstruct wind at each lon-lat position
@@ -157 +157 @@
                      &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) )
 
-                 IF (zdist < zrout2) THEN ! calculation of wind only to a given max radius
+                 IF(zdist < zrout2) THEN ! calculation of wind only to a given max radius
                   ! shape of the wind profile
                   zztmp = ( zrmw / ( zdist + 1.e-12 ) )**zb
                   zztmp =  zvmax * SQRT( zztmp * EXP(1. - zztmp) )    
 
-                  IF (zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2
+                  IF(zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2
                      zztmp = zztmp * ( (zrout2-zdist)*1.e-6 )
                   ENDIF
 
                   ! !!! KILL EQ WINDS
-                  ! IF (SIGN( 1. , zrlat ) /= zhemi) THEN
+                  ! IF(SIGN( 1. , zrlat ) /= zhemi) THEN
                   !    zztmp = 0.                              ! winds in other hemisphere
-                  !    IF (ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S
-                  ! ENDIF
-                  ! IF (ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN
+                  !    IF(ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S
+                  ! ENDIF
+                  ! IF(ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN
                   !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) ) 
                   !    !linear to zero between 10 and 5
@@ -177 +177 @@
                   ! !!! / KILL EQ
 
-                  IF (ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude
+                  IF(ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude
 
                   zwnd_t =   COS( zinfl ) * zztmp    
@@ -196 +196 @@
             END DO
          
-         ELSE IF ( vortex == 1 ) THEN
+         ELSE IF( vortex == 1 ) THEN
 
             ! Vortex Willoughby reconstruct wind at each lon-lat position
@@ -206 +206 @@
             zn   =   2.1340 + 0.0077*zvmax - 0.4522*LOG(zrmw/1000.) - 0.0038*ABS( ztct(jtc,jp_lat) )            
             zA   =   0.5913 + 0.0029*zvmax - 0.1361*LOG(zrmw/1000.) - 0.0042*ABS( ztct(jtc,jp_lat) )  
-            IF (zA < 0) THEN 
+            IF(zA < 0) THEN 
                zA=0
             ENDIF           
@@ -218 +218 @@
                      &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) )
 
-                 IF (zdist < zrout2) THEN ! calculation of wind only to a given max radius
+                 IF(zdist < zrout2) THEN ! calculation of wind only to a given max radius
                
                   ! shape of the wind profile                     
-                  IF (zdist <= zrmw) THEN     ! inside the Radius of Maximum Wind
+                  IF(zdist <= zrmw) THEN     ! inside the Radius of Maximum Wind
                      zztmp  = zvmax * (zdist/zrmw)**zn
                   ELSE 
@@ -227 +227 @@
                   ENDIF
 
-                  IF (zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2
+                  IF(zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2
                      zztmp = zztmp * ( (zrout2-zdist)*1.e-6 )
                   ENDIF
 
                   ! !!! KILL EQ WINDS
-                  ! IF (SIGN( 1. , zrlat ) /= zhemi) THEN
+                  ! IF(SIGN( 1. , zrlat ) /= zhemi) THEN
                   !    zztmp = 0.                              ! winds in other hemisphere
-                  !    IF (ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S
-                  ! ENDIF
-                  ! IF (ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN
+                  !    IF(ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S
+                  ! ENDIF
+                  ! IF(ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN
                   !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) ) 
                   !    !linear to zero between 10 and 5
@@ -242 +242 @@
                   ! !!! / KILL EQ
 
-                  IF (ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude
+                  IF(ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude
 
                   zwnd_t =   COS( zinfl ) * zztmp    

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/fldread.F90

@@ -168 +168 @@
       IF( PRESENT(kit) )   ll_firstcall = ll_firstcall .and. kit == 1
 
-      IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc
+      IF( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc
       ELSE                                      ;   it_offset = 0
       ENDIF
@@ -391 +391 @@
          ENDIF
          !
-         IF ( sdjf%cltype(1:4) == 'week' ) THEN
+         IF( sdjf%cltype(1:4) == 'week' ) THEN
             isec_week = isec_week + ksec_week( sdjf%cltype(6:8) )   ! second since the beginning of the week
             llprevmth = isec_week > nsec_month                      ! longer time since the beginning of the week than the month
@@ -466 +466 @@
       ENDIF
       !
-      IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc
+      IF( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc
       ELSE                                      ;   it_offset = 0
       ENDIF
@@ -659 +659 @@
             ENDIF
          CASE DEFAULT
-            IF (lk_c1d .AND. lmoor ) THEN
+            IF(lk_c1d .AND. lmoor ) THEN
                IF( sdjf%ln_tint ) THEN
                   CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(2,2,:,2), sdjf%nrec_a(1) )
@@ -1074 +1074 @@
          imonth = kmonth
          iday = kday
-         IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week
+         IF( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week
             isec_week = ksec_week( sdjf%cltype(6:8) )- (86400 * 8 )  
             llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month
@@ -1083 +1083 @@
          ENDIF
       ELSE                                                  ! use current day values
-         IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week
+         IF( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week
             isec_week  = ksec_week( sdjf%cltype(6:8) )      ! second since the beginning of the week
             llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month
@@ -1321 +1321 @@
 
       !! get dimensions
-      IF ( SIZE(sd%fnow, 3) > 1 ) THEN
+      !!GS: we consider 2D data as 3D data with vertical dim size = 1
+      !IF( SIZE(sd%fnow, 3) > 1 ) THEN
+      IF( SIZE(sd%fnow, 3) > 0 ) THEN
          ALLOCATE( ddims(4) )
       ELSE
@@ -1334 +1336 @@
 
       CALL iom_open ( sd%wgtname, inum )   ! interpolation weights
-      IF ( inum > 0 ) THEN
+      IF( inum > 0 ) THEN
 
          !! determine whether we have an east-west cyclic grid
@@ -1643 +1645 @@
          
          ref_wgts(kw)%fly_dta(:,:,:) = 0.0
-         SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) )
-         CASE(1)
-              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn)
-         CASE DEFAULT
+         !!GS: we consider 2D data as 3D data with vertical dim size = 1 
+         !SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) )
+         !CASE(1)
+         !     CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn)
+         !CASE DEFAULT
               CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn)
-         END SELECT 
+         !END SELECT 
       ENDIF
       
@@ -1666 +1669 @@
       END DO
 
-      IF (ref_wgts(kw)%numwgt .EQ. 16) THEN
+      IF(ref_wgts(kw)%numwgt .EQ. 16) THEN
 
         !! fix up halo points that we couldnt read from file
@@ -1692 +1695 @@
            IF( jpi1 == 2 ) THEN
               rec1(1) = ref_wgts(kw)%ddims(1) - ref_wgts(kw)%overlap
-              SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) )
-              CASE(1)
-                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn)
-              CASE DEFAULT
+              !!GS: we consider 2D data as 3D data with vertical dim size = 1
+              !SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) )
+              !CASE(1)
+              !     CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn)
+              !CASE DEFAULT
                    CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn)
-              END SELECT      
+              !END SELECT      
               ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:)
            ENDIF
            IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN
               rec1(1) = 1 + ref_wgts(kw)%overlap
-              SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) )
-              CASE(1)
-                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn)
-              CASE DEFAULT
+              !!GS: we consider 2D data as 3D data with vertical dim size = 1
+              !SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) )
+              !CASE(1)
+              !     CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn)
+              !CASE DEFAULT
                    CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn)
-              END SELECT
+              !END SELECT
               ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:)
            ENDIF
@@ -1749 +1754 @@
          END DO
          !
-      END IF
+      ENDIF
       !
    END SUBROUTINE fld_interp

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbc_oce.F90

@@ -11 +11 @@
    !!            4.0  ! 2012-05  (C. Rousset) add attenuation coef for use in ice model 
    !!            4.0  ! 2016-06  (L. Brodeau) new unified bulk routine (based on AeroBulk)
+   !!            4.0  ! 2019-03  (F. Lemarié, G. Samson) add compatibility with ABL mode    
    !!----------------------------------------------------------------------
 
@@ -34 +35 @@
    LOGICAL , PUBLIC ::   ln_flx         !: flux      formulation
    LOGICAL , PUBLIC ::   ln_blk         !: bulk formulation
+   LOGICAL , PUBLIC ::   ln_abl         !: Atmospheric boundary layer model
 #if defined key_oasis3
    LOGICAL , PUBLIC ::   lk_oasis = .TRUE.  !: OASIS used
@@ -76 +78 @@
    INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux                          formulation
    INTEGER , PUBLIC, PARAMETER ::   jp_blk     = 3        !: bulk                          formulation
-   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 4        !: Pure ocean-atmosphere Coupled formulation
-   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 5        !: for OPA when doing coupling via SAS module
+   INTEGER , PUBLIC, PARAMETER ::   jp_abl     = 4        !: Atmospheric boundary layer    formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 5        !: Pure ocean-atmosphere Coupled formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 6        !: for OPA when doing coupling via SAS module
    
    !!----------------------------------------------------------------------
@@ -106 +109 @@
    INTEGER , PUBLIC ::  ncpl_qsr_freq            !: qsr coupling frequency per days from atmosphere
    !
-   LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress)
    !!                                   !!   now    ! before   !!
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vtau   , vtau_b   !: sea surface j-stress (ocean referential)     [N/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   taum              !: module of sea surface stress (at T-point)    [N/m2] 
-   !! wndm is used onmpute surface gases exchanges in ice-free ocean or leads
+   !! wndm is used compute surface gases exchanges in ice-free ocean or leads
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rhoa              !: air density at "rn_zu" m above the sea       [kg/m3] !LB
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr               !: sea heat flux:     solar                     [W/m2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2]
@@ -134 +137 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask          !: coupling mask for ln_mixcpl (warning: allocated in sbccpl)
 
+   !!---------------------------------------------------------------------
+   !! ABL Vertical Domain size  
+   !!---------------------------------------------------------------------
+   INTEGER , PUBLIC            ::   jpka   = 2     !: ABL number of vertical levels (default definition)
+   INTEGER , PUBLIC            ::   jpkam1 = 1     !: jpka-1
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   ght_abl, ghw_abl          !: ABL geopotential height (needed for iom)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   e3t_abl, e3w_abl          !: ABL vertical scale factors (needed for iom)
+
    !!----------------------------------------------------------------------
    !!                     Sea Surface Mean fields
@@ -164 +175 @@
       !
       ALLOCATE( utau(jpi,jpj) , utau_b(jpi,jpj) , taum(jpi,jpj) ,     &
-         &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , STAT=ierr(1) ) 
+         &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , rhoa(jpi,jpj) , STAT=ierr(1) ) 
          !
       ALLOCATE( qns_tot(jpi,jpj) , qns  (jpi,jpj) , qns_b(jpi,jpj),        &
@@ -179 +190 @@
          &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      &
          &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) )
-         !
+      !
       ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) )
-         !
+      !
       sbc_oce_alloc = MAXVAL( ierr )
       CALL mpp_sum ( 'sbc_oce', sbc_oce_alloc )

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcapr.F90

@@ -101 +101 @@
       !
       !                                            !* control check
-      IF ( ln_apr_obc  ) THEN
+      IF( ln_apr_obc  ) THEN
          IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data'
       ENDIF

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcblk.F90

@@ -15 +15 @@
    !!            3.7  !  2014-06  (L. Brodeau)  simplification and optimization of CORE bulk
    !!            4.0  !  2016-06  (L. Brodeau)  sbcblk_core becomes sbcblk and is not restricted to the CORE algorithm anymore
-   !!                 !                        ==> based on AeroBulk (http://aerobulk.sourceforge.net/)
+   !!                 !                        ==> based on AeroBulk (https://github.com/brodeau/aerobulk/)
    !!            4.0  !  2016-10  (G. Madec)  introduce a sbc_blk_init routine
-   !!            4.0  !  2016-10  (M. Vancoppenolle)  Introduce conduction flux emulator (M. Vancoppenolle) 
+   !!            4.0  !  2016-10  (M. Vancoppenolle)  Introduce conduction flux emulator (M. Vancoppenolle)
+   !!            4.0  !  2019-03  (F. Lemarié & G. Samson)  add ABL compatibility (ln_abl=TRUE)
    !!----------------------------------------------------------------------
 
@@ -23 +24 @@
    !!   sbc_blk_init  : initialisation of the chosen bulk formulation as ocean surface boundary condition
    !!   sbc_blk       : bulk formulation as ocean surface boundary condition
-   !!   blk_oce       : computes momentum, heat and freshwater fluxes over ocean
-   !!   rho_air       : density of (moist) air (depends on T_air, q_air and SLP
-   !!   cp_air        : specific heat of (moist) air (depends spec. hum. q_air)
-   !!   q_sat         : saturation humidity as a function of SLP and temperature
-   !!   L_vap         : latent heat of vaporization of water as a function of temperature
-   !!             sea-ice case only : 
-   !!   blk_ice_tau   : provide the air-ice stress
-   !!   blk_ice_flx   : provide the heat and mass fluxes at air-ice interface
+   !!   blk_oce_1     : computes pieces of momentum, heat and freshwater fluxes over ocean for ABL model  (ln_abl=TRUE)
+   !!   blk_oce_2     : finalizes momentum, heat and freshwater fluxes computation over ocean after the ABL step  (ln_abl=TRUE)
+   !!             sea-ice case only :
+   !!   blk_ice_1   : provide the air-ice stress
+   !!   blk_ice_2   : provide the heat and mass fluxes at air-ice interface
    !!   blk_ice_qcn   : provide ice surface temperature and snow/ice conduction flux (emulating conduction flux)
    !!   Cdn10_Lupkes2012 : Lupkes et al. (2012) air-ice drag
-   !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag 
+   !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers
@@ -46 +44 @@
    USE lib_fortran    ! to use key_nosignedzero
 #if defined key_si3
-   USE ice     , ONLY :   u_ice, v_ice, jpl, a_i_b, at_i_b, t_su, rn_cnd_s, hfx_err_dif
+   USE ice     , ONLY :   jpl, a_i_b, at_i_b, rn_cnd_s, hfx_err_dif
    USE icethd_dh      ! for CALL ice_thd_snwblow
 #endif
-   USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009) 
-   USE sbcblk_algo_coare    ! => turb_coare    : COAREv3.0 (Fairall et al. 2003) 
-   USE sbcblk_algo_coare3p5 ! => turb_coare3p5 : COAREv3.5 (Edson et al. 2013)
-   USE sbcblk_algo_ecmwf    ! => turb_ecmwf    : ECMWF (IFS cycle 31) 
+   USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009)
+   USE sbcblk_algo_coare3p0 ! => turb_coare3p0 : COAREv3.0 (Fairall et al. 2003)
+   USE sbcblk_algo_coare3p6 ! => turb_coare3p6 : COAREv3.6 (Fairall et al. 2018 + Edson et al. 2013)
+   USE sbcblk_algo_ecmwf    ! => turb_ecmwf    : ECMWF (IFS cycle 45r1)
    !
    USE iom            ! I/O manager library
@@ -60 +58 @@
    USE prtctl         ! Print control
 
+   USE sbcblk_phy     ! a catalog of functions for physical/meteorological parameters in the marine boundary layer, rho_air, q_sat, etc...
+
+
    IMPLICIT NONE
    PRIVATE
@@ -65 +66 @@
    PUBLIC   sbc_blk_init  ! called in sbcmod
    PUBLIC   sbc_blk       ! called in sbcmod
+   PUBLIC   blk_oce_1     ! called in sbcabl
+   PUBLIC   blk_oce_2     ! called in sbcabl
 #if defined key_si3
-   PUBLIC   blk_ice_tau   ! routine called in icesbc
-   PUBLIC   blk_ice_flx   ! routine called in icesbc
+   PUBLIC   blk_ice_1     ! routine called in icesbc
+   PUBLIC   blk_ice_2     ! routine called in icesbc
    PUBLIC   blk_ice_qcn   ! routine called in icesbc
-#endif 
-
-!!Lolo: should ultimately be moved in the module with all physical constants ?
-!!gm  : In principle, yes.
-   REAL(wp), PARAMETER ::   Cp_dry = 1005.0       !: Specic heat of dry air, constant pressure      [J/K/kg]
-   REAL(wp), PARAMETER ::   Cp_vap = 1860.0       !: Specic heat of water vapor, constant pressure  [J/K/kg]
-   REAL(wp), PARAMETER ::   R_dry = 287.05_wp     !: Specific gas constant for dry air              [J/K/kg]
-   REAL(wp), PARAMETER ::   R_vap = 461.495_wp    !: Specific gas constant for water vapor          [J/K/kg]
-   REAL(wp), PARAMETER ::   reps0 = R_dry/R_vap   !: ratio of gas constant for dry air and water vapor => ~ 0.622
-   REAL(wp), PARAMETER ::   rctv0 = R_vap/R_dry   !: for virtual temperature (== (1-eps)/eps) => ~ 0.608
-
-   INTEGER , PARAMETER ::   jpfld   =10           ! maximum number of files to read
-   INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point
-   INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point
-   INTEGER , PARAMETER ::   jp_tair = 3           ! index of 10m air temperature             (Kelvin)
-   INTEGER , PARAMETER ::   jp_humi = 4           ! index of specific humidity               ( % )
-   INTEGER , PARAMETER ::   jp_qsr  = 5           ! index of solar heat                      (W/m2)
-   INTEGER , PARAMETER ::   jp_qlw  = 6           ! index of Long wave                       (W/m2)
-   INTEGER , PARAMETER ::   jp_prec = 7           ! index of total precipitation (rain+snow) (Kg/m2/s)
-   INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s)
-   INTEGER , PARAMETER ::   jp_slp  = 9           ! index of sea level pressure              (Pa)
-   INTEGER , PARAMETER ::   jp_tdif =10           ! index of tau diff associated to HF tau   (N/m2)   at T-point
-
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read)
-
-   !                                             !!! Bulk parameters
-   REAL(wp), PARAMETER ::   cpa    = 1000.5         ! specific heat of air (only used for ice fluxes now...)
-   REAL(wp), PARAMETER ::   Ls     =    2.839e6     ! latent heat of sublimation
-   REAL(wp), PARAMETER ::   Stef   =    5.67e-8     ! Stefan Boltzmann constant
-   REAL(wp), PARAMETER ::   Cd_ice =    1.4e-3      ! transfer coefficient over ice
-   REAL(wp), PARAMETER ::   albo   =    0.066       ! ocean albedo assumed to be constant
-   !
+#endif
+
+   INTEGER , PUBLIC            ::   jpfld         ! maximum number of files to read
+   INTEGER , PUBLIC, PARAMETER ::   jp_wndi = 1   ! index of 10m wind velocity (i-component) (m/s)    at T-point
+   INTEGER , PUBLIC, PARAMETER ::   jp_wndj = 2   ! index of 10m wind velocity (j-component) (m/s)    at T-point
+   INTEGER , PUBLIC, PARAMETER ::   jp_tair = 3   ! index of 10m air temperature             (Kelvin)
+   INTEGER , PUBLIC, PARAMETER ::   jp_humi = 4   ! index of specific humidity               ( % )
+   INTEGER , PUBLIC, PARAMETER ::   jp_qsr  = 5   ! index of solar heat                      (W/m2)
+   INTEGER , PUBLIC, PARAMETER ::   jp_qlw  = 6   ! index of Long wave                       (W/m2)
+   INTEGER , PUBLIC, PARAMETER ::   jp_prec = 7   ! index of total precipitation (rain+snow) (Kg/m2/s)
+   INTEGER , PUBLIC, PARAMETER ::   jp_snow = 8   ! index of snow (solid prcipitation)       (kg/m2/s)
+   INTEGER , PUBLIC, PARAMETER ::   jp_slp  = 9   ! index of sea level pressure              (Pa)
+   INTEGER , PUBLIC, PARAMETER ::   jp_hpgi =10   ! index of ABL geostrophic wind or hpg (i-component) (m/s) at T-point
+   INTEGER , PUBLIC, PARAMETER ::   jp_hpgj =11   ! index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point
+
+   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input atmospheric fields (file informations, fields read)
+
    !                           !!* Namelist namsbc_blk : bulk parameters
    LOGICAL  ::   ln_NCAR        ! "NCAR"      algorithm   (Large and Yeager 2008)
    LOGICAL  ::   ln_COARE_3p0   ! "COARE 3.0" algorithm   (Fairall et al. 2003)
-   LOGICAL  ::   ln_COARE_3p5   ! "COARE 3.5" algorithm   (Edson et al. 2013)
-   LOGICAL  ::   ln_ECMWF       ! "ECMWF"     algorithm   (IFS cycle 31)
+   LOGICAL  ::   ln_COARE_3p6   ! "COARE 3.6" algorithm   (Edson et al. 2013)
+   LOGICAL  ::   ln_ECMWF       ! "ECMWF"     algorithm   (IFS cycle 45r1)
    !
-   LOGICAL  ::   ln_taudif      ! logical flag to use the "mean of stress module - module of mean stress" data
-   REAL(wp) ::   rn_pfac        ! multiplication factor for precipitation
-   REAL(wp) ::   rn_efac        ! multiplication factor for evaporation
-   REAL(wp) ::   rn_vfac        ! multiplication factor for ice/ocean velocity in the calculation of wind stress
-   REAL(wp) ::   rn_zqt         ! z(q,t) : height of humidity and temperature measurements
-   REAL(wp) ::   rn_zu          ! z(u)   : height of wind measurements
-!!gm ref namelist initialize it so remove the setting to false below
-   LOGICAL  ::   ln_Cd_L12 = .FALSE. !  Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2012)
-   LOGICAL  ::   ln_Cd_L15 = .FALSE. !  Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2015)
+   LOGICAL  ::   ln_Cd_L12      ! ice-atm drag = F( ice concentration )                        (Lupkes et al. JGR2012)
+   LOGICAL  ::   ln_Cd_L15      ! ice-atm drag = F( ice concentration, atmospheric stability ) (Lupkes et al. JGR2015)
    !
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Cd_atm                    ! transfer coefficient for momentum      (tau)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Ch_atm                    ! transfer coefficient for sensible heat (Q_sens)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Ce_atm                    ! tansfert coefficient for evaporation   (Q_lat)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_zu                      ! air temperature at wind speed height (needed by Lupkes 2015 bulk scheme)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_zu                      ! air spec. hum.  at wind speed height (needed by Lupkes 2015 bulk scheme)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   cdn_oce, chn_oce, cen_oce ! needed by Lupkes 2015 bulk scheme
+   REAL(wp)         ::   rn_pfac   ! multiplication factor for precipitation
+   REAL(wp), PUBLIC ::   rn_efac   ! multiplication factor for evaporation
+   REAL(wp), PUBLIC ::   rn_vfac   ! multiplication factor for ice/ocean velocity in the calculation of wind stress
+   REAL(wp)         ::   rn_zqt    ! z(q,t) : height of humidity and temperature measurements
+   REAL(wp)         ::   rn_zu     ! z(u)   : height of wind measurements
+   !
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   Cd_ice , Ch_ice , Ce_ice   ! transfert coefficients over ice
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   Cdn_oce, Chn_oce, Cen_oce  ! neutral coeffs over ocean (L15 bulk scheme)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   t_zu, q_zu                 ! air temp. and spec. hum. at wind speed height (L15 bulk scheme)
+
+   LOGICAL  ::   ln_skin_cs     ! use the cool-skin (only available in ECMWF and COARE algorithms) !LB
+   LOGICAL  ::   ln_skin_wl     ! use the warm-layer parameterization (only available in ECMWF and COARE algorithms) !LB
+   LOGICAL  ::   ln_humi_sph    ! humidity read in files ("sn_humi") is specific humidity [kg/kg] if .true. !LB
+   LOGICAL  ::   ln_humi_dpt    ! humidity read in files ("sn_humi") is dew-point temperature [K] if .true. !LB
+   LOGICAL  ::   ln_humi_rlh    ! humidity read in files ("sn_humi") is relative humidity     [%] if .true. !LB
+   !
+   INTEGER  ::   nhumi          ! choice of the bulk algorithm
+   !                            ! associated indices:
+   INTEGER, PARAMETER :: np_humi_sph = 1
+   INTEGER, PARAMETER :: np_humi_dpt = 2
+   INTEGER, PARAMETER :: np_humi_rlh = 3
 
    INTEGER  ::   nblk           ! choice of the bulk algorithm
@@ -128 +124 @@
    INTEGER, PARAMETER ::   np_NCAR      = 1   ! "NCAR" algorithm        (Large and Yeager 2008)
    INTEGER, PARAMETER ::   np_COARE_3p0 = 2   ! "COARE 3.0" algorithm   (Fairall et al. 2003)
-   INTEGER, PARAMETER ::   np_COARE_3p5 = 3   ! "COARE 3.5" algorithm   (Edson et al. 2013)
-   INTEGER, PARAMETER ::   np_ECMWF     = 4   ! "ECMWF" algorithm       (IFS cycle 31)
+   INTEGER, PARAMETER ::   np_COARE_3p6 = 3   ! "COARE 3.6" algorithm   (Edson et al. 2013)
+   INTEGER, PARAMETER ::   np_ECMWF     = 4   ! "ECMWF" algorithm       (IFS cycle 45r1)
 
    !! * Substitutions
@@ -144 +140 @@
       !!             ***  ROUTINE sbc_blk_alloc ***
       !!-------------------------------------------------------------------
-      ALLOCATE( Cd_atm (jpi,jpj), Ch_atm (jpi,jpj), Ce_atm (jpi,jpj), t_zu(jpi,jpj), q_zu(jpi,jpj), &
-         &      cdn_oce(jpi,jpj), chn_oce(jpi,jpj), cen_oce(jpi,jpj), STAT=sbc_blk_alloc )
+      ALLOCATE( t_zu(jpi,jpj)   , q_zu(jpi,jpj)   ,                                      &
+         &      Cdn_oce(jpi,jpj), Chn_oce(jpi,jpj), Cen_oce(jpi,jpj),                    &
+         &      Cd_ice (jpi,jpj), Ch_ice (jpi,jpj), Ce_ice (jpi,jpj), STAT=sbc_blk_alloc )
       !
       CALL mpp_sum ( 'sbcblk', sbc_blk_alloc )
@@ -158 +155 @@
       !! ** Purpose :   choose and initialize a bulk formulae formulation
       !!
-      !! ** Method  : 
+      !! ** Method  :
       !!
       !!----------------------------------------------------------------------
-      INTEGER  ::   ifpr, jfld            ! dummy loop indice and argument
+      INTEGER  ::   jfpr                  ! dummy loop indice and argument
       INTEGER  ::   ios, ierror, ioptio   ! Local integer
       !!
       CHARACTER(len=100)            ::   cn_dir                ! Root directory for location of atmospheric forcing files
-      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                 ! array of namelist informations on the fields to read
+      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   slf_i        ! array of namelist informations on the fields to read
       TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr       ! informations about the fields to be read
       TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !       "                        "
-      TYPE(FLD_N) ::   sn_slp , sn_tdif                        !       "                        "
+      TYPE(FLD_N) ::   sn_slp , sn_hpgi, sn_hpgj               !       "                        "
       NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw ,                &   ! input fields
-         &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif,                &
-         &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF,             &   ! bulk algorithm
-         &                 cn_dir , ln_taudif, rn_zqt, rn_zu,                         & 
-         &                 rn_pfac, rn_efac, rn_vfac, ln_Cd_L12, ln_Cd_L15
+         &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_hpgi, sn_hpgj,       &
+         &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p6, ln_ECMWF,             &   ! bulk algorithm
+         &                 cn_dir , rn_zqt, rn_zu,                                    &
+         &                 rn_pfac, rn_efac, rn_vfac, ln_Cd_L12, ln_Cd_L15,           &
+         &                 ln_skin_cs, ln_skin_wl, ln_humi_sph, ln_humi_dpt, ln_humi_rlh  ! cool-skin / warm-layer !LB
       !!---------------------------------------------------------------------
       !
@@ -179 +177 @@
       IF( sbc_blk_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk : unable to allocate standard arrays' )
       !
-      !                             !** read bulk namelist  
+      !                             !** read bulk namelist
       READ  ( numnam_ref, namsbc_blk, IOSTAT = ios, ERR = 901)
 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_blk in reference namelist' )
@@ -190 +188 @@
       !                             !** initialization of the chosen bulk formulae (+ check)
       !                                   !* select the bulk chosen in the namelist and check the choice
-                                                               ioptio = 0
-      IF( ln_NCAR      ) THEN   ;   nblk =  np_NCAR        ;   ioptio = ioptio + 1   ;   ENDIF
-      IF( ln_COARE_3p0 ) THEN   ;   nblk =  np_COARE_3p0   ;   ioptio = ioptio + 1   ;   ENDIF
-      IF( ln_COARE_3p5 ) THEN   ;   nblk =  np_COARE_3p5   ;   ioptio = ioptio + 1   ;   ENDIF
-      IF( ln_ECMWF     ) THEN   ;   nblk =  np_ECMWF       ;   ioptio = ioptio + 1   ;   ENDIF
-      !
+      ioptio = 0
+      IF( ln_NCAR      ) THEN
+         nblk =  np_NCAR        ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ln_COARE_3p0 ) THEN
+         nblk =  np_COARE_3p0   ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ln_COARE_3p6 ) THEN
+         nblk =  np_COARE_3p6   ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ln_ECMWF     ) THEN
+         nblk =  np_ECMWF       ;   ioptio = ioptio + 1
+      ENDIF
       IF( ioptio /= 1 )   CALL ctl_stop( 'sbc_blk_init: Choose one and only one bulk algorithm' )
+
+      !                             !** initialization of the cool-skin / warm-layer parametrization
+      IF( ln_skin_cs .OR. ln_skin_wl ) THEN
+         !! Some namelist sanity tests:
+         IF( ln_NCAR )      &
+            & CALL ctl_stop( 'sbc_blk_init: Cool-skin/warm-layer param. not compatible with NCAR algorithm' )
+         IF( nn_fsbc /= 1 ) &
+            & CALL ctl_stop( 'sbc_blk_init: Please set "nn_fsbc" to 1 when using cool-skin/warm-layer param.')
+      END IF
+
+      IF( ln_skin_wl ) THEN
+         !! Check if the frequency of downwelling solar flux input makes sense and if ln_dm2dc=T if it is daily!
+         IF( (sn_qsr%freqh  < 0.).OR.(sn_qsr%freqh  > 24.) ) &
+            & CALL ctl_stop( 'sbc_blk_init: Warm-layer param. (ln_skin_wl) not compatible with freq. of solar flux > daily' )
+         IF( (sn_qsr%freqh == 24.).AND.(.NOT. ln_dm2dc) ) &
+            & CALL ctl_stop( 'sbc_blk_init: Please set ln_dm2dc=T for warm-layer param. (ln_skin_wl) to work properly' )
+      END IF
+
+      ioptio = 0
+      IF( ln_humi_sph ) THEN
+         nhumi =  np_humi_sph    ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ln_humi_dpt ) THEN
+         nhumi =  np_humi_dpt    ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ln_humi_rlh ) THEN
+         nhumi =  np_humi_rlh    ;   ioptio = ioptio + 1
+      ENDIF
+      IF( ioptio /= 1 )   CALL ctl_stop( 'sbc_blk_init: Choose one and only one type of air humidity' )
       !
       IF( ln_dm2dc ) THEN                 !* check: diurnal cycle on Qsr
          IF( sn_qsr%freqh /= 24. )   CALL ctl_stop( 'sbc_blk_init: ln_dm2dc=T only with daily short-wave input' )
-         IF( sn_qsr%ln_tint ) THEN 
+         IF( sn_qsr%ln_tint ) THEN
             CALL ctl_warn( 'sbc_blk_init: ln_dm2dc=T daily qsr time interpolation done by sbcdcy module',   &
                &           '              ==> We force time interpolation = .false. for qsr' )
@@ -208 +242 @@
       !                                   !* set the bulk structure
       !                                      !- store namelist information in an array
+      IF( ln_blk ) jpfld = 9
+      IF( ln_abl ) jpfld = 11
+      ALLOCATE( slf_i(jpfld) )
+      !
       slf_i(jp_wndi) = sn_wndi   ;   slf_i(jp_wndj) = sn_wndj
       slf_i(jp_qsr ) = sn_qsr    ;   slf_i(jp_qlw ) = sn_qlw
       slf_i(jp_tair) = sn_tair   ;   slf_i(jp_humi) = sn_humi
       slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow
-      slf_i(jp_slp)  = sn_slp    ;   slf_i(jp_tdif) = sn_tdif
-      !
-      lhftau = ln_taudif                     !- add an extra field if HF stress is used
-      jfld = jpfld - COUNT( (/.NOT.lhftau/) )
+      slf_i(jp_slp ) = sn_slp
+      IF( ln_abl ) THEN
+         slf_i(jp_hpgi) = sn_hpgi   ;   slf_i(jp_hpgj) = sn_hpgj
+      END IF
       !
       !                                      !- allocate the bulk structure
-      ALLOCATE( sf(jfld), STAT=ierror )
+      ALLOCATE( sf(jpfld), STAT=ierror )
       IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_init: unable to allocate sf structure' )
-      DO ifpr= 1, jfld
-         ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) )
-         IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )
-         IF( slf_i(ifpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(ifpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 )   &
-            &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   &
-            &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' )
-
+      !
+      DO jfpr= 1, jpfld
+         !
+         IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN    !--  not used field  --!   (only now allocated and set to zero)
+            ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) )
+            sf(jfpr)%fnow(:,:,1) = 0._wp
+         ELSE                                                  !-- used field  --!
+            IF(   ln_abl    .AND.                                                      &
+               &    ( jfpr == jp_wndi .OR. jfpr == jp_wndj .OR. jfpr == jp_humi .OR.   &
+               &      jfpr == jp_hpgi .OR. jfpr == jp_hpgj .OR. jfpr == jp_tair     )  ) THEN   ! ABL: some fields are 3D input
+               ALLOCATE( sf(jfpr)%fnow(jpi,jpj,jpka) )
+               IF( slf_i(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,jpka,2) )
+            ELSE                                                                                ! others or Bulk fields are 2D fiels
+               ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) )
+               IF( slf_i(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,1,2) )
+            ENDIF
+            !
+            IF( slf_i(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(jfpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 )   &
+               &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   &
+               &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' )
+         ENDIF
       END DO
       !                                      !- fill the bulk structure with namelist informations
       CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' )
       !
-      IF ( ln_wave ) THEN
-      !Activated wave module but neither drag nor stokes drift activated
-         IF ( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) )   THEN
+      IF( ln_wave ) THEN
+         !Activated wave module but neither drag nor stokes drift activated
+         IF( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) )   THEN
             CALL ctl_stop( 'STOP',  'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauwoc=F, ln_stcor=F' )
-      !drag coefficient read from wave model definable only with mfs bulk formulae and core 
-         ELSEIF (ln_cdgw .AND. .NOT. ln_NCAR )       THEN       
-             CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR and CORE bulk formulae')
-         ELSEIF (ln_stcor .AND. .NOT. ln_sdw)                             THEN
-             CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T')
+            !drag coefficient read from wave model definable only with mfs bulk formulae and core
+         ELSEIF(ln_cdgw .AND. .NOT. ln_NCAR )       THEN
+            CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR and CORE bulk formulae')
+         ELSEIF(ln_stcor .AND. .NOT. ln_sdw)                             THEN
+            CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T')
          ENDIF
       ELSE
-      IF ( ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor )                & 
-         &   CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ',    &
-         &                  'with drag coefficient (ln_cdgw =T) '  ,                        &
-         &                  'or Stokes Drift (ln_sdw=T) ' ,                                 &
-         &                  'or ocean stress modification due to waves (ln_tauwoc=T) ',      &  
-         &                  'or Stokes-Coriolis term (ln_stcori=T)'  )
-      ENDIF 
-      !
-      !           
+         IF( ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor )                &
+            &   CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ',    &
+            &                  'with drag coefficient (ln_cdgw =T) '  ,                        &
+            &                  'or Stokes Drift (ln_sdw=T) ' ,                                 &
+            &                  'or ocean stress modification due to waves (ln_tauwoc=T) ',      &
+            &                  'or Stokes-Coriolis term (ln_stcori=T)'  )
+      ENDIF
+      !
+      IF( ln_abl ) THEN       ! ABL: read 3D fields for wind, temperature, humidity and pressure gradient
+         rn_zqt = ght_abl(2)          ! set the bulk altitude to ABL first level
+         rn_zu  = ght_abl(2)
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '   ABL formulation: overwrite rn_zqt & rn_zu with ABL first level altitude'
+      ENDIF
+      !
+      ! set transfer coefficients to default sea-ice values
+      Cd_ice(:,:) = rCd_ice
+      Ch_ice(:,:) = rCd_ice
+      Ce_ice(:,:) = rCd_ice
+      !
       IF(lwp) THEN                     !** Control print
          !
-         WRITE(numout,*)                  !* namelist 
+         WRITE(numout,*)                  !* namelist
          WRITE(numout,*) '   Namelist namsbc_blk (other than data information):'
          WRITE(numout,*) '      "NCAR"      algorithm   (Large and Yeager 2008)     ln_NCAR      = ', ln_NCAR
          WRITE(numout,*) '      "COARE 3.0" algorithm   (Fairall et al. 2003)       ln_COARE_3p0 = ', ln_COARE_3p0
-         WRITE(numout,*) '      "COARE 3.5" algorithm   (Edson et al. 2013)         ln_COARE_3p5 = ', ln_COARE_3p0
-         WRITE(numout,*) '      "ECMWF"     algorithm   (IFS cycle 31)              ln_ECMWF     = ', ln_ECMWF
-         WRITE(numout,*) '      add High freq.contribution to the stress module     ln_taudif    = ', ln_taudif
+         WRITE(numout,*) '      "COARE 3.6" algorithm (Fairall 2018 + Edson al 2013)ln_COARE_3p6 = ', ln_COARE_3p6
+         WRITE(numout,*) '      "ECMWF"     algorithm   (IFS cycle 45r1)            ln_ECMWF     = ', ln_ECMWF
          WRITE(numout,*) '      Air temperature and humidity reference height (m)   rn_zqt       = ', rn_zqt
          WRITE(numout,*) '      Wind vector reference height (m)                    rn_zu        = ', rn_zu
@@ -273 +335 @@
          CASE( np_NCAR      )   ;   WRITE(numout,*) '   ==>>>   "NCAR" algorithm        (Large and Yeager 2008)'
          CASE( np_COARE_3p0 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.0" algorithm   (Fairall et al. 2003)'
-         CASE( np_COARE_3p5 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.5" algorithm   (Edson et al. 2013)'
-         CASE( np_ECMWF     )   ;   WRITE(numout,*) '   ==>>>   "ECMWF" algorithm       (IFS cycle 31)'
+         CASE( np_COARE_3p6 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.6" algorithm (Fairall 2018+Edson et al. 2013)'
+         CASE( np_ECMWF     )   ;   WRITE(numout,*) '   ==>>>   "ECMWF" algorithm       (IFS cycle 45r1)'
          END SELECT
          !
+         WRITE(numout,*)
+         WRITE(numout,*) '      use cool-skin  parameterization (SSST)  ln_skin_cs  = ', ln_skin_cs
+         WRITE(numout,*) '      use warm-layer parameterization (SSST)  ln_skin_wl  = ', ln_skin_wl
+         !
+         WRITE(numout,*)
+         SELECT CASE( nhumi )              !* Print the choice of air humidity
+         CASE( np_humi_sph )   ;   WRITE(numout,*) '   ==>>>   air humidity is SPECIFIC HUMIDITY     [kg/kg]'
+         CASE( np_humi_dpt )   ;   WRITE(numout,*) '   ==>>>   air humidity is DEW-POINT TEMPERATURE [K]'
+         CASE( np_humi_rlh )   ;   WRITE(numout,*) '   ==>>>   air humidity is RELATIVE HUMIDITY     [%]'
+         END SELECT
+         !
       ENDIF
       !
@@ -289 +362 @@
       !!              (momentum, heat, freshwater and runoff)
       !!
-      !! ** Method  : (1) READ each fluxes in NetCDF files:
-      !!      the 10m wind velocity (i-component) (m/s)    at T-point
-      !!      the 10m wind velocity (j-component) (m/s)    at T-point
-      !!      the 10m or 2m specific humidity     ( % )
-      !!      the solar heat                      (W/m2)
-      !!      the Long wave                       (W/m2)
-      !!      the 10m or 2m air temperature       (Kelvin)
-      !!      the total precipitation (rain+snow) (Kg/m2/s)
-      !!      the snow (solid prcipitation)       (kg/m2/s)
-      !!      the tau diff associated to HF tau   (N/m2)   at T-point   (ln_taudif=T)
-      !!              (2) CALL blk_oce
+      !! ** Method  :
+      !!              (1) READ each fluxes in NetCDF files:
+      !!      the wind velocity (i-component) at z=rn_zu  (m/s) at T-point
+      !!      the wind velocity (j-component) at z=rn_zu  (m/s) at T-point
+      !!      the specific humidity           at z=rn_zqt (kg/kg)
+      !!      the air temperature             at z=rn_zqt (Kelvin)
+      !!      the solar heat                              (W/m2)
+      !!      the Long wave                               (W/m2)
+      !!      the total precipitation (rain+snow)         (Kg/m2/s)
+      !!      the snow (solid precipitation)              (kg/m2/s)
+      !!      ABL dynamical forcing (i/j-components of either hpg or geostrophic winds)
+      !!              (2) CALL blk_oce_1 and blk_oce_2
       !!
       !!      C A U T I O N : never mask the surface stress fields
@@ -316 +390 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time step
-      !!---------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) ::   zssq, zcd_du, zsen, zevp
+      REAL(wp) :: ztmp
+      !!----------------------------------------------------------------------
       !
       CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step
-      !
+
+      ! Sanity/consistence test on humidity at first time step to detect potential screw-up:
+      IF( kt == nit000 ) THEN
+         WRITE(numout,*) ''
+#if defined key_agrif
+         WRITE(numout,*) ' === AGRIF => Sanity/consistence test on air humidity SKIPPED! :( ==='
+#else
+         ztmp = SUM(tmask(:,:,1)) ! number of ocean points on local proc domain
+         IF( ztmp > 8._wp ) THEN ! test only on proc domains with at least 8 ocean points!
+            ztmp = SUM(sf(jp_humi)%fnow(:,:,1)*tmask(:,:,1))/ztmp ! mean humidity over ocean on proc
+            SELECT CASE( nhumi )
+            CASE( np_humi_sph ) ! specific humidity => expect: 0. <= something < 0.065 [kg/kg] (0.061 is saturation at 45degC !!!)
+               IF(  (ztmp < 0._wp) .OR. (ztmp > 0.065)  ) ztmp = -1._wp
+            CASE( np_humi_dpt ) ! dew-point temperature => expect: 110. <= something < 320. [K]
+               IF( (ztmp < 110._wp).OR.(ztmp > 320._wp) ) ztmp = -1._wp
+            CASE( np_humi_rlh ) ! relative humidity => expect: 0. <= something < 100. [%]
+               IF(  (ztmp < 0._wp) .OR.(ztmp > 100._wp) ) ztmp = -1._wp
+            END SELECT
+            IF(ztmp < 0._wp) THEN
+               WRITE(numout,'("   Mean humidity value found on proc #",i5.5," is: ",f)') narea, ztmp
+               CALL ctl_stop( 'STOP', 'Something is wrong with air humidity!!!', &
+                  &   ' ==> check the unit in your input files'       , &
+                  &   ' ==> check consistence of namelist choice: specific? relative? dew-point?', &
+                  &   ' ==> ln_humi_sph -> [kg/kg] | ln_humi_rlh -> [%] | ln_humi_dpt -> [K] !!!' )
+            END IF
+         END IF
+         WRITE(numout,*) ' === Sanity/consistence test on air humidity sucessfuly passed! ==='
+#endif
+         WRITE(numout,*) ''
+      END IF !IF( kt == nit000 )
       !                                            ! compute the surface ocean fluxes using bulk formulea
-      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce( kt, sf, sst_m, ssu_m, ssv_m )
-
+      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
+         CALL blk_oce_1( kt, sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   &   !   <<= in
+            &                sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),   &   !   <<= in
+            &                sf(jp_slp )%fnow(:,:,1), sst_m, ssu_m, ssv_m,       &   !   <<= in
+            &                sf(jp_qsr )%fnow(:,:,1), sf(jp_qlw )%fnow(:,:,1),   &   !   <<= in (wl/cs)
+            &                zssq, zcd_du, zsen, zevp )                              !   =>> out
+
+         CALL blk_oce_2(     sf(jp_tair)%fnow(:,:,1), sf(jp_qsr )%fnow(:,:,1),   &   !   <<= in
+            &                sf(jp_qlw )%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1),   &   !   <<= in
+            &                sf(jp_snow)%fnow(:,:,1), sst_m,                     &   !   <<= in
+            &                zsen, zevp )                                            !   <=> in out
+      ENDIF
+      !
 #if defined key_cice
       IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN
          qlw_ice(:,:,1)   = sf(jp_qlw )%fnow(:,:,1)
-         IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )
-         ELSE                ; qsr_ice(:,:,1) =          sf(jp_qsr)%fnow(:,:,1) 
-         ENDIF 
+         IF( ln_dm2dc ) THEN
+            qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )
+         ELSE
+            qsr_ice(:,:,1) =          sf(jp_qsr)%fnow(:,:,1)
+         ENDIF
          tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1)
-         qatm_ice(:,:)    = sf(jp_humi)%fnow(:,:,1)
+
+         SELECT CASE( nhumi )
+         CASE( np_humi_sph )
+            qatm_ice(:,:) =           sf(jp_humi)%fnow(:,:,1)
+         CASE( np_humi_dpt )
+            qatm_ice(:,:) = q_sat(    sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) )
+         CASE( np_humi_rlh )
+            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
+         END SELECT
+
          tprecip(:,:)     = sf(jp_prec)%fnow(:,:,1) * rn_pfac
          sprecip(:,:)     = sf(jp_snow)%fnow(:,:,1) * rn_pfac
@@ -341 +469 @@
 
 
-   SUBROUTINE blk_oce( kt, sf, pst, pu, pv )
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE blk_oce  ***
-      !!
-      !! ** Purpose :   provide the momentum, heat and freshwater fluxes at
-      !!      the ocean surface at each time step
-      !!
-      !! ** Method  :   bulk formulea for the ocean using atmospheric
-      !!      fields read in sbc_read
+   SUBROUTINE blk_oce_1( kt, pwndi, pwndj , ptair, phumi, &  ! inp
+      &              pslp , pst   , pu   , pv,    &  ! inp
+      &              pqsr , pqlw  ,               &  ! inp
+      &              pssq , pcd_du, psen , pevp   )  ! out
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_oce_1  ***
+      !!
+      !! ** Purpose :   if ln_blk=T, computes surface momentum, heat and freshwater fluxes
+      !!                if ln_abl=T, computes Cd x |U|, Ch x |U|, Ce x |U| for ABL integration
+      !!
+      !! ** Method  :   bulk formulae using atmospheric fields from :
+      !!                if ln_blk=T, atmospheric fields read in sbc_read
+      !!                if ln_abl=T, the ABL model at previous time-step
+      !!
+      !! ** Outputs : - pssq    : surface humidity used to compute latent heat flux (kg/kg)
+      !!              - pcd_du  : Cd x |dU| at T-points  (m/s)
+      !!              - psen    : Ch x |dU| at T-points  (m/s)
+      !!              - pevp    : Ce x |dU| at T-points  (m/s)
+      !!---------------------------------------------------------------------
+      INTEGER , INTENT(in   )                 ::   kt     ! time step index
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndi  ! atmospheric wind at U-point              [m/s]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndj  ! atmospheric wind at V-point              [m/s]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   phumi  ! specific humidity at T-points            [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   ptair  ! potential temperature at T-points        [Kelvin]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pslp   ! sea-level pressure                       [Pa]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pst    ! surface temperature                      [Celcius]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pu     ! surface current at U-point (i-component) [m/s]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pv     ! surface current at V-point (j-component) [m/s]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqsr   !
+      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqlw   !
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pssq   ! specific humidity at pst                 [kg/kg]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pcd_du ! Cd x |dU| at T-points                    [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   psen   ! Ch x |dU| at T-points                    [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pevp   ! Ce x |dU| at T-points                    [m/s]
+      !
+      INTEGER  ::   ji, jj               ! dummy loop indices
+      REAL(wp) ::   zztmp                ! local variable
+      REAL(wp), DIMENSION(jpi,jpj) ::   zwnd_i, zwnd_j    ! wind speed components at T-point
+      REAL(wp), DIMENSION(jpi,jpj) ::   zst               ! surface temperature in Kelvin
+      REAL(wp), DIMENSION(jpi,jpj) ::   zU_zu             ! bulk wind speed at height zu  [m/s]
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztpot             ! potential temperature of air at z=rn_zqt [K]
+      REAL(wp), DIMENSION(jpi,jpj) ::   zqair             ! specific humidity     of air at z=rn_zqt [kg/kg]
+      REAL(wp), DIMENSION(jpi,jpj) ::   zcd_oce           ! momentum transfert coefficient over ocean
+      REAL(wp), DIMENSION(jpi,jpj) ::   zch_oce           ! sensible heat transfert coefficient over ocean
+      REAL(wp), DIMENSION(jpi,jpj) ::   zce_oce           ! latent   heat transfert coefficient over ocean
+      REAL(wp), DIMENSION(jpi,jpj) ::   zqla              ! latent heat flux
+      REAL(wp), DIMENSION(jpi,jpj) ::   zztmp1, zztmp2
+      !!---------------------------------------------------------------------
+      !
+      ! local scalars ( place there for vector optimisation purposes)
+      zst(:,:) = pst(:,:) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K)
+
+      ! ----------------------------------------------------------------------------- !
+      !      0   Wind components and module at T-point relative to the moving ocean   !
+      ! ----------------------------------------------------------------------------- !
+
+      ! ... components ( U10m - U_oce ) at T-point (unmasked)
+#if defined key_cyclone
+      zwnd_i(:,:) = 0._wp
+      zwnd_j(:,:) = 0._wp
+      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012)
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vect. opt.
+            pwndi(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj)
+            pwndj(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj)
+         END DO
+      END DO
+#endif
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vect. opt.
+            zwnd_i(ji,jj) = (  pwndi(ji,jj) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  )
+            zwnd_j(ji,jj) = (  pwndj(ji,jj) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  )
+         END DO
+      END DO
+      CALL lbc_lnk_multi( 'sbcblk', zwnd_i, 'T', -1., zwnd_j, 'T', -1. )
+      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked)
+      wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   &
+         &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1)
+
+      ! ----------------------------------------------------------------------------- !
+      !      I   Solar FLUX                                                           !
+      ! ----------------------------------------------------------------------------- !
+
+      ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave
+      zztmp = 1. - albo
+      IF( ln_dm2dc ) THEN
+         qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1)
+      ELSE
+         qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1)
+      ENDIF
+
+
+      ! ----------------------------------------------------------------------------- !
+      !     II   Turbulent FLUXES                                                     !
+      ! ----------------------------------------------------------------------------- !
+
+      ! specific humidity at SST
+      pssq(:,:) = rdct_qsat_salt * q_sat( zst(:,:), pslp(:,:) )
+
+      IF( ln_skin_cs .OR. ln_skin_wl ) THEN
+         zztmp1(:,:) = zst(:,:)
+         zztmp2(:,:) = pssq(:,:)
+      ENDIF
+
+      ! specific humidity of air at "rn_zqt" m above the sea
+      SELECT CASE( nhumi )
+      CASE( np_humi_sph )
+         zqair(:,:) = phumi(:,:)      ! what we read in file is already a spec. humidity!
+      CASE( np_humi_dpt )
+         !IF(lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of d_air and slp !' !LBrm
+         zqair(:,:) = q_sat( phumi(:,:), pslp(:,:) )
+      CASE( np_humi_rlh )
+         !IF(lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of RH, t_air and slp !' !LBrm
+         zqair(:,:) = q_air_rh( 0.01_wp*phumi(:,:), ptair(:,:), pslp(:,:) ) !LB: 0.01 => RH is % percent in file
+      END SELECT
+      !
+      ! potential temperature of air at "rn_zqt" m above the sea
+      IF( ln_abl ) THEN
+         ztpot = ptair(:,:)
+      ELSE
+         ! Estimate of potential temperature at z=rn_zqt, based on adiabatic lapse-rate
+         !    (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2
+         !    (since reanalysis products provide T at z, not theta !)
+         !#LB: because AGRIF hates functions that return something else than a scalar, need to
+         !     use scalar version of gamma_moist() ...
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt
+            END DO
+         END DO
+      ENDIF
+
+
+
+      !! Time to call the user-selected bulk parameterization for
+      !!  ==  transfer coefficients  ==!   Cd, Ch, Ce at T-point, and more...
+      SELECT CASE( nblk )
+
+      CASE( np_NCAR      )
+         CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm,                              &
+            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
+
+      CASE( np_COARE_3p0 )
+         CALL turb_coare3p0 ( kt, rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, &
+            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   &
+            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) )
+
+      CASE( np_COARE_3p6 )
+         CALL turb_coare3p6 ( kt, rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, &
+            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   &
+            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) )
+
+      CASE( np_ECMWF     )
+         CALL turb_ecmwf   ( kt, rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl,  &
+            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   &
+            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) )
+
+      CASE DEFAULT
+         CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' )
+
+      END SELECT
+
+      IF( ln_skin_cs .OR. ln_skin_wl ) THEN
+         !! In the presence of sea-ice we forget about the cool-skin/warm-layer update of zst and pssq:
+         WHERE ( fr_i < 0.001_wp )
+            ! zst and pssq have been updated by cool-skin/warm-layer scheme and we keep it!!!
+            zst(:,:)  =  zst(:,:)*tmask(:,:,1)
+            pssq(:,:) = pssq(:,:)*tmask(:,:,1)
+         ELSEWHERE
+            ! we forget about the update...
+            zst(:,:)  = zztmp1(:,:) !#LB: using what we backed up before skin-algo
+            pssq(:,:) = zztmp2(:,:) !#LB:  "   "   "
+         END WHERE
+      END IF
+
+      !!      CALL iom_put( "Cd_oce", zcd_oce)  ! output value of pure ocean-atm. transfer coef.
+      !!      CALL iom_put( "Ch_oce", zch_oce)  ! output value of pure ocean-atm. transfer coef.
+
+      IF( ABS(rn_zu - rn_zqt) < 0.1_wp ) THEN
+         !! If zu == zt, then ensuring once for all that:
+         t_zu(:,:) = ztpot(:,:)
+         q_zu(:,:) = zqair(:,:)
+      ENDIF
+
+
+      !  Turbulent fluxes over ocean  => BULK_FORMULA @ sbcblk_phy.F90
+      ! -------------------------------------------------------------
+
+      IF( ln_abl ) THEN         !==  ABL formulation  ==!   multiplication by rho_air and turbulent fluxes computation done in ablstp
+         !! FL do we need this multiplication by tmask ... ???
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zztmp = zU_zu(ji,jj) !* tmask(ji,jj,1)
+               wndm(ji,jj)   = zztmp                   ! Store zU_zu in wndm to compute ustar2 in ablmod
+               pcd_du(ji,jj) = zztmp * zcd_oce(ji,jj)
+               psen(ji,jj)   = zztmp * zch_oce(ji,jj)
+               pevp(ji,jj)   = zztmp * zce_oce(ji,jj)
+            END DO
+         END DO
+      ELSE                      !==  BLK formulation  ==!   turbulent fluxes computation
+         CALL BULK_FORMULA( rn_zu, zst(:,:), pssq(:,:), t_zu(:,:), q_zu(:,:), &
+            &               zcd_oce(:,:), zch_oce(:,:), zce_oce(:,:),         &
+            &               wndm(:,:), zU_zu(:,:), pslp(:,:),                 &
+            &               taum(:,:), psen(:,:), zqla(:,:),                  &
+            &               pEvap=pevp(:,:), prhoa=rhoa(:,:) )
+
+         zqla(:,:) = zqla(:,:) * tmask(:,:,1)
+         psen(:,:) = psen(:,:) * tmask(:,:,1)
+         taum(:,:) = taum(:,:) * tmask(:,:,1)
+         pevp(:,:) = pevp(:,:) * tmask(:,:,1)
+
+         ! Tau i and j component on T-grid points, using array "zcd_oce" as a temporary array...
+         zcd_oce = 0._wp
+         WHERE ( wndm > 0._wp ) zcd_oce = taum / wndm
+         zwnd_i = zcd_oce * zwnd_i
+         zwnd_j = zcd_oce * zwnd_j
+
+         CALL iom_put( "taum_oce", taum )   ! output wind stress module
+
+         ! ... utau, vtau at U- and V_points, resp.
+         !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines
+         !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1
+               utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) &
+                  &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1))
+               vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) ) &
+                  &          * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1))
+            END DO
+         END DO
+         CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. )
+
+         IF(ln_ctl) THEN
+            CALL prt_ctl( tab2d_1=wndm  , clinfo1=' blk_oce_1: wndm   : ')
+            CALL prt_ctl( tab2d_1=utau  , clinfo1=' blk_oce_1: utau   : ', mask1=umask,   &
+               &          tab2d_2=vtau  , clinfo2='            vtau   : ', mask2=vmask )
+         ENDIF
+         !
+      ENDIF
+      !
+      IF(ln_ctl) THEN
+         CALL prt_ctl( tab2d_1=pevp  , clinfo1=' blk_oce_1: pevp   : ' )
+         CALL prt_ctl( tab2d_1=psen  , clinfo1=' blk_oce_1: psen   : ' )
+         CALL prt_ctl( tab2d_1=pssq  , clinfo1=' blk_oce_1: pssq   : ' )
+      ENDIF
+      !
+   END SUBROUTINE blk_oce_1
+
+
+   SUBROUTINE blk_oce_2( ptair, pqsr, pqlw, pprec,   &   ! <<= in
+      &          psnow, pst , psen, pevp     )   ! <<= in
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_oce_2  ***
+      !!
+      !! ** Purpose :   finalize the momentum, heat and freshwater fluxes computation
+      !!                at the ocean surface at each time step knowing Cd, Ch, Ce and
+      !!                atmospheric variables (from ABL or external data)
       !!
       !! ** Outputs : - utau    : i-component of the stress at U-point  (N/m2)
@@ -358 +734 @@
       !!              - qns     : Non Solar heat flux over the ocean    (W/m2)
       !!              - emp     : evaporation minus precipitation       (kg/m2/s)
-      !!
-      !!  ** Nota  :   sf has to be a dummy argument for AGRIF on NEC
-      !!---------------------------------------------------------------------
-      INTEGER  , INTENT(in   )                 ::   kt    ! time step index
-      TYPE(fld), INTENT(inout), DIMENSION(:)   ::   sf    ! input data
-      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius]
-      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pu    ! surface current at U-point (i-component) [m/s]
-      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pv    ! surface current at V-point (j-component) [m/s]
+      !!---------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptair
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pqsr
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pqlw
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pprec
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   psnow
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius]
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   psen
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pevp
       !
       INTEGER  ::   ji, jj               ! dummy loop indices
-      REAL(wp) ::   zztmp                ! local variable
-      REAL(wp), DIMENSION(jpi,jpj) ::   zwnd_i, zwnd_j    ! wind speed components at T-point
-      REAL(wp), DIMENSION(jpi,jpj) ::   zsq               ! specific humidity at pst
-      REAL(wp), DIMENSION(jpi,jpj) ::   zqlw, zqsb        ! long wave and sensible heat fluxes
-      REAL(wp), DIMENSION(jpi,jpj) ::   zqla, zevap       ! latent heat fluxes and evaporation
+      REAL(wp) ::   zztmp,zz1,zz2,zz3    ! local variable
+      REAL(wp), DIMENSION(jpi,jpj) ::   zqlw              ! long wave and sensible heat fluxes
+      REAL(wp), DIMENSION(jpi,jpj) ::   zqla              ! latent heat fluxes and evaporation
       REAL(wp), DIMENSION(jpi,jpj) ::   zst               ! surface temperature in Kelvin
-      REAL(wp), DIMENSION(jpi,jpj) ::   zU_zu             ! bulk wind speed at height zu  [m/s]
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztpot             ! potential temperature of air at z=rn_zqt [K]
-      REAL(wp), DIMENSION(jpi,jpj) ::   zrhoa             ! density of air   [kg/m^3]
       !!---------------------------------------------------------------------
       !
@@ -382 +754 @@
       zst(:,:) = pst(:,:) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K)
 
+
       ! ----------------------------------------------------------------------------- !
-      !      0   Wind components and module at T-point relative to the moving ocean   !
+      !     III    Net longwave radiative FLUX                                        !
       ! ----------------------------------------------------------------------------- !
 
-      ! ... components ( U10m - U_oce ) at T-point (unmasked)
-!!gm    move zwnd_i (_j) set to zero  inside the key_cyclone ???
-      zwnd_i(:,:) = 0._wp
-      zwnd_j(:,:) = 0._wp
-#if defined key_cyclone
-      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            sf(jp_wndi)%fnow(ji,jj,1) = sf(jp_wndi)%fnow(ji,jj,1) + zwnd_i(ji,jj)
-            sf(jp_wndj)%fnow(ji,jj,1) = sf(jp_wndj)%fnow(ji,jj,1) + zwnd_j(ji,jj)
-         END DO
-      END DO
-#endif
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  )
-            zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  )
-         END DO
-      END DO
-      CALL lbc_lnk_multi( 'sbcblk', zwnd_i, 'T', -1., zwnd_j, 'T', -1. )
-      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked)
-      wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   &
-         &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1)
-
-      ! ----------------------------------------------------------------------------- !
-      !      I   Radiative FLUXES                                                     !
-      ! ----------------------------------------------------------------------------- !
-
-      ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave
-      zztmp = 1. - albo
-      IF( ln_dm2dc ) THEN   ;   qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1)
-      ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1)
-      ENDIF
-
-      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave
-
-      ! ----------------------------------------------------------------------------- !
-      !     II    Turbulent FLUXES                                                    !
-      ! ----------------------------------------------------------------------------- !
-
-      ! ... specific humidity at SST and IST tmask(
-      zsq(:,:) = 0.98 * q_sat( zst(:,:), sf(jp_slp)%fnow(:,:,1) )
-      !!
-      !! Estimate of potential temperature at z=rn_zqt, based on adiabatic lapse-rate
-      !!    (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2
-      !!    (since reanalysis products provide T at z, not theta !)
-      ztpot = sf(jp_tair)%fnow(:,:,1) + gamma_moist( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1) ) * rn_zqt
-
-      SELECT CASE( nblk )        !==  transfer coefficients  ==!   Cd, Ch, Ce at T-point
-      !
-      CASE( np_NCAR      )   ;   CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! NCAR-COREv2
-         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
-      CASE( np_COARE_3p0 )   ;   CALL turb_coare   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! COARE v3.0
-         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
-      CASE( np_COARE_3p5 )   ;   CALL turb_coare3p5( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! COARE v3.5
-         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
-      CASE( np_ECMWF     )   ;   CALL turb_ecmwf   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! ECMWF
-         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )
-      CASE DEFAULT
-         CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' )
-      END SELECT
-
-      !                          ! Compute true air density :
-      IF( ABS(rn_zu - rn_zqt) > 0.01 ) THEN     ! At zu: (probably useless to remove zrho*grav*rn_zu from SLP...)
-         zrhoa(:,:) = rho_air( t_zu(:,:)              , q_zu(:,:)              , sf(jp_slp)%fnow(:,:,1) )
-      ELSE                                      ! At zt:
-         zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) )
-      END IF
-
-!!      CALL iom_put( "Cd_oce", Cd_atm)  ! output value of pure ocean-atm. transfer coef.
-!!      CALL iom_put( "Ch_oce", Ch_atm)  ! output value of pure ocean-atm. transfer coef.
-
-      DO jj = 1, jpj             ! tau module, i and j component
-         DO ji = 1, jpi
-            zztmp = zrhoa(ji,jj)  * zU_zu(ji,jj) * Cd_atm(ji,jj)   ! using bulk wind speed
-            taum  (ji,jj) = zztmp * wndm  (ji,jj)
-            zwnd_i(ji,jj) = zztmp * zwnd_i(ji,jj)
-            zwnd_j(ji,jj) = zztmp * zwnd_j(ji,jj)
-         END DO
-      END DO
-
-      !                          ! add the HF tau contribution to the wind stress module
-      IF( lhftau )   taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1)
-
-      CALL iom_put( "taum_oce", taum )   ! output wind stress module
-
-      ! ... utau, vtau at U- and V_points, resp.
-      !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines
-      !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves
-      DO jj = 1, jpjm1
-         DO ji = 1, fs_jpim1
-            utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) &
-               &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1))
-            vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) ) &
-               &          * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1))
-         END DO
-      END DO
-      CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. )
+      !! LB: now moved after Turbulent fluxes because must use the skin temperature rather that the SST
+      !! (zst is skin temperature if ln_skin_cs==.TRUE. .OR. ln_skin_wl==.TRUE.)
+      zqlw(:,:) = emiss_w * ( pqlw(:,:) - stefan*zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1)   ! Net radiative longwave flux
 
       !  Turbulent fluxes over ocean
       ! -----------------------------
 
-      ! zqla used as temporary array, for rho*U (common term of bulk formulae):
-      zqla(:,:) = zrhoa(:,:) * zU_zu(:,:) * tmask(:,:,1)
-
-      IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN
-         !! q_air and t_air are given at 10m (wind reference height)
-         zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce_atm(:,:)*(zsq(:,:) - sf(jp_humi)%fnow(:,:,1)) ) ! Evaporation, using bulk wind speed
-         zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch_atm(:,:)*(zst(:,:) - ztpot(:,:)             )   ! Sensible Heat, using bulk wind speed
-      ELSE
-         !! q_air and t_air are not given at 10m (wind reference height)
-         ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!!
-         zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce_atm(:,:)*(zsq(:,:) - q_zu(:,:) ) ) ! Evaporation, using bulk wind speed
-         zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch_atm(:,:)*(zst(:,:) - t_zu(:,:) )   ! Sensible Heat, using bulk wind speed
-      ENDIF
-
-      zqla(:,:) = L_vap(zst(:,:)) * zevap(:,:)     ! Latent Heat flux
-
+      ! use scalar version of L_vap() for AGRIF compatibility
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zqla(ji,jj) = -1._wp * L_vap( zst(ji,jj) ) * pevp(ji,jj)    ! Latent Heat flux !!GS: possibility to add a global qla to avoid recomputation after abl update
+         ENDDO
+      ENDDO
 
       IF(ln_ctl) THEN
-         CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce: zqla   : ', tab2d_2=Ce_atm , clinfo2=' Ce_oce  : ' )
-         CALL prt_ctl( tab2d_1=zqsb  , clinfo1=' blk_oce: zqsb   : ', tab2d_2=Ch_atm , clinfo2=' Ch_oce  : ' )
-         CALL prt_ctl( tab2d_1=zqlw  , clinfo1=' blk_oce: zqlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' )
-         CALL prt_ctl( tab2d_1=zsq   , clinfo1=' blk_oce: zsq    : ', tab2d_2=zst, clinfo2=' zst : ' )
-         CALL prt_ctl( tab2d_1=utau  , clinfo1=' blk_oce: utau   : ', mask1=umask,   &
-            &          tab2d_2=vtau  , clinfo2=           ' vtau : ', mask2=vmask )
-         CALL prt_ctl( tab2d_1=wndm  , clinfo1=' blk_oce: wndm   : ')
-         CALL prt_ctl( tab2d_1=zst   , clinfo1=' blk_oce: zst    : ')
+         CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce_2: zqla   : ' )
+         CALL prt_ctl( tab2d_1=zqlw  , clinfo1=' blk_oce_2: zqlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' )
+
       ENDIF
 
       ! ----------------------------------------------------------------------------- !
-      !     III    Total FLUXES                                                       !
+      !     IV    Total FLUXES                                                       !
       ! ----------------------------------------------------------------------------- !
       !
-      emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.)
-         &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1)
-      !
-      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar
-         &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * rLfus                        &   ! remove latent melting heat for solid precip
-         &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST
-         &     + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) * rn_pfac  &   ! add liquid precip heat content at Tair
-         &     * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp                          &
-         &     + sf(jp_snow)%fnow(:,:,1) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow)
-         &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi
+      emp (:,:) = (  pevp(:,:)                                       &   ! mass flux (evap. - precip.)
+         &         - pprec(:,:) * rn_pfac  ) * tmask(:,:,1)
+      !
+      qns(:,:) = zqlw(:,:) + psen(:,:) + zqla(:,:)                   &   ! Downward Non Solar
+         &     - psnow(:,:) * rn_pfac * rLfus                        &   ! remove latent melting heat for solid precip
+         &     - pevp(:,:) * pst(:,:) * rcp                          &   ! remove evap heat content at SST !LB??? pst is Celsius !?
+         &     + ( pprec(:,:) - psnow(:,:) ) * rn_pfac               &   ! add liquid precip heat content at Tair
+         &     * ( ptair(:,:) - rt0 ) * rcp                          &
+         &     + psnow(:,:) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow)
+         &     * ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi
       qns(:,:) = qns(:,:) * tmask(:,:,1)
       !
 #if defined key_si3
-      qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                ! non solar without emp (only needed by SI3)
+      qns_oce(:,:) = zqlw(:,:) + psen(:,:) + zqla(:,:)                             ! non solar without emp (only needed by SI3)
       qsr_oce(:,:) = qsr(:,:)
 #endif
       !
+      CALL iom_put( "rho_air"  , rhoa*tmask(:,:,1) )       ! output air density [kg/m^3]
+      CALL iom_put( "evap_oce" , pevp )                    ! evaporation
+      CALL iom_put( "qlw_oce"  , zqlw )                    ! output downward longwave heat over the ocean
+      CALL iom_put( "qsb_oce"  , psen )                    ! output downward sensible heat over the ocean
+      CALL iom_put( "qla_oce"  , zqla )                    ! output downward latent   heat over the ocean
+      tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1)   ! output total precipitation [kg/m2/s]
+      sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1)   ! output solid precipitation [kg/m2/s]
+      CALL iom_put( 'snowpre', sprecip )                   ! Snow
+      CALL iom_put( 'precip' , tprecip )                   ! Total precipitation
+      !
       IF ( nn_ice == 0 ) THEN
-         CALL iom_put( "qlw_oce" ,   zqlw )                 ! output downward longwave heat over the ocean
-         CALL iom_put( "qsb_oce" , - zqsb )                 ! output downward sensible heat over the ocean
-         CALL iom_put( "qla_oce" , - zqla )                 ! output downward latent   heat over the ocean
-         CALL iom_put( "qemp_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean
-         CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean
-         CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean
-         CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean
-         tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) ! output total precipitation [kg/m2/s]
-         sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) ! output solid precipitation [kg/m2/s]
-         CALL iom_put( 'snowpre', sprecip )                 ! Snow
-         CALL iom_put( 'precip' , tprecip )                 ! Total precipitation
+         CALL iom_put( "qemp_oce" , qns-zqlw-psen-zqla )   ! output downward heat content of E-P over the ocean
+         CALL iom_put( "qns_oce"  ,   qns  )               ! output downward non solar heat over the ocean
+         CALL iom_put( "qsr_oce"  ,   qsr  )               ! output downward solar heat over the ocean
+         CALL iom_put( "qt_oce"   ,   qns+qsr )            ! output total downward heat over the ocean
+      ENDIF
+      !
+      IF( ln_skin_cs .OR. ln_skin_wl ) THEN
+         CALL iom_put( "t_skin" ,  (zst - rt0) * tmask(:,:,1) )           ! T_skin in Celsius
+         CALL iom_put( "dt_skin" , (zst - pst - rt0) * tmask(:,:,1) )     ! T_skin - SST temperature difference...
       ENDIF
       !
       IF(ln_ctl) THEN
-         CALL prt_ctl(tab2d_1=zqsb , clinfo1=' blk_oce: zqsb   : ', tab2d_2=zqlw , clinfo2=' zqlw  : ')
-         CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce: zqla   : ', tab2d_2=qsr  , clinfo2=' qsr   : ')
-         CALL prt_ctl(tab2d_1=pst  , clinfo1=' blk_oce: pst    : ', tab2d_2=emp  , clinfo2=' emp   : ')
-         CALL prt_ctl(tab2d_1=utau , clinfo1=' blk_oce: utau   : ', mask1=umask,   &
-            &         tab2d_2=vtau , clinfo2=              ' vtau  : ' , mask2=vmask )
-      ENDIF
-      !
-   END SUBROUTINE blk_oce
-
-
-
-   FUNCTION rho_air( ptak, pqa, pslp )
-      !!-------------------------------------------------------------------------------
-      !!                           ***  FUNCTION rho_air  ***
-      !!
-      !! ** Purpose : compute density of (moist) air using the eq. of state of the atmosphere
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
-      !!-------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak      ! air temperature             [K]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa       ! air specific humidity   [kg/kg]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp      ! pressure in                [Pa]
-      REAL(wp), DIMENSION(jpi,jpj)             ::   rho_air   ! density of moist air   [kg/m^3]
-      !!-------------------------------------------------------------------------------
-      !
-      rho_air = pslp / (  R_dry*ptak * ( 1._wp + rctv0*pqa )  )
-      !
-   END FUNCTION rho_air
-
-
-   FUNCTION cp_air( pqa )
-      !!-------------------------------------------------------------------------------
-      !!                           ***  FUNCTION cp_air  ***
-      !!
-      !! ** Purpose : Compute specific heat (Cp) of moist air
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!-------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa      ! air specific humidity         [kg/kg]
-      REAL(wp), DIMENSION(jpi,jpj)             ::   cp_air   ! specific heat of moist air   [J/K/kg]
-      !!-------------------------------------------------------------------------------
-      !
-      Cp_air = Cp_dry + Cp_vap * pqa
-      !
-   END FUNCTION cp_air
-
-
-   FUNCTION q_sat( ptak, pslp )
-      !!----------------------------------------------------------------------------------
-      !!                           ***  FUNCTION q_sat  ***
-      !!
-      !! ** Purpose : Specific humidity at saturation in [kg/kg]
-      !!              Based on accurate estimate of "e_sat"
-      !!              aka saturation water vapor (Goff, 1957)
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak    ! air temperature                       [K]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp    ! sea level atmospheric pressure       [Pa]
-      REAL(wp), DIMENSION(jpi,jpj)             ::   q_sat   ! Specific humidity at saturation   [kg/kg]
-      !
-      INTEGER  ::   ji, jj         ! dummy loop indices
-      REAL(wp) ::   ze_sat, ztmp   ! local scalar
-      !!----------------------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            !
-            ztmp = rt0 / ptak(ji,jj)
-            !
-            ! Vapour pressure at saturation [hPa] : WMO, (Goff, 1957)
-            ze_sat = 10.**( 10.79574*(1. - ztmp) - 5.028*LOG10(ptak(ji,jj)/rt0)        &
-               &    + 1.50475*10.**(-4)*(1. - 10.**(-8.2969*(ptak(ji,jj)/rt0 - 1.)) )  &
-               &    + 0.42873*10.**(-3)*(10.**(4.76955*(1. - ztmp)) - 1.) + 0.78614  )
-               !
-            q_sat(ji,jj) = reps0 * ze_sat/( 0.01_wp*pslp(ji,jj) - (1._wp - reps0)*ze_sat )   ! 0.01 because SLP is in [Pa]
-            !
-         END DO
-      END DO
-      !
-   END FUNCTION q_sat
-
-
-   FUNCTION gamma_moist( ptak, pqa )
-      !!----------------------------------------------------------------------------------
-      !!                           ***  FUNCTION gamma_moist  ***
-      !!
-      !! ** Purpose : Compute the moist adiabatic lapse-rate.
-      !!     => http://glossary.ametsoc.org/wiki/Moist-adiabatic_lapse_rate
-      !!     => http://www.geog.ucsb.edu/~joel/g266_s10/lecture_notes/chapt03/oh10_3_01/oh10_3_01.html
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak          ! air temperature       [K]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa           ! specific humidity [kg/kg]
-      REAL(wp), DIMENSION(jpi,jpj)             ::   gamma_moist   ! moist adiabatic lapse-rate
-      !
-      INTEGER  ::   ji, jj         ! dummy loop indices
-      REAL(wp) :: zrv, ziRT        ! local scalar
-      !!----------------------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zrv = pqa(ji,jj) / (1. - pqa(ji,jj))
-            ziRT = 1. / (R_dry*ptak(ji,jj))    ! 1/RT
-            gamma_moist(ji,jj) = grav * ( 1. + rLevap*zrv*ziRT ) / ( Cp_dry + rLevap*rLevap*zrv*reps0*ziRT/ptak(ji,jj) )
-         END DO
-      END DO
-      !
-   END FUNCTION gamma_moist
-
-
-   FUNCTION L_vap( psst )
-      !!---------------------------------------------------------------------------------
-      !!                           ***  FUNCTION L_vap  ***
-      !!
-      !! ** Purpose : Compute the latent heat of vaporization of water from temperature
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj)             ::   L_vap   ! latent heat of vaporization   [J/kg]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   psst   ! water temperature                [K]
-      !!----------------------------------------------------------------------------------
-      !
-      L_vap = (  2.501 - 0.00237 * ( psst(:,:) - rt0)  ) * 1.e6
-      !
-   END FUNCTION L_vap
+         CALL prt_ctl(tab2d_1=zqlw , clinfo1=' blk_oce_2: zqlw  : ')
+         CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce_2: zqla  : ', tab2d_2=qsr  , clinfo2=' qsr   : ')
+         CALL prt_ctl(tab2d_1=emp  , clinfo1=' blk_oce_2: emp   : ')
+      ENDIF
+      !
+   END SUBROUTINE blk_oce_2
+
 
 #if defined key_si3
@@ -684 +835 @@
    !!   'key_si3'                                       SI3 sea-ice model
    !!----------------------------------------------------------------------
-   !!   blk_ice_tau : provide the air-ice stress
-   !!   blk_ice_flx : provide the heat and mass fluxes at air-ice interface
+   !!   blk_ice_1   : provide the air-ice stress
+   !!   blk_ice_2   : provide the heat and mass fluxes at air-ice interface
    !!   blk_ice_qcn : provide ice surface temperature and snow/ice conduction flux (emulating conduction flux)
    !!   Cdn10_Lupkes2012 : Lupkes et al. (2012) air-ice drag
-   !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag 
+   !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag
    !!----------------------------------------------------------------------
 
-   SUBROUTINE blk_ice_tau
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE blk_ice_tau  ***
+   SUBROUTINE blk_ice_1( pwndi, pwndj, ptair, phumi, pslp , puice, pvice, ptsui,  &   ! inputs
+      &                  putaui, pvtaui, pseni, pevpi, pssqi, pcd_dui             )   ! optional outputs
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_ice_1  ***
       !!
       !! ** Purpose :   provide the surface boundary condition over sea-ice
@@ -701 +853 @@
       !!                NB: ice drag coefficient is assumed to be a constant
       !!---------------------------------------------------------------------
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pslp    ! sea-level pressure [Pa]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndi   ! atmospheric wind at T-point [m/s]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndj   ! atmospheric wind at T-point [m/s]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   ptair   ! atmospheric wind at T-point [m/s]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   phumi   ! atmospheric wind at T-point [m/s]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   puice   ! sea-ice velocity on I or C grid [m/s]
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pvice   ! "
+      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   ptsui   ! sea-ice surface temperature [K]
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   putaui  ! if ln_blk
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pvtaui  ! if ln_blk
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pseni   ! if ln_abl
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pevpi   ! if ln_abl
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pssqi   ! if ln_abl
+      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pcd_dui ! if ln_abl
+      !
       INTEGER  ::   ji, jj    ! dummy loop indices
-      REAL(wp) ::   zwndi_f , zwndj_f, zwnorm_f   ! relative wind module and components at F-point
       REAL(wp) ::   zwndi_t , zwndj_t             ! relative wind components at T-point
-      REAL(wp), DIMENSION(jpi,jpj) ::   zrhoa     ! transfer coefficient for momentum      (tau)
-      !!---------------------------------------------------------------------
-      !
-      ! set transfer coefficients to default sea-ice values
-      Cd_atm(:,:) = Cd_ice
-      Ch_atm(:,:) = Cd_ice
-      Ce_atm(:,:) = Cd_ice
-
-      wndm_ice(:,:) = 0._wp      !!gm brutal....
+      REAL(wp) ::   zootm_su                      ! sea-ice surface mean temperature
+      REAL(wp) ::   zztmp1, zztmp2                ! temporary arrays
+      REAL(wp), DIMENSION(jpi,jpj) ::   zcd_dui   ! transfer coefficient for momentum      (tau)
+      !!---------------------------------------------------------------------
+      !
 
       ! ------------------------------------------------------------ !
@@ -720 +882 @@
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vect. opt.
-            zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  )
-            zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  )
+            zwndi_t = (  pwndi(ji,jj) - rn_vfac * 0.5_wp * ( puice(ji-1,jj  ) + puice(ji,jj) )  )
+            zwndj_t = (  pwndj(ji,jj) - rn_vfac * 0.5_wp * ( pvice(ji  ,jj-1) + pvice(ji,jj) )  )
             wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
          END DO
@@ -729 +891 @@
       ! Make ice-atm. drag dependent on ice concentration
       IF    ( ln_Cd_L12 ) THEN   ! calculate new drag from Lupkes(2012) equations
-         CALL Cdn10_Lupkes2012( Cd_atm )
-         Ch_atm(:,:) = Cd_atm(:,:)       ! momentum and heat transfer coef. are considered identical
+         CALL Cdn10_Lupkes2012( Cd_ice )
+         Ch_ice(:,:) = Cd_ice(:,:)       ! momentum and heat transfer coef. are considered identical
+         Ce_ice(:,:) = Cd_ice(:,:)
       ELSEIF( ln_Cd_L15 ) THEN   ! calculate new drag from Lupkes(2015) equations
-         CALL Cdn10_Lupkes2015( Cd_atm, Ch_atm ) 
-      ENDIF
-
-!!      CALL iom_put( "Cd_ice", Cd_atm)  ! output value of pure ice-atm. transfer coef.
-!!      CALL iom_put( "Ch_ice", Ch_atm)  ! output value of pure ice-atm. transfer coef.
+         CALL Cdn10_Lupkes2015( ptsui, pslp, Cd_ice, Ch_ice )
+         Ce_ice(:,:) = Ch_ice(:,:)       ! sensible and latent heat transfer coef. are considered identical
+      ENDIF
+
+      !! IF ( iom_use("Cd_ice") ) CALL iom_put("Cd_ice", Cd_ice)   ! output value of pure ice-atm. transfer coef.
+      !! IF ( iom_use("Ch_ice") ) CALL iom_put("Ch_ice", Ch_ice)   ! output value of pure ice-atm. transfer coef.
 
       ! local scalars ( place there for vector optimisation purposes)
-      ! Computing density of air! Way denser that 1.2 over sea-ice !!!
-      zrhoa (:,:) =  rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1))
-
-      !!gm brutal....
-      utau_ice  (:,:) = 0._wp
-      vtau_ice  (:,:) = 0._wp
-      !!gm end
-
-      ! ------------------------------------------------------------ !
-      !    Wind stress relative to the moving ice ( U10m - U_ice )   !
-      ! ------------------------------------------------------------ !
-      ! C-grid ice dynamics :   U & V-points (same as ocean)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vect. opt.
-            utau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )            &
-               &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) )
-            vtau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )            &
-               &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) )
+      !IF (ln_abl) rhoa  (:,:)  = rho_air( ptair(:,:), phumi(:,:), pslp(:,:) ) !!GS: rhoa must be (re)computed here with ABL to avoid division by zero after (TBI)
+      zcd_dui(:,:) = wndm_ice(:,:) * Cd_ice(:,:)
+
+      IF( ln_blk ) THEN
+         ! ------------------------------------------------------------ !
+         !    Wind stress relative to the moving ice ( U10m - U_ice )   !
+         ! ------------------------------------------------------------ !
+         ! C-grid ice dynamics :   U & V-points (same as ocean)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vect. opt.
+               putaui(ji,jj) = 0.5_wp * (  rhoa(ji+1,jj) * zcd_dui(ji+1,jj)             &
+                  &                      + rhoa(ji  ,jj) * zcd_dui(ji  ,jj)  )          &
+                  &         * ( 0.5_wp * ( pwndi(ji+1,jj) + pwndi(ji,jj) ) - rn_vfac * puice(ji,jj) )
+               pvtaui(ji,jj) = 0.5_wp * (  rhoa(ji,jj+1) * zcd_dui(ji,jj+1)             &
+                  &                      + rhoa(ji,jj  ) * zcd_dui(ji,jj  )  )          &
+                  &         * ( 0.5_wp * ( pwndj(ji,jj+1) + pwndj(ji,jj) ) - rn_vfac * pvice(ji,jj) )
+            END DO
          END DO
-      END DO
-      CALL lbc_lnk_multi( 'sbcblk', utau_ice, 'U', -1., vtau_ice, 'V', -1. )
-      !
-      !
-      IF(ln_ctl) THEN
-         CALL prt_ctl(tab2d_1=utau_ice  , clinfo1=' blk_ice: utau_ice : ', tab2d_2=vtau_ice  , clinfo2=' vtau_ice : ')
-         CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice: wndm_ice : ')
-      ENDIF
-      !
-   END SUBROUTINE blk_ice_tau
-
-
-   SUBROUTINE blk_ice_flx( ptsu, phs, phi, palb )
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE blk_ice_flx  ***
+         CALL lbc_lnk_multi( 'sbcblk', putaui, 'U', -1., pvtaui, 'V', -1. )
+         !
+         IF(ln_ctl)   CALL prt_ctl( tab2d_1=putaui  , clinfo1=' blk_ice: putaui : '   &
+            &                     , tab2d_2=pvtaui  , clinfo2='          pvtaui : ' )
+      ELSE
+         zztmp1 = 11637800.0_wp
+         zztmp2 =    -5897.8_wp
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               pcd_dui(ji,jj) = zcd_dui (ji,jj)
+               pseni  (ji,jj) = wndm_ice(ji,jj) * Ch_ice(ji,jj)
+               pevpi  (ji,jj) = wndm_ice(ji,jj) * Ce_ice(ji,jj)
+               zootm_su       = zztmp2 / ptsui(ji,jj)   ! ptsui is in K (it can't be zero ??)
+               pssqi  (ji,jj) = zztmp1 * EXP( zootm_su ) / rhoa(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !
+      IF(ln_ctl)  CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice: wndm_ice : ')
+      !
+   END SUBROUTINE blk_ice_1
+
+
+   SUBROUTINE blk_ice_2( ptsu, phs, phi, palb, ptair, phumi, pslp, pqlw, pprec, psnow  )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_ice_2  ***
       !!
       !! ** Purpose :   provide the heat and mass fluxes at air-ice interface
@@ -782 +956 @@
       !! caution : the net upward water flux has with mm/day unit
       !!---------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu   ! sea ice surface temperature
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu   ! sea ice surface temperature [K]
       REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phs    ! snow thickness
       REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness
       REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   palb   ! ice albedo (all skies)
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   ptair
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   phumi
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pslp
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pqlw
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pprec
+      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   psnow
       !!
       INTEGER  ::   ji, jj, jl               ! dummy loop indices
       REAL(wp) ::   zst3                     ! local variable
       REAL(wp) ::   zcoef_dqlw, zcoef_dqla   !   -      -
-      REAL(wp) ::   zztmp, z1_rLsub           !   -      -
+      REAL(wp) ::   zztmp, zztmp2, z1_rLsub  !   -      -
       REAL(wp) ::   zfr1, zfr2               ! local variables
       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_st         ! inverse of surface temperature
@@ -798 +978 @@
       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_dqsb        ! sensible  heat sensitivity over ice
       REAL(wp), DIMENSION(jpi,jpj)     ::   zevap, zsnw   ! evaporation and snw distribution after wind blowing (SI3)
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zrhoa
-      !!---------------------------------------------------------------------
-      !
-      zcoef_dqlw = 4.0 * 0.95 * Stef             ! local scalars
-      zcoef_dqla = -Ls * 11637800. * (-5897.8)
-      !
-      zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) )
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zqair         ! specific humidity of air at z=rn_zqt [kg/kg] !LB
+      !!---------------------------------------------------------------------
+      !
+      zcoef_dqlw = 4._wp * 0.95_wp * stefan             ! local scalars
+      zcoef_dqla = -rLsub * 11637800._wp * (-5897.8_wp) !LB: BAD!
+      !
+      SELECT CASE( nhumi )
+      CASE( np_humi_sph )
+         zqair(:,:) =  phumi(:,:)      ! what we read in file is already a spec. humidity!
+      CASE( np_humi_dpt )
+         zqair(:,:) = q_sat( phumi(:,:), pslp )
+      CASE( np_humi_rlh )
+         zqair(:,:) = q_air_rh( 0.01_wp*phumi(:,:), ptair(:,:), pslp(:,:) ) !LB: 0.01 => RH is % percent in file
+      END SELECT
       !
       zztmp = 1. / ( 1. - albo )
-      WHERE( ptsu(:,:,:) /= 0._wp )   ;   z1_st(:,:,:) = 1._wp / ptsu(:,:,:)
-      ELSEWHERE                       ;   z1_st(:,:,:) = 0._wp
+      WHERE( ptsu(:,:,:) /= 0._wp )
+         z1_st(:,:,:) = 1._wp / ptsu(:,:,:)
+      ELSEWHERE
+         z1_st(:,:,:) = 0._wp
       END WHERE
       !                                     ! ========================== !
@@ -822 +1011 @@
                qsr_ice(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj)
                ! Long  Wave (lw)
-               z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)
+               z_qlw(ji,jj,jl) = 0.95 * ( pqlw(ji,jj) - stefan * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)
                ! lw sensitivity
                z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3
@@ -830 +1019 @@
                ! ----------------------------!
 
-               ! ... turbulent heat fluxes with Ch_atm recalculated in blk_ice_tau
+               ! ... turbulent heat fluxes with Ch_ice recalculated in blk_ice_1
                ! Sensible Heat
-               z_qsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_atm(ji,jj) * wndm_ice(ji,jj) * (ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1))
+               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))
                ! Latent Heat
-               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls  * Ch_atm(ji,jj) * wndm_ice(ji,jj) *  &
-                  &                ( 11637800. * EXP( -5897.8 * z1_st(ji,jj,jl) ) / zrhoa(ji,jj) - sf(jp_humi)%fnow(ji,jj,1) ) )
+               zztmp2 = EXP( -5897.8 * z1_st(ji,jj,jl) )
+               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa(ji,jj) * rLsub  * Ce_ice(ji,jj) * wndm_ice(ji,jj) *  &
+                  &                ( 11637800. * zztmp2 / rhoa(ji,jj) - zqair(ji,jj) ) )
                ! Latent heat sensitivity for ice (Dqla/Dt)
                IF( qla_ice(ji,jj,jl) > 0._wp ) THEN
-                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ch_atm(ji,jj) * wndm_ice(ji,jj) *  &
-                     &                 z1_st(ji,jj,jl)*z1_st(ji,jj,jl) * EXP(-5897.8 * z1_st(ji,jj,jl))
+                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ce_ice(ji,jj) * wndm_ice(ji,jj) *  &
+                     &                 z1_st(ji,jj,jl) * z1_st(ji,jj,jl) * zztmp2
                ELSE
                   dqla_ice(ji,jj,jl) = 0._wp
@@ -845 +1035 @@
 
                ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice)
-               z_dqsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_atm(ji,jj) * wndm_ice(ji,jj)
+               z_dqsb(ji,jj,jl) = rhoa(ji,jj) * rCp_air * Ch_ice(ji,jj) * wndm_ice(ji,jj)
 
                ! ----------------------------!
@@ -860 +1050 @@
       END DO
       !
-      tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1)  ! total precipitation [kg/m2/s]
-      sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac * tmask(:,:,1)  ! solid precipitation [kg/m2/s]
-      CALL iom_put( 'snowpre', sprecip )                    ! Snow precipitation
-      CALL iom_put( 'precip' , tprecip )                    ! Total precipitation
+      tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1)  ! total precipitation [kg/m2/s]
+      sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1)  ! solid precipitation [kg/m2/s]
+      CALL iom_put( 'snowpre', sprecip )                  ! Snow precipitation
+      CALL iom_put( 'precip' , tprecip )                  ! Total precipitation
 
       ! --- evaporation --- !
@@ -880 +1070 @@
       ! --- heat flux associated with emp --- !
       qemp_oce(:,:) = - ( 1._wp - at_i_b(:,:) ) * zevap(:,:) * sst_m(:,:) * rcp                  & ! evap at sst
-         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip at Tair
+         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( ptair(:,:) - rt0 ) * rcp               & ! liquid precip at Tair
          &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip at min(Tair,Tsnow)
-         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
+         &              ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
       qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only)
-         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
+         &              ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
 
       ! --- total solar and non solar fluxes --- !
@@ -892 +1082 @@
 
       ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
-      qprec_ice(:,:) = rhos * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
+      qprec_ice(:,:) = rhos * ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )
 
       ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) ---
       DO jl = 1, jpl
          qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * rcpi * tmask(:,:,1) )
-         !                         ! But we do not have Tice => consider it at 0degC => evap=0 
+         !                         ! But we do not have Tice => consider it at 0degC => evap=0
       END DO
 
@@ -904 +1094 @@
       zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1
       !
-      WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm  
+      WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm
          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) )
       ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm
          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1
       ELSEWHERE                                                         ! zero when hs>0
-         qtr_ice_top(:,:,:) = 0._wp 
+         qtr_ice_top(:,:,:) = 0._wp
       END WHERE
       !
@@ -921 +1111 @@
       ENDIF
       !
-   END SUBROUTINE blk_ice_flx
-   
+   END SUBROUTINE blk_ice_2
+
 
    SUBROUTINE blk_ice_qcn( ld_virtual_itd, ptsu, ptb, phs, phi )
@@ -931 +1121 @@
       !!                to force sea ice / snow thermodynamics
       !!                in the case conduction flux is emulated
-      !!                
+      !!
       !! ** Method  :   compute surface energy balance assuming neglecting heat storage
       !!                following the 0-layer Semtner (1976) approach
@@ -956 +1146 @@
       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zgfac   ! enhanced conduction factor
       !!---------------------------------------------------------------------
-      
+
       ! -------------------------------------!
       !      I   Enhanced conduction factor  !
@@ -964 +1154 @@
       !
       zgfac(:,:,:) = 1._wp
-      
+
       IF( ld_virtual_itd ) THEN
          !
@@ -970 +1160 @@
          zfac2 = EXP(1._wp) * 0.5_wp * zepsilon
          zfac3 = 2._wp / zepsilon
-         !   
-         DO jl = 1, jpl                
+         !
+         DO jl = 1, jpl
             DO jj = 1 , jpj
                DO ji = 1, jpi
@@ -979 +1169 @@
             END DO
          END DO
-         !      
-      ENDIF
-      
+         !
+      ENDIF
+
       ! -------------------------------------------------------------!
       !      II   Surface temperature and conduction flux            !
@@ -991 +1181 @@
          DO jj = 1 , jpj
             DO ji = 1, jpi
-               !                    
+               !
                zkeff_h = zfac * zgfac(ji,jj,jl) / &                                    ! Effective conductivity of the snow-ice system divided by thickness
                   &      ( rcnd_i * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) )
@@ -1008 +1198 @@
                qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 )
                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) )  &
-                             &   * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) )
+                  &   * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) )
 
                ! --- Diagnose the heat loss due to changing non-solar flux (as in icethd_zdf_bl99) --- !
-               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) 
+               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)
 
             END DO
          END DO
          !
-      END DO 
-      !      
+      END DO
+      !
    END SUBROUTINE blk_ice_qcn
-   
-
-   SUBROUTINE Cdn10_Lupkes2012( Cd )
+
+
+   SUBROUTINE Cdn10_Lupkes2012( pcd )
       !!----------------------------------------------------------------------
       !!                      ***  ROUTINE  Cdn10_Lupkes2012  ***
       !!
-      !! ** Purpose :    Recompute the neutral air-ice drag referenced at 10m 
+      !! ** Purpose :    Recompute the neutral air-ice drag referenced at 10m
       !!                 to make it dependent on edges at leads, melt ponds and flows.
       !!                 After some approximations, this can be resumed to a dependency
       !!                 on ice concentration.
-      !!                
+      !!
       !! ** Method :     The parameterization is taken from Lupkes et al. (2012) eq.(50)
       !!                 with the highest level of approximation: level4, eq.(59)
@@ -1041 +1231 @@
       !!
       !!                 This new drag has a parabolic shape (as a function of A) starting at
-      !!                 Cdw(say 1.5e-3) for A=0, reaching 1.97e-3 for A~0.5 
+      !!                 Cdw(say 1.5e-3) for A=0, reaching 1.97e-3 for A~0.5
       !!                 and going down to Cdi(say 1.4e-3) for A=1
       !!
@@ -1051 +1241 @@
       !!
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Cd
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pcd
       REAL(wp), PARAMETER ::   zCe   = 2.23e-03_wp
       REAL(wp), PARAMETER ::   znu   = 1._wp
@@ -1066 +1256 @@
 
       ! ice-atm drag
-      Cd(:,:) = Cd_ice +  &                                                         ! pure ice drag
-         &      zCe    * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)  ! change due to sea-ice morphology
-      
+      pcd(:,:) = rCd_ice +  &                                                         ! pure ice drag
+         &      zCe     * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)  ! change due to sea-ice morphology
+
    END SUBROUTINE Cdn10_Lupkes2012
 
 
-   SUBROUTINE Cdn10_Lupkes2015( Cd, Ch )
+   SUBROUTINE Cdn10_Lupkes2015( ptm_su, pslp, pcd, pch )
       !!----------------------------------------------------------------------
       !!                      ***  ROUTINE  Cdn10_Lupkes2015  ***
       !!
       !! ** pUrpose :    Alternative turbulent transfert coefficients formulation
-      !!                 between sea-ice and atmosphere with distinct momentum 
-      !!                 and heat coefficients depending on sea-ice concentration 
+      !!                 between sea-ice and atmosphere with distinct momentum
+      !!                 and heat coefficients depending on sea-ice concentration
       !!                 and atmospheric stability (no meltponds effect for now).
-      !!                
+      !!
       !! ** Method :     The parameterization is adapted from Lupkes et al. (2015)
       !!                 and ECHAM6 atmospheric model. Compared to Lupkes2012 scheme,
       !!                 it considers specific skin and form drags (Andreas et al. 2010)
-      !!                 to compute neutral transfert coefficients for both heat and 
+      !!                 to compute neutral transfert coefficients for both heat and
       !!                 momemtum fluxes. Atmospheric stability effect on transfert
       !!                 coefficient is also taken into account following Louis (1979).
@@ -1093 +1283 @@
       !!----------------------------------------------------------------------
       !
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Cd
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Ch
-      REAL(wp), DIMENSION(jpi,jpj)            ::   ztm_su, zst, zqo_sat, zqi_sat
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   ptm_su ! sea-ice surface temperature [K]
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pslp   ! sea-level pressure [Pa]
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pcd    ! momentum transfert coefficient
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pch    ! heat transfert coefficient
+      REAL(wp), DIMENSION(jpi,jpj)            ::   zst, zqo_sat, zqi_sat
       !
       ! ECHAM6 constants
@@ -1123 +1315 @@
       !!----------------------------------------------------------------------
 
-      ! mean temperature
-      WHERE( at_i_b(:,:) > 1.e-20 )   ;   ztm_su(:,:) = SUM( t_su(:,:,:) * a_i_b(:,:,:) , dim=3 ) / at_i_b(:,:)
-      ELSEWHERE                       ;   ztm_su(:,:) = rt0
-      ENDWHERE
-      
       ! Momentum Neutral Transfert Coefficients (should be a constant)
       zCdn_form_tmp = zce10 * ( LOG( 10._wp / z0_form_ice + 1._wp ) / LOG( rn_zu / z0_form_ice + 1._wp ) )**2   ! Eq. 40
       zCdn_skin_ice = ( vkarmn                                      / LOG( rn_zu / z0_skin_ice + 1._wp ) )**2   ! Eq. 7
-      zCdn_ice      = zCdn_skin_ice   ! Eq. 7 (cf Lupkes email for details)
+      zCdn_ice      = zCdn_skin_ice   ! Eq. 7
       !zCdn_ice     = 1.89e-3         ! old ECHAM5 value (cf Eq. 32)
 
       ! Heat Neutral Transfert Coefficients
-      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 (cf Lupkes email for details)
-     
+      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
+
       ! Atmospheric and Surface Variables
       zst(:,:)     = sst_m(:,:) + rt0                                        ! convert SST from Celcius to Kelvin
-      zqo_sat(:,:) = 0.98_wp * q_sat( zst(:,:)   , sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ocean [kg/kg]
-      zqi_sat(:,:) = 0.98_wp * q_sat( ztm_su(:,:), sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ice   [kg/kg]
+      zqo_sat(:,:) = rdct_qsat_salt * q_sat( zst(:,:)   , pslp(:,:) )   ! saturation humidity over ocean [kg/kg]
+      zqi_sat(:,:) =                  q_sat( ptm_su(:,:), pslp(:,:) )   ! saturation humidity over ice   [kg/kg]
       !
       DO jj = 2, jpjm1           ! reduced loop is necessary for reproducibility
@@ -1146 +1333 @@
             ! Virtual potential temperature [K]
             zthetav_os = zst(ji,jj)    * ( 1._wp + rctv0 * zqo_sat(ji,jj) )   ! over ocean
-            zthetav_is = ztm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice
+            zthetav_is = ptm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice
             zthetav_zu = t_zu (ji,jj)  * ( 1._wp + rctv0 * q_zu(ji,jj)    )   ! at zu
-            
+
             ! Bulk Richardson Number (could use Ri_bulk function from aerobulk instead)
             zrib_o = grav / zthetav_os * ( zthetav_zu - zthetav_os ) * rn_zu / MAX( 0.5, wndm(ji,jj)     )**2   ! over ocean
             zrib_i = grav / zthetav_is * ( zthetav_zu - zthetav_is ) * rn_zu / MAX( 0.5, wndm_ice(ji,jj) )**2   ! over ice
-            
+
             ! Momentum and Heat Neutral Transfert Coefficients
             zCdn_form_ice = zCdn_form_tmp * at_i_b(ji,jj) * ( 1._wp - at_i_b(ji,jj) )**zbeta  ! Eq. 40
-            zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) )               ! Eq. 53 
-                       
-            ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead)
+            zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) )               ! Eq. 53
+
+            ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead ?)
             z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water
-            z0i = z0_skin_ice                                             ! over ice (cf Lupkes email for details)
+            z0i = z0_skin_ice                                             ! over ice
             IF( zrib_o <= 0._wp ) THEN
                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
@@ -1168 +1355 @@
                zfhw = 1._wp / ( 1._wp + zah * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 28
             ENDIF
-            
+
             IF( zrib_i <= 0._wp ) THEN
                zfmi = 1._wp - zam * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq.  9
@@ -1176 +1363 @@
                zfhi = 1._wp / ( 1._wp + zah * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 27
             ENDIF
-            
+
             ! Momentum Transfert Coefficients (Eq. 38)
-            Cd(ji,jj) = zCdn_skin_ice *   zfmi +  &
+            pcd(ji,jj) = zCdn_skin_ice *   zfmi +  &
                &        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) )
-            
+
             ! Heat Transfert Coefficients (Eq. 49)
-            Ch(ji,jj) = zChn_skin_ice *   zfhi +  &
+            pch(ji,jj) = zChn_skin_ice *   zfhi +  &
                &        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) )
             !
          END DO
       END DO
-      CALL lbc_lnk_multi( 'sbcblk', Cd, 'T',  1., Ch, 'T', 1. )
+      CALL lbc_lnk_multi( 'sbcblk', pcd, 'T',  1., pch, 'T', 1. )
       !
    END SUBROUTINE Cdn10_Lupkes2015

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcblk_algo_ecmwf.F90

@@ -1 +1 @@
 MODULE sbcblk_algo_ecmwf
    !!======================================================================
-   !!                       ***  MODULE  sbcblk_algo_ecmwf  ***
-   !! Computes turbulent components of surface fluxes
-   !!         according to the method in IFS of the ECMWF model
-   !!
+   !!                   ***  MODULE  sbcblk_algo_ecmwf  ***
+   !! Computes:
    !!   * bulk transfer coefficients C_D, C_E and C_H
    !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed
@@ -10 +8 @@
    !!   => all these are used in bulk formulas in sbcblk.F90
    !!
-   !!    Using the bulk formulation/param. of IFS of ECMWF (cycle 31r2)
+   !!    Using the bulk formulation/param. of IFS of ECMWF (cycle 40r1)
    !!         based on IFS doc (avaible online on the ECMWF's website)
    !!
+   !!       Routine turb_ecmwf maintained and developed in AeroBulk
+   !!                     (https://github.com/brodeau/aerobulk)
    !!
-   !!       Routine turb_ecmwf maintained and developed in AeroBulk
-   !!                     (http://aerobulk.sourceforge.net/)
-   !!
-   !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+   !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk)
    !!----------------------------------------------------------------------
    !! History :  4.0  !  2016-02  (L.Brodeau)   Original code
@@ -41 +38 @@
 
    USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB
+   USE sbcblk_skin_ecmwf ! cool-skin/warm layer scheme !LB
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC ::   TURB_ECMWF   ! called by sbcblk.F90
-
-   !                   !! ECMWF own values for given constants, taken form IFS documentation...
+   PUBLIC :: SBCBLK_ALGO_ECMWF_INIT, TURB_ECMWF
+
+   !! ECMWF own values for given constants, taken form IFS documentation...
    REAL(wp), PARAMETER ::   charn0 = 0.018    ! Charnock constant (pretty high value here !!!
    !                                          !    =>  Usually 0.011 for moderate winds)
    REAL(wp), PARAMETER ::   zi0     = 1000.   ! scale height of the atmospheric boundary layer...1
    REAL(wp), PARAMETER ::   Beta0    = 1.     ! gustiness parameter ( = 1.25 in COAREv3)
-   REAL(wp), PARAMETER ::   rctv0    = 0.608  ! constant to obtain virtual temperature...
-   REAL(wp), PARAMETER ::   Cp_dry = 1005.0   ! Specic heat of dry air, constant pressure      [J/K/kg]
-   REAL(wp), PARAMETER ::   Cp_vap = 1860.0   ! Specic heat of water vapor, constant pressure  [J/K/kg]
    REAL(wp), PARAMETER ::   alpha_M = 0.11    ! For roughness length (smooth surface term)
    REAL(wp), PARAMETER ::   alpha_H = 0.40    ! (Chapter 3, p.34, IFS doc Cy31r1)
    REAL(wp), PARAMETER ::   alpha_Q = 0.62    !
+
+   INTEGER , PARAMETER ::   nb_itt = 10             ! number of itterations
+
    !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE TURB_ECMWF( zt, zu, sst, t_zt, ssq , q_zt , U_zu,   &
-      &                   Cd, Ch, Ce , t_zu, q_zu, U_blk,         &
-      &                   Cdn, Chn, Cen                           )
-      !!----------------------------------------------------------------------------------
-      !!                      ***  ROUTINE  turb_ecmwf  ***
-      !!
-      !!            2015: L. Brodeau (brodeau@gmail.com)
-      !!
-      !! ** Purpose :   Computes turbulent transfert coefficients of surface
-      !!                fluxes according to IFS doc. (cycle 31)
-      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu
-      !!
-      !! ** Method : Monin Obukhov Similarity Theory
+
+   SUBROUTINE sbcblk_algo_ecmwf_init(l_use_cs, l_use_wl)
+      !!---------------------------------------------------------------------
+      !!                  ***  FUNCTION sbcblk_algo_ecmwf_init  ***
       !!
       !! INPUT :
       !! -------
+      !!    * l_use_cs : use the cool-skin parameterization
+      !!    * l_use_wl : use the warm-layer parameterization
+      !!---------------------------------------------------------------------
+      LOGICAL , INTENT(in) ::   l_use_cs ! use the cool-skin parameterization
+      LOGICAL , INTENT(in) ::   l_use_wl ! use the warm-layer parameterization
+      INTEGER :: ierr
+      !!---------------------------------------------------------------------
+      IF( l_use_wl ) THEN
+         ierr = 0
+         ALLOCATE ( dT_wl(jpi,jpj), Hz_wl(jpi,jpj), STAT=ierr )
+         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_wl & Hz_wl failed!' )
+         dT_wl(:,:)  = 0._wp
+         Hz_wl(:,:)  = rd0 ! (rd0, constant, = 3m is default for Zeng & Beljaars)
+      ENDIF
+      IF( l_use_cs ) THEN
+         ierr = 0
+         ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr )
+         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_cs failed!' )
+         dT_cs(:,:) = -0.25_wp  ! First guess of skin correction
+      ENDIF
+   END SUBROUTINE sbcblk_algo_ecmwf_init
+
+
+
+   SUBROUTINE turb_ecmwf( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, &
+      &                      Cd, Ch, Ce, t_zu, q_zu, U_blk,                           &
+      &                      Cdn, Chn, Cen,                                           &
+      &                      Qsw, rad_lw, slp, pdT_cs,                                & ! optionals for cool-skin (and warm-layer)
+      &                      pdT_wl, pHz_wl )                                           ! optionals for warm-layer only
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE  turb_ecmwf  ***
+      !!
+      !! ** Purpose :   Computes turbulent transfert coefficients of surface
+      !!                fluxes according to IFS doc. (cycle 45r1)
+      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu
+      !!                Returns the effective bulk wind speed at zu to be used in the bulk formulas
+      !!
+      !!                Applies the cool-skin warm-layer correction of the SST to T_s
+      !!                if the net shortwave flux at the surface (Qsw), the downwelling longwave
+      !!                radiative fluxes at the surface (rad_lw), and the sea-leve pressure (slp)
+      !!                are provided as (optional) arguments!
+      !!
+      !! INPUT :
+      !! -------
+      !!    *  kt   : current time step (starts at 1)
       !!    *  zt   : height for temperature and spec. hum. of air            [m]
-      !!    *  zu   : height for wind speed (generally 10m)                   [m]
-      !!    *  U_zu : scalar wind speed at 10m                                [m/s]
-      !!    *  sst  : SST                                                     [K]
+      !!    *  zu   : height for wind speed (usually 10m)                     [m]
       !!    *  t_zt : potential air temperature at zt                         [K]
-      !!    *  ssq  : specific humidity at saturation at SST                  [kg/kg]
       !!    *  q_zt : specific humidity of air at zt                          [kg/kg]
-      !!
+      !!    *  U_zu : scalar wind speed at zu                                 [m/s]
+      !!    * l_use_cs : use the cool-skin parameterization
+      !!    * l_use_wl : use the warm-layer parameterization
+      !!
+      !! INPUT/OUTPUT:
+      !! -------------
+      !!    *  T_s  : always "bulk SST" as input                              [K]
+      !!              -> unchanged "bulk SST" as output if CSWL not used      [K]
+      !!              -> skin temperature as output if CSWL used              [K]
+      !!
+      !!    *  q_s  : SSQ aka saturation specific humidity at temp. T_s       [kg/kg]
+      !!              -> doesn't need to be given a value if skin temp computed (in case l_use_cs=True or l_use_wl=True)
+      !!              -> MUST be given the correct value if not computing skint temp. (in case l_use_cs=False or l_use_wl=False)
+      !!
+      !! OPTIONAL INPUT:
+      !! ---------------
+      !!    *  Qsw    : net solar flux (after albedo) at the surface (>0)     [W/m^2]
+      !!    *  rad_lw : downwelling longwave radiation at the surface  (>0)   [W/m^2]
+      !!    *  slp    : sea-level pressure                                    [Pa]
+      !!
+      !! OPTIONAL OUTPUT:
+      !! ----------------
+      !!    * pdT_cs  : SST increment "dT" for cool-skin correction           [K]
+      !!    * pdT_wl  : SST increment "dT" for warm-layer correction          [K]
+      !!    * pHz_wl  : thickness of warm-layer                               [m]
       !!
       !! OUTPUT :
@@ -93 +149 @@
       !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K]
       !!    *  q_zu   : specific humidity of air        //                    [kg/kg]
-      !!    *  U_blk  : bulk wind at 10m                                      [m/s]
-      !!
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
+      !!    *  U_blk  : bulk wind speed at zu                                 [m/s]
+      !!
+      !!
+      !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      INTEGER,  INTENT(in   )                     ::   kt       ! current time step
       REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m]
       REAL(wp), INTENT(in   )                     ::   zu       ! height for U_zu                             [m]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   sst      ! sea surface temperature                [Kelvin]
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   T_s      ! sea surface temperature                [Kelvin]
       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity           [kg/kg]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                   [kg/kg]
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   q_s      ! sea surface specific humidity           [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity at zt             [kg/kg]
       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s]
+      LOGICAL , INTENT(in   )                     ::   l_use_cs ! use the cool-skin parameterization
+      LOGICAL , INTENT(in   )                     ::   l_use_wl ! use the warm-layer parameterization
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau)
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens)
@@ -110 +169 @@
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients
       !
+      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   Qsw      !             [W/m^2]
+      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   rad_lw   !             [W/m^2]
+      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   slp      !             [Pa]
+      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pdT_cs
+      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pdT_wl   !             [K]
+      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pHz_wl   !             [m]
+      !
       INTEGER :: j_itt
-      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
-      INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations
-      !
-      REAL(wp), DIMENSION(jpi,jpj) ::   u_star, t_star, q_star,   &
-         &  dt_zu, dq_zu,    &
-         &  znu_a,           & !: Nu_air, Viscosity of air
-         &  Linv,            & !: 1/L (inverse of Monin Obukhov length...
-         &  z0, z0t, z0q
-      REAL(wp), DIMENSION(jpi,jpj) ::   func_m, func_h
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztmp0, ztmp1, ztmp2
-      !!----------------------------------------------------------------------------------
-      !
-      ! Identical first gess as in COARE, with IFS parameter values though
-      !
+      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
+      !
+      REAL(wp), DIMENSION(jpi,jpj) ::  u_star, t_star, q_star
+      REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu     
+      REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air
+      REAL(wp), DIMENSION(jpi,jpj) :: Linv  !: 1/L (inverse of Monin Obukhov length...
+      REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t, z0q
+      !
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst  ! to back up the initial bulk SST
+      !
+      REAL(wp), DIMENSION(jpi,jpj) :: func_m, func_h
+      REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2
+      CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ecmwf@sbcblk_algo_ecmwf.F90'
+      !!----------------------------------------------------------------------------------
+
+      IF( kt == nit000 ) CALL SBCBLK_ALGO_ECMWF_INIT(l_use_cs, l_use_wl)
+
       l_zt_equal_zu = .FALSE.
-      IF( ABS(zu - zt) < 0.01 )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision
-
-
+      IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision
+
+      !! Initializations for cool skin and warm layer:
+      IF( l_use_cs .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) &
+         &   CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use cool-skin param!' )
+
+      IF( l_use_wl .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) &
+         &   CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use warm-layer param!' )
+
+      IF( l_use_cs .OR. l_use_wl ) THEN
+         ALLOCATE ( zsst(jpi,jpj) )
+         zsst = T_s ! backing up the bulk SST
+         IF( l_use_cs ) T_s = T_s - 0.25_wp   ! First guess of correction
+         q_s    = rdct_qsat_salt*q_sat(MAX(T_s, 200._wp), slp) ! First guess of q_s
+      ENDIF
+
+
+      ! Identical first gess as in COARE, with IFS parameter values though...
+      !
       !! First guess of temperature and humidity at height zu:
-      t_zu = MAX( t_zt , 0.0  )   ! who knows what's given on masked-continental regions...
-      q_zu = MAX( q_zt , 1.e-6)   !               "
+      t_zu = MAX( t_zt ,  180._wp )   ! who knows what's given on masked-continental regions...
+      q_zu = MAX( q_zt , 1.e-6_wp )   !               "
 
       !! Pot. temp. difference (and we don't want it to be 0!)
-      dt_zu = t_zu - sst   ;   dt_zu = SIGN( MAX(ABS(dt_zu),1.e-6), dt_zu )
-      dq_zu = q_zu - ssq   ;   dq_zu = SIGN( MAX(ABS(dq_zu),1.e-9), dq_zu )
-
-      znu_a = visc_air(t_zt) ! Air viscosity (m^2/s) at zt given from temperature in (K)
-
-      ztmp2 = 0.5 * 0.5  ! initial guess for wind gustiness contribution
-      U_blk = SQRT(U_zu*U_zu + ztmp2)
-
-      ! z0     = 0.0001
-      ztmp2   = 10000.     ! optimization: ztmp2 == 1/z0
-      ztmp0   = LOG(zu*ztmp2)
-      ztmp1   = LOG(10.*ztmp2)
-      u_star = 0.035*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10)
-
-      z0     = charn0*u_star*u_star/grav + 0.11*znu_a/u_star
-      z0t    = 0.1*EXP(vkarmn/(0.00115/(vkarmn/ztmp1)))   !  WARNING: 1/z0t !
+      dt_zu = t_zu - T_s ;   dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu )
+      dq_zu = q_zu - q_s ;   dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu )
+
+      znu_a = visc_air(t_zu) ! Air viscosity (m^2/s) at zt given from temperature in (K)
+
+      U_blk = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution
+
+      ztmp0   = LOG(    zu*10000._wp) ! optimization: 10000. == 1/z0 (with z0 first guess == 0.0001)
+      ztmp1   = LOG(10._wp*10000._wp) !       "                    "               "
+      u_star = 0.035_wp*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10)
+
+      z0     = charn0*u_star*u_star/grav + 0.11_wp*znu_a/u_star
+      z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on)
+
+      z0t    = 1._wp / ( 0.1_wp*EXP(vkarmn/(0.00115/(vkarmn/ztmp1))) )
+      z0t    = MIN( MAX(ABS(z0t), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on)
 
       Cd     = (vkarmn/ztmp0)**2    ! first guess of Cd
 
-      ztmp0 = vkarmn*vkarmn/LOG(zt*z0t)/Cd
-
-      ztmp2 = Ri_bulk( zu, t_zu, dt_zu, q_zu, dq_zu, U_blk )   ! Ribu = Bulk Richardson number
-
-      !! First estimate of zeta_u, depending on the stability, ie sign of Ribu (ztmp2):
-      ztmp1 = 0.5 + SIGN( 0.5 , ztmp2 )
+      ztmp0 = vkarmn*vkarmn/LOG(zt/z0t)/Cd
+
+      ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN)
+
+      !! First estimate of zeta_u, depending on the stability, ie sign of BRN (ztmp2):
+      ztmp1 = 0.5 + SIGN( 0.5_wp , ztmp2 )
       func_m = ztmp0*ztmp2 ! temporary array !!
-      !!             Ribu < 0                                 Ribu > 0   Beta = 1.25
-      func_h = (1.-ztmp1)*(func_m/(1.+ztmp2/(-zu/(zi0*0.004*Beta0**3)))) &  ! temporary array !!! func_h == zeta_u
-         &  +     ztmp1*(func_m*(1. + 27./9.*ztmp2/ztmp0))
+      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
+         &  +     ztmp1   * (func_m*(1._wp + 27._wp/9._wp*ztmp2/func_m))              !  BRN > 0
+      !#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" !
 
       !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L
-      ztmp0   =        vkarmn/(LOG(zu*z0t) - psi_h_ecmwf(func_h))
-
-      u_star = U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_ecmwf(func_h))
+      ztmp0  = vkarmn/(LOG(zu/z0t) - psi_h_ecmwf(func_h))
+
+      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)
       t_star = dt_zu*ztmp0
       q_star = dq_zu*ztmp0
 
-      ! What's need to be done if zt /= zu:
+      ! What needs to be done if zt /= zu:
       IF( .NOT. l_zt_equal_zu ) THEN
-         !
          !! First update of values at zu (or zt for wind)
          ztmp0 = psi_h_ecmwf(func_h) - psi_h_ecmwf(zt*func_h/zu)    ! zt*func_h/zu == zeta_t
-         ztmp1 = log(zt/zu) + ztmp0
+         ztmp1 = LOG(zt/zu) + ztmp0
          t_zu = t_zt - t_star/vkarmn*ztmp1
          q_zu = q_zt - q_star/vkarmn*ztmp1
-         q_zu = (0.5 + sign(0.5,q_zu))*q_zu !Makes it impossible to have negative humidity :
-
-         dt_zu = t_zu - sst  ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
-         dq_zu = q_zu - ssq  ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
+         q_zu = (0.5_wp + SIGN(0.5_wp,q_zu))*q_zu !Makes it impossible to have negative humidity :
          !
+         dt_zu = t_zu - T_s  ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu )
+         dq_zu = q_zu - q_s  ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu )
       ENDIF
 
@@ -194 +277 @@
 
       !! First guess of inverse of Monin-Obukov length (1/L) :
-      ztmp0 = (1. + rctv0*q_zu)  ! the factor to apply to temp. to get virt. temp...
-      Linv  =  grav*vkarmn*(t_star*ztmp0 + rctv0*t_zu*q_star) / ( u_star*u_star * t_zu*ztmp0 )
+      Linv = One_on_L( t_zu, q_zu, u_star, t_star, q_star )
 
       !! Functions such as  u* = U_blk*vkarmn/func_m
-      ztmp1 = zu + z0
-      ztmp0 = ztmp1*Linv
-      func_m = LOG(ztmp1) -LOG(z0) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0*Linv)
-      func_h = LOG(ztmp1*z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(1./z0t*Linv)
-
+      ztmp0 = zu*Linv
+      func_m = LOG(zu) - LOG(z0)  - psi_m_ecmwf(ztmp0) + psi_m_ecmwf( z0*Linv)
+      func_h = LOG(zu) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv)
 
       !! ITERATION BLOCK
-      !! ***************
-
       DO j_itt = 1, nb_itt
 
          !! Bulk Richardson Number at z=zu (Eq. 3.25)
-         ztmp0 = Ri_bulk(zu, t_zu, dt_zu, q_zu, dq_zu, U_blk)
+         ztmp0 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN)
 
          !! New estimate of the inverse of the Monin-Obukhon length (Linv == zeta/zu) :
-         Linv = ztmp0*func_m*func_m/func_h / zu     ! From Eq. 3.23, Chap.3, p.33, IFS doc - Cy31r1
+         Linv = ztmp0*func_m*func_m/func_h / zu     ! From Eq. 3.23, Chap.3.2.3, IFS doc - Cy40r1
+         !! Note: it is slightly different that the L we would get with the usual
+         Linv = SIGN( MIN(ABS(Linv),200._wp), Linv ) ! (prevent FPE from stupid values from masked region later on...)
 
          !! Update func_m with new Linv:
-         ztmp1 = zu + z0
-         func_m = LOG(ztmp1) -LOG(z0) - psi_m_ecmwf(ztmp1*Linv) + psi_m_ecmwf(z0*Linv)
+         func_m = LOG(zu) -LOG(z0) - psi_m_ecmwf(zu*Linv) + psi_m_ecmwf(z0*Linv) ! LB: should be "zu+z0" rather than "zu" alone, but z0 is tiny wrt zu!
 
          !! Need to update roughness lengthes:
@@ -223 +302 @@
          ztmp2  = u_star*u_star
          ztmp1  = znu_a/u_star
-         z0    = alpha_M*ztmp1 + charn0*ztmp2/grav
-         z0t    = alpha_H*ztmp1                              ! eq.3.26, Chap.3, p.34, IFS doc - Cy31r1
-         z0q    = alpha_Q*ztmp1
-
-         !! Update wind at 10m taking into acount convection-related wind gustiness:
-         ! Only true when unstable (L<0) => when ztmp0 < 0 => - !!!
-         ztmp2 = ztmp2 * (MAX(-zi0*Linv/vkarmn,0.))**(2./3.) ! => w*^2  (combining Eq. 3.8 and 3.18, hap.3, IFS doc - Cy31r1)
-         !! => equivalent using Beta=1 (gustiness parameter, 1.25 for COARE, also zi0=600 in COARE..)
-         U_blk = MAX(sqrt(U_zu*U_zu + ztmp2), 0.2)              ! eq.3.17, Chap.3, p.32, IFS doc - Cy31r1
+         z0     = MIN( ABS( alpha_M*ztmp1 + charn0*ztmp2/grav ) , 0.001_wp)
+         z0t    = MIN( ABS( alpha_H*ztmp1                     ) , 0.001_wp)   ! eq.3.26, Chap.3, p.34, IFS doc - Cy31r1
+         z0q    = MIN( ABS( alpha_Q*ztmp1                     ) , 0.001_wp)
+
+         !! 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)
+         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)
+         !!   ! Only true when unstable (L<0) => when ztmp0 < 0 => explains "-" before zi0
+         U_blk = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed
          ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0.
 
@@ -238 +316 @@
          !! as well the air-sea differences:
          IF( .NOT. l_zt_equal_zu ) THEN
-
             !! Arrays func_m and func_h are free for a while so using them as temporary arrays...
-            func_h = psi_h_ecmwf((zu+z0)*Linv) ! temporary array !!!
-            func_m = psi_h_ecmwf((zt+z0)*Linv) ! temporary array !!!
+            func_h = psi_h_ecmwf(zu*Linv) ! temporary array !!!
+            func_m = psi_h_ecmwf(zt*Linv) ! temporary array !!!
 
             ztmp2  = psi_h_ecmwf(z0t*Linv)
             ztmp0  = func_h - ztmp2
-            ztmp1  = vkarmn/(LOG(zu+z0) - LOG(z0t) - ztmp0)
+            ztmp1  = vkarmn/(LOG(zu) - LOG(z0t) - ztmp0)
             t_star = dt_zu*ztmp1
             ztmp2  = ztmp0 - func_m + ztmp2
@@ -253 +330 @@
             ztmp2  = psi_h_ecmwf(z0q*Linv)
             ztmp0  = func_h - ztmp2
-            ztmp1  = vkarmn/(LOG(zu+z0) - LOG(z0q) - ztmp0)
+            ztmp1  = vkarmn/(LOG(zu) - LOG(z0q) - ztmp0)
             q_star = dq_zu*ztmp1
             ztmp2  = ztmp0 - func_m + ztmp2
-            ztmp1  = log(zt/zu) + ztmp2
+            ztmp1  = LOG(zt/zu) + ztmp2
             q_zu   = q_zt - q_star/vkarmn*ztmp1
-
-            dt_zu = t_zu - sst ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
-            dq_zu = q_zu - ssq ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
-
-         END IF
+         ENDIF
 
          !! Updating because of updated z0 and z0t and new Linv...
-         ztmp1 = zu + z0
-         ztmp0 = ztmp1*Linv
-         func_m = log(ztmp1) - LOG(z0 ) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0 *Linv)
-         func_h = log(ztmp1) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv)
-
-      END DO
+         ztmp0 = zu*Linv
+         func_m = log(zu) - LOG(z0 ) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0 *Linv)
+         func_h = log(zu) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv)
+
+
+         IF( l_use_cs ) THEN
+            !! Cool-skin contribution
+
+            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, &
+               &                   ztmp1, ztmp0,  Qlat=ztmp2)  ! Qnsol -> ztmp1 / Tau -> ztmp0
+
+            CALL CS_ECMWF( Qsw, ztmp1, u_star, zsst )  ! Qnsol -> ztmp1
+
+            T_s(:,:) = zsst(:,:) + dT_cs(:,:)*tmask(:,:,1)
+            IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1)
+            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
+
+         ENDIF
+
+         IF( l_use_wl ) THEN
+            !! Warm-layer contribution
+            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, &
+               &                   ztmp1, ztmp2)  ! Qnsol -> ztmp1 / Tau -> ztmp2
+            CALL WL_ECMWF( Qsw, ztmp1, u_star, zsst )
+            !! Updating T_s and q_s !!!
+            T_s(:,:) = zsst(:,:) + dT_wl(:,:)*tmask(:,:,1) !
+            IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*tmask(:,:,1)
+            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
+         ENDIF
+
+         IF( l_use_cs .OR. l_use_wl .OR. (.NOT. l_zt_equal_zu) ) THEN
+            dt_zu = t_zu - T_s ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu )
+            dq_zu = q_zu - q_s ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu )
+         ENDIF
+
+      END DO !DO j_itt = 1, nb_itt
 
       Cd = vkarmn*vkarmn/(func_m*func_m)
       Ch = vkarmn*vkarmn/(func_m*func_h)
-      ztmp1 = log((zu + z0)/z0q) - psi_h_ecmwf((zu + z0)*Linv) + psi_h_ecmwf(z0q*Linv)   ! func_q
-      Ce = vkarmn*vkarmn/(func_m*ztmp1)
-
-      ztmp1 = zu + z0
-      Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 ))
-      Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t))
-      Cen = vkarmn*vkarmn / (log(ztmp1/z0q)*log(ztmp1/z0q))
-
-   END SUBROUTINE TURB_ECMWF
+      ztmp2 = log(zu/z0q) - psi_h_ecmwf(zu*Linv) + psi_h_ecmwf(z0q*Linv)   ! func_q
+      Ce = vkarmn*vkarmn/(func_m*ztmp2)
+
+      Cdn = vkarmn*vkarmn / (log(zu/z0 )*log(zu/z0 ))
+      Chn = vkarmn*vkarmn / (log(zu/z0t)*log(zu/z0t))
+      Cen = vkarmn*vkarmn / (log(zu/z0q)*log(zu/z0q))
+
+      IF( l_use_cs .AND. PRESENT(pdT_cs) ) pdT_cs = dT_cs
+      IF( l_use_wl .AND. PRESENT(pdT_wl) ) pdT_wl = dT_wl
+      IF( l_use_wl .AND. PRESENT(pHz_wl) ) pHz_wl = Hz_wl
+
+      IF( l_use_cs .OR. l_use_wl ) DEALLOCATE ( zsst )
+
+   END SUBROUTINE turb_ecmwf
 
 
@@ -294 +402 @@
       !!         and L is M-O length
       !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
       !!----------------------------------------------------------------------------------
       REAL(wp), DIMENSION(jpi,jpj) :: psi_m_ecmwf
@@ -302 +410 @@
       REAL(wp) :: zzeta, zx, ztmp, psi_unst, psi_stab, stab
       !!----------------------------------------------------------------------------------
-      !
       DO jj = 1, jpj
          DO ji = 1, jpi
             !
-            zzeta = MIN( pzeta(ji,jj) , 5. ) !! Very stable conditions (L positif and big!):
+            zzeta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!):
             !
             ! Unstable (Paulson 1970):
             !   eq.3.20, Chap.3, p.33, IFS doc - Cy31r1
-            zx = SQRT(ABS(1. - 16.*zzeta))
-            ztmp = 1. + SQRT(zx)
+            zx = SQRT(ABS(1._wp - 16._wp*zzeta))
+            ztmp = 1._wp + SQRT(zx)
             ztmp = ztmp*ztmp
-            psi_unst = LOG( 0.125*ztmp*(1. + zx) )   &
-               &       -2.*ATAN( SQRT(zx) ) + 0.5*rpi
+            psi_unst = LOG( 0.125_wp*ztmp*(1._wp + zx) )   &
+               &       -2._wp*ATAN( SQRT(zx) ) + 0.5_wp*rpi
             !
             ! Unstable:
             ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1
-            psi_stab = -2./3.*(zzeta - 5./0.35)*EXP(-0.35*zzeta) &
-               &       - zzeta - 2./3.*5./0.35
+            psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) &
+               &       - zzeta - 2._wp/3._wp*5._wp/0.35_wp
             !
             ! Combining:
-            stab = 0.5 + SIGN(0.5, zzeta) ! zzeta > 0 => stab = 1
-            !
-            psi_m_ecmwf(ji,jj) = (1. - stab) * psi_unst & ! (zzeta < 0) Unstable
-               &                +      stab  * psi_stab   ! (zzeta > 0) Stable
+            stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1
+            !
+            psi_m_ecmwf(ji,jj) = (1._wp - stab) * psi_unst & ! (zzeta < 0) Unstable
+               &                +      stab  * psi_stab      ! (zzeta > 0) Stable
             !
          END DO
       END DO
-      !
    END FUNCTION psi_m_ecmwf
 
-   
+
    FUNCTION psi_h_ecmwf( pzeta )
       !!----------------------------------------------------------------------------------
@@ -342 +448 @@
       !!         and L is M-O length
       !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
       !!----------------------------------------------------------------------------------
       REAL(wp), DIMENSION(jpi,jpj) :: psi_h_ecmwf
@@ -354 +460 @@
          DO ji = 1, jpi
             !
-            zzeta = MIN(pzeta(ji,jj) , 5.)   ! Very stable conditions (L positif and big!):
-            !
-            zx  = ABS(1. - 16.*zzeta)**.25        ! this is actually (1/phi_m)**2  !!!
+            zzeta = MIN(pzeta(ji,jj) , 5._wp)   ! Very stable conditions (L positif and big!):
+            !
+            zx  = ABS(1._wp - 16._wp*zzeta)**.25        ! this is actually (1/phi_m)**2  !!!
             !                                     ! eq.3.19, Chap.3, p.33, IFS doc - Cy31r1
             ! Unstable (Paulson 1970) :
-            psi_unst = 2.*LOG(0.5*(1. + zx*zx))   ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1
+            psi_unst = 2._wp*LOG(0.5_wp*(1._wp + zx*zx))   ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1
             !
             ! Stable:
-            psi_stab = -2./3.*(zzeta - 5./0.35)*EXP(-0.35*zzeta) & ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1
-               &       - ABS(1. + 2./3.*zzeta)**1.5 - 2./3.*5./0.35 + 1. 
+            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
+               &       - ABS(1._wp + 2._wp/3._wp*zzeta)**1.5_wp - 2._wp/3._wp*5._wp/0.35_wp + 1._wp
             ! LB: added ABS() to avoid NaN values when unstable, which contaminates the unstable solution...
             !
-            stab = 0.5 + SIGN(0.5, zzeta) ! zzeta > 0 => stab = 1
-            !
-            !
-            psi_h_ecmwf(ji,jj) = (1. - stab) * psi_unst &   ! (zzeta < 0) Unstable
-               &                +    stab    * psi_stab     ! (zzeta > 0) Stable
+            stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1
+            !
+            !
+            psi_h_ecmwf(ji,jj) = (1._wp - stab) * psi_unst &   ! (zzeta < 0) Unstable
+               &                +    stab    * psi_stab        ! (zzeta > 0) Stable
             !
          END DO
       END DO
-      !
    END FUNCTION psi_h_ecmwf
 
-
-   FUNCTION Ri_bulk( pz, ptz, pdt, pqz, pdq, pub )
-      !!----------------------------------------------------------------------------------
-      !! Bulk Richardson number (Eq. 3.25 IFS doc)
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj) ::   Ri_bulk   !
-      !
-      REAL(wp)                    , INTENT(in) ::   pz    ! height above the sea        [m]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptz   ! air temperature at pz m     [K]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pdt   ! ptz - sst                   [K]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqz   ! air temperature at pz m [kg/kg]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pdq   ! pqz - ssq               [kg/kg]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pub   ! bulk wind speed           [m/s]
-      !!----------------------------------------------------------------------------------
-      !
-      Ri_bulk =   grav*pz/(pub*pub)                                          &
-         &      * ( pdt/(ptz - 0.5_wp*(pdt + grav*pz/(Cp_dry+Cp_vap*pqz)))   &
-         &          + rctv0*pdq )
-      !
-   END FUNCTION Ri_bulk
-
-
-   FUNCTION visc_air(ptak)
-      !!----------------------------------------------------------------------------------
-      !! Air kinetic viscosity (m^2/s) given from temperature in degrees...
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj)             ::   visc_air   !
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak       ! air temperature in (K)
-      !
-      INTEGER  ::   ji, jj      ! dummy loop indices
-      REAL(wp) ::   ztc, ztc2   ! local scalar
-      !!----------------------------------------------------------------------------------
-      !
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ztc  = ptak(ji,jj) - rt0   ! air temp, in deg. C
-            ztc2 = ztc*ztc
-            visc_air(ji,jj) = 1.326e-5*(1. + 6.542E-3*ztc + 8.301e-6*ztc2 - 4.84e-9*ztc2*ztc)
-         END DO
-      END DO
-      !
-   END FUNCTION visc_air
 
    !!======================================================================

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcblk_algo_ncar.F90

@@ -11 +11 @@
    !!
    !!       Routine turb_ncar maintained and developed in AeroBulk
-   !!                     (http://aerobulk.sourceforge.net/)
+   !!                     (https://github.com/brodeau/aerobulk/)
    !!
    !!                         L. Brodeau, 2015
@@ -38 +38 @@
    USE lib_fortran     ! to use key_nosignedzero
 
+   USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC ::   TURB_NCAR   ! called by sbcblk.F90
-
-   !                              ! NCAR own values for given constants:
-   REAL(wp), PARAMETER ::   rctv0 = 0.608   ! constant to obtain virtual temperature...
-   
+   PUBLIC :: TURB_NCAR   ! called by sbcblk.F90
+
+   INTEGER , PARAMETER ::   nb_itt = 5        ! number of itterations
+
    !!----------------------------------------------------------------------
 CONTAINS
@@ -61 +61 @@
       !!                Returns the effective bulk wind speed at 10m to be used in the bulk formulas
       !!
-      !! ** Method : Monin Obukhov Similarity Theory
-      !!             + Large & Yeager (2004,2008) closure: CD_n10 = f(U_n10)
-      !!
-      !! ** References :   Large & Yeager, 2004 / Large & Yeager, 2008
-      !!
-      !! ** Last update: Laurent Brodeau, June 2014:
-      !!    - handles both cases zt=zu and zt/=zu
-      !!    - optimized: less 2D arrays allocated and less operations
-      !!    - better first guess of stability by checking air-sea difference of virtual temperature
-      !!       rather than temperature difference only...
-      !!    - added function "cd_neutral_10m" that uses the improved parametrization of
-      !!      Large & Yeager 2008. Drag-coefficient reduction for Cyclone conditions!
-      !!    - using code-wide physical constants defined into "phycst.mod" rather than redifining them
-      !!      => 'vkarmn' and 'grav'
-      !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
       !!
       !! INPUT :
       !! -------
       !!    *  zt   : height for temperature and spec. hum. of air            [m]
-      !!    *  zu   : height for wind speed (generally 10m)                   [m]
-      !!    *  U_zu : scalar wind speed at 10m                                [m/s]
-      !!    *  sst  : SST                                                     [K]
+      !!    *  zu   : height for wind speed (usually 10m)                     [m]
+      !!    *  sst  : bulk SST                                                [K]
       !!    *  t_zt : potential air temperature at zt                         [K]
       !!    *  ssq  : specific humidity at saturation at SST                  [kg/kg]
       !!    *  q_zt : specific humidity of air at zt                          [kg/kg]
+      !!    *  U_zu : scalar wind speed at zu                                 [m/s]
       !!
       !!
@@ -96 +80 @@
       !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K]
       !!    *  q_zu   : specific humidity of air        //                    [kg/kg]
-      !!    *  U_blk  : bulk wind at 10m                                      [m/s]
+      !!    *  U_blk  : bulk wind speed at zu                                 [m/s]
+      !!
+      !!
+      !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
       !!----------------------------------------------------------------------------------
       REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m]
@@ -103 +90 @@
       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin]
       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity           [kg/kg]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                   [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity at zt             [kg/kg]
       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau)
@@ -110 +97 @@
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s]
       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients
       !
-      INTEGER ::   j_itt
-      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
-      INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations
+      INTEGER :: j_itt
+      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
       !
       REAL(wp), DIMENSION(jpi,jpj) ::   Cx_n10        ! 10m neutral latent/sensible coefficient
@@ -126 +112 @@
       !
       l_zt_equal_zu = .FALSE.
-      IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision
-
-      U_blk = MAX( 0.5 , U_zu )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s
+      IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision
+
+      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
 
       !! First guess of stability:
-      ztmp0 = t_zt*(1. + rctv0*q_zt) - sst*(1. + rctv0*ssq) ! air-sea difference of virtual pot. temp. at zt
-      stab  = 0.5 + sign(0.5,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable
+      ztmp0 = virt_temp(t_zt, q_zt) - virt_temp(sst, ssq) ! air-sea difference of virtual pot. temp. at zt
+      stab  = 0.5_wp + sign(0.5_wp,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable
 
       !! Neutral coefficients at 10m:
@@ -139 +125 @@
          ztmp0   (:,:) = cdn_wave(:,:)
       ELSE
-         ztmp0 = cd_neutral_10m( U_blk )
+      ztmp0 = cd_neutral_10m( U_blk )
       ENDIF
 
@@ -146 +132 @@
       !! Initializing transf. coeff. with their first guess neutral equivalents :
       Cd = ztmp0
-      Ce = 1.e-3*( 34.6 * sqrt_Cd_n10 )
-      Ch = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))
+      Ce = 1.e-3_wp*( 34.6_wp * sqrt_Cd_n10 )
+      Ch = 1.e-3_wp*sqrt_Cd_n10*(18._wp*stab + 32.7_wp*(1._wp - stab))
       stab = sqrt_Cd_n10   ! Temporaty array !!! stab == SQRT(Cd)
  
-      IF( ln_cdgw )   Cen = Ce  ; Chn = Ch
+      IF( ln_cdgw ) THEN
+   Cen = Ce
+   Chn = Ch
+      ENDIF
 
       !! Initializing values at z_u with z_t values:
       t_zu = t_zt   ;   q_zu = q_zt
 
-      !!  * Now starting iteration loop
-      DO j_itt=1, nb_itt
+      !! ITERATION BLOCK
+      DO j_itt = 1, nb_itt
          !
          ztmp1 = t_zu - sst   ! Updating air/sea differences
@@ -162 +151 @@
 
          ! Updating turbulent scales :   (L&Y 2004 eq. (7))
-         ztmp1  = Ch/stab*ztmp1    ! theta*   (stab == SQRT(Cd))
-         ztmp2  = Ce/stab*ztmp2    ! q*       (stab == SQRT(Cd))
-
-         ztmp0 = 1. + rctv0*q_zu      ! multiply this with t and you have the virtual temperature
+         ztmp0 = stab*U_blk       ! u*       (stab == SQRT(Cd))
+         ztmp1 = Ch/stab*ztmp1    ! theta*   (stab == SQRT(Cd))
+         ztmp2 = Ce/stab*ztmp2    ! q*       (stab == SQRT(Cd))
 
          ! Estimate the inverse of Monin-Obukov length (1/L) at height zu:
-         ztmp0 =  (grav*vkarmn/(t_zu*ztmp0)*(ztmp1*ztmp0 + rctv0*t_zu*ztmp2)) / (Cd*U_blk*U_blk)
-         !                                                      ( Cd*U_blk*U_blk is U*^2 at zu )
-
+         ztmp0 = One_on_L( t_zu, q_zu, ztmp0, ztmp1, ztmp2 )
+         
          !! Stability parameters :
-         zeta_u   = zu*ztmp0   ;  zeta_u = sign( min(abs(zeta_u),10.0), zeta_u )
+         zeta_u   = zu*ztmp0
+         zeta_u = sign( min(abs(zeta_u),10._wp), zeta_u )
          zpsi_h_u = psi_h( zeta_u )
 
@@ -178 +166 @@
          IF( .NOT. l_zt_equal_zu ) THEN
             !! Array 'stab' is free for the moment so using it to store 'zeta_t'
-            stab = zt*ztmp0 ;  stab = SIGN( MIN(ABS(stab),10.0), stab )  ! Temporaty array stab == zeta_t !!!
+            stab = zt*ztmp0
+            stab = SIGN( MIN(ABS(stab),10._wp), stab )  ! Temporaty array stab == zeta_t !!!
             stab = LOG(zt/zu) + zpsi_h_u - psi_h(stab)                   ! stab just used as temp array again!
             t_zu = t_zt - ztmp1/vkarmn*stab    ! ztmp1 is still theta*  L&Y 2004 eq.(9b)
             q_zu = q_zt - ztmp2/vkarmn*stab    ! ztmp2 is still q*      L&Y 2004 eq.(9c)
-            q_zu = max(0., q_zu)
-         END IF
-
+            q_zu = max(0._wp, q_zu)
+         ENDIF
+
+         ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)...
+         !   In very rare low-wind conditions, the old way of estimating the
+         !   neutral wind speed at 10m leads to a negative value that causes the code
+         !   to crash. To prevent this a threshold of 0.25m/s is imposed.
          ztmp2 = psi_m(zeta_u)
          IF( ln_cdgw ) THEN      ! surface wave case
             stab = vkarmn / ( vkarmn / sqrt_Cd_n10 - ztmp2 )  ! (stab == SQRT(Cd))
             Cd   = stab * stab
-            ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10
+            ztmp0 = (LOG(zu/10._wp) - zpsi_h_u) / vkarmn / sqrt_Cd_n10
             ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd))
-            ztmp1 = 1. + Chn * ztmp0     
+            ztmp1 = 1._wp + Chn * ztmp0     
             Ch    = Chn * ztmp2 / ztmp1  ! L&Y 2004 eq. (10b)
-            ztmp1 = 1. + Cen * ztmp0
+            ztmp1 = 1._wp + Cen * ztmp0
             Ce    = Cen * ztmp2 / ztmp1  ! L&Y 2004 eq. (10c)
 
          ELSE
-            ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)...
-            !   In very rare low-wind conditions, the old way of estimating the
-            !   neutral wind speed at 10m leads to a negative value that causes the code
-            !   to crash. To prevent this a threshold of 0.25m/s is imposed.
-            ztmp0 = MAX( 0.25 , U_blk/(1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - ztmp2)) ) ! U_n10 (ztmp2 == psi_m(zeta_u))
-            ztmp0 = cd_neutral_10m(ztmp0)                                               ! Cd_n10
-            Cdn(:,:) = ztmp0
-            sqrt_Cd_n10 = sqrt(ztmp0)
-
-            stab    = 0.5 + sign(0.5,zeta_u)                           ! update stability
-            Cx_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))  ! L&Y 2004 eq. (6c-6d)    (Cx_n10 == Ch_n10)
-            Chn(:,:) = Cx_n10
-
-            !! Update of transfer coefficients:
-            ztmp1 = 1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - ztmp2)   ! L&Y 2004 eq. (10a) (ztmp2 == psi_m(zeta_u))
-            Cd      = ztmp0 / ( ztmp1*ztmp1 )
-            stab = SQRT( Cd ) ! Temporary array !!! (stab == SQRT(Cd))
-
-            ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10
-            ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd))
-            ztmp1 = 1. + Cx_n10*ztmp0    ! (Cx_n10 == Ch_n10)
-            Ch  = Cx_n10*ztmp2 / ztmp1   ! L&Y 2004 eq. (10b)
-
-            Cx_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)  ! L&Y 2004 eq. (6b)    ! Cx_n10 == Ce_n10
-            Cen(:,:) = Cx_n10
-            ztmp1 = 1. + Cx_n10*ztmp0
-            Ce  = Cx_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c)
-            ENDIF
-         !
-      END DO
-      !
+         ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)...
+         !   In very rare low-wind conditions, the old way of estimating the
+         !   neutral wind speed at 10m leads to a negative value that causes the code
+         !   to crash. To prevent this a threshold of 0.25m/s is imposed.
+         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))
+         ztmp0 = cd_neutral_10m(ztmp0)                                               ! Cd_n10
+         Cdn(:,:) = ztmp0
+         sqrt_Cd_n10 = sqrt(ztmp0)
+
+         stab    = 0.5_wp + sign(0.5_wp,zeta_u)                        ! update stability
+         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)
+         Chn(:,:) = Cx_n10
+
+         !! Update of transfer coefficients:
+         ztmp1 = 1._wp + sqrt_Cd_n10/vkarmn*(LOG(zu/10._wp) - ztmp2)   ! L&Y 2004 eq. (10a) (ztmp2 == psi_m(zeta_u))
+         Cd      = ztmp0 / ( ztmp1*ztmp1 )
+         stab = SQRT( Cd ) ! Temporary array !!! (stab == SQRT(Cd))
+
+         ztmp0 = (LOG(zu/10._wp) - zpsi_h_u) / vkarmn / sqrt_Cd_n10
+         ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd))
+         ztmp1 = 1._wp + Cx_n10*ztmp0    ! (Cx_n10 == Ch_n10)
+         Ch  = Cx_n10*ztmp2 / ztmp1   ! L&Y 2004 eq. (10b)
+
+         Cx_n10  = 1.e-3_wp * (34.6_wp * sqrt_Cd_n10)  ! L&Y 2004 eq. (6b)    ! Cx_n10 == Ce_n10
+         Cen(:,:) = Cx_n10
+         ztmp1 = 1._wp + Cx_n10*ztmp0
+         Ce  = Cx_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c)
+         ENDIF
+
+      END DO !DO j_itt = 1, nb_itt
+
    END SUBROUTINE turb_ncar
 
@@ -238 +231 @@
       !! Origin: Large & Yeager 2008 eq.(11a) and eq.(11b)
       !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
       !!----------------------------------------------------------------------------------
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pw10           ! scalar wind speed at 10m (m/s)
@@ -255 +248 @@
             !
             ! When wind speed > 33 m/s => Cyclone conditions => special treatment
-            zgt33 = 0.5 + SIGN( 0.5, (zw - 33.) )   ! If pw10 < 33. => 0, else => 1
-            !
-            cd_neutral_10m(ji,jj) = 1.e-3 * ( &
-               &       (1. - zgt33)*( 2.7/zw + 0.142 + zw/13.09 - 3.14807E-10*zw6) & ! wind <  33 m/s
-               &      +    zgt33   *      2.34 )                                     ! wind >= 33 m/s
-            !
-            cd_neutral_10m(ji,jj) = MAX(cd_neutral_10m(ji,jj), 1.E-6)
+            zgt33 = 0.5_wp + SIGN( 0.5_wp, (zw - 33._wp) )   ! If pw10 < 33. => 0, else => 1
+            !
+            cd_neutral_10m(ji,jj) = 1.e-3_wp * ( &
+               &       (1._wp - zgt33)*( 2.7_wp/zw + 0.142_wp + zw/13.09_wp - 3.14807E-10_wp*zw6) & ! wind <  33 m/s
+               &      +    zgt33   *      2.34_wp )                                                 ! wind >= 33 m/s
+            !
+            cd_neutral_10m(ji,jj) = MAX(cd_neutral_10m(ji,jj), 1.E-6_wp)
             !
          END DO
@@ -273 +266 @@
       !! Universal profile stability function for momentum
       !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e)
-      !!     
-      !! pzet0 : stability paramenter, z/L where z is altitude measurement                                          
+      !!
+      !! pzeta : stability paramenter, z/L where z is altitude measurement
       !!         and L is M-O length
       !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pzeta
-      REAL(wp), DIMENSION(jpi,jpj)             ::   psi_m
-      !
-      INTEGER  ::   ji, jj         ! dummy loop indices
+      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: psi_m
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
       REAL(wp) :: zx2, zx, zstab   ! local scalars
       !!----------------------------------------------------------------------------------
-      !
       DO jj = 1, jpj
          DO ji = 1, jpi
-            zx2 = SQRT( ABS( 1. - 16.*pzeta(ji,jj) ) )
-            zx2 = MAX ( zx2 , 1. )
+            zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) )
+            zx2 = MAX( zx2 , 1._wp )
             zx  = SQRT( zx2 )
-            zstab = 0.5 + SIGN( 0.5 , pzeta(ji,jj) )
-            !
-            psi_m(ji,jj) =        zstab  * (-5.*pzeta(ji,jj))       &          ! Stable
-               &          + (1. - zstab) * (2.*LOG((1. + zx)*0.5)   &          ! Unstable
-               &               + LOG((1. + zx2)*0.5) - 2.*ATAN(zx) + rpi*0.5)  !    "
+            zstab = 0.5_wp + SIGN( 0.5_wp , pzeta(ji,jj) )
+            !
+            psi_m(ji,jj) =        zstab  * (-5._wp*pzeta(ji,jj))       &          ! Stable
+               &          + (1._wp - zstab) * (2._wp*LOG((1._wp + zx)*0.5_wp)   &          ! Unstable
+               &               + LOG((1._wp + zx2)*0.5_wp) - 2._wp*ATAN(zx) + rpi*0.5_wp)  !    "
             !
          END DO
       END DO
-      !
    END FUNCTION psi_m
 
@@ -308 +299 @@
       !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e)
       !!
-      !! pzet0 : stability paramenter, z/L where z is altitude measurement                                          
+      !! pzeta : stability paramenter, z/L where z is altitude measurement
       !!         and L is M-O length
       !!
-      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
-      !!----------------------------------------------------------------------------------
+      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: psi_h
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
-      REAL(wp), DIMENSION(jpi,jpj)             :: psi_h
-      !
-      INTEGER  ::   ji, jj    ! dummy loop indices
+      !
+      INTEGER  ::   ji, jj     ! dummy loop indices
       REAL(wp) :: zx2, zstab  ! local scalars
       !!----------------------------------------------------------------------------------
@@ -322 +313 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            zx2 = SQRT( ABS( 1. - 16.*pzeta(ji,jj) ) )
-            zx2 = MAX ( zx2 , 1. )
-            zstab = 0.5 + SIGN( 0.5 , pzeta(ji,jj) )
-            !
-            psi_h(ji,jj) =         zstab  * (-5.*pzeta(ji,jj))        &  ! Stable
-               &           + (1. - zstab) * (2.*LOG( (1. + zx2)*0.5 ))   ! Unstable
+            zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) )
+            zx2 = MAX( zx2 , 1._wp )
+            zstab = 0.5_wp + SIGN( 0.5_wp , pzeta(ji,jj) )
+            !
+            psi_h(ji,jj) =         zstab  * (-5._wp*pzeta(ji,jj))        &  ! Stable
+               &           + (1._wp - zstab) * (2._wp*LOG( (1._wp + zx2)*0.5_wp ))   ! Unstable
             !
          END DO
       END DO
-      !
    END FUNCTION psi_h
 

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbccpl.F90

@@ -451 +451 @@
       CASE( 'conservative'  )
          srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE.
-         IF ( k_ice <= 1 )  srcv(jpr_ievp)%laction = .FALSE.
+         IF( k_ice <= 1 )  srcv(jpr_ievp)%laction = .FALSE.
       CASE( 'oce and ice'   )   ;   srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE.
       CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' )
@@ -532 +532 @@
       !                                                      ! ------------------------- !
       srcv(jpr_taum)%clname = 'O_TauMod'   ;   IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' )   srcv(jpr_taum)%laction = .TRUE.
-      lhftau = srcv(jpr_taum)%laction
       !
       !                                                      ! ------------------------- !
@@ -557 +556 @@
       srcv(jpr_botm )%clname = 'OBotMlt'
       IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN
-         IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN
+         IF( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN
             srcv(jpr_topm:jpr_botm)%nct = nn_cats_cpl
          ELSE
@@ -568 +567 @@
       !                                                      ! ------------------------- !
       srcv(jpr_ts_ice)%clname = 'OTsfIce'    ! needed by Met Office
-      IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' )   srcv(jpr_ts_ice)%laction = .TRUE.
-      IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' )   srcv(jpr_ts_ice)%nct     = nn_cats_cpl
-      IF ( TRIM( sn_rcv_emp%clcat    ) == 'yes' )   srcv(jpr_ievp)%nct       = nn_cats_cpl
+      IF( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' )   srcv(jpr_ts_ice)%laction = .TRUE.
+      IF( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' )   srcv(jpr_ts_ice)%nct     = nn_cats_cpl
+      IF( TRIM( sn_rcv_emp%clcat    ) == 'yes' )   srcv(jpr_ievp)%nct       = nn_cats_cpl
 
       !                                                      ! ------------------------- !
@@ -692 +691 @@
          ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere
          DO jn = 1, jprcv
-            IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname))
+            IF( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname))
          END DO
          !
@@ -719 +718 @@
       ! =================================================== !
       DO jn = 1, jprcv
-         IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
+         IF( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
       END DO
       ! Allocate taum part of frcv which is used even when not received as coupling field
-      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
+      IF( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
       ! Allocate w10m part of frcv which is used even when not received as coupling field
-      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )
+      IF( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )
       ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field
-      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )
-      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )
+      IF( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )
+      IF( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )
       ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.
       IF( k_ice /= 0 ) THEN
-         IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )
-         IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
-      END IF
+         IF( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )
+         IF( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
+      ENDIF
 
       ! ================================ !
@@ -756 +755 @@
       CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice' )
          ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE.
-         IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = nn_cats_cpl
+         IF( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = nn_cats_cpl
       CASE( 'mixed oce-ice'                        )   ;   ssnd( jps_tmix )%laction = .TRUE.
       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' )
@@ -776 +775 @@
       !     1. sending mixed oce-ice albedo or
       !     2. receiving mixed oce-ice solar radiation 
-      IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN
+      IF( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN
          CALL oce_alb( zaos, zacs )
          ! Due to lack of information on nebulosity : mean clear/overcast sky
@@ -795 +794 @@
          ssnd(jps_fice1)%laction = .TRUE.                 ! First-order regridded ice concentration, to be used producing atmos-to-ice fluxes (Met Office requirement)
 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now
-         IF ( TRIM( sn_snd_thick%clcat  ) == 'yes' ) ssnd(jps_fice)%nct  = nn_cats_cpl
-         IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl
+         IF( TRIM( sn_snd_thick%clcat  ) == 'yes' ) ssnd(jps_fice)%nct  = nn_cats_cpl
+         IF( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl
       ENDIF
       
-      IF (TRIM( sn_snd_ifrac%cldes )  == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 
+      IF(TRIM( sn_snd_ifrac%cldes )  == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 
 
       SELECT CASE ( TRIM( sn_snd_thick%cldes ) )
@@ -805 +804 @@
       CASE( 'ice and snow' ) 
          ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
-         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
+         IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
             ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl
          ENDIF
       CASE ( 'weighted ice and snow' ) 
          ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
-         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl
+         IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl
       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' )
       END SELECT
@@ -827 +826 @@
          ssnd(jps_a_p)%laction  = .TRUE. 
          ssnd(jps_ht_p)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
+         IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
             ssnd(jps_a_p)%nct  = nn_cats_cpl 
             ssnd(jps_ht_p)%nct = nn_cats_cpl 
          ELSE 
-            IF ( nn_cats_cpl > 1 ) THEN 
+            IF( nn_cats_cpl > 1 ) THEN 
                CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 
             ENDIF 
@@ -838 +837 @@
          ssnd(jps_a_p)%laction  = .TRUE. 
          ssnd(jps_ht_p)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
+         IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
             ssnd(jps_a_p)%nct  = nn_cats_cpl  
             ssnd(jps_ht_p)%nct = nn_cats_cpl  
@@ -913 +912 @@
       CASE ( 'ice only' ) 
          ssnd(jps_ttilyr)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN 
+         IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN 
             ssnd(jps_ttilyr)%nct = nn_cats_cpl 
          ELSE 
-            IF ( nn_cats_cpl > 1 ) THEN 
+            IF( nn_cats_cpl > 1 ) THEN 
                CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' ) 
             ENDIF 
@@ -922 +921 @@
       CASE ( 'weighted ice' ) 
          ssnd(jps_ttilyr)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl 
+         IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl 
       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes ) 
       END SELECT 
@@ -932 +931 @@
       CASE ( 'ice only' ) 
          ssnd(jps_kice)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 
+         IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 
             ssnd(jps_kice)%nct = nn_cats_cpl 
          ELSE 
-            IF ( nn_cats_cpl > 1 ) THEN 
+            IF( nn_cats_cpl > 1 ) THEN 
                CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 
             ENDIF 
@@ -941 +940 @@
       CASE ( 'weighted ice' ) 
          ssnd(jps_kice)%laction = .TRUE. 
-         IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl 
+         IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl 
       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes ) 
       END SELECT 
@@ -1002 +1001 @@
          ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere
          DO jn = 1, jpsnd
-            IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname))
+            IF( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname))
          END DO
          !
@@ -1029 +1028 @@
       CALL cpl_define(jprcv, jpsnd, nn_cplmodel)
       
-      IF (ln_usecplmask) THEN 
+      IF(ln_usecplmask) THEN 
          xcplmask(:,:,:) = 0.
          CALL iom_open( 'cplmask', inum )
@@ -1266 +1265 @@
     
           IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:)  ! correct this later (read from restart if possible) 
-      END IF 
+      ENDIF 
       !
       IF( ln_sdw ) THEN  ! Stokes Drift correction activated
@@ -1419 +1418 @@
          ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
          ELSE                                       ;   zqns(:,:) = 0._wp
-         END IF
+         ENDIF
          ! update qns over the free ocean with:
          IF( nn_components /= jp_iam_opa ) THEN
@@ -1691 +1690 @@
       ! --- evaporation over ice (kg/m2/s) --- !
       DO jl=1,jpl
-         IF (sn_rcv_emp%clcat == 'yes') THEN   ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl)
+         IF(sn_rcv_emp%clcat == 'yes') THEN   ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl)
          ELSE                                  ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 )   ;   ENDIF
       ENDDO
@@ -1790 +1789 @@
       CASE( 'conservative' )     ! the required fields are directly provided
          zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
-         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
+         IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
             zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
          ELSE
@@ -1799 +1798 @@
       CASE( 'oce and ice' )      ! the total flux is computed from ocean and ice fluxes
          zqns_tot(:,:) =  ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
-         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
+         IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
             DO jl=1,jpl
                zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)   
@@ -1901 +1900 @@
 #endif
       ! outputs
-      IF ( srcv(jpr_cal)%laction       ) CALL iom_put('hflx_cal_cea'    , - frcv(jpr_cal)%z3(:,:,1) * rLfus )                      ! latent heat from calving
-      IF ( srcv(jpr_icb)%laction       ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )                      ! latent heat from icebergs melting
-      IF ( iom_use('hflx_rain_cea')    ) CALL iom_put('hflx_rain_cea'   , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average)
-      IF ( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) &
+      IF( srcv(jpr_cal)%laction       ) CALL iom_put('hflx_cal_cea'    , - frcv(jpr_cal)%z3(:,:,1) * rLfus )                      ! latent heat from calving
+      IF( srcv(jpr_icb)%laction       ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )                      ! latent heat from icebergs melting
+      IF( iom_use('hflx_rain_cea')    ) CALL iom_put('hflx_rain_cea'   , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average)
+      IF( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) &
            &                                                              * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) )            ! heat flux from evap (cell average)
-      IF ( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  )               ! heat flux from snow (cell average)
-      IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &
+      IF( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  )               ! heat flux from snow (cell average)
+      IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &
            &                                                              * ( 1._wp - zsnw(:,:) )                  )               ! heat flux from snow (over ocean)
-      IF ( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
+      IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
            &                                                              *           zsnw(:,:)                    )               ! heat flux from snow (over ice)
       ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp.
@@ -1920 +1919 @@
       CASE( 'conservative' )
          zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
-         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
+         IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
             zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
          ELSE
@@ -1932 +1931 @@
       CASE( 'oce and ice' )
          zqsr_tot(:,:  ) =  ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
-         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
+         IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
             DO jl = 1, jpl
                zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)   
@@ -1988 +1987 @@
       !                                                      ! ========================= !
       CASE ('coupled')
-         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
+         IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
             zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
          ELSE
@@ -2067 +2066 @@
       IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
          
-         IF ( nn_components == jp_iam_opa ) THEN
+         IF( nn_components == jp_iam_opa ) THEN
             ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm)   ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part
          ELSE
@@ -2472 +2471 @@
       IF( ssnd(jps_ficet)%laction ) THEN 
          CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info ) 
-      END IF 
+      ENDIF 
       !                                                      ! ------------------------- ! 
       !                                                      !   Water levels to waves   ! 
@@ -2487 +2486 @@
          ENDIF  
          CALL cpl_snd( jps_wlev  , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
-      END IF 
+      ENDIF 
       !
       !  Fields sent by OPA to SAS when doing OPA<->SAS coupling

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcdcy.F90

@@ -7 +7 @@
    !!   NEMO    2.0  !  2006-02  (S. Masson, G. Madec)  adaptation to NEMO
    !!           3.1  !  2009-07  (J.M. Molines)  adaptation to v3.1
+   !!           4.*  !  2019-10  (L. Brodeau)  nothing really new, but the routine
+   !!                ! "sbc_dcy_param" has been extracted from old function "sbc_dcy"
+   !!                ! => this allows the warm-layer param of COARE3* to know the time
+   !!                ! of dawn and dusk even if "ln_dm2dc=.false." (rdawn_dcy & rdusk_dcy
+   !!                ! are now public)
    !!----------------------------------------------------------------------
 
@@ -22 +27 @@
    IMPLICIT NONE
    PRIVATE
-   
+
    INTEGER, PUBLIC ::   nday_qsr   !: day when parameters were computed
-   
+
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   raa , rbb  , rcc  , rab     ! diurnal cycle parameters
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rtmd, rdawn, rdusk, rscal   !    -      -       -
-  
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rtmd, rscal   !    -      -       -
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: rdawn_dcy, rdusk_dcy   !    -      -       -
+
    PUBLIC   sbc_dcy        ! routine called by sbc
+   PUBLIC   sbc_dcy_param  ! routine used here and called by warm-layer parameterization (sbcblk_skin_coare*)
 
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
 CONTAINS
 
-      INTEGER FUNCTION sbc_dcy_alloc()
-         !!----------------------------------------------------------------------
-         !!                ***  FUNCTION sbc_dcy_alloc  ***
-         !!----------------------------------------------------------------------
-         ALLOCATE( raa (jpi,jpj) , rbb  (jpi,jpj) , rcc  (jpi,jpj) , rab  (jpi,jpj) ,     &
-            &      rtmd(jpi,jpj) , rdawn(jpi,jpj) , rdusk(jpi,jpj) , rscal(jpi,jpj) , STAT=sbc_dcy_alloc )
-            !
-         CALL mpp_sum ( 'sbcdcy', sbc_dcy_alloc )
-         IF( sbc_dcy_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sbc_dcy_alloc: failed to allocate arrays' )
-      END FUNCTION sbc_dcy_alloc
+   INTEGER FUNCTION sbc_dcy_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION sbc_dcy_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( raa (jpi,jpj) , rbb  (jpi,jpj) , rcc  (jpi,jpj) , rab  (jpi,jpj) ,     &
+         &      rtmd(jpi,jpj) , rdawn_dcy(jpi,jpj) , rdusk_dcy(jpi,jpj) , rscal(jpi,jpj) , STAT=sbc_dcy_alloc )
+      !
+      CALL mpp_sum ( 'sbcdcy', sbc_dcy_alloc )
+      IF( sbc_dcy_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sbc_dcy_alloc: failed to allocate arrays' )
+   END FUNCTION sbc_dcy_alloc
 
 
@@ -60 +67 @@
       !!
       !! reference  : Bernie, DJ, E Guilyardi, G Madec, JM Slingo, and SJ Woolnough, 2007
-      !!              Impact of resolving the diurnal cycle in an ocean--atmosphere GCM. 
+      !!              Impact of resolving the diurnal cycle in an ocean--atmosphere GCM.
       !!              Part 1: a diurnally forced OGCM. Climate Dynamics 29:6, 575-590.
       !!----------------------------------------------------------------------
       LOGICAL , OPTIONAL          , INTENT(in) ::   l_mask    ! use the routine for night mask computation
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqsrin    ! input daily QSR flux 
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqsrin    ! input daily QSR flux
       REAL(wp), DIMENSION(jpi,jpj)             ::   zqsrout   ! output QSR flux with diurnal cycle
       !!
       INTEGER  ::   ji, jj                                       ! dummy loop indices
       INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask
-      REAL(wp) ::   ztwopi, zinvtwopi, zconvrad 
       REAL(wp) ::   zlo, zup, zlousd, zupusd
-      REAL(wp) ::   zdsws, zdecrad, ztx, zsin, zcos
-      REAL(wp) ::   ztmp, ztmp1, ztmp2, ztest
+      REAL(wp) ::   ztmp, ztmp1, ztmp2
       REAL(wp) ::   ztmpm, ztmpm1, ztmpm2
-      !---------------------------statement functions------------------------
-      REAL(wp) ::   fintegral, pt1, pt2, paaa, pbbb, pccc        ! dummy statement function arguments
-      fintegral( pt1, pt2, paaa, pbbb, pccc ) =                         &
-         &   paaa * pt2 + zinvtwopi * pbbb * SIN(pccc + ztwopi * pt2)   &
-         & - paaa * pt1 - zinvtwopi * pbbb * SIN(pccc + ztwopi * pt1)
       !!---------------------------------------------------------------------
       !
       ! Initialization
       ! --------------
-      ztwopi    = 2._wp * rpi
-      zinvtwopi = 1._wp / ztwopi
-      zconvrad  = ztwopi / 360._wp
-
       ! When are we during the day (from 0 to 1)
       zlo = ( REAL(nsec_day, wp) - 0.5_wp * rdt ) / rday
       zup = zlo + ( REAL(nn_fsbc, wp)     * rdt ) / rday
-      !                                          
-      IF( nday_qsr == -1 ) THEN       ! first time step only  
+      !
+      IF( nday_qsr == -1 ) THEN       ! first time step only
          IF(lwp) THEN
             WRITE(numout,*)
@@ -98 +94 @@
             WRITE(numout,*)
          ENDIF
+      ENDIF
+
+      ! Setting parameters for each new day:
+      CALL sbc_dcy_param()
+
+      !CALL iom_put( "rdusk_dcy", rdusk_dcy(:,:)*tmask(:,:,1) ) !LB
+      !CALL iom_put( "rdawn_dcy", rdawn_dcy(:,:)*tmask(:,:,1) ) !LB
+      !CALL iom_put( "rscal_dcy", rscal(:,:)*tmask(:,:,1) ) !LB
+
+
+      !     3. update qsr with the diurnal cycle
+      !     ------------------------------------
+
+      imask_night(:,:) = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ztmpm = 0._wp
+            IF( ABS(rab(ji,jj)) < 1. ) THEN         ! day duration is less than 24h
+               !
+               IF( rdawn_dcy(ji,jj) < rdusk_dcy(ji,jj) ) THEN       ! day time in one part
+                  zlousd = MAX(zlo, rdawn_dcy(ji,jj))
+                  zlousd = MIN(zlousd, zup)
+                  zupusd = MIN(zup, rdusk_dcy(ji,jj))
+                  zupusd = MAX(zupusd, zlo)
+                  ztmp = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
+                  ztmpm = zupusd - zlousd
+                  IF( ztmpm .EQ. 0 ) imask_night(ji,jj) = 1
+                  !
+               ELSE                                         ! day time in two parts
+                  zlousd = MIN(zlo, rdusk_dcy(ji,jj))
+                  zupusd = MIN(zup, rdusk_dcy(ji,jj))
+                  ztmp1 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+                  ztmpm1=zupusd-zlousd
+                  zlousd = MAX(zlo, rdawn_dcy(ji,jj))
+                  zupusd = MAX(zup, rdawn_dcy(ji,jj))
+                  ztmp2 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+                  ztmpm2 =zupusd-zlousd
+                  ztmp = ztmp1 + ztmp2
+                  ztmpm = ztmpm1 + ztmpm2
+                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
+                  IF(ztmpm .EQ. 0.) imask_night(ji,jj) = 1
+               ENDIF
+            ELSE                                   ! 24h light or 24h night
+               !
+               IF( raa(ji,jj) > rbb(ji,jj) ) THEN           ! 24h day
+                  ztmp = fintegral(zlo, zup, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
+                  imask_night(ji,jj) = 0
+                  !
+               ELSE                                         ! No day
+                  zqsrout(ji,jj) = 0.0_wp
+                  imask_night(ji,jj) = 1
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      !
+      IF( PRESENT(l_mask) .AND. l_mask ) THEN
+         zqsrout(:,:) = float(imask_night(:,:))
+      ENDIF
+      !
+   END FUNCTION sbc_dcy
+
+
+   SUBROUTINE sbc_dcy_param( )
+      !!
+      INTEGER  ::   ji, jj                                       ! dummy loop indices
+      !INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask
+      REAL(wp) ::   zdsws, zdecrad, ztx, zsin, zcos
+      REAL(wp) ::   ztmp, ztest
+      !---------------------------statement functions------------------------
+      !
+      IF( nday_qsr == -1 ) THEN       ! first time step only
          ! allocate sbcdcy arrays
          IF( sbc_dcy_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_dcy_alloc : unable to allocate arrays' )
          ! Compute rcc needed to compute the time integral of the diurnal cycle
-         rcc(:,:) = zconvrad * glamt(:,:) - rpi
+         rcc(:,:) = rad * glamt(:,:) - rpi
          ! time of midday
          rtmd(:,:) = 0.5_wp - glamt(:,:) / 360._wp
@@ -107 +177 @@
       ENDIF
 
-      ! If this is a new day, we have to update the dawn, dusk and scaling function  
+      ! If this is a new day, we have to update the dawn, dusk and scaling function
       !----------------------
-    
-      !     2.1 dawn and dusk  
-
-      ! nday is the number of days since the beginning of the current month 
-      IF( nday_qsr /= nday ) THEN 
+
+      !     2.1 dawn and dusk
+
+      ! nday is the number of days since the beginning of the current month
+      IF( nday_qsr /= nday ) THEN
          ! save the day of the year and the daily mean of qsr
-         nday_qsr = nday 
-         ! number of days since the previous winter solstice (supposed to be always 21 December)         
+         nday_qsr = nday
+         ! number of days since the previous winter solstice (supposed to be always 21 December)
          zdsws = REAL(11 + nday_year, wp)
          ! declination of the earths orbit
-         zdecrad = (-23.5_wp * zconvrad) * COS( zdsws * ztwopi / REAL(nyear_len(1),wp) )
+         zdecrad = (-23.5_wp * rad) * COS( zdsws * 2._wp*rpi / REAL(nyear_len(1),wp) )
          ! Compute A and B needed to compute the time integral of the diurnal cycle
 
@@ -125 +195 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               ztmp = zconvrad * gphit(ji,jj)
+               ztmp = rad * gphit(ji,jj)
                raa(ji,jj) = SIN( ztmp ) * zsin
                rbb(ji,jj) = COS( ztmp ) * zcos
-            END DO  
-         END DO  
+            END DO
+         END DO
          ! Compute the time of dawn and dusk
 
-         ! rab to test if the day time is equal to 0, less than 24h of full day        
+         ! rab to test if the day time is equal to 0, less than 24h of full day
          rab(:,:) = -raa(:,:) / rbb(:,:)
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF ( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h
-         ! When is it night?
-                  ztx = zinvtwopi * (ACOS(rab(ji,jj)) - rcc(ji,jj))
-                  ztest = -rbb(ji,jj) * SIN( rcc(ji,jj) + ztwopi * ztx )
-         ! is it dawn or dusk?
-                  IF ( ztest > 0._wp ) THEN
-                     rdawn(ji,jj) = ztx
-                     rdusk(ji,jj) = rtmd(ji,jj) + ( rtmd(ji,jj) - rdawn(ji,jj) )
+               IF( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h
+                  ! When is it night?
+                  ztx = 1._wp/(2._wp*rpi) * (ACOS(rab(ji,jj)) - rcc(ji,jj))
+                  ztest = -rbb(ji,jj) * SIN( rcc(ji,jj) + 2._wp*rpi * ztx )
+                  ! is it dawn or dusk?
+                  IF( ztest > 0._wp ) THEN
+                     rdawn_dcy(ji,jj) = ztx
+                     rdusk_dcy(ji,jj) = rtmd(ji,jj) + ( rtmd(ji,jj) - rdawn_dcy(ji,jj) )
                   ELSE
-                     rdusk(ji,jj) = ztx
-                     rdawn(ji,jj) = rtmd(ji,jj) - ( rdusk(ji,jj) - rtmd(ji,jj) )
+                     rdusk_dcy(ji,jj) = ztx
+                     rdawn_dcy(ji,jj) = rtmd(ji,jj) - ( rdusk_dcy(ji,jj) - rtmd(ji,jj) )
                   ENDIF
                ELSE
-                  rdawn(ji,jj) = rtmd(ji,jj) + 0.5_wp
-                  rdusk(ji,jj) = rdawn(ji,jj)
-               ENDIF
-             END DO  
-         END DO  
-         rdawn(:,:) = MOD( (rdawn(:,:) + 1._wp), 1._wp )
-         rdusk(:,:) = MOD( (rdusk(:,:) + 1._wp), 1._wp )
+                  rdawn_dcy(ji,jj) = rtmd(ji,jj) + 0.5_wp
+                  rdusk_dcy(ji,jj) = rdawn_dcy(ji,jj)
+               ENDIF
+            END DO
+         END DO
+         rdawn_dcy(:,:) = MOD( (rdawn_dcy(:,:) + 1._wp), 1._wp )
+         rdusk_dcy(:,:) = MOD( (rdusk_dcy(:,:) + 1._wp), 1._wp )
          !     2.2 Compute the scaling function:
          !         S* = the inverse of the time integral of the diurnal cycle from dawn to dusk
@@ -162 +232 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF ( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h
+               IF( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h
                   rscal(ji,jj) = 0.0_wp
-                  IF ( rdawn(ji,jj) < rdusk(ji,jj) ) THEN      ! day time in one part
-                     IF( (rdusk(ji,jj) - rdawn(ji,jj) ) .ge. 0.001_wp ) THEN
-                       rscal(ji,jj) = fintegral(rdawn(ji,jj), rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                       rscal(ji,jj) = 1._wp / rscal(ji,jj)
+                  IF( rdawn_dcy(ji,jj) < rdusk_dcy(ji,jj) ) THEN      ! day time in one part
+                     IF( (rdusk_dcy(ji,jj) - rdawn_dcy(ji,jj) ) .ge. 0.001_wp ) THEN
+                        rscal(ji,jj) = fintegral(rdawn_dcy(ji,jj), rdusk_dcy(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+                        rscal(ji,jj) = 1._wp / rscal(ji,jj)
                      ENDIF
                   ELSE                                         ! day time in two parts
-                     IF( (rdusk(ji,jj) + (1._wp - rdawn(ji,jj)) ) .ge. 0.001_wp ) THEN
-                       rscal(ji,jj) = fintegral(0._wp, rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))   &
-                          &         + fintegral(rdawn(ji,jj), 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                       rscal(ji,jj) = 1. / rscal(ji,jj)
+                     IF( (rdusk_dcy(ji,jj) + (1._wp - rdawn_dcy(ji,jj)) ) .ge. 0.001_wp ) THEN
+                        rscal(ji,jj) = fintegral(0._wp, rdusk_dcy(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))   &
+                           &         + fintegral(rdawn_dcy(ji,jj), 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
+                        rscal(ji,jj) = 1. / rscal(ji,jj)
                      ENDIF
                   ENDIF
                ELSE
-                  IF ( raa(ji,jj) > rbb(ji,jj) ) THEN         ! 24h day
-                     rscal(ji,jj) = fintegral(0._wp, 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                  IF( raa(ji,jj) > rbb(ji,jj) ) THEN         ! 24h day
+                     rscal(ji,jj) = fintegral(0._wp, 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj))
                      rscal(ji,jj) = 1._wp / rscal(ji,jj)
                   ELSE                                          ! No day
@@ -184 +254 @@
                   ENDIF
                ENDIF
-            END DO  
-         END DO  
+            END DO
+         END DO
          !
          ztmp = rday / ( rdt * REAL(nn_fsbc, wp) )
          rscal(:,:) = rscal(:,:) * ztmp
          !
-      ENDIF 
-         !     3. update qsr with the diurnal cycle
-         !     ------------------------------------
-
-      imask_night(:,:) = 0
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ztmpm = 0._wp
-            IF( ABS(rab(ji,jj)) < 1. ) THEN         ! day duration is less than 24h
-               !
-               IF( rdawn(ji,jj) < rdusk(ji,jj) ) THEN       ! day time in one part
-                  zlousd = MAX(zlo, rdawn(ji,jj))
-                  zlousd = MIN(zlousd, zup)
-                  zupusd = MIN(zup, rdusk(ji,jj))
-                  zupusd = MAX(zupusd, zlo)
-                  ztmp = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
-                  ztmpm = zupusd - zlousd
-                  IF ( ztmpm .EQ. 0 ) imask_night(ji,jj) = 1
-                  !
-               ELSE                                         ! day time in two parts
-                  zlousd = MIN(zlo, rdusk(ji,jj))
-                  zupusd = MIN(zup, rdusk(ji,jj))
-                  ztmp1 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                  ztmpm1=zupusd-zlousd
-                  zlousd = MAX(zlo, rdawn(ji,jj))
-                  zupusd = MAX(zup, rdawn(ji,jj))
-                  ztmp2 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                  ztmpm2 =zupusd-zlousd
-                  ztmp = ztmp1 + ztmp2
-                  ztmpm = ztmpm1 + ztmpm2
-                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
-                  IF (ztmpm .EQ. 0.) imask_night(ji,jj) = 1
-               ENDIF
-            ELSE                                   ! 24h light or 24h night
-               !
-               IF( raa(ji,jj) > rbb(ji,jj) ) THEN           ! 24h day
-                  ztmp = fintegral(zlo, zup, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
-                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
-                  imask_night(ji,jj) = 0
-                  !
-               ELSE                                         ! No day
-                  zqsrout(ji,jj) = 0.0_wp
-                  imask_night(ji,jj) = 1
-               ENDIF
-            ENDIF
-         END DO  
-      END DO  
-      !
-      IF( PRESENT(l_mask) .AND. l_mask ) THEN
-         zqsrout(:,:) = float(imask_night(:,:))
-      ENDIF
-      !
-   END FUNCTION sbc_dcy
+      ENDIF !IF( nday_qsr /= nday )
+      !
+   END SUBROUTINE sbc_dcy_param
+
+
+   FUNCTION fintegral( pt1, pt2, paaa, pbbb, pccc )
+      REAL(wp), INTENT(in) :: pt1, pt2, paaa, pbbb, pccc
+      REAL(wp) :: fintegral
+      fintegral =   paaa * pt2 + 1._wp/(2._wp*rpi) * pbbb * SIN(pccc + 2._wp*rpi*pt2)   &
+         &        - paaa * pt1 - 1._wp/(2._wp*rpi) * pbbb * SIN(pccc + 2._wp*rpi*pt1)
+   END FUNCTION fintegral
 
    !!======================================================================

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcice_cice.F90

@@ -132 +132 @@
          IF      ( ksbc == jp_flx ) THEN
             CALL cice_sbc_force(kt)
-         ELSE IF ( ksbc == jp_purecpl ) THEN
+         ELSE IF( ksbc == jp_purecpl ) THEN
             CALL sbc_cpl_ice_flx( fr_i )
          ENDIF
@@ -140 +140 @@
          CALL cice_sbc_out ( kt, ksbc )
 
-         IF ( ksbc == jp_purecpl )  CALL cice_sbc_hadgam(kt+1)
+         IF( ksbc == jp_purecpl )  CALL cice_sbc_hadgam(kt+1)
 
       ENDIF                                          ! End sea-ice time step only
@@ -169 +169 @@
       ! there is no restart file.
       ! Values from a CICE restart file would overwrite this
-      IF ( .NOT. ln_rstart ) THEN    
+      IF( .NOT. ln_rstart ) THEN    
          CALL nemo2cice( ts(:,:,1,jp_tem,Kmm) , sst , 'T' , 1.) 
       ENDIF  
@@ -178 +178 @@
 
 ! Do some CICE consistency checks
-      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
-         IF ( calc_strair .OR. calc_Tsfc ) THEN
+      IF( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
+         IF( calc_strair .OR. calc_Tsfc ) THEN
             CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' )
          ENDIF
-      ELSEIF (ksbc == jp_blk) THEN
-         IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN
+      ELSEIF(ksbc == jp_blk) THEN
+         IF( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN
             CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' )
          ENDIF
@@ -203 +203 @@
 
       CALL cice2nemo(aice,fr_i, 'T', 1. )
-      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
+      IF( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
          DO jl=1,ncat
             CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
@@ -298 +298 @@
 ! forced and coupled case 
 
-      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
+      IF( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
 
          ztmpn(:,:,:)=0.0
@@ -323 +323 @@
 
 ! Surface downward latent heat flux (CI_5)
-         IF (ksbc == jp_flx) THEN
+         IF(ksbc == jp_flx) THEN
             DO jl=1,ncat
                ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl)
@@ -333 +333 @@
             DO jj=1,jpj
                DO ji=1,jpi
-                  IF (fr_i(ji,jj).eq.0.0) THEN
+                  IF(fr_i(ji,jj).eq.0.0) THEN
                      DO jl=1,ncat
                         ztmpn(ji,jj,jl)=0.0
@@ -352 +352 @@
 ! GBM conductive flux through ice (CI_6)
 !  Convert to GBM
-            IF (ksbc == jp_flx) THEN
+            IF(ksbc == jp_flx) THEN
                ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl)
             ELSE
@@ -361 +361 @@
 ! GBM surface heat flux (CI_7)
 !  Convert to GBM
-            IF (ksbc == jp_flx) THEN
+            IF(ksbc == jp_flx) THEN
                ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 
             ELSE
@@ -369 +369 @@
          ENDDO
 
-      ELSE IF (ksbc == jp_blk) THEN
+      ELSE IF(ksbc == jp_blk) THEN
 
 ! Pass bulk forcing fields to CICE (which will calculate heat fluxes etc itself)
@@ -547 +547 @@
 ! Freshwater fluxes 
 
-      IF (ksbc == jp_flx) THEN
+      IF(ksbc == jp_flx) THEN
 ! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip)
 ! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below
@@ -553 +553 @@
 ! Better to use evap and tprecip? (but for now don't read in evap in this case)
          emp(:,:)  = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:))
-      ELSE IF (ksbc == jp_blk) THEN
+      ELSE IF(ksbc == jp_blk) THEN
          emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)        
-      ELSE IF (ksbc == jp_purecpl) THEN
+      ELSE IF(ksbc == jp_purecpl) THEN
 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) 
 ! This is currently as required with the coupling fields from the UM atmosphere
@@ -585 +585 @@
 ! Scale qsr and qns according to ice fraction (bulk formulae only)
 
-      IF (ksbc == jp_blk) THEN
+      IF(ksbc == jp_blk) THEN
          qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:))
          qns(:,:)=qns(:,:)*(1.0-fr_i(:,:))
       ENDIF
 ! Take into account snow melting except for fully coupled when already in qns_tot
-      IF (ksbc == jp_purecpl) THEN
+      IF(ksbc == jp_purecpl) THEN
          qsr(:,:)= qsr_tot(:,:)
          qns(:,:)= qns_tot(:,:)
@@ -625 +625 @@
 
       CALL cice2nemo(aice,fr_i,'T', 1. )
-      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
+      IF( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
          DO jl=1,ncat
             CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
@@ -878 +878 @@
 !     B. Gather pn into global array (png)
 
-      IF ( jpnij > 1) THEN
+      IF( jpnij > 1) THEN
          CALL mppsync
          CALL mppgather (pn,0,png) 
@@ -891 +891 @@
 ! (may be OK but not 100% sure)
 
-      IF (nproc==0) THEN     
+      IF(nproc==0) THEN     
 !        pcg(:,:)=0.0
          DO jn=1,jpnij
@@ -1014 +1014 @@
 ! the lbclnk call on pn will replace these with sensible values
 
-      IF (nproc==0) THEN
+      IF(nproc==0) THEN
          png(:,:,:)=0.0
          DO jn=1,jpnij
@@ -1027 +1027 @@
 !     C. Scatter png into NEMO field (pn) for each processor
 
-      IF ( jpnij > 1) THEN
+      IF( jpnij > 1) THEN
          CALL mppsync
          CALL mppscatter (png,0,pn) 

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcmod.F90

@@ -15 +15 @@
    !!            3.6  ! 2014-11  (P. Mathiot, C. Harris) add ice shelves melting
    !!            4.0  ! 2016-06  (L. Brodeau) new general bulk formulation
+   !!            4.0  ! 2019-03  (F. Lemarié & G. Samson)  add ABL compatibility (ln_abl=TRUE)
    !!----------------------------------------------------------------------
 
@@ -33 +34 @@
    USE sbcflx         ! surface boundary condition: flux formulation
    USE sbcblk         ! surface boundary condition: bulk formulation
+   USE sbcabl         ! atmospheric boundary layer
    USE sbcice_if      ! surface boundary condition: ice-if sea-ice model
 #if defined key_si3
@@ -92 +94 @@
       LOGICAL ::   ll_purecpl, ll_opa, ll_not_nemo   ! local logical
       !!
-      NAMELIST/namsbc/ nn_fsbc  ,                                                  &
-         &             ln_usr   , ln_flx     , ln_blk       ,                      &
-         &             ln_cpl   , ln_mixcpl  , nn_components,                      &
-         &             nn_ice   , ln_ice_embd,                                     &
-         &             ln_traqsr, ln_dm2dc   ,                                     &
+      NAMELIST/namsbc/ nn_fsbc  ,                                                    &
+         &             ln_usr   , ln_flx   , ln_blk   , ln_abl,                      &
+         &             ln_cpl   , ln_mixcpl, nn_components,                          &
+         &             nn_ice   , ln_ice_embd,                                       &
+         &             ln_traqsr, ln_dm2dc ,                                         &
          &             ln_rnf   , nn_fwb     , ln_ssr   , ln_apr_dyn,              &
-         &             ln_wave  , ln_cdgw    , ln_sdw   , ln_tauwoc , ln_stcor,    &
-         &             ln_tauw  , nn_lsm     , nn_sdrift
+         &             ln_wave  , ln_cdgw  , ln_sdw   , ln_tauwoc  , ln_stcor  ,     &
+         &             ln_tauw  , nn_lsm, nn_sdrift
       !!----------------------------------------------------------------------
       !
@@ -124 +126 @@
          IF( lk_cice )   nn_ice      = 3
       ENDIF
-#else
-      IF( lk_si3  )   nn_ice      = 2
-      IF( lk_cice )   nn_ice      = 3
+!!GS: TBD
+!#else
+!      IF( lk_si3  )   nn_ice      = 2
+!      IF( lk_cice )   nn_ice      = 3
 #endif
       !
@@ -136 +139 @@
          WRITE(numout,*) '         flux         formulation                   ln_flx        = ', ln_flx
          WRITE(numout,*) '         bulk         formulation                   ln_blk        = ', ln_blk
+         WRITE(numout,*) '         ABL          formulation                   ln_abl        = ', ln_abl
          WRITE(numout,*) '      Type of coupling (Ocean/Ice/Atmosphere) : '
          WRITE(numout,*) '         ocean-atmosphere coupled formulation       ln_cpl        = ', ln_cpl
@@ -223 +227 @@
       CASE( 1 )                        !- Ice-cover climatology ("Ice-if" model)  
       CASE( 2 )                        !- SI3  ice model
+         IF( .NOT.( ln_blk .OR. ln_cpl .OR. ln_abl .OR. ln_usr ) )   &
+            &                   CALL ctl_stop( 'sbc_init : SI3 sea-ice model requires ln_blk or ln_cpl or ln_abl or ln_usr = T' )
       CASE( 3 )                        !- CICE ice model
-         IF( .NOT.( ln_blk .OR. ln_cpl ) )   CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl = T' )
-         IF( lk_agrif                    )   CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' ) 
+         IF( .NOT.( ln_blk .OR. ln_cpl .OR. ln_abl .OR. ln_usr ) )   &
+            &                   CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl or ln_abl or ln_usr = T' )
+         IF( lk_agrif                                )   &
+            &                   CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' ) 
       CASE DEFAULT                     !- not supported
       END SELECT
@@ -248 +256 @@
 
       !                          ! Choice of the Surface Boudary Condition (set nsbc)
+      nday_qsr = -1   ! allow initialization at the 1st call !LB: now warm-layer of COARE* calls "sbc_dcy_param" of sbcdcy.F90!
       IF( ln_dm2dc ) THEN           !* daily mean to diurnal cycle
-         nday_qsr = -1   ! allow initialization at the 1st call
-         IF( .NOT.( ln_flx .OR. ln_blk ) .AND. nn_components /= jp_iam_opa )   &
-            &   CALL ctl_stop( 'qsr diurnal cycle from daily values requires a flux or bulk formulation' )
+         !LB:nday_qsr = -1   ! allow initialization at the 1st call
+         IF( .NOT.( ln_flx .OR. ln_blk .OR. ln_abl ) .AND. nn_components /= jp_iam_opa )   &
+            &   CALL ctl_stop( 'qsr diurnal cycle from daily values requires flux, bulk or abl formulation' )
       ENDIF
       !                             !* Choice of the Surface Boudary Condition
@@ -264 +273 @@
       IF( ln_flx          ) THEN   ;   nsbc = jp_flx     ; icpt = icpt + 1   ;   ENDIF       ! flux                 formulation
       IF( ln_blk          ) THEN   ;   nsbc = jp_blk     ; icpt = icpt + 1   ;   ENDIF       ! bulk                 formulation
+      IF( ln_abl          ) THEN   ;   nsbc = jp_abl     ; icpt = icpt + 1   ;   ENDIF       ! ABL                  formulation
       IF( ll_purecpl      ) THEN   ;   nsbc = jp_purecpl ; icpt = icpt + 1   ;   ENDIF       ! Pure Coupled         formulation
       IF( ll_opa          ) THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module
@@ -275 +285 @@
          CASE( jp_flx     )   ;   WRITE(numout,*) '   ==>>>   flux formulation'
          CASE( jp_blk     )   ;   WRITE(numout,*) '   ==>>>   bulk formulation'
+         CASE( jp_abl     )   ;   WRITE(numout,*) '   ==>>>   ABL  formulation'
          CASE( jp_purecpl )   ;   WRITE(numout,*) '   ==>>>   pure coupled formulation'
 !!gm abusive use of jp_none ??   ===>>> need to be check and changed by adding a jp_sas parameter
@@ -325 +336 @@
       IF( l_sbc_clo   )   CALL sbc_clo_init              ! closed sea surface initialisation
       !
-      IF( ln_blk      )   CALL sbc_blk_init              ! bulk formulae initialization
-
-      IF( ln_ssr      )   CALL sbc_ssr_init              ! Sea-Surface Restoring initialization
+      IF( ln_blk      )   CALL sbc_blk_init            ! bulk formulae initialization
+
+      IF( ln_abl      )   CALL sbc_abl_init            ! Atmospheric Boundary Layer (ABL)
+
+      IF( ln_ssr      )   CALL sbc_ssr_init            ! Sea-Surface Restoring initialization
       !
       !
@@ -394 +407 @@
          emp_b (:,:) = emp (:,:)
          sfx_b (:,:) = sfx (:,:)
-         IF ( ln_rnf ) THEN
+         IF( ln_rnf ) THEN
             rnf_b    (:,:  ) = rnf    (:,:  )
             rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
@@ -418 +431 @@
       CASE( jp_flx     )   ;   CALL sbc_flx       ( kt )                             ! flux formulation
       CASE( jp_blk     )
-         IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! OPA-SAS coupling: SAS receiving fields from OPA
-                               CALL sbc_blk       ( kt )                             ! bulk formulation for the ocean
+         IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! OPA-SAS coupling: SAS receiving fields from OPA
+                               CALL sbc_blk       ( kt )                    ! bulk formulation for the ocean
                                !
-      CASE( jp_purecpl )   ;   CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! pure coupled formulation
+      CASE( jp_abl     )
+         IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! OPA-SAS coupling: SAS receiving fields from OPA
+                               CALL sbc_abl       ( kt )                    ! ABL  formulation for the ocean
+                               !
+      CASE( jp_purecpl )   ;   CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! pure coupled formulation
       CASE( jp_none    )
          IF( ll_opa    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! OPA-SAS coupling: OPA receiving fields from SAS
@@ -460 +477 @@
 !!$!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why.
 !!$      CALL lbc_lnk( 'sbcmod', emp, 'T', 1. )
-      IF ( ll_wd ) THEN     ! If near WAD point limit the flux for now
+      IF( ll_wd ) THEN     ! If near WAD point limit the flux for now
          zthscl = atanh(rn_wd_sbcfra)                     ! taper frac default is .999 
          zwdht(:,:) = ssh(:,:,Kmm) + ht_0(:,:) - rn_wdmin1   ! do this calc of water
@@ -492 +509 @@
             CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b, ldxios = lrxios )   ! before i-stress  (U-point)
             CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b, ldxios = lrxios )   ! before j-stress  (V-point)
-            CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b, ldxios = lrxios  )   ! before non solar heat flux (T-point)
+            CALL iom_get( numror, jpdom_autoglo,  'qns_b',  qns_b, ldxios = lrxios )   ! before non solar heat flux (T-point)
             ! The 3D heat content due to qsr forcing is treated in traqsr
             ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b, ldxios = lrxios  ) ! before     solar heat flux (T-point)

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcrnf.F90

@@ -435 +435 @@
          !                                      !    - mixed upstream-centered (ln_traadv_cen2=T)
          !
-         IF ( ln_rnf_depth )   CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already',   &
+         IF( ln_rnf_depth )   CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already',   &
             &                                              'be spread through depth by ln_rnf_depth'               )
          !

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbctide.F90

@@ -72 +72 @@
          ! Temporarily set nsec_day to beginning of day.
          nsec_day_orig = nsec_day
-         IF ( nsec_day /= NINT(0.5_wp * rdt) ) THEN 
+         IF( nsec_day /= NINT(0.5_wp * rdt) ) THEN 
             kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt
             nsec_day = NINT(0.5_wp * rdt)

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/tideini.F90

@@ -66 +66 @@
       !
       IF( ln_tide ) THEN
-         IF (lwp) THEN
+         IF(lwp) THEN
             WRITE(numout,*)
             WRITE(numout,*) 'tide_init : Initialization of the tidal components'
@@ -125 +125 @@
       kt_tide = nit000
       !
-      IF (.NOT.ln_scal_load ) rn_scal_load = 0._wp
+      IF(.NOT.ln_scal_load ) rn_scal_load = 0._wp
       !
    END SUBROUTINE tide_init

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ZDF/zdfiwm.F90

@@ -415 +415 @@
       !!              de Lavergne et al. in prep., 2017
       !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
       INTEGER  ::   inum         ! local integer
       INTEGER  ::   ios