Ignore:
Timestamp:
2019-12-11T12:38:43+01:00 (17 months 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
Files:
2 deleted
25 edited
8 copied

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icesbc.F90

    r11960 r12182  
    2727   USE lbclnk         ! lateral boundary conditions (or mpp links) 
    2828   USE timing         ! Timing 
     29   USE fldread        !!GS: needed by agrif 
    2930 
    3031   IMPLICIT NONE 
     
    7172      SELECT CASE( ksbc ) 
    7273         CASE( jp_usr     )   ;    CALL usrdef_sbc_ice_tau( kt )                 ! user defined formulation 
    73          CASE( jp_blk     )   ;    CALL blk_ice_tau                              ! Bulk         formulation 
     74         CASE( jp_blk     )   ;    CALL blk_ice_1( sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   & 
     75            &                                      sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),   & 
     76            &                                      sf(jp_slp )%fnow(:,:,1), u_ice, v_ice, tm_su    ,   &   ! inputs 
     77            &                                      putaui = utau_ice, pvtaui = vtau_ice            )       ! outputs                              
     78 !        CASE( jp_abl     )    utau_ice & vtau_ice are computed in ablmod 
    7479         CASE( jp_purecpl )   ;    CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled      formulation 
    7580      END SELECT 
     
    143148      CASE( jp_usr )              !--- user defined formulation 
    144149                                  CALL usrdef_sbc_ice_flx( kt, h_s, h_i ) 
    145       CASE( jp_blk )              !--- bulk formulation 
    146                                   CALL blk_ice_flx    ( t_su, h_s, h_i, alb_ice )    !  
     150      CASE( jp_blk, jp_abl )  !--- bulk formulation & ABL formulation 
     151                                  CALL blk_ice_2    ( t_su, h_s, h_i, alb_ice, sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),    & 
     152            &                                           sf(jp_slp)%fnow(:,:,1), sf(jp_qlw)%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1), sf(jp_snow)%fnow(:,:,1) )    !  
    147153         IF( ln_mixcpl        )   CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i ) 
    148154         IF( nn_flxdist /= -1 )   CALL ice_flx_dist   ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist ) 
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icevar.F90

    r11732 r12182  
    115115      ! 
    116116      ato_i(:,:) = 1._wp - at_i(:,:)         ! open water fraction   
    117  
     117      ! 
     118      !!GS: tm_su always needed by ABL over sea-ice 
     119      ALLOCATE( z1_at_i(jpi,jpj) ) 
     120      WHERE( at_i(:,:) > epsi20 )   ;   z1_at_i(:,:) = 1._wp / at_i(:,:) 
     121      ELSEWHERE                     ;   z1_at_i(:,:) = 0._wp 
     122      END WHERE 
     123      tm_su(:,:) = SUM( t_su(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 
     124      WHERE( at_i(:,:)<=epsi20 ) tm_su(:,:) = rt0 
     125      ! 
    118126      ! The following fields are calculated for diagnostics and outputs only 
    119127      ! ==> Do not use them for other purposes 
    120128      IF( kn > 1 ) THEN 
    121129         ! 
    122          ALLOCATE( z1_at_i(jpi,jpj) , z1_vt_i(jpi,jpj) , z1_vt_s(jpi,jpj) ) 
    123          WHERE( at_i(:,:) > epsi20 )   ;   z1_at_i(:,:) = 1._wp / at_i(:,:) 
    124          ELSEWHERE                     ;   z1_at_i(:,:) = 0._wp 
    125          END WHERE 
     130         ALLOCATE( z1_vt_i(jpi,jpj) , z1_vt_s(jpi,jpj) ) 
    126131         WHERE( vt_i(:,:) > epsi20 )   ;   z1_vt_i(:,:) = 1._wp / vt_i(:,:) 
    127132         ELSEWHERE                     ;   z1_vt_i(:,:) = 0._wp 
     
    136141         !          
    137142         !                          ! mean temperature (K), salinity and age 
    138          tm_su(:,:) = SUM( t_su(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 
    139143         tm_si(:,:) = SUM( t_si(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 
    140144         om_i (:,:) = SUM( oa_i(:,:,:)              , dim=3 ) * z1_at_i(:,:) 
     
    154158         !                           ! put rt0 where there is no ice 
    155159         WHERE( at_i(:,:)<=epsi20 ) 
    156             tm_su(:,:) = rt0 
    157160            tm_si(:,:) = rt0 
    158161            tm_i (:,:) = rt0 
     
    165168         END WHERE          
    166169         ! 
    167          DEALLOCATE( z1_at_i , z1_vt_i , z1_vt_s ) 
     170         DEALLOCATE( z1_vt_i , z1_vt_s ) 
    168171         ! 
    169172      ENDIF 
     173      ! 
     174      DEALLOCATE( z1_at_i ) 
    170175      ! 
    171176   END SUBROUTINE ice_var_agg 
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diawri.F90

    r12150 r12182  
    2828   USE isf_oce 
    2929   USE isfcpl 
     30   USE abl            ! abl variables in case ln_abl = .true. 
    3031   USE dom_oce        ! ocean space and time domain 
    3132   USE phycst         ! physical constants 
     
    6869   PUBLIC   dia_wri_state 
    6970   PUBLIC   dia_wri_alloc           ! Called by nemogcm module 
    70  
     71#if ! defined key_iomput    
     72   PUBLIC   dia_wri_alloc_abl       ! Called by sbcabl  module (if ln_abl = .true.) 
     73#endif 
    7174   INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file 
    7275   INTEGER ::          nb_T              , ndim_bT   ! grid_T file 
     
    7477   INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file 
    7578   INTEGER ::   nid_W, nz_W, nh_W                    ! grid_W file 
     79   INTEGER ::   nid_A, nz_A, nh_A, ndim_A, ndim_hA   ! grid_ABL file    
    7680   INTEGER ::   ndex(1)                              ! ??? 
    7781   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV 
     82   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL 
    7883   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V 
    7984   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT 
     
    417422         &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 
    418423         ! 
    419       dia_wri_alloc = MAXVAL(ierr) 
     424     dia_wri_alloc = MAXVAL(ierr) 
    420425      CALL mpp_sum( 'diawri', dia_wri_alloc ) 
    421426      ! 
    422427   END FUNCTION dia_wri_alloc 
     428  
     429   INTEGER FUNCTION dia_wri_alloc_abl() 
     430      !!---------------------------------------------------------------------- 
     431     ALLOCATE(   ndex_hA(jpi*jpj), ndex_A (jpi*jpj*jpkam1), STAT=dia_wri_alloc_abl) 
     432      CALL mpp_sum( 'diawri', dia_wri_alloc_abl ) 
     433      ! 
     434   END FUNCTION dia_wri_alloc_abl 
    423435 
    424436    
     
    444456      INTEGER  ::   ierr                                     ! error code return from allocation 
    445457      INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers 
     458      INTEGER  ::   ipka                                     ! ABL 
    446459      INTEGER  ::   jn, ierror                               ! local integers 
    447460      REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars 
     
    449462      REAL(wp), DIMENSION(jpi,jpj)   :: zw2d       ! 2D workspace 
    450463      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d       ! 3D workspace 
     464      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl   ! ABL 3D workspace 
    451465      !!---------------------------------------------------------------------- 
    452466      ! 
     
    482496      ijmi = 1      ;      ijma = jpj 
    483497      ipk = jpk 
     498      IF(ln_abl) ipka = jpkam1 
    484499 
    485500      ! define time axis 
     
    584599            &          "m", ipk, gdepw_1d, nz_W, "down" ) 
    585600 
     601         IF( ln_abl ) THEN  
     602         ! Define the ABL grid FILE ( nid_A ) 
     603            CALL dia_nam( clhstnam, nn_write, 'grid_ABL' ) 
     604            IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename 
     605            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
     606               &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
     607               &          nit000-1, zjulian, rdt, nh_A, nid_A, domain_id=nidom, snc4chunks=snc4set ) 
     608            CALL histvert( nid_A, "ght_abl", "Vertical T levels",      &  ! Vertical grid: gdept 
     609               &           "m", ipka, ght_abl(2:jpka), nz_A, "up" ) 
     610            !                                                            ! Index of ocean points 
     611         ALLOCATE( zw3d_abl(jpi,jpj,ipka) )  
     612         zw3d_abl(:,:,:) = 1._wp  
     613         CALL wheneq( jpi*jpj*ipka, zw3d_abl, 1, 1., ndex_A , ndim_A  )      ! volume 
     614            CALL wheneq( jpi*jpj     , zw3d_abl, 1, 1., ndex_hA, ndim_hA )      ! surface 
     615         DEALLOCATE(zw3d_abl) 
     616         ENDIF 
    586617 
    587618         ! Declare all the output fields as NETCDF variables 
     
    633664         CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm 
    634665            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    635 ! 
     666         ! 
     667         IF( ln_abl ) THEN 
     668            CALL histdef( nid_A, "t_abl", "Potential Temperature"     , "K"        ,       &  ! t_abl 
     669               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
     670            CALL histdef( nid_A, "q_abl", "Humidity"                  , "kg/kg"    ,       &  ! q_abl 
     671               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     672            CALL histdef( nid_A, "u_abl", "Atmospheric U-wind   "     , "m/s"        ,     &  ! u_abl 
     673               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
     674            CALL histdef( nid_A, "v_abl", "Atmospheric V-wind   "     , "m/s"    ,         &  ! v_abl 
     675               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     676            CALL histdef( nid_A, "tke_abl", "Atmospheric TKE   "     , "m2/s2"    ,        &  ! tke_abl 
     677               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     678            CALL histdef( nid_A, "avm_abl", "Atmospheric turbulent viscosity", "m2/s"   ,  &  ! avm_abl 
     679               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     680            CALL histdef( nid_A, "avt_abl", "Atmospheric turbulent diffusivity", "m2/s2",  &  ! avt_abl 
     681               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     682            CALL histdef( nid_A, "pblh", "Atmospheric boundary layer height "  , "m",      &  ! pblh 
     683               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )                  
     684#if defined key_si3 
     685            CALL histdef( nid_A, "oce_frac", "Fraction of open ocean"  , " ",      &  ! ato_i 
     686               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout ) 
     687#endif 
     688            CALL histend( nid_A, snc4chunks=snc4set ) 
     689         ENDIF 
     690         ! 
    636691         IF( ln_icebergs ) THEN 
    637692            CALL histdef( nid_T, "calving"             , "calving mass input"                       , "kg/s"   , & 
     
    791846      CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction    
    792847      CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed    
    793 ! 
     848      ! 
     849      IF( ln_abl ) THEN  
     850         ALLOCATE( zw3d_abl(jpi,jpj,jpka) ) 
     851         IF( ln_mskland )   THEN  
     852            DO jk=1,jpka 
     853               zw3d_abl(:,:,jk) = tmask(:,:,1) 
     854            END DO        
     855         ELSE 
     856            zw3d_abl(:,:,:) = 1._wp      
     857         ENDIF        
     858         CALL histwrite( nid_A,  "pblh"   , it, pblh(:,:)                  *zw3d_abl(:,:,1     ), ndim_hA, ndex_hA )   ! pblh  
     859         CALL histwrite( nid_A,  "u_abl"  , it, u_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! u_abl 
     860         CALL histwrite( nid_A,  "v_abl"  , it, v_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! v_abl 
     861         CALL histwrite( nid_A,  "t_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,1)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! t_abl 
     862         CALL histwrite( nid_A,  "q_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,2)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! q_abl        
     863         CALL histwrite( nid_A,  "tke_abl", it, tke_abl (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! tke_abl 
     864         CALL histwrite( nid_A,  "avm_abl", it, avm_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avm_abl 
     865         CALL histwrite( nid_A,  "avt_abl", it, avt_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avt_abl  
     866#if defined key_si3 
     867         CALL histwrite( nid_A,  "oce_frac"   , it, ato_i(:,:)                                  , ndim_hA, ndex_hA )   ! ato_i 
     868#endif 
     869         DEALLOCATE(zw3d_abl) 
     870      ENDIF 
     871      ! 
    794872      IF( ln_icebergs ) THEN 
    795873         ! 
     
    861939         CALL histclo( nid_V ) 
    862940         CALL histclo( nid_W ) 
     941         IF(ln_abl) CALL histclo( nid_A ) 
    863942      ENDIF 
    864943      ! 
     
    883962      INTEGER           , INTENT( in ) ::   Kmm              ! time level index 
    884963      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created 
    885       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zisfdebug 
    886964      !! 
    887965      INTEGER :: inum, jk 
     
    9551033         CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd            )    ! now StokesDrift k-velocity 
    9561034      ENDIF 
     1035      IF ( ln_abl ) THEN 
     1036         CALL iom_rstput ( 0, 0, inum, "uz1_abl",   u_abl(:,:,2,nt_a  ) )   ! now first level i-wind 
     1037         CALL iom_rstput ( 0, 0, inum, "vz1_abl",   v_abl(:,:,2,nt_a  ) )   ! now first level j-wind 
     1038         CALL iom_rstput ( 0, 0, inum, "tz1_abl",  tq_abl(:,:,2,nt_a,1) )   ! now first level temperature 
     1039         CALL iom_rstput ( 0, 0, inum, "qz1_abl",  tq_abl(:,:,2,nt_a,2) )   ! now first level humidity 
     1040      ENDIF 
    9571041  
    9581042#if defined key_si3 
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/IOM/in_out_manager.F90

    r11960 r12182  
    8787   LOGICAL ::   lrst_oce              !: logical to control the oce restart write  
    8888   LOGICAL ::   lrst_ice              !: logical to control the ice restart write  
     89   LOGICAL ::   lrst_abl              !: logical to control the abl restart write  
    8990   INTEGER ::   numror = 0            !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90) 
    9091   INTEGER ::   numrir                !: logical unit for ice   restart (read) 
     92   INTEGER ::   numrar                !: logical unit for abl   restart (read) 
    9193   INTEGER ::   numrow                !: logical unit for ocean restart (write) 
    9294   INTEGER ::   numriw                !: logical unit for ice   restart (write) 
     95   INTEGER ::   numraw                !: logical unit for abl   restart (write) 
    9396   INTEGER ::   nrst_lst              !: number of restart to output next 
    9497 
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/IOM/iom.F90

    r12150 r12182  
    2929   USE lib_mpp           ! MPP library 
    3030#if defined key_iomput 
    31    USE sbc_oce  , ONLY :   nn_fsbc         ! ocean space and time domain 
     31   USE sbc_oce  , ONLY :   nn_fsbc, ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1 
    3232   USE icb_oce  , ONLY :   nclasses, class_num       !  !: iceberg classes 
    3333#if defined key_si3 
     
    111111      ! 
    112112      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 
     113      REAL(wp), DIMENSION(2,jpkam1)         :: za_bnds   ! ABL vertical boundaries 
    113114      LOGICAL ::   ll_tmppatch = .TRUE.    !: seb: patch before we remove periodicity 
    114115      INTEGER ::   nldi_save, nlei_save    !:      and close boundaries in output files 
     
    194195      ! vertical grid definition 
    195196      IF(.NOT.llrst_context) THEN 
    196           CALL iom_set_axis_attr( "deptht",  paxis = gdept_1d ) 
    197           CALL iom_set_axis_attr( "depthu",  paxis = gdept_1d ) 
    198           CALL iom_set_axis_attr( "depthv",  paxis = gdept_1d ) 
    199           CALL iom_set_axis_attr( "depthw",  paxis = gdepw_1d ) 
    200  
     197          CALL iom_set_axis_attr(  "deptht", paxis = gdept_1d ) 
     198          CALL iom_set_axis_attr(  "depthu", paxis = gdept_1d ) 
     199          CALL iom_set_axis_attr(  "depthv", paxis = gdept_1d ) 
     200          CALL iom_set_axis_attr(  "depthw", paxis = gdepw_1d ) 
     201 
     202          ! ABL 
     203          IF( .NOT. ALLOCATED(ght_abl) ) THEN   ! force definition for xml files (xios)  
     204             ALLOCATE( ght_abl(jpka), ghw_abl(jpka), e3t_abl(jpka), e3w_abl(jpka) )   ! default allocation needed by iom 
     205             ght_abl(:) = -1._wp   ;   ghw_abl(:) = -1._wp 
     206             e3t_abl(:) = -1._wp   ;   e3w_abl(:) = -1._wp 
     207          ENDIF 
     208          CALL iom_set_axis_attr( "ght_abl", ght_abl(2:jpka) ) 
     209          CALL iom_set_axis_attr( "ghw_abl", ghw_abl(2:jpka) ) 
     210           
    201211          ! Add vertical grid bounds 
    202212          jkmin = MIN(2,jpk)  ! in case jpk=1 (i.e. sas2D) 
     
    207217          zw_bnds(2,1:jpkm1  ) = gdepw_1d(jkmin:jpk) 
    208218          zw_bnds(2,jpk:     ) = gdepw_1d(jpk) + e3t_1d(jpk) 
    209           CALL iom_set_axis_attr( "deptht", bounds=zw_bnds ) 
    210           CALL iom_set_axis_attr( "depthu", bounds=zw_bnds ) 
    211           CALL iom_set_axis_attr( "depthv", bounds=zw_bnds ) 
    212           CALL iom_set_axis_attr( "depthw", bounds=zt_bnds ) 
     219          CALL iom_set_axis_attr(  "deptht", bounds=zw_bnds ) 
     220          CALL iom_set_axis_attr(  "depthu", bounds=zw_bnds ) 
     221          CALL iom_set_axis_attr(  "depthv", bounds=zw_bnds ) 
     222          CALL iom_set_axis_attr(  "depthw", bounds=zt_bnds ) 
     223 
     224          ! ABL 
     225          za_bnds(1,:) = ghw_abl(1:jpkam1) 
     226          za_bnds(2,:) = ghw_abl(2:jpka  ) 
     227          CALL iom_set_axis_attr( "ght_abl", bounds=za_bnds ) 
     228          za_bnds(1,:) = ght_abl(2:jpka  ) 
     229          za_bnds(2,:) = ght_abl(2:jpka  ) + e3w_abl(2:jpka) 
     230          CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds ) 
     231 
    213232          CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) ) 
    214233# if defined key_si3 
     
    682701      clname   = trim(cdname) 
    683702      IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN 
    684 !FUS         iln    = INDEX(clname,'/')  
    685          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) 
     703         iln    = INDEX(clname,'/')  
    686704         cltmpn = clname(1:iln) 
    687705         clname = clname(iln+1:LEN_TRIM(clname)) 
     
    11281146            WRITE(cldmspc , fmt='(i1)') idmspc 
    11291147            ! 
    1130             IF(     idmspc <  irankpv ) THEN  
    1131                CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   & 
    1132                   &                         'it is impossible to read a '//clrankpv//'D array from this file...' ) 
    1133             ELSEIF( idmspc == irankpv ) THEN 
     1148            !!GS: we consider 2D data as 3D data with vertical dim size = 1 
     1149            !IF(     idmspc <  irankpv ) THEN  
     1150            !   CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   & 
     1151            !      &                         'it is impossible to read a '//clrankpv//'D array from this file...' ) 
     1152            !ELSEIF( idmspc == irankpv ) THEN 
     1153            IF( idmspc == irankpv ) THEN 
    11341154               IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   & 
    11351155                  &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 
     
    19291949      ! 
    19301950      INTEGER :: ji, jj, jn, ni, nj 
    1931       INTEGER :: icnr, jcnr                                    ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
    1932       !                                                        ! represents the bottom-left corner of cell (i,j) 
     1951      INTEGER :: icnr, jcnr                             ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
     1952      !                                                 ! represents the bottom-left corner of cell (i,j) 
    19331953      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j) 
    19341954      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_fld       ! Working array to determine where to rotate cells 
     
    21012121      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of) 
    21022122      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of) 
    2103       f_op%timestep = 1        ;  f_of%timestep =  0  ; CALL iom_set_field_attr('ptrc_T'          , freq_op=f_op, freq_offset=f_of) 
    2104       f_op%timestep = 1        ;  f_of%timestep =  0  ; CALL iom_set_field_attr('diad_T'          , freq_op=f_op, freq_offset=f_of) 
     2123      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('ABL'             , freq_op=f_op, freq_offset=f_of) 
    21052124 
    21062125      ! output file names (attribut: name) 
     
    22272246      CHARACTER(LEN=20)  ::   clfreq 
    22282247      CHARACTER(LEN=20)  ::   cldate 
    2229       CHARACTER(LEN=256) ::   cltmpn                 !FUS needed for correct path with AGRIF 
    2230       INTEGER            ::   iln                    !FUS needed for correct path with AGRIF 
    22312248      INTEGER            ::   idx 
    22322249      INTEGER            ::   jn 
     
    23112328            END DO 
    23122329            ! 
    2313 !FUS            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    2314 !FUS see comment line 700  
    2315             IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) THEN 
    2316              iln    = INDEX(clname,'/',BACK=.true.) 
    2317              cltmpn = clname(1:iln) 
    2318              clname = clname(iln+1:LEN_TRIM(clname)) 
    2319              clname = TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    2320             ENDIF 
    2321 !FUS  
     2330            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    23222331            IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname ) 
    23232332            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

    r11536 r12182  
    1919   !!---------------------------------------------------------------------- 
    2020   USE dom_oce         ! ocean space and time domain 
     21   USE sbc_oce, ONLY: jpka, ght_abl ! abl vertical level number and height 
    2122   USE lbclnk          ! lateal boundary condition / mpp exchanges 
    2223   USE iom_def         ! iom variables definitions 
     
    5657      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence  
    5758      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters:  
    58       INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the third dimension 
     59      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the ice/abl third dimension 
    5960 
    6061      CHARACTER(LEN=256) ::   clinfo           ! info character 
     
    6970      INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5 
    7071      LOGICAL            ::   llclobber        ! local definition of ln_clobber 
    71       INTEGER            ::   ilevels           ! vertical levels 
     72      INTEGER            ::   ilevels          ! vertical levels 
    7273      !--------------------------------------------------------------------- 
    7374      ! 
     
    7677      ! 
    7778      !                 !number of vertical levels 
    78       IF( PRESENT(kdlev) ) THEN   ;   ilevels = kdlev    ! use input value (useful for sea-ice) 
    79       ELSE                        ;   ilevels = jpk      ! by default jpk 
     79      IF( PRESENT(kdlev) )   THEN   ;   ilevels = kdlev    ! use input value (useful for sea-ice and abl) 
     80      ELSE                          ;   ilevels = jpk      ! by default jpk 
    8081      ENDIF 
    8182      ! 
     
    126127            CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo) 
    127128            CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), idmy ), clinfo) 
    128             CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',            jpk, idmy ), clinfo) 
    129             CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    130             IF( PRESENT(kdlev) )   & 
    131                CALL iom_nf90_check(NF90_DEF_DIM( if90id,    'numcat',          kdlev, idmy ), clinfo) 
     129            IF( PRESENT(kdlev) ) THEN 
     130              IF( kdlev == jpka ) THEN 
     131                 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev',          kdlev, idmy ), clinfo) 
     132                 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
     133              ELSE 
     134                 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev',            jpk, idmy ), clinfo) 
     135                 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
     136                 CALL iom_nf90_check(NF90_DEF_DIM( if90id,  'numcat',          kdlev, idmy ), clinfo) 
     137              ENDIF 
     138            ELSE 
     139               CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev',            jpk, idmy ), clinfo) 
     140               CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
     141            ENDIF 
    132142            ! global attributes 
    133143            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo) 
     
    196206      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable 
    197207      INTEGER              , INTENT(in   )           ::   kiv   !  
    198       INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions 
    199       INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions 
     208      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of each dimension 
     209      INTEGER              , INTENT(  out), OPTIONAL ::   kndims   ! number of dimensions 
    200210      LOGICAL              , INTENT(  out), OPTIONAL ::   lduld    ! true if the last dimension is unlimited (time) 
    201211      ! 
     
    584594         IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0 
    585595         ELSEIF( PRESENT(pv_r1d) ) THEN 
    586             IF( SIZE(pv_r1d,1) == jpk ) THEN   ;   idim3 = 3 
    587             ELSE                               ;   idim3 = 5 
     596            IF(( SIZE(pv_r1d,1) == jpk ).OR.( SIZE(pv_r1d,1) == jpka )) THEN   ;   idim3 = 3 
     597            ELSE                                                               ;   idim3 = 5 
    588598            ENDIF 
    589599                                              idims = 2   ;   idimid(1:idims) = (/idim3,4/) 
    590600         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/) 
    591601         ELSEIF( PRESENT(pv_r3d) ) THEN 
    592             IF( SIZE(pv_r3d,3) == jpk ) THEN   ;   idim3 = 3 
    593             ELSE                               ;   idim3 = 5 
     602            IF(( SIZE(pv_r3d,3) == jpk ).OR.( SIZE(pv_r3d,3) == jpka )) THEN   ;   idim3 = 3 
     603            ELSE                                                               ;   idim3 = 5 
    594604            ENDIF 
    595605                                              idims = 4   ;   idimid(1:idims) = (/1,2,idim3,4/) 
     
    674684               CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo ) 
    675685               CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo ) 
    676                CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gdept_1d       ), clinfo ) 
     686               IF (iom_file(kiomid)%nlev == jpka) THEN   ;   CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy,  ght_abl), clinfo ) 
     687               ELSE                                      ;   CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gdept_1d), clinfo ) 
     688               ENDIF 
    677689               IF( NF90_INQ_VARID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN 
    678690                  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

    r10425 r12182  
    5252   SUBROUTINE obs_avg_h2d_init( kpk, kpk2, kmaxifp, kmaxjfp, k2dint, plam,  pphi, & 
    5353      &                         pglam, pgphi, pglamf, pgphif, pmask, plamscl, pphiscl, lindegrees, & 
    54       &                         pweig, pobsmask, iminpoints ) 
     54      &                         pweig, iminpoints ) 
    5555      !!----------------------------------------------------------------------- 
    5656      !! 
     
    9898      REAL(KIND=wp), DIMENSION(kmaxifp,kmaxjfp,kpk2), INTENT(OUT) ::  & 
    9999         & pweig                ! Weights for averaging 
    100       REAL(KIND=wp), DIMENSION(kpk2), INTENT(OUT) ::  & 
    101          & pobsmask             ! Vertical mask for observations 
    102100      INTEGER, INTENT(IN), OPTIONAL :: & 
    103101         & iminpoints           ! Reject point which is not surrounded 
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/OBS/obs_oper.F90

    r10068 r12182  
    342342            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,     & 
    343343               &                   zglam2(:,:,iobs), zgphi2(:,:,iobs), & 
    344                &                   zmask2(:,:,1,iobs), zweig2, zmsk_2 ) 
     344               &                   zmask2(:,:,1,iobs), zweig2, zmsk_2) 
    345345  
    346346         ENDIF 
     
    924924               &                   zglamf(:,:,iobs), zgphif(:,:,iobs), & 
    925925               &                   zmask(:,:,iobs), plamscl, pphiscl, & 
    926                &                   lindegrees, zweig, zobsmask ) 
     926               &                   lindegrees, zweig ) 
    927927 
    928928            ! Average the model SST to the observation footprint 
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/cpl_oasis3.F90

    r10582 r12182  
    114114      !------------------------------------------------------------------ 
    115115      CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror ) 
    116       IF ( nerror /= OASIS_Ok ) & 
     116      IF( nerror /= OASIS_Ok ) & 
    117117         CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') 
    118118 
     
    122122 
    123123      CALL oasis_get_localcomm ( kl_comm, nerror ) 
    124       IF ( nerror /= OASIS_Ok ) & 
     124      IF( nerror /= OASIS_Ok ) & 
    125125         CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 
    126126      ! 
     
    149149 
    150150      ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 
    151       IF ( ltmp_wapatch ) THEN 
     151      IF( ltmp_wapatch ) THEN 
    152152         nldi_save = nldi   ;   nlei_save = nlei 
    153153         nldj_save = nldj   ;   nlej_save = nlej 
     
    217217      ! 
    218218      DO ji = 1, ksnd 
    219          IF ( ssnd(ji)%laction ) THEN 
     219         IF( ssnd(ji)%laction ) THEN 
    220220 
    221221            IF( ssnd(ji)%nct > nmaxcat ) THEN 
     
    228228               DO jm = 1, kcplmodel 
    229229 
    230                   IF ( ssnd(ji)%nct .GT. 1 ) THEN 
     230                  IF( ssnd(ji)%nct .GT. 1 ) THEN 
    231231                     WRITE(cli2,'(i2.2)') jc 
    232232                     zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2 
     
    234234                     zclname = ssnd(ji)%clname 
    235235                  ENDIF 
    236                   IF ( kcplmodel  > 1 ) THEN 
     236                  IF( kcplmodel  > 1 ) THEN 
    237237                     WRITE(cli2,'(i2.2)') jm 
    238238                     zclname = 'model'//cli2//'_'//TRIM(zclname) 
     
    241241                  IF( agrif_fixed() /= 0 ) THEN  
    242242                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
    243                   END IF 
     243                  ENDIF 
    244244#endif 
    245245                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out 
    246246                  CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 1 /),   & 
    247247                     &                OASIS_Out          , ishape , OASIS_REAL, nerror ) 
    248                   IF ( nerror /= OASIS_Ok ) THEN 
     248                  IF( nerror /= OASIS_Ok ) THEN 
    249249                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 
    250250                     CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 
     
    262262      ! 
    263263      DO ji = 1, krcv 
    264          IF ( srcv(ji)%laction ) THEN  
     264         IF( srcv(ji)%laction ) THEN  
    265265             
    266266            IF( srcv(ji)%nct > nmaxcat ) THEN 
     
    273273               DO jm = 1, kcplmodel 
    274274                   
    275                   IF ( srcv(ji)%nct .GT. 1 ) THEN 
     275                  IF( srcv(ji)%nct .GT. 1 ) THEN 
    276276                     WRITE(cli2,'(i2.2)') jc 
    277277                     zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2 
     
    279279                     zclname = srcv(ji)%clname 
    280280                  ENDIF 
    281                   IF ( kcplmodel  > 1 ) THEN 
     281                  IF( kcplmodel  > 1 ) THEN 
    282282                     WRITE(cli2,'(i2.2)') jm 
    283283                     zclname = 'model'//cli2//'_'//TRIM(zclname) 
     
    286286                  IF( agrif_fixed() /= 0 ) THEN  
    287287                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
    288                   END IF 
     288                  ENDIF 
    289289#endif 
    290290                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 
    291291                  CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 1 /),   & 
    292292                     &                OASIS_In           , ishape , OASIS_REAL, nerror ) 
    293                   IF ( nerror /= OASIS_Ok ) THEN 
     293                  IF( nerror /= OASIS_Ok ) THEN 
    294294                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 
    295295                     CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 
     
    310310      IF( nerror /= OASIS_Ok )   CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 
    311311      ! 
    312       IF ( ltmp_wapatch ) THEN 
     312      IF( ltmp_wapatch ) THEN 
    313313         nldi = nldi_save   ;   nlei = nlei_save 
    314314         nldj = nldj_save   ;   nlej = nlej_save 
     
    332332      !!-------------------------------------------------------------------- 
    333333      ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 
    334       IF ( ltmp_wapatch ) THEN 
     334      IF( ltmp_wapatch ) THEN 
    335335         nldi_save = nldi   ;   nlei_save = nlei 
    336336         nldj_save = nldj   ;   nlej_save = nlej 
     
    349349               CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 
    350350                
    351                IF ( ln_ctl ) THEN         
    352                   IF ( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   & 
     351               IF( ln_ctl ) THEN         
     352                  IF( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   & 
    353353                     & kinfo == OASIS_SentOut  .OR. kinfo == OASIS_ToRestOut ) THEN 
    354354                     WRITE(numout,*) '****************' 
     
    368368         ENDDO 
    369369      ENDDO 
    370       IF ( ltmp_wapatch ) THEN 
     370      IF( ltmp_wapatch ) THEN 
    371371         nldi = nldi_save   ;   nlei = nlei_save 
    372372         nldj = nldj_save   ;   nlej = nlej_save 
     
    393393      !!-------------------------------------------------------------------- 
    394394      ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 
    395       IF ( ltmp_wapatch ) THEN 
     395      IF( ltmp_wapatch ) THEN 
    396396         nldi_save = nldi   ;   nlei_save = nlei 
    397397         nldj_save = nldj   ;   nlej_save = nlej 
     
    403403      ! 
    404404      DO jc = 1, srcv(kid)%nct 
    405          IF ( ltmp_wapatch ) THEN 
     405         IF( ltmp_wapatch ) THEN 
    406406            IF( nimpp           ==      1 ) nldi = 1 
    407407            IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 
     
    420420                  &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
    421421                
    422                IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
     422               IF( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
    423423                
    424                IF ( llaction ) THEN 
     424               IF( llaction ) THEN 
    425425                   
    426426                  kinfo = OASIS_Rcv 
     
    432432                  ENDIF 
    433433                   
    434                   IF ( ln_ctl ) THEN         
     434                  IF( ln_ctl ) THEN         
    435435                     WRITE(numout,*) '****************' 
    436436                     WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 
     
    450450         ENDDO 
    451451 
    452          IF ( ltmp_wapatch ) THEN 
     452         IF( ltmp_wapatch ) THEN 
    453453            nldi = nldi_save   ;   nlei = nlei_save 
    454454            nldj = nldj_save   ;   nlej = nlej_save 
     
    483483      ! 
    484484      DO ji = 1, nsnd 
    485          IF (ssnd(ji)%laction ) THEN 
     485         IF(ssnd(ji)%laction ) THEN 
    486486            DO jm = 1, ncplmodel 
    487487               IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN 
     
    495495      ENDDO 
    496496      DO ji = 1, nrcv 
    497          IF (srcv(ji)%laction ) THEN 
     497         IF(srcv(ji)%laction ) THEN 
    498498            DO jm = 1, ncplmodel 
    499499               IF( srcv(ji)%nid(1,jm) /= -1 ) THEN 
     
    529529      ! 
    530530      DEALLOCATE( exfld ) 
    531       IF (nstop == 0) THEN 
     531      IF(nstop == 0) THEN 
    532532         CALL oasis_terminate( nerror )          
    533533      ELSE 
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/cyclone.F90

    r10068 r12182  
    137137            zhemi = SIGN( 1. , zrlat ) 
    138138            zinfl = 15.* rad                             ! clim inflow angle in Tropical Cyclones 
    139          IF ( vortex == 0 ) THEN 
     139         IF( vortex == 0 ) THEN 
    140140 
    141141            ! Vortex Holland reconstruct wind at each lon-lat position 
     
    157157                     &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) ) 
    158158 
    159                  IF (zdist < zrout2) THEN ! calculation of wind only to a given max radius 
     159                 IF(zdist < zrout2) THEN ! calculation of wind only to a given max radius 
    160160                  ! shape of the wind profile 
    161161                  zztmp = ( zrmw / ( zdist + 1.e-12 ) )**zb 
    162162                  zztmp =  zvmax * SQRT( zztmp * EXP(1. - zztmp) )     
    163163 
    164                   IF (zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2 
     164                  IF(zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2 
    165165                     zztmp = zztmp * ( (zrout2-zdist)*1.e-6 ) 
    166166                  ENDIF 
    167167 
    168168                  ! !!! KILL EQ WINDS 
    169                   ! IF (SIGN( 1. , zrlat ) /= zhemi) THEN 
     169                  ! IF(SIGN( 1. , zrlat ) /= zhemi) THEN 
    170170                  !    zztmp = 0.                              ! winds in other hemisphere 
    171                   !    IF (ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S 
    172                   ! ENDIF 
    173                   ! IF (ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN 
     171                  !    IF(ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S 
     172                  ! ENDIF 
     173                  ! IF(ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN 
    174174                  !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) )  
    175175                  !    !linear to zero between 10 and 5 
     
    177177                  ! !!! / KILL EQ 
    178178 
    179                   IF (ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude 
     179                  IF(ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude 
    180180 
    181181                  zwnd_t =   COS( zinfl ) * zztmp     
     
    196196            END DO 
    197197          
    198          ELSE IF ( vortex == 1 ) THEN 
     198         ELSE IF( vortex == 1 ) THEN 
    199199 
    200200            ! Vortex Willoughby reconstruct wind at each lon-lat position 
     
    206206            zn   =   2.1340 + 0.0077*zvmax - 0.4522*LOG(zrmw/1000.) - 0.0038*ABS( ztct(jtc,jp_lat) )             
    207207            zA   =   0.5913 + 0.0029*zvmax - 0.1361*LOG(zrmw/1000.) - 0.0042*ABS( ztct(jtc,jp_lat) )   
    208             IF (zA < 0) THEN  
     208            IF(zA < 0) THEN  
    209209               zA=0 
    210210            ENDIF            
     
    218218                     &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) ) 
    219219 
    220                  IF (zdist < zrout2) THEN ! calculation of wind only to a given max radius 
     220                 IF(zdist < zrout2) THEN ! calculation of wind only to a given max radius 
    221221                
    222222                  ! shape of the wind profile                      
    223                   IF (zdist <= zrmw) THEN     ! inside the Radius of Maximum Wind 
     223                  IF(zdist <= zrmw) THEN     ! inside the Radius of Maximum Wind 
    224224                     zztmp  = zvmax * (zdist/zrmw)**zn 
    225225                  ELSE  
     
    227227                  ENDIF 
    228228 
    229                   IF (zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2 
     229                  IF(zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2 
    230230                     zztmp = zztmp * ( (zrout2-zdist)*1.e-6 ) 
    231231                  ENDIF 
    232232 
    233233                  ! !!! KILL EQ WINDS 
    234                   ! IF (SIGN( 1. , zrlat ) /= zhemi) THEN 
     234                  ! IF(SIGN( 1. , zrlat ) /= zhemi) THEN 
    235235                  !    zztmp = 0.                              ! winds in other hemisphere 
    236                   !    IF (ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S 
    237                   ! ENDIF 
    238                   ! IF (ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN 
     236                  !    IF(ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S 
     237                  ! ENDIF 
     238                  ! IF(ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN 
    239239                  !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) )  
    240240                  !    !linear to zero between 10 and 5 
     
    242242                  ! !!! / KILL EQ 
    243243 
    244                   IF (ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude 
     244                  IF(ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude 
    245245 
    246246                  zwnd_t =   COS( zinfl ) * zztmp     
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/fldread.F90

    r11949 r12182  
    168168      IF( PRESENT(kit) )   ll_firstcall = ll_firstcall .and. kit == 1 
    169169 
    170       IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
     170      IF( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
    171171      ELSE                                      ;   it_offset = 0 
    172172      ENDIF 
     
    391391         ENDIF 
    392392         ! 
    393          IF ( sdjf%cltype(1:4) == 'week' ) THEN 
     393         IF( sdjf%cltype(1:4) == 'week' ) THEN 
    394394            isec_week = isec_week + ksec_week( sdjf%cltype(6:8) )   ! second since the beginning of the week 
    395395            llprevmth = isec_week > nsec_month                      ! longer time since the beginning of the week than the month 
     
    466466      ENDIF 
    467467      ! 
    468       IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
     468      IF( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
    469469      ELSE                                      ;   it_offset = 0 
    470470      ENDIF 
     
    659659            ENDIF 
    660660         CASE DEFAULT 
    661             IF (lk_c1d .AND. lmoor ) THEN 
     661            IF(lk_c1d .AND. lmoor ) THEN 
    662662               IF( sdjf%ln_tint ) THEN 
    663663                  CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(2,2,:,2), sdjf%nrec_a(1) ) 
     
    10741074         imonth = kmonth 
    10751075         iday = kday 
    1076          IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week 
     1076         IF( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week 
    10771077            isec_week = ksec_week( sdjf%cltype(6:8) )- (86400 * 8 )   
    10781078            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month 
     
    10831083         ENDIF 
    10841084      ELSE                                                  ! use current day values 
    1085          IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week 
     1085         IF( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week 
    10861086            isec_week  = ksec_week( sdjf%cltype(6:8) )      ! second since the beginning of the week 
    10871087            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month 
     
    13211321 
    13221322      !! get dimensions 
    1323       IF ( SIZE(sd%fnow, 3) > 1 ) THEN 
     1323      !!GS: we consider 2D data as 3D data with vertical dim size = 1 
     1324      !IF( SIZE(sd%fnow, 3) > 1 ) THEN 
     1325      IF( SIZE(sd%fnow, 3) > 0 ) THEN 
    13241326         ALLOCATE( ddims(4) ) 
    13251327      ELSE 
     
    13341336 
    13351337      CALL iom_open ( sd%wgtname, inum )   ! interpolation weights 
    1336       IF ( inum > 0 ) THEN 
     1338      IF( inum > 0 ) THEN 
    13371339 
    13381340         !! determine whether we have an east-west cyclic grid 
     
    16431645          
    16441646         ref_wgts(kw)%fly_dta(:,:,:) = 0.0 
    1645          SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) ) 
    1646          CASE(1) 
    1647               CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn) 
    1648          CASE DEFAULT 
     1647         !!GS: we consider 2D data as 3D data with vertical dim size = 1  
     1648         !SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) ) 
     1649         !CASE(1) 
     1650         !     CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn) 
     1651         !CASE DEFAULT 
    16491652              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn) 
    1650          END SELECT  
     1653         !END SELECT  
    16511654      ENDIF 
    16521655       
     
    16661669      END DO 
    16671670 
    1668       IF (ref_wgts(kw)%numwgt .EQ. 16) THEN 
     1671      IF(ref_wgts(kw)%numwgt .EQ. 16) THEN 
    16691672 
    16701673        !! fix up halo points that we couldnt read from file 
     
    16921695           IF( jpi1 == 2 ) THEN 
    16931696              rec1(1) = ref_wgts(kw)%ddims(1) - ref_wgts(kw)%overlap 
    1694               SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) ) 
    1695               CASE(1) 
    1696                    CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn) 
    1697               CASE DEFAULT 
     1697              !!GS: we consider 2D data as 3D data with vertical dim size = 1 
     1698              !SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) ) 
     1699              !CASE(1) 
     1700              !     CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn) 
     1701              !CASE DEFAULT 
    16981702                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn) 
    1699               END SELECT       
     1703              !END SELECT       
    17001704              ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:) 
    17011705           ENDIF 
    17021706           IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
    17031707              rec1(1) = 1 + ref_wgts(kw)%overlap 
    1704               SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) ) 
    1705               CASE(1) 
    1706                    CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn) 
    1707               CASE DEFAULT 
     1708              !!GS: we consider 2D data as 3D data with vertical dim size = 1 
     1709              !SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) ) 
     1710              !CASE(1) 
     1711              !     CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn) 
     1712              !CASE DEFAULT 
    17081713                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn) 
    1709               END SELECT 
     1714              !END SELECT 
    17101715              ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:) 
    17111716           ENDIF 
     
    17491754         END DO 
    17501755         ! 
    1751       END IF 
     1756      ENDIF 
    17521757      ! 
    17531758   END SUBROUTINE fld_interp 
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbc_oce.F90

    r12150 r12182  
    1111   !!            4.0  ! 2012-05  (C. Rousset) add attenuation coef for use in ice model  
    1212   !!            4.0  ! 2016-06  (L. Brodeau) new unified bulk routine (based on AeroBulk) 
     13   !!            4.0  ! 2019-03  (F. Lemarié, G. Samson) add compatibility with ABL mode     
    1314   !!---------------------------------------------------------------------- 
    1415 
     
    3435   LOGICAL , PUBLIC ::   ln_flx         !: flux      formulation 
    3536   LOGICAL , PUBLIC ::   ln_blk         !: bulk formulation 
     37   LOGICAL , PUBLIC ::   ln_abl         !: Atmospheric boundary layer model 
    3638#if defined key_oasis3 
    3739   LOGICAL , PUBLIC ::   lk_oasis = .TRUE.  !: OASIS used 
     
    7678   INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux                          formulation 
    7779   INTEGER , PUBLIC, PARAMETER ::   jp_blk     = 3        !: bulk                          formulation 
    78    INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 4        !: Pure ocean-atmosphere Coupled formulation 
    79    INTEGER , PUBLIC, PARAMETER ::   jp_none    = 5        !: for OPA when doing coupling via SAS module 
     80   INTEGER , PUBLIC, PARAMETER ::   jp_abl     = 4        !: Atmospheric boundary layer    formulation 
     81   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 5        !: Pure ocean-atmosphere Coupled formulation 
     82   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 6        !: for OPA when doing coupling via SAS module 
    8083    
    8184   !!---------------------------------------------------------------------- 
     
    106109   INTEGER , PUBLIC ::  ncpl_qsr_freq            !: qsr coupling frequency per days from atmosphere 
    107110   ! 
    108    LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress) 
    109111   !!                                   !!   now    ! before   !! 
    110112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2] 
    111113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vtau   , vtau_b   !: sea surface j-stress (ocean referential)     [N/m2] 
    112114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   taum              !: module of sea surface stress (at T-point)    [N/m2]  
    113    !! wndm is used onmpute surface gases exchanges in ice-free ocean or leads 
     115   !! wndm is used compute surface gases exchanges in ice-free ocean or leads 
    114116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s] 
     117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rhoa              !: air density at "rn_zu" m above the sea       [kg/m3] !LB 
    115118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr               !: sea heat flux:     solar                     [W/m2] 
    116119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2] 
     
    134137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask          !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) 
    135138 
     139   !!--------------------------------------------------------------------- 
     140   !! ABL Vertical Domain size   
     141   !!--------------------------------------------------------------------- 
     142   INTEGER , PUBLIC            ::   jpka   = 2     !: ABL number of vertical levels (default definition) 
     143   INTEGER , PUBLIC            ::   jpkam1 = 1     !: jpka-1 
     144   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   ght_abl, ghw_abl          !: ABL geopotential height (needed for iom) 
     145   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   e3t_abl, e3w_abl          !: ABL vertical scale factors (needed for iom) 
     146 
    136147   !!---------------------------------------------------------------------- 
    137148   !!                     Sea Surface Mean fields 
     
    164175      ! 
    165176      ALLOCATE( utau(jpi,jpj) , utau_b(jpi,jpj) , taum(jpi,jpj) ,     & 
    166          &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , STAT=ierr(1) )  
     177         &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , rhoa(jpi,jpj) , STAT=ierr(1) )  
    167178         ! 
    168179      ALLOCATE( qns_tot(jpi,jpj) , qns  (jpi,jpj) , qns_b(jpi,jpj),        & 
     
    179190         &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      & 
    180191         &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 
    181          ! 
     192      ! 
    182193      ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) ) 
    183          ! 
     194      ! 
    184195      sbc_oce_alloc = MAXVAL( ierr ) 
    185196      CALL mpp_sum ( 'sbc_oce', sbc_oce_alloc ) 
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcapr.F90

    r11960 r12182  
    101101      ! 
    102102      !                                            !* control check 
    103       IF ( ln_apr_obc  ) THEN 
     103      IF( ln_apr_obc  ) THEN 
    104104         IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data' 
    105105      ENDIF 
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcblk.F90

    r11960 r12182  
    1515   !!            3.7  !  2014-06  (L. Brodeau)  simplification and optimization of CORE bulk 
    1616   !!            4.0  !  2016-06  (L. Brodeau)  sbcblk_core becomes sbcblk and is not restricted to the CORE algorithm anymore 
    17    !!                 !                        ==> based on AeroBulk (http://aerobulk.sourceforge.net/) 
     17   !!                 !                        ==> based on AeroBulk (https://github.com/brodeau/aerobulk/) 
    1818   !!            4.0  !  2016-10  (G. Madec)  introduce a sbc_blk_init routine 
    19    !!            4.0  !  2016-10  (M. Vancoppenolle)  Introduce conduction flux emulator (M. Vancoppenolle)  
     19   !!            4.0  !  2016-10  (M. Vancoppenolle)  Introduce conduction flux emulator (M. Vancoppenolle) 
     20   !!            4.0  !  2019-03  (F. Lemarié & G. Samson)  add ABL compatibility (ln_abl=TRUE) 
    2021   !!---------------------------------------------------------------------- 
    2122 
     
    2324   !!   sbc_blk_init  : initialisation of the chosen bulk formulation as ocean surface boundary condition 
    2425   !!   sbc_blk       : bulk formulation as ocean surface boundary condition 
    25    !!   blk_oce       : computes momentum, heat and freshwater fluxes over ocean 
    26    !!   rho_air       : density of (moist) air (depends on T_air, q_air and SLP 
    27    !!   cp_air        : specific heat of (moist) air (depends spec. hum. q_air) 
    28    !!   q_sat         : saturation humidity as a function of SLP and temperature 
    29    !!   L_vap         : latent heat of vaporization of water as a function of temperature 
    30    !!             sea-ice case only :  
    31    !!   blk_ice_tau   : provide the air-ice stress 
    32    !!   blk_ice_flx   : provide the heat and mass fluxes at air-ice interface 
     26   !!   blk_oce_1     : computes pieces of momentum, heat and freshwater fluxes over ocean for ABL model  (ln_abl=TRUE) 
     27   !!   blk_oce_2     : finalizes momentum, heat and freshwater fluxes computation over ocean after the ABL step  (ln_abl=TRUE) 
     28   !!             sea-ice case only : 
     29   !!   blk_ice_1   : provide the air-ice stress 
     30   !!   blk_ice_2   : provide the heat and mass fluxes at air-ice interface 
    3331   !!   blk_ice_qcn   : provide ice surface temperature and snow/ice conduction flux (emulating conduction flux) 
    3432   !!   Cdn10_Lupkes2012 : Lupkes et al. (2012) air-ice drag 
    35    !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag  
     33   !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag 
    3634   !!---------------------------------------------------------------------- 
    3735   USE oce            ! ocean dynamics and tracers 
     
    4644   USE lib_fortran    ! to use key_nosignedzero 
    4745#if defined key_si3 
    48    USE ice     , ONLY :   u_ice, v_ice, jpl, a_i_b, at_i_b, t_su, rn_cnd_s, hfx_err_dif 
     46   USE ice     , ONLY :   jpl, a_i_b, at_i_b, rn_cnd_s, hfx_err_dif 
    4947   USE icethd_dh      ! for CALL ice_thd_snwblow 
    5048#endif 
    51    USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009)  
    52    USE sbcblk_algo_coare    ! => turb_coare    : COAREv3.0 (Fairall et al. 2003)  
    53    USE sbcblk_algo_coare3p5 ! => turb_coare3p5 : COAREv3.5 (Edson et al. 2013) 
    54    USE sbcblk_algo_ecmwf    ! => turb_ecmwf    : ECMWF (IFS cycle 31)  
     49   USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009) 
     50   USE sbcblk_algo_coare3p0 ! => turb_coare3p0 : COAREv3.0 (Fairall et al. 2003) 
     51   USE sbcblk_algo_coare3p6 ! => turb_coare3p6 : COAREv3.6 (Fairall et al. 2018 + Edson et al. 2013) 
     52   USE sbcblk_algo_ecmwf    ! => turb_ecmwf    : ECMWF (IFS cycle 45r1) 
    5553   ! 
    5654   USE iom            ! I/O manager library 
     
    6058   USE prtctl         ! Print control 
    6159 
     60   USE sbcblk_phy     ! a catalog of functions for physical/meteorological parameters in the marine boundary layer, rho_air, q_sat, etc... 
     61 
     62 
    6263   IMPLICIT NONE 
    6364   PRIVATE 
     
    6566   PUBLIC   sbc_blk_init  ! called in sbcmod 
    6667   PUBLIC   sbc_blk       ! called in sbcmod 
     68   PUBLIC   blk_oce_1     ! called in sbcabl 
     69   PUBLIC   blk_oce_2     ! called in sbcabl 
    6770#if defined key_si3 
    68    PUBLIC   blk_ice_tau   ! routine called in icesbc 
    69    PUBLIC   blk_ice_flx   ! routine called in icesbc 
     71   PUBLIC   blk_ice_   ! routine called in icesbc 
     72   PUBLIC   blk_ice_   ! routine called in icesbc 
    7073   PUBLIC   blk_ice_qcn   ! routine called in icesbc 
    71 #endif  
    72  
    73 !!Lolo: should ultimately be moved in the module with all physical constants ? 
    74 !!gm  : In principle, yes. 
    75    REAL(wp), PARAMETER ::   Cp_dry = 1005.0       !: Specic heat of dry air, constant pressure      [J/K/kg] 
    76    REAL(wp), PARAMETER ::   Cp_vap = 1860.0       !: Specic heat of water vapor, constant pressure  [J/K/kg] 
    77    REAL(wp), PARAMETER ::   R_dry = 287.05_wp     !: Specific gas constant for dry air              [J/K/kg] 
    78    REAL(wp), PARAMETER ::   R_vap = 461.495_wp    !: Specific gas constant for water vapor          [J/K/kg] 
    79    REAL(wp), PARAMETER ::   reps0 = R_dry/R_vap   !: ratio of gas constant for dry air and water vapor => ~ 0.622 
    80    REAL(wp), PARAMETER ::   rctv0 = R_vap/R_dry   !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 
    81  
    82    INTEGER , PARAMETER ::   jpfld   =10           ! maximum number of files to read 
    83    INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point 
    84    INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point 
    85    INTEGER , PARAMETER ::   jp_tair = 3           ! index of 10m air temperature             (Kelvin) 
    86    INTEGER , PARAMETER ::   jp_humi = 4           ! index of specific humidity               ( % ) 
    87    INTEGER , PARAMETER ::   jp_qsr  = 5           ! index of solar heat                      (W/m2) 
    88    INTEGER , PARAMETER ::   jp_qlw  = 6           ! index of Long wave                       (W/m2) 
    89    INTEGER , PARAMETER ::   jp_prec = 7           ! index of total precipitation (rain+snow) (Kg/m2/s) 
    90    INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s) 
    91    INTEGER , PARAMETER ::   jp_slp  = 9           ! index of sea level pressure              (Pa) 
    92    INTEGER , PARAMETER ::   jp_tdif =10           ! index of tau diff associated to HF tau   (N/m2)   at T-point 
    93  
    94    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read) 
    95  
    96    !                                             !!! Bulk parameters 
    97    REAL(wp), PARAMETER ::   cpa    = 1000.5         ! specific heat of air (only used for ice fluxes now...) 
    98    REAL(wp), PARAMETER ::   Ls     =    2.839e6     ! latent heat of sublimation 
    99    REAL(wp), PARAMETER ::   Stef   =    5.67e-8     ! Stefan Boltzmann constant 
    100    REAL(wp), PARAMETER ::   Cd_ice =    1.4e-3      ! transfer coefficient over ice 
    101    REAL(wp), PARAMETER ::   albo   =    0.066       ! ocean albedo assumed to be constant 
    102    ! 
     74#endif 
     75 
     76   INTEGER , PUBLIC            ::   jpfld         ! maximum number of files to read 
     77   INTEGER , PUBLIC, PARAMETER ::   jp_wndi = 1   ! index of 10m wind velocity (i-component) (m/s)    at T-point 
     78   INTEGER , PUBLIC, PARAMETER ::   jp_wndj = 2   ! index of 10m wind velocity (j-component) (m/s)    at T-point 
     79   INTEGER , PUBLIC, PARAMETER ::   jp_tair = 3   ! index of 10m air temperature             (Kelvin) 
     80   INTEGER , PUBLIC, PARAMETER ::   jp_humi = 4   ! index of specific humidity               ( % ) 
     81   INTEGER , PUBLIC, PARAMETER ::   jp_qsr  = 5   ! index of solar heat                      (W/m2) 
     82   INTEGER , PUBLIC, PARAMETER ::   jp_qlw  = 6   ! index of Long wave                       (W/m2) 
     83   INTEGER , PUBLIC, PARAMETER ::   jp_prec = 7   ! index of total precipitation (rain+snow) (Kg/m2/s) 
     84   INTEGER , PUBLIC, PARAMETER ::   jp_snow = 8   ! index of snow (solid prcipitation)       (kg/m2/s) 
     85   INTEGER , PUBLIC, PARAMETER ::   jp_slp  = 9   ! index of sea level pressure              (Pa) 
     86   INTEGER , PUBLIC, PARAMETER ::   jp_hpgi =10   ! index of ABL geostrophic wind or hpg (i-component) (m/s) at T-point 
     87   INTEGER , PUBLIC, PARAMETER ::   jp_hpgj =11   ! index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point 
     88 
     89   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input atmospheric fields (file informations, fields read) 
     90 
    10391   !                           !!* Namelist namsbc_blk : bulk parameters 
    10492   LOGICAL  ::   ln_NCAR        ! "NCAR"      algorithm   (Large and Yeager 2008) 
    10593   LOGICAL  ::   ln_COARE_3p0   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
    106    LOGICAL  ::   ln_COARE_3p5   ! "COARE 3.5" algorithm   (Edson et al. 2013) 
    107    LOGICAL  ::   ln_ECMWF       ! "ECMWF"     algorithm   (IFS cycle 31) 
     94   LOGICAL  ::   ln_COARE_3p6   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
     95   LOGICAL  ::   ln_ECMWF       ! "ECMWF"     algorithm   (IFS cycle 45r1) 
    10896   ! 
    109    LOGICAL  ::   ln_taudif      ! logical flag to use the "mean of stress module - module of mean stress" data 
    110    REAL(wp) ::   rn_pfac        ! multiplication factor for precipitation 
    111    REAL(wp) ::   rn_efac        ! multiplication factor for evaporation 
    112    REAL(wp) ::   rn_vfac        ! multiplication factor for ice/ocean velocity in the calculation of wind stress 
    113    REAL(wp) ::   rn_zqt         ! z(q,t) : height of humidity and temperature measurements 
    114    REAL(wp) ::   rn_zu          ! z(u)   : height of wind measurements 
    115 !!gm ref namelist initialize it so remove the setting to false below 
    116    LOGICAL  ::   ln_Cd_L12 = .FALSE. !  Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2012) 
    117    LOGICAL  ::   ln_Cd_L15 = .FALSE. !  Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2015) 
     97   LOGICAL  ::   ln_Cd_L12      ! ice-atm drag = F( ice concentration )                        (Lupkes et al. JGR2012) 
     98   LOGICAL  ::   ln_Cd_L15      ! ice-atm drag = F( ice concentration, atmospheric stability ) (Lupkes et al. JGR2015) 
    11899   ! 
    119    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Cd_atm                    ! transfer coefficient for momentum      (tau) 
    120    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Ch_atm                    ! transfer coefficient for sensible heat (Q_sens) 
    121    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Ce_atm                    ! tansfert coefficient for evaporation   (Q_lat) 
    122    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_zu                      ! air temperature at wind speed height (needed by Lupkes 2015 bulk scheme) 
    123    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_zu                      ! air spec. hum.  at wind speed height (needed by Lupkes 2015 bulk scheme) 
    124    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   cdn_oce, chn_oce, cen_oce ! needed by Lupkes 2015 bulk scheme 
     100   REAL(wp)         ::   rn_pfac   ! multiplication factor for precipitation 
     101   REAL(wp), PUBLIC ::   rn_efac   ! multiplication factor for evaporation 
     102   REAL(wp), PUBLIC ::   rn_vfac   ! multiplication factor for ice/ocean velocity in the calculation of wind stress 
     103   REAL(wp)         ::   rn_zqt    ! z(q,t) : height of humidity and temperature measurements 
     104   REAL(wp)         ::   rn_zu     ! z(u)   : height of wind measurements 
     105   ! 
     106   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   Cd_ice , Ch_ice , Ce_ice   ! transfert coefficients over ice 
     107   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   Cdn_oce, Chn_oce, Cen_oce  ! neutral coeffs over ocean (L15 bulk scheme) 
     108   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   t_zu, q_zu                 ! air temp. and spec. hum. at wind speed height (L15 bulk scheme) 
     109 
     110   LOGICAL  ::   ln_skin_cs     ! use the cool-skin (only available in ECMWF and COARE algorithms) !LB 
     111   LOGICAL  ::   ln_skin_wl     ! use the warm-layer parameterization (only available in ECMWF and COARE algorithms) !LB 
     112   LOGICAL  ::   ln_humi_sph    ! humidity read in files ("sn_humi") is specific humidity [kg/kg] if .true. !LB 
     113   LOGICAL  ::   ln_humi_dpt    ! humidity read in files ("sn_humi") is dew-point temperature [K] if .true. !LB 
     114   LOGICAL  ::   ln_humi_rlh    ! humidity read in files ("sn_humi") is relative humidity     [%] if .true. !LB 
     115   ! 
     116   INTEGER  ::   nhumi          ! choice of the bulk algorithm 
     117   !                            ! associated indices: 
     118   INTEGER, PARAMETER :: np_humi_sph = 1 
     119   INTEGER, PARAMETER :: np_humi_dpt = 2 
     120   INTEGER, PARAMETER :: np_humi_rlh = 3 
    125121 
    126122   INTEGER  ::   nblk           ! choice of the bulk algorithm 
     
    128124   INTEGER, PARAMETER ::   np_NCAR      = 1   ! "NCAR" algorithm        (Large and Yeager 2008) 
    129125   INTEGER, PARAMETER ::   np_COARE_3p0 = 2   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
    130    INTEGER, PARAMETER ::   np_COARE_3p5 = 3   ! "COARE 3.5" algorithm   (Edson et al. 2013) 
    131    INTEGER, PARAMETER ::   np_ECMWF     = 4   ! "ECMWF" algorithm       (IFS cycle 31) 
     126   INTEGER, PARAMETER ::   np_COARE_3p6 = 3   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
     127   INTEGER, PARAMETER ::   np_ECMWF     = 4   ! "ECMWF" algorithm       (IFS cycle 45r1) 
    132128 
    133129   !! * Substitutions 
     
    144140      !!             ***  ROUTINE sbc_blk_alloc *** 
    145141      !!------------------------------------------------------------------- 
    146       ALLOCATE( Cd_atm (jpi,jpj), Ch_atm (jpi,jpj), Ce_atm (jpi,jpj), t_zu(jpi,jpj), q_zu(jpi,jpj), & 
    147          &      cdn_oce(jpi,jpj), chn_oce(jpi,jpj), cen_oce(jpi,jpj), STAT=sbc_blk_alloc ) 
     142      ALLOCATE( t_zu(jpi,jpj)   , q_zu(jpi,jpj)   ,                                      & 
     143         &      Cdn_oce(jpi,jpj), Chn_oce(jpi,jpj), Cen_oce(jpi,jpj),                    & 
     144         &      Cd_ice (jpi,jpj), Ch_ice (jpi,jpj), Ce_ice (jpi,jpj), STAT=sbc_blk_alloc ) 
    148145      ! 
    149146      CALL mpp_sum ( 'sbcblk', sbc_blk_alloc ) 
     
    158155      !! ** Purpose :   choose and initialize a bulk formulae formulation 
    159156      !! 
    160       !! ** Method  :  
     157      !! ** Method  : 
    161158      !! 
    162159      !!---------------------------------------------------------------------- 
    163       INTEGER  ::   ifpr, jfld            ! dummy loop indice and argument 
     160      INTEGER  ::   jfpr                  ! dummy loop indice and argument 
    164161      INTEGER  ::   ios, ierror, ioptio   ! Local integer 
    165162      !! 
    166163      CHARACTER(len=100)            ::   cn_dir                ! Root directory for location of atmospheric forcing files 
    167       TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                 ! array of namelist informations on the fields to read 
     164      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   slf_i        ! array of namelist informations on the fields to read 
    168165      TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr       ! informations about the fields to be read 
    169166      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !       "                        " 
    170       TYPE(FLD_N) ::   sn_slp , sn_tdif                        !       "                        " 
     167      TYPE(FLD_N) ::   sn_slp , sn_hpgi, sn_hpgj               !       "                        " 
    171168      NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw ,                &   ! input fields 
    172          &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif,                & 
    173          &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF,             &   ! bulk algorithm 
    174          &                 cn_dir , ln_taudif, rn_zqt, rn_zu,                         &  
    175          &                 rn_pfac, rn_efac, rn_vfac, ln_Cd_L12, ln_Cd_L15 
     169         &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_hpgi, sn_hpgj,       & 
     170         &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p6, ln_ECMWF,             &   ! bulk algorithm 
     171         &                 cn_dir , rn_zqt, rn_zu,                                    & 
     172         &                 rn_pfac, rn_efac, rn_vfac, ln_Cd_L12, ln_Cd_L15,           & 
     173         &                 ln_skin_cs, ln_skin_wl, ln_humi_sph, ln_humi_dpt, ln_humi_rlh  ! cool-skin / warm-layer !LB 
    176174      !!--------------------------------------------------------------------- 
    177175      ! 
     
    179177      IF( sbc_blk_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk : unable to allocate standard arrays' ) 
    180178      ! 
    181       !                             !** read bulk namelist   
     179      !                             !** read bulk namelist 
    182180      READ  ( numnam_ref, namsbc_blk, IOSTAT = ios, ERR = 901) 
    183181901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_blk in reference namelist' ) 
     
    190188      !                             !** initialization of the chosen bulk formulae (+ check) 
    191189      !                                   !* select the bulk chosen in the namelist and check the choice 
    192                                                                ioptio = 0 
    193       IF( ln_NCAR      ) THEN   ;   nblk =  np_NCAR        ;   ioptio = ioptio + 1   ;   ENDIF 
    194       IF( ln_COARE_3p0 ) THEN   ;   nblk =  np_COARE_3p0   ;   ioptio = ioptio + 1   ;   ENDIF 
    195       IF( ln_COARE_3p5 ) THEN   ;   nblk =  np_COARE_3p5   ;   ioptio = ioptio + 1   ;   ENDIF 
    196       IF( ln_ECMWF     ) THEN   ;   nblk =  np_ECMWF       ;   ioptio = ioptio + 1   ;   ENDIF 
    197       ! 
     190      ioptio = 0 
     191      IF( ln_NCAR      ) THEN 
     192         nblk =  np_NCAR        ;   ioptio = ioptio + 1 
     193      ENDIF 
     194      IF( ln_COARE_3p0 ) THEN 
     195         nblk =  np_COARE_3p0   ;   ioptio = ioptio + 1 
     196      ENDIF 
     197      IF( ln_COARE_3p6 ) THEN 
     198         nblk =  np_COARE_3p6   ;   ioptio = ioptio + 1 
     199      ENDIF 
     200      IF( ln_ECMWF     ) THEN 
     201         nblk =  np_ECMWF       ;   ioptio = ioptio + 1 
     202      ENDIF 
    198203      IF( ioptio /= 1 )   CALL ctl_stop( 'sbc_blk_init: Choose one and only one bulk algorithm' ) 
     204 
     205      !                             !** initialization of the cool-skin / warm-layer parametrization 
     206      IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
     207         !! Some namelist sanity tests: 
     208         IF( ln_NCAR )      & 
     209            & CALL ctl_stop( 'sbc_blk_init: Cool-skin/warm-layer param. not compatible with NCAR algorithm' ) 
     210         IF( nn_fsbc /= 1 ) & 
     211            & CALL ctl_stop( 'sbc_blk_init: Please set "nn_fsbc" to 1 when using cool-skin/warm-layer param.') 
     212      END IF 
     213 
     214      IF( ln_skin_wl ) THEN 
     215         !! Check if the frequency of downwelling solar flux input makes sense and if ln_dm2dc=T if it is daily! 
     216         IF( (sn_qsr%freqh  < 0.).OR.(sn_qsr%freqh  > 24.) ) & 
     217            & CALL ctl_stop( 'sbc_blk_init: Warm-layer param. (ln_skin_wl) not compatible with freq. of solar flux > daily' ) 
     218         IF( (sn_qsr%freqh == 24.).AND.(.NOT. ln_dm2dc) ) & 
     219            & CALL ctl_stop( 'sbc_blk_init: Please set ln_dm2dc=T for warm-layer param. (ln_skin_wl) to work properly' ) 
     220      END IF 
     221 
     222      ioptio = 0 
     223      IF( ln_humi_sph ) THEN 
     224         nhumi =  np_humi_sph    ;   ioptio = ioptio + 1 
     225      ENDIF 
     226      IF( ln_humi_dpt ) THEN 
     227         nhumi =  np_humi_dpt    ;   ioptio = ioptio + 1 
     228      ENDIF 
     229      IF( ln_humi_rlh ) THEN 
     230         nhumi =  np_humi_rlh    ;   ioptio = ioptio + 1 
     231      ENDIF 
     232      IF( ioptio /= 1 )   CALL ctl_stop( 'sbc_blk_init: Choose one and only one type of air humidity' ) 
    199233      ! 
    200234      IF( ln_dm2dc ) THEN                 !* check: diurnal cycle on Qsr 
    201235         IF( sn_qsr%freqh /= 24. )   CALL ctl_stop( 'sbc_blk_init: ln_dm2dc=T only with daily short-wave input' ) 
    202          IF( sn_qsr%ln_tint ) THEN  
     236         IF( sn_qsr%ln_tint ) THEN 
    203237            CALL ctl_warn( 'sbc_blk_init: ln_dm2dc=T daily qsr time interpolation done by sbcdcy module',   & 
    204238               &           '              ==> We force time interpolation = .false. for qsr' ) 
     
    208242      !                                   !* set the bulk structure 
    209243      !                                      !- store namelist information in an array 
     244      IF( ln_blk ) jpfld = 9 
     245      IF( ln_abl ) jpfld = 11 
     246      ALLOCATE( slf_i(jpfld) ) 
     247      ! 
    210248      slf_i(jp_wndi) = sn_wndi   ;   slf_i(jp_wndj) = sn_wndj 
    211249      slf_i(jp_qsr ) = sn_qsr    ;   slf_i(jp_qlw ) = sn_qlw 
    212250      slf_i(jp_tair) = sn_tair   ;   slf_i(jp_humi) = sn_humi 
    213251      slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow 
    214       slf_i(jp_slp)  = sn_slp    ;   slf_i(jp_tdif) = sn_tdif 
    215       ! 
    216       lhftau = ln_taudif                     !- add an extra field if HF stress is used 
    217       jfld = jpfld - COUNT( (/.NOT.lhftau/) ) 
     252      slf_i(jp_slp ) = sn_slp 
     253      IF( ln_abl ) THEN 
     254         slf_i(jp_hpgi) = sn_hpgi   ;   slf_i(jp_hpgj) = sn_hpgj 
     255      END IF 
    218256      ! 
    219257      !                                      !- allocate the bulk structure 
    220       ALLOCATE( sf(jfld), STAT=ierror ) 
     258      ALLOCATE( sf(jpfld), STAT=ierror ) 
    221259      IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_init: unable to allocate sf structure' ) 
    222       DO ifpr= 1, jfld 
    223          ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
    224          IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
    225          IF( slf_i(ifpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(ifpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 )   & 
    226             &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   & 
    227             &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) 
    228  
     260      ! 
     261      DO jfpr= 1, jpfld 
     262         ! 
     263         IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN    !--  not used field  --!   (only now allocated and set to zero) 
     264            ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 
     265            sf(jfpr)%fnow(:,:,1) = 0._wp 
     266         ELSE                                                  !-- used field  --! 
     267            IF(   ln_abl    .AND.                                                      & 
     268               &    ( jfpr == jp_wndi .OR. jfpr == jp_wndj .OR. jfpr == jp_humi .OR.   & 
     269               &      jfpr == jp_hpgi .OR. jfpr == jp_hpgj .OR. jfpr == jp_tair     )  ) THEN   ! ABL: some fields are 3D input 
     270               ALLOCATE( sf(jfpr)%fnow(jpi,jpj,jpka) ) 
     271               IF( slf_i(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,jpka,2) ) 
     272            ELSE                                                                                ! others or Bulk fields are 2D fiels 
     273               ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 
     274               IF( slf_i(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,1,2) ) 
     275            ENDIF 
     276            ! 
     277            IF( slf_i(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(jfpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 )   & 
     278               &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   & 
     279               &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) 
     280         ENDIF 
    229281      END DO 
    230282      !                                      !- fill the bulk structure with namelist informations 
    231283      CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' ) 
    232284      ! 
    233       IF ( ln_wave ) THEN 
    234       !Activated wave module but neither drag nor stokes drift activated 
    235          IF ( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) )   THEN 
     285      IF( ln_wave ) THEN 
     286         !Activated wave module but neither drag nor stokes drift activated 
     287         IF( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) )   THEN 
    236288            CALL ctl_stop( 'STOP',  'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauwoc=F, ln_stcor=F' ) 
    237       !drag coefficient read from wave model definable only with mfs bulk formulae and core  
    238          ELSEIF (ln_cdgw .AND. .NOT. ln_NCAR )       THEN        
    239              CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR and CORE bulk formulae') 
    240          ELSEIF (ln_stcor .AND. .NOT. ln_sdw)                             THEN 
    241              CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') 
     289            !drag coefficient read from wave model definable only with mfs bulk formulae and core 
     290         ELSEIF(ln_cdgw .AND. .NOT. ln_NCAR )       THEN 
     291            CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR and CORE bulk formulae') 
     292         ELSEIF(ln_stcor .AND. .NOT. ln_sdw)                             THEN 
     293            CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') 
    242294         ENDIF 
    243295      ELSE 
    244       IF ( ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor )                &  
    245          &   CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ',    & 
    246          &                  'with drag coefficient (ln_cdgw =T) '  ,                        & 
    247          &                  'or Stokes Drift (ln_sdw=T) ' ,                                 & 
    248          &                  'or ocean stress modification due to waves (ln_tauwoc=T) ',      &   
    249          &                  'or Stokes-Coriolis term (ln_stcori=T)'  ) 
    250       ENDIF  
    251       ! 
    252       !            
     296         IF( ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor )                & 
     297            &   CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ',    & 
     298            &                  'with drag coefficient (ln_cdgw =T) '  ,                        & 
     299            &                  'or Stokes Drift (ln_sdw=T) ' ,                                 & 
     300            &                  'or ocean stress modification due to waves (ln_tauwoc=T) ',      & 
     301            &                  'or Stokes-Coriolis term (ln_stcori=T)'  ) 
     302      ENDIF 
     303      ! 
     304      IF( ln_abl ) THEN       ! ABL: read 3D fields for wind, temperature, humidity and pressure gradient 
     305         rn_zqt = ght_abl(2)          ! set the bulk altitude to ABL first level 
     306         rn_zu  = ght_abl(2) 
     307         IF(lwp) WRITE(numout,*) 
     308         IF(lwp) WRITE(numout,*) '   ABL formulation: overwrite rn_zqt & rn_zu with ABL first level altitude' 
     309      ENDIF 
     310      ! 
     311      ! set transfer coefficients to default sea-ice values 
     312      Cd_ice(:,:) = rCd_ice 
     313      Ch_ice(:,:) = rCd_ice 
     314      Ce_ice(:,:) = rCd_ice 
     315      ! 
    253316      IF(lwp) THEN                     !** Control print 
    254317         ! 
    255          WRITE(numout,*)                  !* namelist  
     318         WRITE(numout,*)                  !* namelist 
    256319         WRITE(numout,*) '   Namelist namsbc_blk (other than data information):' 
    257320         WRITE(numout,*) '      "NCAR"      algorithm   (Large and Yeager 2008)     ln_NCAR      = ', ln_NCAR 
    258321         WRITE(numout,*) '      "COARE 3.0" algorithm   (Fairall et al. 2003)       ln_COARE_3p0 = ', ln_COARE_3p0 
    259          WRITE(numout,*) '      "COARE 3.5" algorithm   (Edson et al. 2013)         ln_COARE_3p5 = ', ln_COARE_3p0 
    260          WRITE(numout,*) '      "ECMWF"     algorithm   (IFS cycle 31)              ln_ECMWF     = ', ln_ECMWF 
    261          WRITE(numout,*) '      add High freq.contribution to the stress module     ln_taudif    = ', ln_taudif 
     322         WRITE(numout,*) '      "COARE 3.6" algorithm (Fairall 2018 + Edson al 2013)ln_COARE_3p6 = ', ln_COARE_3p6 
     323         WRITE(numout,*) '      "ECMWF"     algorithm   (IFS cycle 45r1)            ln_ECMWF     = ', ln_ECMWF 
    262324         WRITE(numout,*) '      Air temperature and humidity reference height (m)   rn_zqt       = ', rn_zqt 
    263325         WRITE(numout,*) '      Wind vector reference height (m)                    rn_zu        = ', rn_zu 
     
    273335         CASE( np_NCAR      )   ;   WRITE(numout,*) '   ==>>>   "NCAR" algorithm        (Large and Yeager 2008)' 
    274336         CASE( np_COARE_3p0 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.0" algorithm   (Fairall et al. 2003)' 
    275          CASE( np_COARE_3p5 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.5" algorithm   (Edson et al. 2013)' 
    276          CASE( np_ECMWF     )   ;   WRITE(numout,*) '   ==>>>   "ECMWF" algorithm       (IFS cycle 31)' 
     337         CASE( np_COARE_3p6 )   ;   WRITE(numout,*) '   ==>>>   "COARE 3.6" algorithm (Fairall 2018+Edson et al. 2013)' 
     338         CASE( np_ECMWF     )   ;   WRITE(numout,*) '   ==>>>   "ECMWF" algorithm       (IFS cycle 45r1)' 
    277339         END SELECT 
    278340         ! 
     341         WRITE(numout,*) 
     342         WRITE(numout,*) '      use cool-skin  parameterization (SSST)  ln_skin_cs  = ', ln_skin_cs 
     343         WRITE(numout,*) '      use warm-layer parameterization (SSST)  ln_skin_wl  = ', ln_skin_wl 
     344         ! 
     345         WRITE(numout,*) 
     346         SELECT CASE( nhumi )              !* Print the choice of air humidity 
     347         CASE( np_humi_sph )   ;   WRITE(numout,*) '   ==>>>   air humidity is SPECIFIC HUMIDITY     [kg/kg]' 
     348         CASE( np_humi_dpt )   ;   WRITE(numout,*) '   ==>>>   air humidity is DEW-POINT TEMPERATURE [K]' 
     349         CASE( np_humi_rlh )   ;   WRITE(numout,*) '   ==>>>   air humidity is RELATIVE HUMIDITY     [%]' 
     350         END SELECT 
     351         ! 
    279352      ENDIF 
    280353      ! 
     
    289362      !!              (momentum, heat, freshwater and runoff) 
    290363      !! 
    291       !! ** Method  : (1) READ each fluxes in NetCDF files: 
    292       !!      the 10m wind velocity (i-component) (m/s)    at T-point 
    293       !!      the 10m wind velocity (j-component) (m/s)    at T-point 
    294       !!      the 10m or 2m specific humidity     ( % ) 
    295       !!      the solar heat                      (W/m2) 
    296       !!      the Long wave                       (W/m2) 
    297       !!      the 10m or 2m air temperature       (Kelvin) 
    298       !!      the total precipitation (rain+snow) (Kg/m2/s) 
    299       !!      the snow (solid prcipitation)       (kg/m2/s) 
    300       !!      the tau diff associated to HF tau   (N/m2)   at T-point   (ln_taudif=T) 
    301       !!              (2) CALL blk_oce 
     364      !! ** Method  : 
     365      !!              (1) READ each fluxes in NetCDF files: 
     366      !!      the wind velocity (i-component) at z=rn_zu  (m/s) at T-point 
     367      !!      the wind velocity (j-component) at z=rn_zu  (m/s) at T-point 
     368      !!      the specific humidity           at z=rn_zqt (kg/kg) 
     369      !!      the air temperature             at z=rn_zqt (Kelvin) 
     370      !!      the solar heat                              (W/m2) 
     371      !!      the Long wave                               (W/m2) 
     372      !!      the total precipitation (rain+snow)         (Kg/m2/s) 
     373      !!      the snow (solid precipitation)              (kg/m2/s) 
     374      !!      ABL dynamical forcing (i/j-components of either hpg or geostrophic winds) 
     375      !!              (2) CALL blk_oce_1 and blk_oce_2 
    302376      !! 
    303377      !!      C A U T I O N : never mask the surface stress fields 
     
    316390      !!---------------------------------------------------------------------- 
    317391      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    318       !!--------------------------------------------------------------------- 
     392      !!---------------------------------------------------------------------- 
     393      REAL(wp), DIMENSION(jpi,jpj) ::   zssq, zcd_du, zsen, zevp 
     394      REAL(wp) :: ztmp 
     395      !!---------------------------------------------------------------------- 
    319396      ! 
    320397      CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step 
    321       ! 
     398 
     399      ! Sanity/consistence test on humidity at first time step to detect potential screw-up: 
     400      IF( kt == nit000 ) THEN 
     401         WRITE(numout,*) '' 
     402#if defined key_agrif 
     403         WRITE(numout,*) ' === AGRIF => Sanity/consistence test on air humidity SKIPPED! :( ===' 
     404#else 
     405         ztmp = SUM(tmask(:,:,1)) ! number of ocean points on local proc domain 
     406         IF( ztmp > 8._wp ) THEN ! test only on proc domains with at least 8 ocean points! 
     407            ztmp = SUM(sf(jp_humi)%fnow(:,:,1)*tmask(:,:,1))/ztmp ! mean humidity over ocean on proc 
     408            SELECT CASE( nhumi ) 
     409            CASE( np_humi_sph ) ! specific humidity => expect: 0. <= something < 0.065 [kg/kg] (0.061 is saturation at 45degC !!!) 
     410               IF(  (ztmp < 0._wp) .OR. (ztmp > 0.065)  ) ztmp = -1._wp 
     411            CASE( np_humi_dpt ) ! dew-point temperature => expect: 110. <= something < 320. [K] 
     412               IF( (ztmp < 110._wp).OR.(ztmp > 320._wp) ) ztmp = -1._wp 
     413            CASE( np_humi_rlh ) ! relative humidity => expect: 0. <= something < 100. [%] 
     414               IF(  (ztmp < 0._wp) .OR.(ztmp > 100._wp) ) ztmp = -1._wp 
     415            END SELECT 
     416            IF(ztmp < 0._wp) THEN 
     417               WRITE(numout,'("   Mean humidity value found on proc #",i5.5," is: ",f)') narea, ztmp 
     418               CALL ctl_stop( 'STOP', 'Something is wrong with air humidity!!!', & 
     419                  &   ' ==> check the unit in your input files'       , & 
     420                  &   ' ==> check consistence of namelist choice: specific? relative? dew-point?', & 
     421                  &   ' ==> ln_humi_sph -> [kg/kg] | ln_humi_rlh -> [%] | ln_humi_dpt -> [K] !!!' ) 
     422            END IF 
     423         END IF 
     424         WRITE(numout,*) ' === Sanity/consistence test on air humidity sucessfuly passed! ===' 
     425#endif 
     426         WRITE(numout,*) '' 
     427      END IF !IF( kt == nit000 ) 
    322428      !                                            ! compute the surface ocean fluxes using bulk formulea 
    323       IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce( kt, sf, sst_m, ssu_m, ssv_m ) 
    324  
     429      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
     430         CALL blk_oce_1( kt, sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   &   !   <<= in 
     431            &                sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),   &   !   <<= in 
     432            &                sf(jp_slp )%fnow(:,:,1), sst_m, ssu_m, ssv_m,       &   !   <<= in 
     433            &                sf(jp_qsr )%fnow(:,:,1), sf(jp_qlw )%fnow(:,:,1),   &   !   <<= in (wl/cs) 
     434            &                zssq, zcd_du, zsen, zevp )                              !   =>> out 
     435 
     436         CALL blk_oce_2(     sf(jp_tair)%fnow(:,:,1), sf(jp_qsr )%fnow(:,:,1),   &   !   <<= in 
     437            &                sf(jp_qlw )%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1),   &   !   <<= in 
     438            &                sf(jp_snow)%fnow(:,:,1), sst_m,                     &   !   <<= in 
     439            &                zsen, zevp )                                            !   <=> in out 
     440      ENDIF 
     441      ! 
    325442#if defined key_cice 
    326443      IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN 
    327444         qlw_ice(:,:,1)   = sf(jp_qlw )%fnow(:,:,1) 
    328          IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) 
    329          ELSE                ; qsr_ice(:,:,1) =          sf(jp_qsr)%fnow(:,:,1)  
    330          ENDIF  
     445         IF( ln_dm2dc ) THEN 
     446            qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) 
     447         ELSE 
     448            qsr_ice(:,:,1) =          sf(jp_qsr)%fnow(:,:,1) 
     449         ENDIF 
    331450         tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1) 
    332          qatm_ice(:,:)    = sf(jp_humi)%fnow(:,:,1) 
     451 
     452         SELECT CASE( nhumi ) 
     453         CASE( np_humi_sph ) 
     454            qatm_ice(:,:) =           sf(jp_humi)%fnow(:,:,1) 
     455         CASE( np_humi_dpt ) 
     456            qatm_ice(:,:) = q_sat(    sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) ) 
     457         CASE( np_humi_rlh ) 
     458            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 
     459         END SELECT 
     460 
    333461         tprecip(:,:)     = sf(jp_prec)%fnow(:,:,1) * rn_pfac 
    334462         sprecip(:,:)     = sf(jp_snow)%fnow(:,:,1) * rn_pfac 
     
    341469 
    342470 
    343    SUBROUTINE blk_oce( kt, sf, pst, pu, pv ) 
    344       !!--------------------------------------------------------------------- 
    345       !!                     ***  ROUTINE blk_oce  *** 
    346       !! 
    347       !! ** Purpose :   provide the momentum, heat and freshwater fluxes at 
    348       !!      the ocean surface at each time step 
    349       !! 
    350       !! ** Method  :   bulk formulea for the ocean using atmospheric 
    351       !!      fields read in sbc_read 
     471   SUBROUTINE blk_oce_1( kt, pwndi, pwndj , ptair, phumi, &  ! inp 
     472      &              pslp , pst   , pu   , pv,    &  ! inp 
     473      &              pqsr , pqlw  ,               &  ! inp 
     474      &              pssq , pcd_du, psen , pevp   )  ! out 
     475      !!--------------------------------------------------------------------- 
     476      !!                     ***  ROUTINE blk_oce_1  *** 
     477      !! 
     478      !! ** Purpose :   if ln_blk=T, computes surface momentum, heat and freshwater fluxes 
     479      !!                if ln_abl=T, computes Cd x |U|, Ch x |U|, Ce x |U| for ABL integration 
     480      !! 
     481      !! ** Method  :   bulk formulae using atmospheric fields from : 
     482      !!                if ln_blk=T, atmospheric fields read in sbc_read 
     483      !!                if ln_abl=T, the ABL model at previous time-step 
     484      !! 
     485      !! ** Outputs : - pssq    : surface humidity used to compute latent heat flux (kg/kg) 
     486      !!              - pcd_du  : Cd x |dU| at T-points  (m/s) 
     487      !!              - psen    : Ch x |dU| at T-points  (m/s) 
     488      !!              - pevp    : Ce x |dU| at T-points  (m/s) 
     489      !!--------------------------------------------------------------------- 
     490      INTEGER , INTENT(in   )                 ::   kt     ! time step index 
     491      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndi  ! atmospheric wind at U-point              [m/s] 
     492      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndj  ! atmospheric wind at V-point              [m/s] 
     493      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   phumi  ! specific humidity at T-points            [kg/kg] 
     494      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   ptair  ! potential temperature at T-points        [Kelvin] 
     495      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pslp   ! sea-level pressure                       [Pa] 
     496      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pst    ! surface temperature                      [Celcius] 
     497      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pu     ! surface current at U-point (i-component) [m/s] 
     498      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pv     ! surface current at V-point (j-component) [m/s] 
     499      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqsr   ! 
     500      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqlw   ! 
     501      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pssq   ! specific humidity at pst                 [kg/kg] 
     502      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pcd_du ! Cd x |dU| at T-points                    [m/s] 
     503      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   psen   ! Ch x |dU| at T-points                    [m/s] 
     504      REAL(wp), INTENT(  out), DIMENSION(:,:) ::   pevp   ! Ce x |dU| at T-points                    [m/s] 
     505      ! 
     506      INTEGER  ::   ji, jj               ! dummy loop indices 
     507      REAL(wp) ::   zztmp                ! local variable 
     508      REAL(wp), DIMENSION(jpi,jpj) ::   zwnd_i, zwnd_j    ! wind speed components at T-point 
     509      REAL(wp), DIMENSION(jpi,jpj) ::   zst               ! surface temperature in Kelvin 
     510      REAL(wp), DIMENSION(jpi,jpj) ::   zU_zu             ! bulk wind speed at height zu  [m/s] 
     511      REAL(wp), DIMENSION(jpi,jpj) ::   ztpot             ! potential temperature of air at z=rn_zqt [K] 
     512      REAL(wp), DIMENSION(jpi,jpj) ::   zqair             ! specific humidity     of air at z=rn_zqt [kg/kg] 
     513      REAL(wp), DIMENSION(jpi,jpj) ::   zcd_oce           ! momentum transfert coefficient over ocean 
     514      REAL(wp), DIMENSION(jpi,jpj) ::   zch_oce           ! sensible heat transfert coefficient over ocean 
     515      REAL(wp), DIMENSION(jpi,jpj) ::   zce_oce           ! latent   heat transfert coefficient over ocean 
     516      REAL(wp), DIMENSION(jpi,jpj) ::   zqla              ! latent heat flux 
     517      REAL(wp), DIMENSION(jpi,jpj) ::   zztmp1, zztmp2 
     518      !!--------------------------------------------------------------------- 
     519      ! 
     520      ! local scalars ( place there for vector optimisation purposes) 
     521      zst(:,:) = pst(:,:) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K) 
     522 
     523      ! ----------------------------------------------------------------------------- ! 
     524      !      0   Wind components and module at T-point relative to the moving ocean   ! 
     525      ! ----------------------------------------------------------------------------- ! 
     526 
     527      ! ... components ( U10m - U_oce ) at T-point (unmasked) 
     528#if defined key_cyclone 
     529      zwnd_i(:,:) = 0._wp 
     530      zwnd_j(:,:) = 0._wp 
     531      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012) 
     532      DO jj = 2, jpjm1 
     533         DO ji = fs_2, fs_jpim1   ! vect. opt. 
     534            pwndi(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj) 
     535            pwndj(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj) 
     536         END DO 
     537      END DO 
     538#endif 
     539      DO jj = 2, jpjm1 
     540         DO ji = fs_2, fs_jpim1   ! vect. opt. 
     541            zwnd_i(ji,jj) = (  pwndi(ji,jj) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  ) 
     542            zwnd_j(ji,jj) = (  pwndj(ji,jj) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  ) 
     543         END DO 
     544      END DO 
     545      CALL lbc_lnk_multi( 'sbcblk', zwnd_i, 'T', -1., zwnd_j, 'T', -1. ) 
     546      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 
     547      wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   & 
     548         &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1) 
     549 
     550      ! ----------------------------------------------------------------------------- ! 
     551      !      I   Solar FLUX                                                           ! 
     552      ! ----------------------------------------------------------------------------- ! 
     553 
     554      ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave 
     555      zztmp = 1. - albo 
     556      IF( ln_dm2dc ) THEN 
     557         qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 
     558      ELSE 
     559         qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1) 
     560      ENDIF 
     561 
     562 
     563      ! ----------------------------------------------------------------------------- ! 
     564      !     II   Turbulent FLUXES                                                     ! 
     565      ! ----------------------------------------------------------------------------- ! 
     566 
     567      ! specific humidity at SST 
     568      pssq(:,:) = rdct_qsat_salt * q_sat( zst(:,:), pslp(:,:) ) 
     569 
     570      IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
     571         zztmp1(:,:) = zst(:,:) 
     572         zztmp2(:,:) = pssq(:,:) 
     573      ENDIF 
     574 
     575      ! specific humidity of air at "rn_zqt" m above the sea 
     576      SELECT CASE( nhumi ) 
     577      CASE( np_humi_sph ) 
     578         zqair(:,:) = phumi(:,:)      ! what we read in file is already a spec. humidity! 
     579      CASE( np_humi_dpt ) 
     580         !IF(lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of d_air and slp !' !LBrm 
     581         zqair(:,:) = q_sat( phumi(:,:), pslp(:,:) ) 
     582      CASE( np_humi_rlh ) 
     583         !IF(lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of RH, t_air and slp !' !LBrm 
     584         zqair(:,:) = q_air_rh( 0.01_wp*phumi(:,:), ptair(:,:), pslp(:,:) ) !LB: 0.01 => RH is % percent in file 
     585      END SELECT 
     586      ! 
     587      ! potential temperature of air at "rn_zqt" m above the sea 
     588      IF( ln_abl ) THEN 
     589         ztpot = ptair(:,:) 
     590      ELSE 
     591         ! Estimate of potential temperature at z=rn_zqt, based on adiabatic lapse-rate 
     592         !    (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2 
     593         !    (since reanalysis products provide T at z, not theta !) 
     594         !#LB: because AGRIF hates functions that return something else than a scalar, need to 
     595         !     use scalar version of gamma_moist() ... 
     596         DO jj = 1, jpj 
     597            DO ji = 1, jpi 
     598               ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt 
     599            END DO 
     600         END DO 
     601      ENDIF 
     602 
     603 
     604 
     605      !! Time to call the user-selected bulk parameterization for 
     606      !!  ==  transfer coefficients  ==!   Cd, Ch, Ce at T-point, and more... 
     607      SELECT CASE( nblk ) 
     608 
     609      CASE( np_NCAR      ) 
     610         CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm,                              & 
     611            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
     612 
     613      CASE( np_COARE_3p0 ) 
     614         CALL turb_coare3p0 ( kt, rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, & 
     615            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
     616            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
     617 
     618      CASE( np_COARE_3p6 ) 
     619         CALL turb_coare3p6 ( kt, rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl, & 
     620            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
     621            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
     622 
     623      CASE( np_ECMWF     ) 
     624         CALL turb_ecmwf   ( kt, rn_zqt, rn_zu, zst, ztpot, pssq, zqair, wndm, ln_skin_cs, ln_skin_wl,  & 
     625            &                zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
     626            &                Qsw=qsr(:,:), rad_lw=pqlw(:,:), slp=pslp(:,:) ) 
     627 
     628      CASE DEFAULT 
     629         CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' ) 
     630 
     631      END SELECT 
     632 
     633      IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
     634         !! In the presence of sea-ice we forget about the cool-skin/warm-layer update of zst and pssq: 
     635         WHERE ( fr_i < 0.001_wp ) 
     636            ! zst and pssq have been updated by cool-skin/warm-layer scheme and we keep it!!! 
     637            zst(:,:)  =  zst(:,:)*tmask(:,:,1) 
     638            pssq(:,:) = pssq(:,:)*tmask(:,:,1) 
     639         ELSEWHERE 
     640            ! we forget about the update... 
     641            zst(:,:)  = zztmp1(:,:) !#LB: using what we backed up before skin-algo 
     642            pssq(:,:) = zztmp2(:,:) !#LB:  "   "   " 
     643         END WHERE 
     644      END IF 
     645 
     646      !!      CALL iom_put( "Cd_oce", zcd_oce)  ! output value of pure ocean-atm. transfer coef. 
     647      !!      CALL iom_put( "Ch_oce", zch_oce)  ! output value of pure ocean-atm. transfer coef. 
     648 
     649      IF( ABS(rn_zu - rn_zqt) < 0.1_wp ) THEN 
     650         !! If zu == zt, then ensuring once for all that: 
     651         t_zu(:,:) = ztpot(:,:) 
     652         q_zu(:,:) = zqair(:,:) 
     653      ENDIF 
     654 
     655 
     656      !  Turbulent fluxes over ocean  => BULK_FORMULA @ sbcblk_phy.F90 
     657      ! ------------------------------------------------------------- 
     658 
     659      IF( ln_abl ) THEN         !==  ABL formulation  ==!   multiplication by rho_air and turbulent fluxes computation done in ablstp 
     660         !! FL do we need this multiplication by tmask ... ??? 
     661         DO jj = 1, jpj 
     662            DO ji = 1, jpi 
     663               zztmp = zU_zu(ji,jj) !* tmask(ji,jj,1) 
     664               wndm(ji,jj)   = zztmp                   ! Store zU_zu in wndm to compute ustar2 in ablmod 
     665               pcd_du(ji,jj) = zztmp * zcd_oce(ji,jj) 
     666               psen(ji,jj)   = zztmp * zch_oce(ji,jj) 
     667               pevp(ji,jj)   = zztmp * zce_oce(ji,jj) 
     668            END DO 
     669         END DO 
     670      ELSE                      !==  BLK formulation  ==!   turbulent fluxes computation 
     671         CALL BULK_FORMULA( rn_zu, zst(:,:), pssq(:,:), t_zu(:,:), q_zu(:,:), & 
     672            &               zcd_oce(:,:), zch_oce(:,:), zce_oce(:,:),         & 
     673            &               wndm(:,:), zU_zu(:,:), pslp(:,:),                 & 
     674            &               taum(:,:), psen(:,:), zqla(:,:),                  & 
     675            &               pEvap=pevp(:,:), prhoa=rhoa(:,:) ) 
     676 
     677         zqla(:,:) = zqla(:,:) * tmask(:,:,1) 
     678         psen(:,:) = psen(:,:) * tmask(:,:,1) 
     679         taum(:,:) = taum(:,:) * tmask(:,:,1) 
     680         pevp(:,:) = pevp(:,:) * tmask(:,:,1) 
     681 
     682         ! Tau i and j component on T-grid points, using array "zcd_oce" as a temporary array... 
     683         zcd_oce = 0._wp 
     684         WHERE ( wndm > 0._wp ) zcd_oce = taum / wndm 
     685         zwnd_i = zcd_oce * zwnd_i 
     686         zwnd_j = zcd_oce * zwnd_j 
     687 
     688         CALL iom_put( "taum_oce", taum )   ! output wind stress module 
     689 
     690         ! ... utau, vtau at U- and V_points, resp. 
     691         !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 
     692         !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves 
     693         DO jj = 1, jpjm1 
     694            DO ji = 1, fs_jpim1 
     695               utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) & 
     696                  &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1)) 
     697               vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) ) & 
     698                  &          * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1)) 
     699            END DO 
     700         END DO 
     701         CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. ) 
     702 
     703         IF(ln_ctl) THEN 
     704            CALL prt_ctl( tab2d_1=wndm  , clinfo1=' blk_oce_1: wndm   : ') 
     705            CALL prt_ctl( tab2d_1=utau  , clinfo1=' blk_oce_1: utau   : ', mask1=umask,   & 
     706               &          tab2d_2=vtau  , clinfo2='            vtau   : ', mask2=vmask ) 
     707         ENDIF 
     708         ! 
     709      ENDIF 
     710      ! 
     711      IF(ln_ctl) THEN 
     712         CALL prt_ctl( tab2d_1=pevp  , clinfo1=' blk_oce_1: pevp   : ' ) 
     713         CALL prt_ctl( tab2d_1=psen  , clinfo1=' blk_oce_1: psen   : ' ) 
     714         CALL prt_ctl( tab2d_1=pssq  , clinfo1=' blk_oce_1: pssq   : ' ) 
     715      ENDIF 
     716      ! 
     717   END SUBROUTINE blk_oce_1 
     718 
     719 
     720   SUBROUTINE blk_oce_2( ptair, pqsr, pqlw, pprec,   &   ! <<= in 
     721      &          psnow, pst , psen, pevp     )   ! <<= in 
     722      !!--------------------------------------------------------------------- 
     723      !!                     ***  ROUTINE blk_oce_2  *** 
     724      !! 
     725      !! ** Purpose :   finalize the momentum, heat and freshwater fluxes computation 
     726      !!                at the ocean surface at each time step knowing Cd, Ch, Ce and 
     727      !!                atmospheric variables (from ABL or external data) 
    352728      !! 
    353729      !! ** Outputs : - utau    : i-component of the stress at U-point  (N/m2) 
     
    358734      !!              - qns     : Non Solar heat flux over the ocean    (W/m2) 
    359735      !!              - emp     : evaporation minus precipitation       (kg/m2/s) 
    360       !! 
    361       !!  ** Nota  :   sf has to be a dummy argument for AGRIF on NEC 
    362       !!--------------------------------------------------------------------- 
    363       INTEGER  , INTENT(in   )                 ::   kt    ! time step index 
    364       TYPE(fld), INTENT(inout), DIMENSION(:)   ::   sf    ! input data 
    365       REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius] 
    366       REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pu    ! surface current at U-point (i-component) [m/s] 
    367       REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pv    ! surface current at V-point (j-component) [m/s] 
     736      !!--------------------------------------------------------------------- 
     737      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptair 
     738      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pqsr 
     739      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pqlw 
     740      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pprec 
     741      REAL(wp), INTENT(in), DIMENSION(:,:) ::   psnow 
     742      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius] 
     743      REAL(wp), INTENT(in), DIMENSION(:,:) ::   psen 
     744      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pevp 
    368745      ! 
    369746      INTEGER  ::   ji, jj               ! dummy loop indices 
    370       REAL(wp) ::   zztmp                ! local variable 
    371       REAL(wp), DIMENSION(jpi,jpj) ::   zwnd_i, zwnd_j    ! wind speed components at T-point 
    372       REAL(wp), DIMENSION(jpi,jpj) ::   zsq               ! specific humidity at pst 
    373       REAL(wp), DIMENSION(jpi,jpj) ::   zqlw, zqsb        ! long wave and sensible heat fluxes 
    374       REAL(wp), DIMENSION(jpi,jpj) ::   zqla, zevap       ! latent heat fluxes and evaporation 
     747      REAL(wp) ::   zztmp,zz1,zz2,zz3    ! local variable 
     748      REAL(wp), DIMENSION(jpi,jpj) ::   zqlw              ! long wave and sensible heat fluxes 
     749      REAL(wp), DIMENSION(jpi,jpj) ::   zqla              ! latent heat fluxes and evaporation 
    375750      REAL(wp), DIMENSION(jpi,jpj) ::   zst               ! surface temperature in Kelvin 
    376       REAL(wp), DIMENSION(jpi,jpj) ::   zU_zu             ! bulk wind speed at height zu  [m/s] 
    377       REAL(wp), DIMENSION(jpi,jpj) ::   ztpot             ! potential temperature of air at z=rn_zqt [K] 
    378       REAL(wp), DIMENSION(jpi,jpj) ::   zrhoa             ! density of air   [kg/m^3] 
    379751      !!--------------------------------------------------------------------- 
    380752      ! 
     
    382754      zst(:,:) = pst(:,:) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K) 
    383755 
     756 
    384757      ! ----------------------------------------------------------------------------- ! 
    385       !      0   Wind components and module at T-point relative to the moving ocean   ! 
     758      !     III    Net longwave radiative FLUX                                        ! 
    386759      ! ----------------------------------------------------------------------------- ! 
    387760 
    388       ! ... components ( U10m - U_oce ) at T-point (unmasked) 
    389 !!gm    move zwnd_i (_j) set to zero  inside the key_cyclone ??? 
    390       zwnd_i(:,:) = 0._wp 
    391       zwnd_j(:,:) = 0._wp 
    392 #if defined key_cyclone 
    393       CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012) 
    394       DO jj = 2, jpjm1 
    395          DO ji = fs_2, fs_jpim1   ! vect. opt. 
    396             sf(jp_wndi)%fnow(ji,jj,1) = sf(jp_wndi)%fnow(ji,jj,1) + zwnd_i(ji,jj) 
    397             sf(jp_wndj)%fnow(ji,jj,1) = sf(jp_wndj)%fnow(ji,jj,1) + zwnd_j(ji,jj) 
    398          END DO 
    399       END DO 
    400 #endif 
    401       DO jj = 2, jpjm1 
    402          DO ji = fs_2, fs_jpim1   ! vect. opt. 
    403             zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  ) 
    404             zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  ) 
    405          END DO 
    406       END DO 
    407       CALL lbc_lnk_multi( 'sbcblk', zwnd_i, 'T', -1., zwnd_j, 'T', -1. ) 
    408       ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 
    409       wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   & 
    410          &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1) 
    411  
    412       ! ----------------------------------------------------------------------------- ! 
    413       !      I   Radiative FLUXES                                                     ! 
    414       ! ----------------------------------------------------------------------------- ! 
    415  
    416       ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave 
    417       zztmp = 1. - albo 
    418       IF( ln_dm2dc ) THEN   ;   qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 
    419       ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1) 
    420       ENDIF 
    421  
    422       zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave 
    423  
    424       ! ----------------------------------------------------------------------------- ! 
    425       !     II    Turbulent FLUXES                                                    ! 
    426       ! ----------------------------------------------------------------------------- ! 
    427  
    428       ! ... specific humidity at SST and IST tmask( 
    429       zsq(:,:) = 0.98 * q_sat( zst(:,:), sf(jp_slp)%fnow(:,:,1) ) 
    430       !! 
    431       !! Estimate of potential temperature at z=rn_zqt, based on adiabatic lapse-rate 
    432       !!    (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2 
    433       !!    (since reanalysis products provide T at z, not theta !) 
    434       ztpot = sf(jp_tair)%fnow(:,:,1) + gamma_moist( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1) ) * rn_zqt 
    435  
    436       SELECT CASE( nblk )        !==  transfer coefficients  ==!   Cd, Ch, Ce at T-point 
    437       ! 
    438       CASE( np_NCAR      )   ;   CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! NCAR-COREv2 
    439          &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    440       CASE( np_COARE_3p0 )   ;   CALL turb_coare   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! COARE v3.0 
    441          &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    442       CASE( np_COARE_3p5 )   ;   CALL turb_coare3p5( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! COARE v3.5 
    443          &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    444       CASE( np_ECMWF     )   ;   CALL turb_ecmwf   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! ECMWF 
    445          &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    446       CASE DEFAULT 
    447          CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' ) 
    448       END SELECT 
    449  
    450       !                          ! Compute true air density : 
    451       IF( ABS(rn_zu - rn_zqt) > 0.01 ) THEN     ! At zu: (probably useless to remove zrho*grav*rn_zu from SLP...) 
    452          zrhoa(:,:) = rho_air( t_zu(:,:)              , q_zu(:,:)              , sf(jp_slp)%fnow(:,:,1) ) 
    453       ELSE                                      ! At zt: 
    454          zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) ) 
    455       END IF 
    456  
    457 !!      CALL iom_put( "Cd_oce", Cd_atm)  ! output value of pure ocean-atm. transfer coef. 
    458 !!      CALL iom_put( "Ch_oce", Ch_atm)  ! output value of pure ocean-atm. transfer coef. 
    459  
    460       DO jj = 1, jpj             ! tau module, i and j component 
    461          DO ji = 1, jpi 
    462             zztmp = zrhoa(ji,jj)  * zU_zu(ji,jj) * Cd_atm(ji,jj)   ! using bulk wind speed 
    463             taum  (ji,jj) = zztmp * wndm  (ji,jj) 
    464             zwnd_i(ji,jj) = zztmp * zwnd_i(ji,jj) 
    465             zwnd_j(ji,jj) = zztmp * zwnd_j(ji,jj) 
    466          END DO 
    467       END DO 
    468  
    469       !                          ! add the HF tau contribution to the wind stress module 
    470       IF( lhftau )   taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 
    471  
    472       CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    473  
    474       ! ... utau, vtau at U- and V_points, resp. 
    475       !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 
    476       !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves 
    477       DO jj = 1, jpjm1 
    478          DO ji = 1, fs_jpim1 
    479             utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) & 
    480                &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1)) 
    481             vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) ) & 
    482                &          * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1)) 
    483          END DO 
    484       END DO 
    485       CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. ) 
     761      !! LB: now moved after Turbulent fluxes because must use the skin temperature rather that the SST 
     762      !! (zst is skin temperature if ln_skin_cs==.TRUE. .OR. ln_skin_wl==.TRUE.) 
     763      zqlw(:,:) = emiss_w * ( pqlw(:,:) - stefan*zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1)   ! Net radiative longwave flux 
    486764 
    487765      !  Turbulent fluxes over ocean 
    488766      ! ----------------------------- 
    489767 
    490       ! zqla used as temporary array, for rho*U (common term of bulk formulae): 
    491       zqla(:,:) = zrhoa(:,:) * zU_zu(:,:) * tmask(:,:,1) 
    492  
    493       IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN 
    494          !! q_air and t_air are given at 10m (wind reference height) 
    495          zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce_atm(:,:)*(zsq(:,:) - sf(jp_humi)%fnow(:,:,1)) ) ! Evaporation, using bulk wind speed 
    496          zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch_atm(:,:)*(zst(:,:) - ztpot(:,:)             )   ! Sensible Heat, using bulk wind speed 
    497       ELSE 
    498          !! q_air and t_air are not given at 10m (wind reference height) 
    499          ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!! 
    500          zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce_atm(:,:)*(zsq(:,:) - q_zu(:,:) ) ) ! Evaporation, using bulk wind speed 
    501          zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch_atm(:,:)*(zst(:,:) - t_zu(:,:) )   ! Sensible Heat, using bulk wind speed 
    502       ENDIF 
    503  
    504       zqla(:,:) = L_vap(zst(:,:)) * zevap(:,:)     ! Latent Heat flux 
    505  
     768      ! use scalar version of L_vap() for AGRIF compatibility 
     769      DO jj = 1, jpj 
     770         DO ji = 1, jpi 
     771            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 
     772         ENDDO 
     773      ENDDO 
    506774 
    507775      IF(ln_ctl) THEN 
    508          CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce: zqla   : ', tab2d_2=Ce_atm , clinfo2=' Ce_oce  : ' ) 
    509          CALL prt_ctl( tab2d_1=zqsb  , clinfo1=' blk_oce: zqsb   : ', tab2d_2=Ch_atm , clinfo2=' Ch_oce  : ' ) 
    510          CALL prt_ctl( tab2d_1=zqlw  , clinfo1=' blk_oce: zqlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' ) 
    511          CALL prt_ctl( tab2d_1=zsq   , clinfo1=' blk_oce: zsq    : ', tab2d_2=zst, clinfo2=' zst : ' ) 
    512          CALL prt_ctl( tab2d_1=utau  , clinfo1=' blk_oce: utau   : ', mask1=umask,   & 
    513             &          tab2d_2=vtau  , clinfo2=           ' vtau : ', mask2=vmask ) 
    514          CALL prt_ctl( tab2d_1=wndm  , clinfo1=' blk_oce: wndm   : ') 
    515          CALL prt_ctl( tab2d_1=zst   , clinfo1=' blk_oce: zst    : ') 
     776         CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce_2: zqla   : ' ) 
     777         CALL prt_ctl( tab2d_1=zqlw  , clinfo1=' blk_oce_2: zqlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' ) 
     778 
    516779      ENDIF 
    517780 
    518781      ! ----------------------------------------------------------------------------- ! 
    519       !     III    Total FLUXES                                                       ! 
     782      !     IV    Total FLUXES                                                       ! 
    520783      ! ----------------------------------------------------------------------------- ! 
    521784      ! 
    522       emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.) 
    523          &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1) 
    524       ! 
    525       qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar 
    526          &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * rLfus                        &   ! remove latent melting heat for solid precip 
    527          &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST 
    528          &     + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) * rn_pfac  &   ! add liquid precip heat content at Tair 
    529          &     * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp                          & 
    530          &     + sf(jp_snow)%fnow(:,:,1) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow) 
    531          &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi 
     785      emp (:,:) = (  pevp(:,:)                                       &   ! mass flux (evap. - precip.) 
     786         &         - pprec(:,:) * rn_pfac  ) * tmask(:,:,1) 
     787      ! 
     788      qns(:,:) = zqlw(:,:) + psen(:,:) + zqla(:,:)                   &   ! Downward Non Solar 
     789         &     - psnow(:,:) * rn_pfac * rLfus                        &   ! remove latent melting heat for solid precip 
     790         &     - pevp(:,:) * pst(:,:) * rcp                          &   ! remove evap heat content at SST !LB??? pst is Celsius !? 
     791         &     + ( pprec(:,:) - psnow(:,:) ) * rn_pfac               &   ! add liquid precip heat content at Tair 
     792         &     * ( ptair(:,:) - rt0 ) * rcp                          & 
     793         &     + psnow(:,:) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow) 
     794         &     * ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi 
    532795      qns(:,:) = qns(:,:) * tmask(:,:,1) 
    533796      ! 
    534797#if defined key_si3 
    535       qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                ! non solar without emp (only needed by SI3) 
     798      qns_oce(:,:) = zqlw(:,:) + psen(:,:) + zqla(:,:)                             ! non solar without emp (only needed by SI3) 
    536799      qsr_oce(:,:) = qsr(:,:) 
    537800#endif 
    538801      ! 
     802      CALL iom_put( "rho_air"  , rhoa*tmask(:,:,1) )       ! output air density [kg/m^3] 
     803      CALL iom_put( "evap_oce" , pevp )                    ! evaporation 
     804      CALL iom_put( "qlw_oce"  , zqlw )                    ! output downward longwave heat over the ocean 
     805      CALL iom_put( "qsb_oce"  , psen )                    ! output downward sensible heat over the ocean 
     806      CALL iom_put( "qla_oce"  , zqla )                    ! output downward latent   heat over the ocean 
     807      tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1)   ! output total precipitation [kg/m2/s] 
     808      sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1)   ! output solid precipitation [kg/m2/s] 
     809      CALL iom_put( 'snowpre', sprecip )                   ! Snow 
     810      CALL iom_put( 'precip' , tprecip )                   ! Total precipitation 
     811      ! 
    539812      IF ( nn_ice == 0 ) THEN 
    540          CALL iom_put( "qlw_oce" ,   zqlw )                 ! output downward longwave heat over the ocean 
    541          CALL iom_put( "qsb_oce" , - zqsb )                 ! output downward sensible heat over the ocean 
    542          CALL iom_put( "qla_oce" , - zqla )                 ! output downward latent   heat over the ocean 
    543          CALL iom_put( "qemp_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean 
    544          CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean 
    545          CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean 
    546          CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean 
    547          tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) ! output total precipitation [kg/m2/s] 
    548          sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) ! output solid precipitation [kg/m2/s] 
    549          CALL iom_put( 'snowpre', sprecip )                 ! Snow 
    550          CALL iom_put( 'precip' , tprecip )                 ! Total precipitation 
     813         CALL iom_put( "qemp_oce" , qns-zqlw-psen-zqla )   ! output downward heat content of E-P over the ocean 
     814         CALL iom_put( "qns_oce"  ,   qns  )               ! output downward non solar heat over the ocean 
     815         CALL iom_put( "qsr_oce"  ,   qsr  )               ! output downward solar heat over the ocean 
     816         CALL iom_put( "qt_oce"   ,   qns+qsr )            ! output total downward heat over the ocean 
     817      ENDIF 
     818      ! 
     819      IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
     820         CALL iom_put( "t_skin" ,  (zst - rt0) * tmask(:,:,1) )           ! T_skin in Celsius 
     821         CALL iom_put( "dt_skin" , (zst - pst - rt0) * tmask(:,:,1) )     ! T_skin - SST temperature difference... 
    551822      ENDIF 
    552823      ! 
    553824      IF(ln_ctl) THEN 
    554          CALL prt_ctl(tab2d_1=zqsb , clinfo1=' blk_oce: zqsb   : ', tab2d_2=zqlw , clinfo2=' zqlw  : ') 
    555          CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce: zqla   : ', tab2d_2=qsr  , clinfo2=' qsr   : ') 
    556          CALL prt_ctl(tab2d_1=pst  , clinfo1=' blk_oce: pst    : ', tab2d_2=emp  , clinfo2=' emp   : ') 
    557          CALL prt_ctl(tab2d_1=utau , clinfo1=' blk_oce: utau   : ', mask1=umask,   & 
    558             &         tab2d_2=vtau , clinfo2=              ' vtau  : ' , mask2=vmask ) 
    559       ENDIF 
    560       ! 
    561    END SUBROUTINE blk_oce 
    562  
    563  
    564  
    565    FUNCTION rho_air( ptak, pqa, pslp ) 
    566       !!------------------------------------------------------------------------------- 
    567       !!                           ***  FUNCTION rho_air  *** 
    568       !! 
    569       !! ** Purpose : compute density of (moist) air using the eq. of state of the atmosphere 
    570       !! 
    571       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)  
    572       !!------------------------------------------------------------------------------- 
    573       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak      ! air temperature             [K] 
    574       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa       ! air specific humidity   [kg/kg] 
    575       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp      ! pressure in                [Pa] 
    576       REAL(wp), DIMENSION(jpi,jpj)             ::   rho_air   ! density of moist air   [kg/m^3] 
    577       !!------------------------------------------------------------------------------- 
    578       ! 
    579       rho_air = pslp / (  R_dry*ptak * ( 1._wp + rctv0*pqa )  ) 
    580       ! 
    581    END FUNCTION rho_air 
    582  
    583  
    584    FUNCTION cp_air( pqa ) 
    585       !!------------------------------------------------------------------------------- 
    586       !!                           ***  FUNCTION cp_air  *** 
    587       !! 
    588       !! ** Purpose : Compute specific heat (Cp) of moist air 
    589       !! 
    590       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    591       !!------------------------------------------------------------------------------- 
    592       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa      ! air specific humidity         [kg/kg] 
    593       REAL(wp), DIMENSION(jpi,jpj)             ::   cp_air   ! specific heat of moist air   [J/K/kg] 
    594       !!------------------------------------------------------------------------------- 
    595       ! 
    596       Cp_air = Cp_dry + Cp_vap * pqa 
    597       ! 
    598    END FUNCTION cp_air 
    599  
    600  
    601    FUNCTION q_sat( ptak, pslp ) 
    602       !!---------------------------------------------------------------------------------- 
    603       !!                           ***  FUNCTION q_sat  *** 
    604       !! 
    605       !! ** Purpose : Specific humidity at saturation in [kg/kg] 
    606       !!              Based on accurate estimate of "e_sat" 
    607       !!              aka saturation water vapor (Goff, 1957) 
    608       !! 
    609       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    610       !!---------------------------------------------------------------------------------- 
    611       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak    ! air temperature                       [K] 
    612       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp    ! sea level atmospheric pressure       [Pa] 
    613       REAL(wp), DIMENSION(jpi,jpj)             ::   q_sat   ! Specific humidity at saturation   [kg/kg] 
    614       ! 
    615       INTEGER  ::   ji, jj         ! dummy loop indices 
    616       REAL(wp) ::   ze_sat, ztmp   ! local scalar 
    617       !!---------------------------------------------------------------------------------- 
    618       ! 
    619       DO jj = 1, jpj 
    620          DO ji = 1, jpi 
    621             ! 
    622             ztmp = rt0 / ptak(ji,jj) 
    623             ! 
    624             ! Vapour pressure at saturation [hPa] : WMO, (Goff, 1957) 
    625             ze_sat = 10.**( 10.79574*(1. - ztmp) - 5.028*LOG10(ptak(ji,jj)/rt0)        & 
    626                &    + 1.50475*10.**(-4)*(1. - 10.**(-8.2969*(ptak(ji,jj)/rt0 - 1.)) )  & 
    627                &    + 0.42873*10.**(-3)*(10.**(4.76955*(1. - ztmp)) - 1.) + 0.78614  ) 
    628                ! 
    629             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] 
    630             ! 
    631          END DO 
    632       END DO 
    633       ! 
    634    END FUNCTION q_sat 
    635  
    636  
    637    FUNCTION gamma_moist( ptak, pqa ) 
    638       !!---------------------------------------------------------------------------------- 
    639       !!                           ***  FUNCTION gamma_moist  *** 
    640       !! 
    641       !! ** Purpose : Compute the moist adiabatic lapse-rate. 
    642       !!     => http://glossary.ametsoc.org/wiki/Moist-adiabatic_lapse_rate 
    643       !!     => http://www.geog.ucsb.edu/~joel/g266_s10/lecture_notes/chapt03/oh10_3_01/oh10_3_01.html 
    644       !! 
    645       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    646       !!---------------------------------------------------------------------------------- 
    647       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak          ! air temperature       [K] 
    648       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa           ! specific humidity [kg/kg] 
    649       REAL(wp), DIMENSION(jpi,jpj)             ::   gamma_moist   ! moist adiabatic lapse-rate 
    650       ! 
    651       INTEGER  ::   ji, jj         ! dummy loop indices 
    652       REAL(wp) :: zrv, ziRT        ! local scalar 
    653       !!---------------------------------------------------------------------------------- 
    654       ! 
    655       DO jj = 1, jpj 
    656          DO ji = 1, jpi 
    657             zrv = pqa(ji,jj) / (1. - pqa(ji,jj)) 
    658             ziRT = 1. / (R_dry*ptak(ji,jj))    ! 1/RT 
    659             gamma_moist(ji,jj) = grav * ( 1. + rLevap*zrv*ziRT ) / ( Cp_dry + rLevap*rLevap*zrv*reps0*ziRT/ptak(ji,jj) ) 
    660          END DO 
    661       END DO 
    662       ! 
    663    END FUNCTION gamma_moist 
    664  
    665  
    666    FUNCTION L_vap( psst ) 
    667       !!--------------------------------------------------------------------------------- 
    668       !!                           ***  FUNCTION L_vap  *** 
    669       !! 
    670       !! ** Purpose : Compute the latent heat of vaporization of water from temperature 
    671       !! 
    672       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    673       !!---------------------------------------------------------------------------------- 
    674       REAL(wp), DIMENSION(jpi,jpj)             ::   L_vap   ! latent heat of vaporization   [J/kg] 
    675       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   psst   ! water temperature                [K] 
    676       !!---------------------------------------------------------------------------------- 
    677       ! 
    678       L_vap = (  2.501 - 0.00237 * ( psst(:,:) - rt0)  ) * 1.e6 
    679       ! 
    680    END FUNCTION L_vap 
     825         CALL prt_ctl(tab2d_1=zqlw , clinfo1=' blk_oce_2: zqlw  : ') 
     826         CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce_2: zqla  : ', tab2d_2=qsr  , clinfo2=' qsr   : ') 
     827         CALL prt_ctl(tab2d_1=emp  , clinfo1=' blk_oce_2: emp   : ') 
     828      ENDIF 
     829      ! 
     830   END SUBROUTINE blk_oce_2 
     831 
    681832 
    682833#if defined key_si3 
     
    684835   !!   'key_si3'                                       SI3 sea-ice model 
    685836   !!---------------------------------------------------------------------- 
    686    !!   blk_ice_tau : provide the air-ice stress 
    687    !!   blk_ice_flx : provide the heat and mass fluxes at air-ice interface 
     837   !!   blk_ice_ : provide the air-ice stress 
     838   !!   blk_ice_ : provide the heat and mass fluxes at air-ice interface 
    688839   !!   blk_ice_qcn : provide ice surface temperature and snow/ice conduction flux (emulating conduction flux) 
    689840   !!   Cdn10_Lupkes2012 : Lupkes et al. (2012) air-ice drag 
    690    !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag  
     841   !!   Cdn10_Lupkes2015 : Lupkes et al. (2015) air-ice drag 
    691842   !!---------------------------------------------------------------------- 
    692843 
    693    SUBROUTINE blk_ice_tau 
    694       !!--------------------------------------------------------------------- 
    695       !!                     ***  ROUTINE blk_ice_tau  *** 
     844   SUBROUTINE blk_ice_1( pwndi, pwndj, ptair, phumi, pslp , puice, pvice, ptsui,  &   ! inputs 
     845      &                  putaui, pvtaui, pseni, pevpi, pssqi, pcd_dui             )   ! optional outputs 
     846      !!--------------------------------------------------------------------- 
     847      !!                     ***  ROUTINE blk_ice_1  *** 
    696848      !! 
    697849      !! ** Purpose :   provide the surface boundary condition over sea-ice 
     
    701853      !!                NB: ice drag coefficient is assumed to be a constant 
    702854      !!--------------------------------------------------------------------- 
     855      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pslp    ! sea-level pressure [Pa] 
     856      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndi   ! atmospheric wind at T-point [m/s] 
     857      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndj   ! atmospheric wind at T-point [m/s] 
     858      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   ptair   ! atmospheric wind at T-point [m/s] 
     859      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   phumi   ! atmospheric wind at T-point [m/s] 
     860      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   puice   ! sea-ice velocity on I or C grid [m/s] 
     861      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pvice   ! " 
     862      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   ptsui   ! sea-ice surface temperature [K] 
     863      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   putaui  ! if ln_blk 
     864      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pvtaui  ! if ln_blk 
     865      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pseni   ! if ln_abl 
     866      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pevpi   ! if ln_abl 
     867      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pssqi   ! if ln_abl 
     868      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pcd_dui ! if ln_abl 
     869      ! 
    703870      INTEGER  ::   ji, jj    ! dummy loop indices 
    704       REAL(wp) ::   zwndi_f , zwndj_f, zwnorm_f   ! relative wind module and components at F-point 
    705871      REAL(wp) ::   zwndi_t , zwndj_t             ! relative wind components at T-point 
    706       REAL(wp), DIMENSION(jpi,jpj) ::   zrhoa     ! transfer coefficient for momentum      (tau) 
    707       !!--------------------------------------------------------------------- 
    708       ! 
    709       ! set transfer coefficients to default sea-ice values 
    710       Cd_atm(:,:) = Cd_ice 
    711       Ch_atm(:,:) = Cd_ice 
    712       Ce_atm(:,:) = Cd_ice 
    713  
    714       wndm_ice(:,:) = 0._wp      !!gm brutal.... 
     872      REAL(wp) ::   zootm_su                      ! sea-ice surface mean temperature 
     873      REAL(wp) ::   zztmp1, zztmp2                ! temporary arrays 
     874      REAL(wp), DIMENSION(jpi,jpj) ::   zcd_dui   ! transfer coefficient for momentum      (tau) 
     875      !!--------------------------------------------------------------------- 
     876      ! 
    715877 
    716878      ! ------------------------------------------------------------ ! 
     
    720882      DO jj = 2, jpjm1 
    721883         DO ji = fs_2, fs_jpim1   ! vect. opt. 
    722             zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  ) 
    723             zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  ) 
     884            zwndi_t = (  pwndi(ji,jj) - rn_vfac * 0.5_wp * ( puice(ji-1,jj  ) + puice(ji,jj) )  ) 
     885            zwndj_t = (  pwndj(ji,jj) - rn_vfac * 0.5_wp * ( pvice(ji  ,jj-1) + pvice(ji,jj) )  ) 
    724886            wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    725887         END DO 
     
    729891      ! Make ice-atm. drag dependent on ice concentration 
    730892      IF    ( ln_Cd_L12 ) THEN   ! calculate new drag from Lupkes(2012) equations 
    731          CALL Cdn10_Lupkes2012( Cd_atm ) 
    732          Ch_atm(:,:) = Cd_atm(:,:)       ! momentum and heat transfer coef. are considered identical 
     893         CALL Cdn10_Lupkes2012( Cd_ice ) 
     894         Ch_ice(:,:) = Cd_ice(:,:)       ! momentum and heat transfer coef. are considered identical 
     895         Ce_ice(:,:) = Cd_ice(:,:) 
    733896      ELSEIF( ln_Cd_L15 ) THEN   ! calculate new drag from Lupkes(2015) equations 
    734          CALL Cdn10_Lupkes2015( Cd_atm, Ch_atm )  
    735       ENDIF 
    736  
    737 !!      CALL iom_put( "Cd_ice", Cd_atm)  ! output value of pure ice-atm. transfer coef. 
    738 !!      CALL iom_put( "Ch_ice", Ch_atm)  ! output value of pure ice-atm. transfer coef. 
     897         CALL Cdn10_Lupkes2015( ptsui, pslp, Cd_ice, Ch_ice ) 
     898         Ce_ice(:,:) = Ch_ice(:,:)       ! sensible and latent heat transfer coef. are considered identical 
     899      ENDIF 
     900 
     901      !! IF ( iom_use("Cd_ice") ) CALL iom_put("Cd_ice", Cd_ice)   ! output value of pure ice-atm. transfer coef. 
     902      !! IF ( iom_use("Ch_ice") ) CALL iom_put("Ch_ice", Ch_ice)   ! output value of pure ice-atm. transfer coef. 
    739903 
    740904      ! local scalars ( place there for vector optimisation purposes) 
    741       ! Computing density of air! Way denser that 1.2 over sea-ice !!! 
    742       zrhoa (:,:) =  rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) 
    743  
    744       !!gm brutal.... 
    745       utau_ice  (:,:) = 0._wp 
    746       vtau_ice  (:,:) = 0._wp 
    747       !!gm end 
    748  
    749       ! ------------------------------------------------------------ ! 
    750       !    Wind stress relative to the moving ice ( U10m - U_ice )   ! 
    751       ! ------------------------------------------------------------ ! 
    752       ! C-grid ice dynamics :   U & V-points (same as ocean) 
    753       DO jj = 2, jpjm1 
    754          DO ji = fs_2, fs_jpim1   ! vect. opt. 
    755             utau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )            & 
    756                &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) ) 
    757             vtau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )            & 
    758                &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) ) 
     905      !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) 
     906      zcd_dui(:,:) = wndm_ice(:,:) * Cd_ice(:,:) 
     907 
     908      IF( ln_blk ) THEN 
     909         ! ------------------------------------------------------------ ! 
     910         !    Wind stress relative to the moving ice ( U10m - U_ice )   ! 
     911         ! ------------------------------------------------------------ ! 
     912         ! C-grid ice dynamics :   U & V-points (same as ocean) 
     913         DO jj = 2, jpjm1 
     914            DO ji = fs_2, fs_jpim1   ! vect. opt. 
     915               putaui(ji,jj) = 0.5_wp * (  rhoa(ji+1,jj) * zcd_dui(ji+1,jj)             & 
     916                  &                      + rhoa(ji  ,jj) * zcd_dui(ji  ,jj)  )          & 
     917                  &         * ( 0.5_wp * ( pwndi(ji+1,jj) + pwndi(ji,jj) ) - rn_vfac * puice(ji,jj) ) 
     918               pvtaui(ji,jj) = 0.5_wp * (  rhoa(ji,jj+1) * zcd_dui(ji,jj+1)             & 
     919                  &                      + rhoa(ji,jj  ) * zcd_dui(ji,jj  )  )          & 
     920                  &         * ( 0.5_wp * ( pwndj(ji,jj+1) + pwndj(ji,jj) ) - rn_vfac * pvice(ji,jj) ) 
     921            END DO 
    759922         END DO 
    760       END DO 
    761       CALL lbc_lnk_multi( 'sbcblk', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 
    762       ! 
    763       ! 
    764       IF(ln_ctl) THEN 
    765          CALL prt_ctl(tab2d_1=utau_ice  , clinfo1=' blk_ice: utau_ice : ', tab2d_2=vtau_ice  , clinfo2=' vtau_ice : ') 
    766          CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice: wndm_ice : ') 
    767       ENDIF 
    768       ! 
    769    END SUBROUTINE blk_ice_tau 
    770  
    771  
    772    SUBROUTINE blk_ice_flx( ptsu, phs, phi, palb ) 
    773       !!--------------------------------------------------------------------- 
    774       !!                     ***  ROUTINE blk_ice_flx  *** 
     923         CALL lbc_lnk_multi( 'sbcblk', putaui, 'U', -1., pvtaui, 'V', -1. ) 
     924         ! 
     925         IF(ln_ctl)   CALL prt_ctl( tab2d_1=putaui  , clinfo1=' blk_ice: putaui : '   & 
     926            &                     , tab2d_2=pvtaui  , clinfo2='          pvtaui : ' ) 
     927      ELSE 
     928         zztmp1 = 11637800.0_wp 
     929         zztmp2 =    -5897.8_wp 
     930         DO jj = 1, jpj 
     931            DO ji = 1, jpi 
     932               pcd_dui(ji,jj) = zcd_dui (ji,jj) 
     933               pseni  (ji,jj) = wndm_ice(ji,jj) * Ch_ice(ji,jj) 
     934               pevpi  (ji,jj) = wndm_ice(ji,jj) * Ce_ice(ji,jj) 
     935               zootm_su       = zztmp2 / ptsui(ji,jj)   ! ptsui is in K (it can't be zero ??) 
     936               pssqi  (ji,jj) = zztmp1 * EXP( zootm_su ) / rhoa(ji,jj) 
     937            END DO 
     938         END DO 
     939      ENDIF 
     940      ! 
     941      IF(ln_ctl)  CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice: wndm_ice : ') 
     942      ! 
     943   END SUBROUTINE blk_ice_1 
     944 
     945 
     946   SUBROUTINE blk_ice_2( ptsu, phs, phi, palb, ptair, phumi, pslp, pqlw, pprec, psnow  ) 
     947      !!--------------------------------------------------------------------- 
     948      !!                     ***  ROUTINE blk_ice_2  *** 
    775949      !! 
    776950      !! ** Purpose :   provide the heat and mass fluxes at air-ice interface 
     
    782956      !! caution : the net upward water flux has with mm/day unit 
    783957      !!--------------------------------------------------------------------- 
    784       REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu   ! sea ice surface temperature 
     958      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu   ! sea ice surface temperature [K] 
    785959      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phs    ! snow thickness 
    786960      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness 
    787961      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   palb   ! ice albedo (all skies) 
     962      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   ptair 
     963      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   phumi 
     964      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pslp 
     965      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pqlw 
     966      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   pprec 
     967      REAL(wp), DIMENSION(:,:  ), INTENT(in)  ::   psnow 
    788968      !! 
    789969      INTEGER  ::   ji, jj, jl               ! dummy loop indices 
    790970      REAL(wp) ::   zst3                     ! local variable 
    791971      REAL(wp) ::   zcoef_dqlw, zcoef_dqla   !   -      - 
    792       REAL(wp) ::   zztmp, z1_rLsub           !   -      - 
     972      REAL(wp) ::   zztmp, zztmp2, z1_rLsub  !   -      - 
    793973      REAL(wp) ::   zfr1, zfr2               ! local variables 
    794974      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_st         ! inverse of surface temperature 
     
    798978      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_dqsb        ! sensible  heat sensitivity over ice 
    799979      REAL(wp), DIMENSION(jpi,jpj)     ::   zevap, zsnw   ! evaporation and snw distribution after wind blowing (SI3) 
    800       REAL(wp), DIMENSION(jpi,jpj)     ::   zrhoa 
    801       !!--------------------------------------------------------------------- 
    802       ! 
    803       zcoef_dqlw = 4.0 * 0.95 * Stef             ! local scalars 
    804       zcoef_dqla = -Ls * 11637800. * (-5897.8) 
    805       ! 
    806       zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) ) 
     980      REAL(wp), DIMENSION(jpi,jpj)     ::   zqair         ! specific humidity of air at z=rn_zqt [kg/kg] !LB 
     981      !!--------------------------------------------------------------------- 
     982      ! 
     983      zcoef_dqlw = 4._wp * 0.95_wp * stefan             ! local scalars 
     984      zcoef_dqla = -rLsub * 11637800._wp * (-5897.8_wp) !LB: BAD! 
     985      ! 
     986      SELECT CASE( nhumi ) 
     987      CASE( np_humi_sph ) 
     988         zqair(:,:) =  phumi(:,:)      ! what we read in file is already a spec. humidity! 
     989      CASE( np_humi_dpt ) 
     990         zqair(:,:) = q_sat( phumi(:,:), pslp ) 
     991      CASE( np_humi_rlh ) 
     992         zqair(:,:) = q_air_rh( 0.01_wp*phumi(:,:), ptair(:,:), pslp(:,:) ) !LB: 0.01 => RH is % percent in file 
     993      END SELECT 
    807994      ! 
    808995      zztmp = 1. / ( 1. - albo ) 
    809       WHERE( ptsu(:,:,:) /= 0._wp )   ;   z1_st(:,:,:) = 1._wp / ptsu(:,:,:) 
    810       ELSEWHERE                       ;   z1_st(:,:,:) = 0._wp 
     996      WHERE( ptsu(:,:,:) /= 0._wp ) 
     997         z1_st(:,:,:) = 1._wp / ptsu(:,:,:) 
     998      ELSEWHERE 
     999         z1_st(:,:,:) = 0._wp 
    8111000      END WHERE 
    8121001      !                                     ! ========================== ! 
     
    8221011               qsr_ice(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 
    8231012               ! Long  Wave (lw) 
    824                z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
     1013               z_qlw(ji,jj,jl) = 0.95 * ( pqlw(ji,jj) - stefan * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
    8251014               ! lw sensitivity 
    8261015               z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3 
     
    8301019               ! ----------------------------! 
    8311020 
    832                ! ... turbulent heat fluxes with Ch_atm recalculated in blk_ice_tau 
     1021               ! ... turbulent heat fluxes with Ch_ice recalculated in blk_ice_1 
    8331022               ! Sensible Heat 
    834                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)) 
     1023               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)) 
    8351024               ! Latent Heat 
    836                qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls  * Ch_atm(ji,jj) * wndm_ice(ji,jj) *  & 
    837                   &                ( 11637800. * EXP( -5897.8 * z1_st(ji,jj,jl) ) / zrhoa(ji,jj) - sf(jp_humi)%fnow(ji,jj,1) ) ) 
     1025               zztmp2 = EXP( -5897.8 * z1_st(ji,jj,jl) ) 
     1026               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa(ji,jj) * rLsub  * Ce_ice(ji,jj) * wndm_ice(ji,jj) *  & 
     1027                  &                ( 11637800. * zztmp2 / rhoa(ji,jj) - zqair(ji,jj) ) ) 
    8381028               ! Latent heat sensitivity for ice (Dqla/Dt) 
    8391029               IF( qla_ice(ji,jj,jl) > 0._wp ) THEN 
    840                   dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ch_atm(ji,jj) * wndm_ice(ji,jj) *  & 
    841                      &                 z1_st(ji,jj,jl)*z1_st(ji,jj,jl) * EXP(-5897.8 * z1_st(ji,jj,jl)) 
     1030                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ce_ice(ji,jj) * wndm_ice(ji,jj) *  & 
     1031                     &                 z1_st(ji,jj,jl) * z1_st(ji,jj,jl) * zztmp2 
    8421032               ELSE 
    8431033                  dqla_ice(ji,jj,jl) = 0._wp 
     
    8451035 
    8461036               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    847                z_dqsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_atm(ji,jj) * wndm_ice(ji,jj) 
     1037               z_dqsb(ji,jj,jl) = rhoa(ji,jj) * rCp_air * Ch_ice(ji,jj) * wndm_ice(ji,jj) 
    8481038 
    8491039               ! ----------------------------! 
     
    8601050      END DO 
    8611051      ! 
    862       tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1)  ! total precipitation [kg/m2/s] 
    863       sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac * tmask(:,:,1)  ! solid precipitation [kg/m2/s] 
    864       CALL iom_put( 'snowpre', sprecip )                    ! Snow precipitation 
    865       CALL iom_put( 'precip' , tprecip )                    ! Total precipitation 
     1052      tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1)  ! total precipitation [kg/m2/s] 
     1053      sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1)  ! solid precipitation [kg/m2/s] 
     1054      CALL iom_put( 'snowpre', sprecip )                  ! Snow precipitation 
     1055      CALL iom_put( 'precip' , tprecip )                  ! Total precipitation 
    8661056 
    8671057      ! --- evaporation --- ! 
     
    8801070      ! --- heat flux associated with emp --- ! 
    8811071      qemp_oce(:,:) = - ( 1._wp - at_i_b(:,:) ) * zevap(:,:) * sst_m(:,:) * rcp                  & ! evap at sst 
    882          &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip at Tair 
     1072         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( ptair(:,:) - rt0 ) * rcp               & ! liquid precip at Tair 
    8831073         &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip at min(Tair,Tsnow) 
    884          &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 
     1074         &              ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 
    8851075      qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only) 
    886          &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 
     1076         &              ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 
    8871077 
    8881078      ! --- total solar and non solar fluxes --- ! 
     
    8921082 
    8931083      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
    894       qprec_ice(:,:) = rhos * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 
     1084      qprec_ice(:,:) = rhos * ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 
    8951085 
    8961086      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- 
    8971087      DO jl = 1, jpl 
    8981088         qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * rcpi * tmask(:,:,1) ) 
    899          !                         ! But we do not have Tice => consider it at 0degC => evap=0  
     1089         !                         ! But we do not have Tice => consider it at 0degC => evap=0 
    9001090      END DO 
    9011091 
     
    9041094      zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1 
    9051095      ! 
    906       WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
     1096      WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm 
    9071097         qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
    9081098      ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm 
    9091099         qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 
    9101100      ELSEWHERE                                                         ! zero when hs>0 
    911          qtr_ice_top(:,:,:) = 0._wp  
     1101         qtr_ice_top(:,:,:) = 0._wp 
    9121102      END WHERE 
    9131103      ! 
     
    9211111      ENDIF 
    9221112      ! 
    923    END SUBROUTINE blk_ice_flx 
    924     
     1113   END SUBROUTINE blk_ice_2 
     1114 
    9251115 
    9261116   SUBROUTINE blk_ice_qcn( ld_virtual_itd, ptsu, ptb, phs, phi ) 
     
    9311121      !!                to force sea ice / snow thermodynamics 
    9321122      !!                in the case conduction flux is emulated 
    933       !!                 
     1123      !! 
    9341124      !! ** Method  :   compute surface energy balance assuming neglecting heat storage 
    9351125      !!                following the 0-layer Semtner (1976) approach 
     
    9561146      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zgfac   ! enhanced conduction factor 
    9571147      !!--------------------------------------------------------------------- 
    958        
     1148 
    9591149      ! -------------------------------------! 
    9601150      !      I   Enhanced conduction factor  ! 
     
    9641154      ! 
    9651155      zgfac(:,:,:) = 1._wp 
    966        
     1156 
    9671157      IF( ld_virtual_itd ) THEN 
    9681158         ! 
     
    9701160         zfac2 = EXP(1._wp) * 0.5_wp * zepsilon 
    9711161         zfac3 = 2._wp / zepsilon 
    972          !    
    973          DO jl = 1, jpl                 
     1162         ! 
     1163         DO jl = 1, jpl 
    9741164            DO jj = 1 , jpj 
    9751165               DO ji = 1, jpi 
     
    9791169            END DO 
    9801170         END DO 
    981          !       
    982       ENDIF 
    983        
     1171         ! 
     1172      ENDIF 
     1173 
    9841174      ! -------------------------------------------------------------! 
    9851175      !      II   Surface temperature and conduction flux            ! 
     
    9911181         DO jj = 1 , jpj 
    9921182            DO ji = 1, jpi 
    993                !                     
     1183               ! 
    9941184               zkeff_h = zfac * zgfac(ji,jj,jl) / &                                    ! Effective conductivity of the snow-ice system divided by thickness 
    9951185                  &      ( rcnd_i * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) ) 
     
    10081198               qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) 
    10091199               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) )  & 
    1010                              &   * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) ) 
     1200                  &   * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) ) 
    10111201 
    10121202               ! --- Diagnose the heat loss due to changing non-solar flux (as in icethd_zdf_bl99) --- ! 
    1013                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)  
     1203               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) 
    10141204 
    10151205            END DO 
    10161206         END DO 
    10171207         ! 
    1018       END DO  
    1019       !       
     1208      END DO 
     1209      ! 
    10201210   END SUBROUTINE blk_ice_qcn 
    1021     
    1022  
    1023    SUBROUTINE Cdn10_Lupkes2012( Cd ) 
     1211 
     1212 
     1213   SUBROUTINE Cdn10_Lupkes2012( pcd ) 
    10241214      !!---------------------------------------------------------------------- 
    10251215      !!                      ***  ROUTINE  Cdn10_Lupkes2012  *** 
    10261216      !! 
    1027       !! ** Purpose :    Recompute the neutral air-ice drag referenced at 10m  
     1217      !! ** Purpose :    Recompute the neutral air-ice drag referenced at 10m 
    10281218      !!                 to make it dependent on edges at leads, melt ponds and flows. 
    10291219      !!                 After some approximations, this can be resumed to a dependency 
    10301220      !!                 on ice concentration. 
    1031       !!                 
     1221      !! 
    10321222      !! ** Method :     The parameterization is taken from Lupkes et al. (2012) eq.(50) 
    10331223      !!                 with the highest level of approximation: level4, eq.(59) 
     
    10411231      !! 
    10421232      !!                 This new drag has a parabolic shape (as a function of A) starting at 
    1043       !!                 Cdw(say 1.5e-3) for A=0, reaching 1.97e-3 for A~0.5  
     1233      !!                 Cdw(say 1.5e-3) for A=0, reaching 1.97e-3 for A~0.5 
    10441234      !!                 and going down to Cdi(say 1.4e-3) for A=1 
    10451235      !! 
     
    10511241      !! 
    10521242      !!---------------------------------------------------------------------- 
    1053       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Cd 
     1243      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pcd 
    10541244      REAL(wp), PARAMETER ::   zCe   = 2.23e-03_wp 
    10551245      REAL(wp), PARAMETER ::   znu   = 1._wp 
     
    10661256 
    10671257      ! ice-atm drag 
    1068       Cd(:,:) = Cd_ice +  &                                                         ! pure ice drag 
    1069          &      zCe    * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)  ! change due to sea-ice morphology 
    1070        
     1258      pcd(:,:) = rCd_ice +  &                                                         ! pure ice drag 
     1259         &      zCe     * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)  ! change due to sea-ice morphology 
     1260 
    10711261   END SUBROUTINE Cdn10_Lupkes2012 
    10721262 
    10731263 
    1074    SUBROUTINE Cdn10_Lupkes2015( Cd, Ch ) 
     1264   SUBROUTINE Cdn10_Lupkes2015( ptm_su, pslp, pcd, pch ) 
    10751265      !!---------------------------------------------------------------------- 
    10761266      !!                      ***  ROUTINE  Cdn10_Lupkes2015  *** 
    10771267      !! 
    10781268      !! ** pUrpose :    Alternative turbulent transfert coefficients formulation 
    1079       !!                 between sea-ice and atmosphere with distinct momentum  
    1080       !!                 and heat coefficients depending on sea-ice concentration  
     1269      !!                 between sea-ice and atmosphere with distinct momentum 
     1270      !!                 and heat coefficients depending on sea-ice concentration 
    10811271      !!                 and atmospheric stability (no meltponds effect for now). 
    1082       !!                 
     1272      !! 
    10831273      !! ** Method :     The parameterization is adapted from Lupkes et al. (2015) 
    10841274      !!                 and ECHAM6 atmospheric model. Compared to Lupkes2012 scheme, 
    10851275      !!                 it considers specific skin and form drags (Andreas et al. 2010) 
    1086       !!                 to compute neutral transfert coefficients for both heat and  
     1276      !!                 to compute neutral transfert coefficients for both heat and 
    10871277      !!                 momemtum fluxes. Atmospheric stability effect on transfert 
    10881278      !!                 coefficient is also taken into account following Louis (1979). 
     
    10931283      !!---------------------------------------------------------------------- 
    10941284      ! 
    1095       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Cd 
    1096       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Ch 
    1097       REAL(wp), DIMENSION(jpi,jpj)            ::   ztm_su, zst, zqo_sat, zqi_sat 
     1285      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   ptm_su ! sea-ice surface temperature [K] 
     1286      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pslp   ! sea-level pressure [Pa] 
     1287      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pcd    ! momentum transfert coefficient 
     1288      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pch    ! heat transfert coefficient 
     1289      REAL(wp), DIMENSION(jpi,jpj)            ::   zst, zqo_sat, zqi_sat 
    10981290      ! 
    10991291      ! ECHAM6 constants 
     
    11231315      !!---------------------------------------------------------------------- 
    11241316 
    1125       ! mean temperature 
    1126       WHERE( at_i_b(:,:) > 1.e-20 )   ;   ztm_su(:,:) = SUM( t_su(:,:,:) * a_i_b(:,:,:) , dim=3 ) / at_i_b(:,:) 
    1127       ELSEWHERE                       ;   ztm_su(:,:) = rt0 
    1128       ENDWHERE 
    1129        
    11301317      ! Momentum Neutral Transfert Coefficients (should be a constant) 
    11311318      zCdn_form_tmp = zce10 * ( LOG( 10._wp / z0_form_ice + 1._wp ) / LOG( rn_zu / z0_form_ice + 1._wp ) )**2   ! Eq. 40 
    11321319      zCdn_skin_ice = ( vkarmn                                      / LOG( rn_zu / z0_skin_ice + 1._wp ) )**2   ! Eq. 7 
    1133       zCdn_ice      = zCdn_skin_ice   ! Eq. 7 (cf Lupkes email for details) 
     1320      zCdn_ice      = zCdn_skin_ice   ! Eq. 7 
    11341321      !zCdn_ice     = 1.89e-3         ! old ECHAM5 value (cf Eq. 32) 
    11351322 
    11361323      ! Heat Neutral Transfert Coefficients 
    1137       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) 
    1138       
     1324      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 
     1325 
    11391326      ! Atmospheric and Surface Variables 
    11401327      zst(:,:)     = sst_m(:,:) + rt0                                        ! convert SST from Celcius to Kelvin 
    1141       zqo_sat(:,:) = 0.98_wp * q_sat( zst(:,:)   , sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ocean [kg/kg] 
    1142       zqi_sat(:,:) = 0.98_wp * q_sat( ztm_su(:,:), sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ice   [kg/kg] 
     1328      zqo_sat(:,:) = rdct_qsat_salt * q_sat( zst(:,:)   , pslp(:,:) )   ! saturation humidity over ocean [kg/kg] 
     1329      zqi_sat(:,:) =                  q_sat( ptm_su(:,:), pslp(:,:) )   ! saturation humidity over ice   [kg/kg] 
    11431330      ! 
    11441331      DO jj = 2, jpjm1           ! reduced loop is necessary for reproducibility 
     
    11461333            ! Virtual potential temperature [K] 
    11471334            zthetav_os = zst(ji,jj)    * ( 1._wp + rctv0 * zqo_sat(ji,jj) )   ! over ocean 
    1148             zthetav_is = ztm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice 
     1335            zthetav_is = ptm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice 
    11491336            zthetav_zu = t_zu (ji,jj)  * ( 1._wp + rctv0 * q_zu(ji,jj)    )   ! at zu 
    1150              
     1337 
    11511338            ! Bulk Richardson Number (could use Ri_bulk function from aerobulk instead) 
    11521339            zrib_o = grav / zthetav_os * ( zthetav_zu - zthetav_os ) * rn_zu / MAX( 0.5, wndm(ji,jj)     )**2   ! over ocean 
    11531340            zrib_i = grav / zthetav_is * ( zthetav_zu - zthetav_is ) * rn_zu / MAX( 0.5, wndm_ice(ji,jj) )**2   ! over ice 
    1154              
     1341 
    11551342            ! Momentum and Heat Neutral Transfert Coefficients 
    11561343            zCdn_form_ice = zCdn_form_tmp * at_i_b(ji,jj) * ( 1._wp - at_i_b(ji,jj) )**zbeta  ! Eq. 40 
    1157             zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) )               ! Eq. 53  
    1158                         
    1159             ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead) 
     1344            zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) )               ! Eq. 53 
     1345 
     1346            ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead ?) 
    11601347            z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water 
    1161             z0i = z0_skin_ice                                             ! over ice (cf Lupkes email for details) 
     1348            z0i = z0_skin_ice                                             ! over ice 
    11621349            IF( zrib_o <= 0._wp ) THEN 
    11631350               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 
     
    11681355               zfhw = 1._wp / ( 1._wp + zah * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 28 
    11691356            ENDIF 
    1170              
     1357 
    11711358            IF( zrib_i <= 0._wp ) THEN 
    11721359               zfmi = 1._wp - zam * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq.  9 
     
    11761363               zfhi = 1._wp / ( 1._wp + zah * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 27 
    11771364            ENDIF 
    1178              
     1365 
    11791366            ! Momentum Transfert Coefficients (Eq. 38) 
    1180             Cd(ji,jj) = zCdn_skin_ice *   zfmi +  & 
     1367            pcd(ji,jj) = zCdn_skin_ice *   zfmi +  & 
    11811368               &        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) ) 
    1182              
     1369 
    11831370            ! Heat Transfert Coefficients (Eq. 49) 
    1184             Ch(ji,jj) = zChn_skin_ice *   zfhi +  & 
     1371            pch(ji,jj) = zChn_skin_ice *   zfhi +  & 
    11851372               &        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) ) 
    11861373            ! 
    11871374         END DO 
    11881375      END DO 
    1189       CALL lbc_lnk_multi( 'sbcblk', Cd, 'T',  1., Ch, 'T', 1. ) 
     1376      CALL lbc_lnk_multi( 'sbcblk', pcd, 'T',  1., pch, 'T', 1. ) 
    11901377      ! 
    11911378   END SUBROUTINE Cdn10_Lupkes2015 
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcblk_algo_ecmwf.F90

    r10069 r12182  
    11MODULE sbcblk_algo_ecmwf 
    22   !!====================================================================== 
    3    !!                       ***  MODULE  sbcblk_algo_ecmwf  *** 
    4    !! Computes turbulent components of surface fluxes 
    5    !!         according to the method in IFS of the ECMWF model 
    6    !! 
     3   !!                   ***  MODULE  sbcblk_algo_ecmwf  *** 
     4   !! Computes: 
    75   !!   * bulk transfer coefficients C_D, C_E and C_H 
    86   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed 
     
    108   !!   => all these are used in bulk formulas in sbcblk.F90 
    119   !! 
    12    !!    Using the bulk formulation/param. of IFS of ECMWF (cycle 31r2) 
     10   !!    Using the bulk formulation/param. of IFS of ECMWF (cycle 40r1) 
    1311   !!         based on IFS doc (avaible online on the ECMWF's website) 
    1412   !! 
     13   !!       Routine turb_ecmwf maintained and developed in AeroBulk 
     14   !!                     (https://github.com/brodeau/aerobulk) 
    1515   !! 
    16    !!       Routine turb_ecmwf maintained and developed in AeroBulk 
    17    !!                     (http://aerobulk.sourceforge.net/) 
    18    !! 
    19    !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
     16   !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk) 
    2017   !!---------------------------------------------------------------------- 
    2118   !! History :  4.0  !  2016-02  (L.Brodeau)   Original code 
     
    4138 
    4239   USE sbc_oce         ! Surface boundary condition: ocean fields 
     40   USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB 
     41   USE sbcblk_skin_ecmwf ! cool-skin/warm layer scheme !LB 
    4342 
    4443   IMPLICIT NONE 
    4544   PRIVATE 
    4645 
    47    PUBLIC ::   TURB_ECMWF   ! called by sbcblk.F90 
    48  
    49    !                   !! ECMWF own values for given constants, taken form IFS documentation... 
     46   PUBLIC :: SBCBLK_ALGO_ECMWF_INIT, TURB_ECMWF 
     47 
     48   !! ECMWF own values for given constants, taken form IFS documentation... 
    5049   REAL(wp), PARAMETER ::   charn0 = 0.018    ! Charnock constant (pretty high value here !!! 
    5150   !                                          !    =>  Usually 0.011 for moderate winds) 
    5251   REAL(wp), PARAMETER ::   zi0     = 1000.   ! scale height of the atmospheric boundary layer...1 
    5352   REAL(wp), PARAMETER ::   Beta0    = 1.     ! gustiness parameter ( = 1.25 in COAREv3) 
    54    REAL(wp), PARAMETER ::   rctv0    = 0.608  ! constant to obtain virtual temperature... 
    55    REAL(wp), PARAMETER ::   Cp_dry = 1005.0   ! Specic heat of dry air, constant pressure      [J/K/kg] 
    56    REAL(wp), PARAMETER ::   Cp_vap = 1860.0   ! Specic heat of water vapor, constant pressure  [J/K/kg] 
    5753   REAL(wp), PARAMETER ::   alpha_M = 0.11    ! For roughness length (smooth surface term) 
    5854   REAL(wp), PARAMETER ::   alpha_H = 0.40    ! (Chapter 3, p.34, IFS doc Cy31r1) 
    5955   REAL(wp), PARAMETER ::   alpha_Q = 0.62    ! 
     56 
     57   INTEGER , PARAMETER ::   nb_itt = 10             ! number of itterations 
     58 
    6059   !!---------------------------------------------------------------------- 
    6160CONTAINS 
    6261 
    63    SUBROUTINE TURB_ECMWF( zt, zu, sst, t_zt, ssq , q_zt , U_zu,   & 
    64       &                   Cd, Ch, Ce , t_zu, q_zu, U_blk,         & 
    65       &                   Cdn, Chn, Cen                           ) 
    66       !!---------------------------------------------------------------------------------- 
    67       !!                      ***  ROUTINE  turb_ecmwf  *** 
    68       !! 
    69       !!            2015: L. Brodeau (brodeau@gmail.com) 
    70       !! 
    71       !! ** Purpose :   Computes turbulent transfert coefficients of surface 
    72       !!                fluxes according to IFS doc. (cycle 31) 
    73       !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu 
    74       !! 
    75       !! ** Method : Monin Obukhov Similarity Theory 
     62 
     63   SUBROUTINE sbcblk_algo_ecmwf_init(l_use_cs, l_use_wl) 
     64      !!--------------------------------------------------------------------- 
     65      !!                  ***  FUNCTION sbcblk_algo_ecmwf_init  *** 
    7666      !! 
    7767      !! INPUT : 
    7868      !! ------- 
     69      !!    * l_use_cs : use the cool-skin parameterization 
     70      !!    * l_use_wl : use the warm-layer parameterization 
     71      !!--------------------------------------------------------------------- 
     72      LOGICAL , INTENT(in) ::   l_use_cs ! use the cool-skin parameterization 
     73      LOGICAL , INTENT(in) ::   l_use_wl ! use the warm-layer parameterization 
     74      INTEGER :: ierr 
     75      !!--------------------------------------------------------------------- 
     76      IF( l_use_wl ) THEN 
     77         ierr = 0 
     78         ALLOCATE ( dT_wl(jpi,jpj), Hz_wl(jpi,jpj), STAT=ierr ) 
     79         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_wl & Hz_wl failed!' ) 
     80         dT_wl(:,:)  = 0._wp 
     81         Hz_wl(:,:)  = rd0 ! (rd0, constant, = 3m is default for Zeng & Beljaars) 
     82      ENDIF 
     83      IF( l_use_cs ) THEN 
     84         ierr = 0 
     85         ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr ) 
     86         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_cs failed!' ) 
     87         dT_cs(:,:) = -0.25_wp  ! First guess of skin correction 
     88      ENDIF 
     89   END SUBROUTINE sbcblk_algo_ecmwf_init 
     90 
     91 
     92 
     93   SUBROUTINE turb_ecmwf( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, & 
     94      &                      Cd, Ch, Ce, t_zu, q_zu, U_blk,                           & 
     95      &                      Cdn, Chn, Cen,                                           & 
     96      &                      Qsw, rad_lw, slp, pdT_cs,                                & ! optionals for cool-skin (and warm-layer) 
     97      &                      pdT_wl, pHz_wl )                                           ! optionals for warm-layer only 
     98      !!---------------------------------------------------------------------- 
     99      !!                      ***  ROUTINE  turb_ecmwf  *** 
     100      !! 
     101      !! ** Purpose :   Computes turbulent transfert coefficients of surface 
     102      !!                fluxes according to IFS doc. (cycle 45r1) 
     103      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu 
     104      !!                Returns the effective bulk wind speed at zu to be used in the bulk formulas 
     105      !! 
     106      !!                Applies the cool-skin warm-layer correction of the SST to T_s 
     107      !!                if the net shortwave flux at the surface (Qsw), the downwelling longwave 
     108      !!                radiative fluxes at the surface (rad_lw), and the sea-leve pressure (slp) 
     109      !!                are provided as (optional) arguments! 
     110      !! 
     111      !! INPUT : 
     112      !! ------- 
     113      !!    *  kt   : current time step (starts at 1) 
    79114      !!    *  zt   : height for temperature and spec. hum. of air            [m] 
    80       !!    *  zu   : height for wind speed (generally 10m)                   [m] 
    81       !!    *  U_zu : scalar wind speed at 10m                                [m/s] 
    82       !!    *  sst  : SST                                                     [K] 
     115      !!    *  zu   : height for wind speed (usually 10m)                     [m] 
    83116      !!    *  t_zt : potential air temperature at zt                         [K] 
    84       !!    *  ssq  : specific humidity at saturation at SST                  [kg/kg] 
    85117      !!    *  q_zt : specific humidity of air at zt                          [kg/kg] 
    86       !! 
     118      !!    *  U_zu : scalar wind speed at zu                                 [m/s] 
     119      !!    * l_use_cs : use the cool-skin parameterization 
     120      !!    * l_use_wl : use the warm-layer parameterization 
     121      !! 
     122      !! INPUT/OUTPUT: 
     123      !! ------------- 
     124      !!    *  T_s  : always "bulk SST" as input                              [K] 
     125      !!              -> unchanged "bulk SST" as output if CSWL not used      [K] 
     126      !!              -> skin temperature as output if CSWL used              [K] 
     127      !! 
     128      !!    *  q_s  : SSQ aka saturation specific humidity at temp. T_s       [kg/kg] 
     129      !!              -> doesn't need to be given a value if skin temp computed (in case l_use_cs=True or l_use_wl=True) 
     130      !!              -> MUST be given the correct value if not computing skint temp. (in case l_use_cs=False or l_use_wl=False) 
     131      !! 
     132      !! OPTIONAL INPUT: 
     133      !! --------------- 
     134      !!    *  Qsw    : net solar flux (after albedo) at the surface (>0)     [W/m^2] 
     135      !!    *  rad_lw : downwelling longwave radiation at the surface  (>0)   [W/m^2] 
     136      !!    *  slp    : sea-level pressure                                    [Pa] 
     137      !! 
     138      !! OPTIONAL OUTPUT: 
     139      !! ---------------- 
     140      !!    * pdT_cs  : SST increment "dT" for cool-skin correction           [K] 
     141      !!    * pdT_wl  : SST increment "dT" for warm-layer correction          [K] 
     142      !!    * pHz_wl  : thickness of warm-layer                               [m] 
    87143      !! 
    88144      !! OUTPUT : 
     
    93149      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K] 
    94150      !!    *  q_zu   : specific humidity of air        //                    [kg/kg] 
    95       !!    *  U_blk  : bulk wind at 10m                                      [m/s] 
    96       !! 
    97       !! 
    98       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    99       !!---------------------------------------------------------------------------------- 
     151      !!    *  U_blk  : bulk wind speed at zu                                 [m/s] 
     152      !! 
     153      !! 
     154      !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/) 
     155      !!---------------------------------------------------------------------------------- 
     156      INTEGER,  INTENT(in   )                     ::   kt       ! current time step 
    100157      REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m] 
    101158      REAL(wp), INTENT(in   )                     ::   zu       ! height for U_zu                             [m] 
    102       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   sst      ! sea surface temperature                [Kelvin] 
     159      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   T_s      ! sea surface temperature                [Kelvin] 
    103160      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin] 
    104       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity           [kg/kg] 
    105       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                   [kg/kg] 
     161      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   q_s      ! sea surface specific humidity           [kg/kg] 
     162      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity at zt             [kg/kg] 
    106163      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s] 
     164      LOGICAL , INTENT(in   )                     ::   l_use_cs ! use the cool-skin parameterization 
     165      LOGICAL , INTENT(in   )                     ::   l_use_wl ! use the warm-layer parameterization 
    107166      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau) 
    108167      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens) 
     
    110169      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K] 
    111170      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg] 
    112       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s] 
     171      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s] 
    113172      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients 
    114173      ! 
     174      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   Qsw      !             [W/m^2] 
     175      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   rad_lw   !             [W/m^2] 
     176      REAL(wp), INTENT(in   ), OPTIONAL, DIMENSION(jpi,jpj) ::   slp      !             [Pa] 
     177      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pdT_cs 
     178      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pdT_wl   !             [K] 
     179      REAL(wp), INTENT(  out), OPTIONAL, DIMENSION(jpi,jpj) ::   pHz_wl   !             [m] 
     180      ! 
    115181      INTEGER :: j_itt 
    116       LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    117       INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations 
    118       ! 
    119       REAL(wp), DIMENSION(jpi,jpj) ::   u_star, t_star, q_star,   & 
    120          &  dt_zu, dq_zu,    & 
    121          &  znu_a,           & !: Nu_air, Viscosity of air 
    122          &  Linv,            & !: 1/L (inverse of Monin Obukhov length... 
    123          &  z0, z0t, z0q 
    124       REAL(wp), DIMENSION(jpi,jpj) ::   func_m, func_h 
    125       REAL(wp), DIMENSION(jpi,jpj) ::   ztmp0, ztmp1, ztmp2 
    126       !!---------------------------------------------------------------------------------- 
    127       ! 
    128       ! Identical first gess as in COARE, with IFS parameter values though 
    129       ! 
     182      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
     183      ! 
     184      REAL(wp), DIMENSION(jpi,jpj) ::  u_star, t_star, q_star 
     185      REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu      
     186      REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air 
     187      REAL(wp), DIMENSION(jpi,jpj) :: Linv  !: 1/L (inverse of Monin Obukhov length... 
     188      REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t, z0q 
     189      ! 
     190      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst  ! to back up the initial bulk SST 
     191      ! 
     192      REAL(wp), DIMENSION(jpi,jpj) :: func_m, func_h 
     193      REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 
     194      CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ecmwf@sbcblk_algo_ecmwf.F90' 
     195      !!---------------------------------------------------------------------------------- 
     196 
     197      IF( kt == nit000 ) CALL SBCBLK_ALGO_ECMWF_INIT(l_use_cs, l_use_wl) 
     198 
    130199      l_zt_equal_zu = .FALSE. 
    131       IF( ABS(zu - zt) < 0.01 )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
    132  
    133  
     200      IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     201 
     202      !! Initializations for cool skin and warm layer: 
     203      IF( l_use_cs .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) & 
     204         &   CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use cool-skin param!' ) 
     205 
     206      IF( l_use_wl .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) & 
     207         &   CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use warm-layer param!' ) 
     208 
     209      IF( l_use_cs .OR. l_use_wl ) THEN 
     210         ALLOCATE ( zsst(jpi,jpj) ) 
     211         zsst = T_s ! backing up the bulk SST 
     212         IF( l_use_cs ) T_s = T_s - 0.25_wp   ! First guess of correction 
     213         q_s    = rdct_qsat_salt*q_sat(MAX(T_s, 200._wp), slp) ! First guess of q_s 
     214      ENDIF 
     215 
     216 
     217      ! Identical first gess as in COARE, with IFS parameter values though... 
     218      ! 
    134219      !! First guess of temperature and humidity at height zu: 
    135       t_zu = MAX( t_zt , 0.0 )   ! who knows what's given on masked-continental regions... 
    136       q_zu = MAX( q_zt , 1.e-6)   !               " 
     220      t_zu = MAX( t_zt ,  180._wp )   ! who knows what's given on masked-continental regions... 
     221      q_zu = MAX( q_zt , 1.e-6_wp )   !               " 
    137222 
    138223      !! Pot. temp. difference (and we don't want it to be 0!) 
    139       dt_zu = t_zu - sst   ;   dt_zu = SIGN( MAX(ABS(dt_zu),1.e-6), dt_zu ) 
    140       dq_zu = q_zu - ssq   ;   dq_zu = SIGN( MAX(ABS(dq_zu),1.e-9), dq_zu ) 
    141  
    142       znu_a = visc_air(t_zt) ! Air viscosity (m^2/s) at zt given from temperature in (K) 
    143  
    144       ztmp2 = 0.5 * 0.5 ! initial guess for wind gustiness contribution 
    145       U_blk = SQRT(U_zu*U_zu + ztmp2) 
    146  
    147       ! z0     = 0.0001 
    148       ztmp2   = 10000.     ! optimization: ztmp2 == 1/z0 
    149       ztmp0   = LOG(zu*ztmp2) 
    150       ztmp1   = LOG(10.*ztmp2) 
    151       u_star = 0.035*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10) 
    152  
    153       z0     = charn0*u_star*u_star/grav + 0.11*znu_a/u_star 
    154       z0t    = 0.1*EXP(vkarmn/(0.00115/(vkarmn/ztmp1)))   !  WARNING: 1/z0t ! 
     224      dt_zu = t_zu - T_s ;   dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu ) 
     225      dq_zu = q_zu - q_s ;   dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu ) 
     226 
     227      znu_a = visc_air(t_zu) ! Air viscosity (m^2/s) at zt given from temperature in (K) 
     228 
     229      U_blk = SQRT(U_zu*U_zu + 0.5_wp*0.5_wp) ! initial guess for wind gustiness contribution 
     230 
     231      ztmp0   = LOG(    zu*10000._wp) ! optimization: 10000. == 1/z0 (with z0 first guess == 0.0001) 
     232      ztmp1   = LOG(10._wp*10000._wp) !       "                    "               " 
     233      u_star = 0.035_wp*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10) 
     234 
     235      z0     = charn0*u_star*u_star/grav + 0.11_wp*znu_a/u_star 
     236      z0     = MIN( MAX(ABS(z0), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
     237 
     238      z0t    = 1._wp / ( 0.1_wp*EXP(vkarmn/(0.00115/(vkarmn/ztmp1))) ) 
     239      z0t    = MIN( MAX(ABS(z0t), 1.E-9) , 1._wp )                      ! (prevents FPE from stupid values from masked region later on) 
    155240 
    156241      Cd     = (vkarmn/ztmp0)**2    ! first guess of Cd 
    157242 
    158       ztmp0 = vkarmn*vkarmn/LOG(zt*z0t)/Cd 
    159  
    160       ztmp2 = Ri_bulk( zu, t_zu, dt_zu, q_zu, dq_zu, U_blk )   ! Ribu = Bulk Richardson number 
    161  
    162       !! First estimate of zeta_u, depending on the stability, ie sign of Ribu (ztmp2): 
    163       ztmp1 = 0.5 + SIGN( 0.5 , ztmp2 ) 
     243      ztmp0 = vkarmn*vkarmn/LOG(zt/z0t)/Cd 
     244 
     245      ztmp2 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN) 
     246 
     247      !! First estimate of zeta_u, depending on the stability, ie sign of BRN (ztmp2): 
     248      ztmp1 = 0.5 + SIGN( 0.5_wp , ztmp2 ) 
    164249      func_m = ztmp0*ztmp2 ! temporary array !! 
    165       !!             Ribu < 0                                 Ribu > 0   Beta = 1.25 
    166       func_h = (1.-ztmp1)*(func_m/(1.+ztmp2/(-zu/(zi0*0.004*Beta0**3)))) &  ! temporary array !!! func_h == zeta_u 
    167          &  +     ztmp1*(func_m*(1. + 27./9.*ztmp2/ztmp0)) 
     250      func_h = (1._wp-ztmp1) * (func_m/(1._wp+ztmp2/(-zu/(zi0*0.004_wp*Beta0**3)))) & !  BRN < 0 ! temporary array !!! func_h == zeta_u 
     251         &  +     ztmp1   * (func_m*(1._wp + 27._wp/9._wp*ztmp2/func_m))              !  BRN > 0 
     252      !#LB: should make sure that the "func_m" of "27./9.*ztmp2/func_m" is "ztmp0*ztmp2" and not "ztmp0==vkarmn*vkarmn/LOG(zt/z0t)/Cd" ! 
    168253 
    169254      !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L 
    170       ztmp0   =        vkarmn/(LOG(zu*z0t) - psi_h_ecmwf(func_h)) 
    171  
    172       u_star = U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_ecmwf(func_h)) 
     255      ztmp0  = vkarmn/(LOG(zu/z0t) - psi_h_ecmwf(func_h)) 
     256 
     257      u_star = MAX ( U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_ecmwf(func_h)) , 1.E-9 )  !  (MAX => prevents FPE from stupid values from masked region later on) 
    173258      t_star = dt_zu*ztmp0 
    174259      q_star = dq_zu*ztmp0 
    175260 
    176       ! What's need to be done if zt /= zu: 
     261      ! What needs to be done if zt /= zu: 
    177262      IF( .NOT. l_zt_equal_zu ) THEN 
    178          ! 
    179263         !! First update of values at zu (or zt for wind) 
    180264         ztmp0 = psi_h_ecmwf(func_h) - psi_h_ecmwf(zt*func_h/zu)    ! zt*func_h/zu == zeta_t 
    181          ztmp1 = log(zt/zu) + ztmp0 
     265         ztmp1 = LOG(zt/zu) + ztmp0 
    182266         t_zu = t_zt - t_star/vkarmn*ztmp1 
    183267         q_zu = q_zt - q_star/vkarmn*ztmp1 
    184          q_zu = (0.5 + sign(0.5,q_zu))*q_zu !Makes it impossible to have negative humidity : 
    185  
    186          dt_zu = t_zu - sst  ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu ) 
    187          dq_zu = q_zu - ssq  ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu ) 
     268         q_zu = (0.5_wp + SIGN(0.5_wp,q_zu))*q_zu !Makes it impossible to have negative humidity : 
    188269         ! 
     270         dt_zu = t_zu - T_s  ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu ) 
     271         dq_zu = q_zu - q_s  ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu ) 
    189272      ENDIF 
    190273 
     
    194277 
    195278      !! First guess of inverse of Monin-Obukov length (1/L) : 
    196       ztmp0 = (1. + rctv0*q_zu)  ! the factor to apply to temp. to get virt. temp... 
    197       Linv  =  grav*vkarmn*(t_star*ztmp0 + rctv0*t_zu*q_star) / ( u_star*u_star * t_zu*ztmp0 ) 
     279      Linv = One_on_L( t_zu, q_zu, u_star, t_star, q_star ) 
    198280 
    199281      !! Functions such as  u* = U_blk*vkarmn/func_m 
    200       ztmp1 = zu + z0 
    201       ztmp0 = ztmp1*Linv 
    202       func_m = LOG(ztmp1) -LOG(z0) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0*Linv) 
    203       func_h = LOG(ztmp1*z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(1./z0t*Linv) 
    204  
     282      ztmp0 = zu*Linv 
     283      func_m = LOG(zu) - LOG(z0)  - psi_m_ecmwf(ztmp0) + psi_m_ecmwf( z0*Linv) 
     284      func_h = LOG(zu) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv) 
    205285 
    206286      !! ITERATION BLOCK 
    207       !! *************** 
    208  
    209287      DO j_itt = 1, nb_itt 
    210288 
    211289         !! Bulk Richardson Number at z=zu (Eq. 3.25) 
    212          ztmp0 = Ri_bulk(zu, t_zu, dt_zu, q_zu, dq_zu, U_blk) 
     290         ztmp0 = Ri_bulk( zu, T_s, t_zu, q_s, q_zu, U_blk ) ! Bulk Richardson Number (BRN) 
    213291 
    214292         !! New estimate of the inverse of the Monin-Obukhon length (Linv == zeta/zu) : 
    215          Linv = ztmp0*func_m*func_m/func_h / zu     ! From Eq. 3.23, Chap.3, p.33, IFS doc - Cy31r1 
     293         Linv = ztmp0*func_m*func_m/func_h / zu     ! From Eq. 3.23, Chap.3.2.3, IFS doc - Cy40r1 
     294         !! Note: it is slightly different that the L we would get with the usual 
     295         Linv = SIGN( MIN(ABS(Linv),200._wp), Linv ) ! (prevent FPE from stupid values from masked region later on...) 
    216296 
    217297         !! Update func_m with new Linv: 
    218          ztmp1 = zu + z0 
    219          func_m = LOG(ztmp1) -LOG(z0) - psi_m_ecmwf(ztmp1*Linv) + psi_m_ecmwf(z0*Linv) 
     298         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! 
    220299 
    221300         !! Need to update roughness lengthes: 
     
    223302         ztmp2  = u_star*u_star 
    224303         ztmp1  = znu_a/u_star 
    225          z0    = alpha_M*ztmp1 + charn0*ztmp2/grav 
    226          z0t    = alpha_H*ztmp1                              ! eq.3.26, Chap.3, p.34, IFS doc - Cy31r1 
    227          z0q    = alpha_Q*ztmp1 
    228  
    229          !! Update wind at 10m taking into acount convection-related wind gustiness: 
    230          ! Only true when unstable (L<0) => when ztmp0 < 0 => - !!! 
    231          ztmp2 = ztmp2 * (MAX(-zi0*Linv/vkarmn,0.))**(2./3.) ! => w*^2  (combining Eq. 3.8 and 3.18, hap.3, IFS doc - Cy31r1) 
    232          !! => equivalent using Beta=1 (gustiness parameter, 1.25 for COARE, also zi0=600 in COARE..) 
    233          U_blk = MAX(sqrt(U_zu*U_zu + ztmp2), 0.2)              ! eq.3.17, Chap.3, p.32, IFS doc - Cy31r1 
     304         z0     = MIN( ABS( alpha_M*ztmp1 + charn0*ztmp2/grav ) , 0.001_wp) 
     305         z0t    = MIN( ABS( alpha_H*ztmp1                     ) , 0.001_wp)   ! eq.3.26, Chap.3, p.34, IFS doc - Cy31r1 
     306         z0q    = MIN( ABS( alpha_Q*ztmp1                     ) , 0.001_wp) 
     307 
     308         !! 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) 
     309         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) 
     310         !!   ! Only true when unstable (L<0) => when ztmp0 < 0 => explains "-" before zi0 
     311         U_blk = MAX(SQRT(U_zu*U_zu + ztmp2), 0.2_wp)        ! include gustiness in bulk wind speed 
    234312         ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0. 
    235313 
     
    238316         !! as well the air-sea differences: 
    239317         IF( .NOT. l_zt_equal_zu ) THEN 
    240  
    241318            !! Arrays func_m and func_h are free for a while so using them as temporary arrays... 
    242             func_h = psi_h_ecmwf((zu+z0)*Linv) ! temporary array !!! 
    243             func_m = psi_h_ecmwf((zt+z0)*Linv) ! temporary array !!! 
     319            func_h = psi_h_ecmwf(zu*Linv) ! temporary array !!! 
     320            func_m = psi_h_ecmwf(zt*Linv) ! temporary array !!! 
    244321 
    245322            ztmp2  = psi_h_ecmwf(z0t*Linv) 
    246323            ztmp0  = func_h - ztmp2 
    247             ztmp1  = vkarmn/(LOG(zu+z0) - LOG(z0t) - ztmp0) 
     324            ztmp1  = vkarmn/(LOG(zu) - LOG(z0t) - ztmp0) 
    248325            t_star = dt_zu*ztmp1 
    249326            ztmp2  = ztmp0 - func_m + ztmp2 
     
    253330            ztmp2  = psi_h_ecmwf(z0q*Linv) 
    254331            ztmp0  = func_h - ztmp2 
    255             ztmp1  = vkarmn/(LOG(zu+z0) - LOG(z0q) - ztmp0) 
     332            ztmp1  = vkarmn/(LOG(zu) - LOG(z0q) - ztmp0) 
    256333            q_star = dq_zu*ztmp1 
    257334            ztmp2  = ztmp0 - func_m + ztmp2 
    258             ztmp1  = log(zt/zu) + ztmp2 
     335            ztmp1  = LOG(zt/zu) + ztmp2 
    259336            q_zu   = q_zt - q_star/vkarmn*ztmp1 
    260  
    261             dt_zu = t_zu - sst ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu ) 
    262             dq_zu = q_zu - ssq ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu ) 
    263  
    264          END IF 
     337         ENDIF 
    265338 
    266339         !! Updating because of updated z0 and z0t and new Linv... 
    267          ztmp1 = zu + z0 
    268          ztmp0 = ztmp1*Linv 
    269          func_m = log(ztmp1) - LOG(z0 ) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0 *Linv) 
    270          func_h = log(ztmp1) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv) 
    271  
    272       END DO 
     340         ztmp0 = zu*Linv 
     341         func_m = log(zu) - LOG(z0 ) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0 *Linv) 
     342         func_h = log(zu) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv) 
     343 
     344 
     345         IF( l_use_cs ) THEN 
     346            !! Cool-skin contribution 
     347 
     348            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 
     349               &                   ztmp1, ztmp0,  Qlat=ztmp2)  ! Qnsol -> ztmp1 / Tau -> ztmp0 
     350 
     351            CALL CS_ECMWF( Qsw, ztmp1, u_star, zsst )  ! Qnsol -> ztmp1 
     352 
     353            T_s(:,:) = zsst(:,:) + dT_cs(:,:)*tmask(:,:,1) 
     354            IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1) 
     355            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:)) 
     356 
     357         ENDIF 
     358 
     359         IF( l_use_wl ) THEN 
     360            !! Warm-layer contribution 
     361            CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 
     362               &                   ztmp1, ztmp2)  ! Qnsol -> ztmp1 / Tau -> ztmp2 
     363            CALL WL_ECMWF( Qsw, ztmp1, u_star, zsst ) 
     364            !! Updating T_s and q_s !!! 
     365            T_s(:,:) = zsst(:,:) + dT_wl(:,:)*tmask(:,:,1) ! 
     366            IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*tmask(:,:,1) 
     367            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:)) 
     368         ENDIF 
     369 
     370         IF( l_use_cs .OR. l_use_wl .OR. (.NOT. l_zt_equal_zu) ) THEN 
     371            dt_zu = t_zu - T_s ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6_wp), dt_zu ) 
     372            dq_zu = q_zu - q_s ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9_wp), dq_zu ) 
     373         ENDIF 
     374 
     375      END DO !DO j_itt = 1, nb_itt 
    273376 
    274377      Cd = vkarmn*vkarmn/(func_m*func_m) 
    275378      Ch = vkarmn*vkarmn/(func_m*func_h) 
    276       ztmp1 = log((zu + z0)/z0q) - psi_h_ecmwf((zu + z0)*Linv) + psi_h_ecmwf(z0q*Linv)   ! func_q 
    277       Ce = vkarmn*vkarmn/(func_m*ztmp1) 
    278  
    279       ztmp1 = zu + z0 
    280       Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 )) 
    281       Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t)) 
    282       Cen = vkarmn*vkarmn / (log(ztmp1/z0q)*log(ztmp1/z0q)) 
    283  
    284    END SUBROUTINE TURB_ECMWF 
     379      ztmp2 = log(zu/z0q) - psi_h_ecmwf(zu*Linv) + psi_h_ecmwf(z0q*Linv)   ! func_q 
     380      Ce = vkarmn*vkarmn/(func_m*ztmp2) 
     381 
     382      Cdn = vkarmn*vkarmn / (log(zu/z0 )*log(zu/z0 )) 
     383      Chn = vkarmn*vkarmn / (log(zu/z0t)*log(zu/z0t)) 
     384      Cen = vkarmn*vkarmn / (log(zu/z0q)*log(zu/z0q)) 
     385 
     386      IF( l_use_cs .AND. PRESENT(pdT_cs) ) pdT_cs = dT_cs 
     387      IF( l_use_wl .AND. PRESENT(pdT_wl) ) pdT_wl = dT_wl 
     388      IF( l_use_wl .AND. PRESENT(pHz_wl) ) pHz_wl = Hz_wl 
     389 
     390      IF( l_use_cs .OR. l_use_wl ) DEALLOCATE ( zsst ) 
     391 
     392   END SUBROUTINE turb_ecmwf 
    285393 
    286394 
     
    294402      !!         and L is M-O length 
    295403      !! 
    296       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
     404      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    297405      !!---------------------------------------------------------------------------------- 
    298406      REAL(wp), DIMENSION(jpi,jpj) :: psi_m_ecmwf 
     
    302410      REAL(wp) :: zzeta, zx, ztmp, psi_unst, psi_stab, stab 
    303411      !!---------------------------------------------------------------------------------- 
    304       ! 
    305412      DO jj = 1, jpj 
    306413         DO ji = 1, jpi 
    307414            ! 
    308             zzeta = MIN( pzeta(ji,jj) , 5. ) !! Very stable conditions (L positif and big!): 
     415            zzeta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!): 
    309416            ! 
    310417            ! Unstable (Paulson 1970): 
    311418            !   eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
    312             zx = SQRT(ABS(1. - 16.*zzeta)) 
    313             ztmp = 1. + SQRT(zx) 
     419            zx = SQRT(ABS(1._wp - 16._wp*zzeta)) 
     420            ztmp = 1._wp + SQRT(zx) 
    314421            ztmp = ztmp*ztmp 
    315             psi_unst = LOG( 0.125*ztmp*(1. + zx) )   & 
    316                &       -2.*ATAN( SQRT(zx) ) + 0.5*rpi 
     422            psi_unst = LOG( 0.125_wp*ztmp*(1._wp + zx) )   & 
     423               &       -2._wp*ATAN( SQRT(zx) ) + 0.5_wp*rpi 
    317424            ! 
    318425            ! Unstable: 
    319426            ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 
    320             psi_stab = -2./3.*(zzeta - 5./0.35)*EXP(-0.35*zzeta) & 
    321                &       - zzeta - 2./3.*5./0.35 
     427            psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & 
     428               &       - zzeta - 2._wp/3._wp*5._wp/0.35_wp 
    322429            ! 
    323430            ! Combining: 
    324             stab = 0.5 + SIGN(0.5, zzeta) ! zzeta > 0 => stab = 1 
    325             ! 
    326             psi_m_ecmwf(ji,jj) = (1. - stab) * psi_unst & ! (zzeta < 0) Unstable 
    327                &                +      stab  * psi_stab   ! (zzeta > 0) Stable 
     431            stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 
     432            ! 
     433            psi_m_ecmwf(ji,jj) = (1._wp - stab) * psi_unst & ! (zzeta < 0) Unstable 
     434               &                +      stab  * psi_stab      ! (zzeta > 0) Stable 
    328435            ! 
    329436         END DO 
    330437      END DO 
    331       ! 
    332438   END FUNCTION psi_m_ecmwf 
    333439 
    334     
     440 
    335441   FUNCTION psi_h_ecmwf( pzeta ) 
    336442      !!---------------------------------------------------------------------------------- 
     
    342448      !!         and L is M-O length 
    343449      !! 
    344       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
     450      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    345451      !!---------------------------------------------------------------------------------- 
    346452      REAL(wp), DIMENSION(jpi,jpj) :: psi_h_ecmwf 
     
    354460         DO ji = 1, jpi 
    355461            ! 
    356             zzeta = MIN(pzeta(ji,jj) , 5.)   ! Very stable conditions (L positif and big!): 
    357             ! 
    358             zx  = ABS(1. - 16.*zzeta)**.25        ! this is actually (1/phi_m)**2  !!! 
     462            zzeta = MIN(pzeta(ji,jj) , 5._wp)   ! Very stable conditions (L positif and big!): 
     463            ! 
     464            zx  = ABS(1._wp - 16._wp*zzeta)**.25        ! this is actually (1/phi_m)**2  !!! 
    359465            !                                     ! eq.3.19, Chap.3, p.33, IFS doc - Cy31r1 
    360466            ! Unstable (Paulson 1970) : 
    361             psi_unst = 2.*LOG(0.5*(1. + zx*zx))   ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
     467            psi_unst = 2._wp*LOG(0.5_wp*(1._wp + zx*zx))   ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
    362468            ! 
    363469            ! Stable: 
    364             psi_stab = -2./3.*(zzeta - 5./0.35)*EXP(-0.35*zzeta) & ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 
    365                &       - ABS(1. + 2./3.*zzeta)**1.5 - 2./3.*5./0.35 + 1.  
     470            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 
     471               &       - ABS(1._wp + 2._wp/3._wp*zzeta)**1.5_wp - 2._wp/3._wp*5._wp/0.35_wp + 1._wp 
    366472            ! LB: added ABS() to avoid NaN values when unstable, which contaminates the unstable solution... 
    367473            ! 
    368             stab = 0.5 + SIGN(0.5, zzeta) ! zzeta > 0 => stab = 1 
    369             ! 
    370             ! 
    371             psi_h_ecmwf(ji,jj) = (1. - stab) * psi_unst &   ! (zzeta < 0) Unstable 
    372                &                +    stab    * psi_stab     ! (zzeta > 0) Stable 
     474            stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 
     475            ! 
     476            ! 
     477            psi_h_ecmwf(ji,jj) = (1._wp - stab) * psi_unst &   ! (zzeta < 0) Unstable 
     478               &                +    stab    * psi_stab        ! (zzeta > 0) Stable 
    373479            ! 
    374480         END DO 
    375481      END DO 
    376       ! 
    377482   END FUNCTION psi_h_ecmwf 
    378483 
    379  
    380    FUNCTION Ri_bulk( pz, ptz, pdt, pqz, pdq, pub ) 
    381       !!---------------------------------------------------------------------------------- 
    382       !! Bulk Richardson number (Eq. 3.25 IFS doc) 
    383       !! 
    384       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    385       !!---------------------------------------------------------------------------------- 
    386       REAL(wp), DIMENSION(jpi,jpj) ::   Ri_bulk   ! 
    387       ! 
    388       REAL(wp)                    , INTENT(in) ::   pz    ! height above the sea        [m] 
    389       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptz   ! air temperature at pz m     [K] 
    390       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pdt   ! ptz - sst                   [K] 
    391       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqz   ! air temperature at pz m [kg/kg] 
    392       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pdq   ! pqz - ssq               [kg/kg] 
    393       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pub   ! bulk wind speed           [m/s] 
    394       !!---------------------------------------------------------------------------------- 
    395       ! 
    396       Ri_bulk =   grav*pz/(pub*pub)                                          & 
    397          &      * ( pdt/(ptz - 0.5_wp*(pdt + grav*pz/(Cp_dry+Cp_vap*pqz)))   & 
    398          &          + rctv0*pdq ) 
    399       ! 
    400    END FUNCTION Ri_bulk 
    401  
    402  
    403    FUNCTION visc_air(ptak) 
    404       !!---------------------------------------------------------------------------------- 
    405       !! Air kinetic viscosity (m^2/s) given from temperature in degrees... 
    406       !! 
    407       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    408       !!---------------------------------------------------------------------------------- 
    409       REAL(wp), DIMENSION(jpi,jpj)             ::   visc_air   ! 
    410       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak       ! air temperature in (K) 
    411       ! 
    412       INTEGER  ::   ji, jj      ! dummy loop indices 
    413       REAL(wp) ::   ztc, ztc2   ! local scalar 
    414       !!---------------------------------------------------------------------------------- 
    415       ! 
    416       DO jj = 1, jpj 
    417          DO ji = 1, jpi 
    418             ztc  = ptak(ji,jj) - rt0   ! air temp, in deg. C 
    419             ztc2 = ztc*ztc 
    420             visc_air(ji,jj) = 1.326e-5*(1. + 6.542E-3*ztc + 8.301e-6*ztc2 - 4.84e-9*ztc2*ztc) 
    421          END DO 
    422       END DO 
    423       ! 
    424    END FUNCTION visc_air 
    425484 
    426485   !!====================================================================== 
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcblk_algo_ncar.F90

    r10190 r12182  
    1111   !! 
    1212   !!       Routine turb_ncar maintained and developed in AeroBulk 
    13    !!                     (http://aerobulk.sourceforge.net/) 
     13   !!                     (https://github.com/brodeau/aerobulk/) 
    1414   !! 
    1515   !!                         L. Brodeau, 2015 
     
    3838   USE lib_fortran     ! to use key_nosignedzero 
    3939 
     40   USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB 
    4041 
    4142   IMPLICIT NONE 
    4243   PRIVATE 
    4344 
    44    PUBLIC ::   TURB_NCAR   ! called by sbcblk.F90 
    45  
    46    !                              ! NCAR own values for given constants: 
    47    REAL(wp), PARAMETER ::   rctv0 = 0.608   ! constant to obtain virtual temperature... 
    48     
     45   PUBLIC :: TURB_NCAR   ! called by sbcblk.F90 
     46 
     47   INTEGER , PARAMETER ::   nb_itt = 5        ! number of itterations 
     48 
    4949   !!---------------------------------------------------------------------- 
    5050CONTAINS 
     
    6161      !!                Returns the effective bulk wind speed at 10m to be used in the bulk formulas 
    6262      !! 
    63       !! ** Method : Monin Obukhov Similarity Theory 
    64       !!             + Large & Yeager (2004,2008) closure: CD_n10 = f(U_n10) 
    65       !! 
    66       !! ** References :   Large & Yeager, 2004 / Large & Yeager, 2008 
    67       !! 
    68       !! ** Last update: Laurent Brodeau, June 2014: 
    69       !!    - handles both cases zt=zu and zt/=zu 
    70       !!    - optimized: less 2D arrays allocated and less operations 
    71       !!    - better first guess of stability by checking air-sea difference of virtual temperature 
    72       !!       rather than temperature difference only... 
    73       !!    - added function "cd_neutral_10m" that uses the improved parametrization of 
    74       !!      Large & Yeager 2008. Drag-coefficient reduction for Cyclone conditions! 
    75       !!    - using code-wide physical constants defined into "phycst.mod" rather than redifining them 
    76       !!      => 'vkarmn' and 'grav' 
    77       !! 
    78       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    7963      !! 
    8064      !! INPUT : 
    8165      !! ------- 
    8266      !!    *  zt   : height for temperature and spec. hum. of air            [m] 
    83       !!    *  zu   : height for wind speed (generally 10m)                   [m] 
    84       !!    *  U_zu : scalar wind speed at 10m                                [m/s] 
    85       !!    *  sst  : SST                                                     [K] 
     67      !!    *  zu   : height for wind speed (usually 10m)                     [m] 
     68      !!    *  sst  : bulk SST                                                [K] 
    8669      !!    *  t_zt : potential air temperature at zt                         [K] 
    8770      !!    *  ssq  : specific humidity at saturation at SST                  [kg/kg] 
    8871      !!    *  q_zt : specific humidity of air at zt                          [kg/kg] 
     72      !!    *  U_zu : scalar wind speed at zu                                 [m/s] 
    8973      !! 
    9074      !! 
     
    9680      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K] 
    9781      !!    *  q_zu   : specific humidity of air        //                    [kg/kg] 
    98       !!    *  U_blk  : bulk wind at 10m                                      [m/s] 
     82      !!    *  U_blk  : bulk wind speed at zu                                 [m/s] 
     83      !! 
     84      !! 
     85      !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    9986      !!---------------------------------------------------------------------------------- 
    10087      REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m] 
     
    10390      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin] 
    10491      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity           [kg/kg] 
    105       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                   [kg/kg] 
     92      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity at zt             [kg/kg] 
    10693      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s] 
    10794      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau) 
     
    11097      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K] 
    11198      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg] 
    112       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s] 
     99      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind speed at zu                     [m/s] 
    113100      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients 
    114101      ! 
    115       INTEGER ::   j_itt 
    116       LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    117       INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations 
     102      INTEGER :: j_itt 
     103      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    118104      ! 
    119105      REAL(wp), DIMENSION(jpi,jpj) ::   Cx_n10        ! 10m neutral latent/sensible coefficient 
     
    126112      ! 
    127113      l_zt_equal_zu = .FALSE. 
    128       IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
    129  
    130       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 
     114      IF( ABS(zu - zt) < 0.01_wp )  l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     115 
     116      U_blk = MAX( 0.5_wp , U_zu )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s 
    131117 
    132118      !! First guess of stability: 
    133       ztmp0 = t_zt*(1. + rctv0*q_zt) - sst*(1. + rctv0*ssq) ! air-sea difference of virtual pot. temp. at zt 
    134       stab  = 0.5 + sign(0.5,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable 
     119      ztmp0 = virt_temp(t_zt, q_zt) - virt_temp(sst, ssq) ! air-sea difference of virtual pot. temp. at zt 
     120      stab  = 0.5_wp + sign(0.5_wp,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable 
    135121 
    136122      !! Neutral coefficients at 10m: 
     
    139125         ztmp0   (:,:) = cdn_wave(:,:) 
    140126      ELSE 
    141          ztmp0 = cd_neutral_10m( U_blk ) 
     127      ztmp0 = cd_neutral_10m( U_blk ) 
    142128      ENDIF 
    143129 
     
    146132      !! Initializing transf. coeff. with their first guess neutral equivalents : 
    147133      Cd = ztmp0 
    148       Ce = 1.e-3*( 34.6 * sqrt_Cd_n10 ) 
    149       Ch = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab)) 
     134      Ce = 1.e-3_wp*( 34.6_wp * sqrt_Cd_n10 ) 
     135      Ch = 1.e-3_wp*sqrt_Cd_n10*(18._wp*stab + 32.7_wp*(1._wp - stab)) 
    150136      stab = sqrt_Cd_n10   ! Temporaty array !!! stab == SQRT(Cd) 
    151137  
    152       IF( ln_cdgw )   Cen = Ce  ; Chn = Ch 
     138      IF( ln_cdgw ) THEN 
     139   Cen = Ce 
     140   Chn = Ch 
     141      ENDIF 
    153142 
    154143      !! Initializing values at z_u with z_t values: 
    155144      t_zu = t_zt   ;   q_zu = q_zt 
    156145 
    157       !!  * Now starting iteration loop 
    158       DO j_itt=1, nb_itt 
     146      !! ITERATION BLOCK 
     147      DO j_itt = 1, nb_itt 
    159148         ! 
    160149         ztmp1 = t_zu - sst   ! Updating air/sea differences 
     
    162151 
    163152         ! Updating turbulent scales :   (L&Y 2004 eq. (7)) 
    164          ztmp1  = Ch/stab*ztmp1    ! theta*   (stab == SQRT(Cd)) 
    165          ztmp2  = Ce/stab*ztmp2    ! q*       (stab == SQRT(Cd)) 
    166  
    167          ztmp0 = 1. + rctv0*q_zu      ! multiply this with t and you have the virtual temperature 
     153         ztmp0 = stab*U_blk       ! u*       (stab == SQRT(Cd)) 
     154         ztmp1 = Ch/stab*ztmp1    ! theta*   (stab == SQRT(Cd)) 
     155         ztmp2 = Ce/stab*ztmp2    ! q*       (stab == SQRT(Cd)) 
    168156 
    169157         ! Estimate the inverse of Monin-Obukov length (1/L) at height zu: 
    170          ztmp0 =  (grav*vkarmn/(t_zu*ztmp0)*(ztmp1*ztmp0 + rctv0*t_zu*ztmp2)) / (Cd*U_blk*U_blk) 
    171          !                                                      ( Cd*U_blk*U_blk is U*^2 at zu ) 
    172  
     158         ztmp0 = One_on_L( t_zu, q_zu, ztmp0, ztmp1, ztmp2 ) 
     159          
    173160         !! Stability parameters : 
    174          zeta_u   = zu*ztmp0   ;  zeta_u = sign( min(abs(zeta_u),10.0), zeta_u ) 
     161         zeta_u   = zu*ztmp0 
     162         zeta_u = sign( min(abs(zeta_u),10._wp), zeta_u ) 
    175163         zpsi_h_u = psi_h( zeta_u ) 
    176164 
     
    178166         IF( .NOT. l_zt_equal_zu ) THEN 
    179167            !! Array 'stab' is free for the moment so using it to store 'zeta_t' 
    180             stab = zt*ztmp0 ;  stab = SIGN( MIN(ABS(stab),10.0), stab )  ! Temporaty array stab == zeta_t !!! 
     168            stab = zt*ztmp0 
     169            stab = SIGN( MIN(ABS(stab),10._wp), stab )  ! Temporaty array stab == zeta_t !!! 
    181170            stab = LOG(zt/zu) + zpsi_h_u - psi_h(stab)                   ! stab just used as temp array again! 
    182171            t_zu = t_zt - ztmp1/vkarmn*stab    ! ztmp1 is still theta*  L&Y 2004 eq.(9b) 
    183172            q_zu = q_zt - ztmp2/vkarmn*stab    ! ztmp2 is still q*      L&Y 2004 eq.(9c) 
    184             q_zu = max(0., q_zu) 
    185          END IF 
    186  
     173            q_zu = max(0._wp, q_zu) 
     174         ENDIF 
     175 
     176         ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)... 
     177         !   In very rare low-wind conditions, the old way of estimating the 
     178         !   neutral wind speed at 10m leads to a negative value that causes the code 
     179         !   to crash. To prevent this a threshold of 0.25m/s is imposed. 
    187180         ztmp2 = psi_m(zeta_u) 
    188181         IF( ln_cdgw ) THEN      ! surface wave case 
    189182            stab = vkarmn / ( vkarmn / sqrt_Cd_n10 - ztmp2 )  ! (stab == SQRT(Cd)) 
    190183            Cd   = stab * stab 
    191             ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 
     184            ztmp0 = (LOG(zu/10._wp) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 
    192185            ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd)) 
    193             ztmp1 = 1. + Chn * ztmp0      
     186            ztmp1 = 1._wp + Chn * ztmp0      
    194187            Ch    = Chn * ztmp2 / ztmp1  ! L&Y 2004 eq. (10b) 
    195             ztmp1 = 1. + Cen * ztmp0 
     188            ztmp1 = 1._wp + Cen * ztmp0 
    196189            Ce    = Cen * ztmp2 / ztmp1  ! L&Y 2004 eq. (10c) 
    197190 
    198191         ELSE 
    199             ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)... 
    200             !   In very rare low-wind conditions, the old way of estimating the 
    201             !   neutral wind speed at 10m leads to a negative value that causes the code 
    202             !   to crash. To prevent this a threshold of 0.25m/s is imposed. 
    203             ztmp0 = MAX( 0.25 , U_blk/(1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - ztmp2)) ) ! U_n10 (ztmp2 == psi_m(zeta_u)) 
    204             ztmp0 = cd_neutral_10m(ztmp0)                                               ! Cd_n10 
    205             Cdn(:,:) = ztmp0 
    206             sqrt_Cd_n10 = sqrt(ztmp0) 
    207  
    208             stab    = 0.5 + sign(0.5,zeta_u)                           ! update stability 
    209             Cx_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))  ! L&Y 2004 eq. (6c-6d)    (Cx_n10 == Ch_n10) 
    210             Chn(:,:) = Cx_n10 
    211  
    212             !! Update of transfer coefficients: 
    213             ztmp1 = 1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - ztmp2)   ! L&Y 2004 eq. (10a) (ztmp2 == psi_m(zeta_u)) 
    214             Cd      = ztmp0 / ( ztmp1*ztmp1 ) 
    215             stab = SQRT( Cd ) ! Temporary array !!! (stab == SQRT(Cd)) 
    216  
    217             ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 
    218             ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd)) 
    219             ztmp1 = 1. + Cx_n10*ztmp0    ! (Cx_n10 == Ch_n10) 
    220             Ch  = Cx_n10*ztmp2 / ztmp1   ! L&Y 2004 eq. (10b) 
    221  
    222             Cx_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)  ! L&Y 2004 eq. (6b)    ! Cx_n10 == Ce_n10 
    223             Cen(:,:) = Cx_n10 
    224             ztmp1 = 1. + Cx_n10*ztmp0 
    225             Ce  = Cx_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c) 
    226             ENDIF 
    227          ! 
    228       END DO 
    229       ! 
     192         ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)... 
     193         !   In very rare low-wind conditions, the old way of estimating the 
     194         !   neutral wind speed at 10m leads to a negative value that causes the code 
     195         !   to crash. To prevent this a threshold of 0.25m/s is imposed. 
     196         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)) 
     197         ztmp0 = cd_neutral_10m(ztmp0)                                               ! Cd_n10 
     198         Cdn(:,:) = ztmp0 
     199         sqrt_Cd_n10 = sqrt(ztmp0) 
     200 
     201         stab    = 0.5_wp + sign(0.5_wp,zeta_u)                        ! update stability 
     202         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) 
     203         Chn(:,:) = Cx_n10 
     204 
     205         !! Update of transfer coefficients: 
     206         ztmp1 = 1._wp + sqrt_Cd_n10/vkarmn*(LOG(zu/10._wp) - ztmp2)   ! L&Y 2004 eq. (10a) (ztmp2 == psi_m(zeta_u)) 
     207         Cd      = ztmp0 / ( ztmp1*ztmp1 ) 
     208         stab = SQRT( Cd ) ! Temporary array !!! (stab == SQRT(Cd)) 
     209 
     210         ztmp0 = (LOG(zu/10._wp) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 
     211         ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd)) 
     212         ztmp1 = 1._wp + Cx_n10*ztmp0    ! (Cx_n10 == Ch_n10) 
     213         Ch  = Cx_n10*ztmp2 / ztmp1   ! L&Y 2004 eq. (10b) 
     214 
     215         Cx_n10  = 1.e-3_wp * (34.6_wp * sqrt_Cd_n10)  ! L&Y 2004 eq. (6b)    ! Cx_n10 == Ce_n10 
     216         Cen(:,:) = Cx_n10 
     217         ztmp1 = 1._wp + Cx_n10*ztmp0 
     218         Ce  = Cx_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c) 
     219         ENDIF 
     220 
     221      END DO !DO j_itt = 1, nb_itt 
     222 
    230223   END SUBROUTINE turb_ncar 
    231224 
     
    238231      !! Origin: Large & Yeager 2008 eq.(11a) and eq.(11b) 
    239232      !! 
    240       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
     233      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
    241234      !!---------------------------------------------------------------------------------- 
    242235      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pw10           ! scalar wind speed at 10m (m/s) 
     
    255248            ! 
    256249            ! When wind speed > 33 m/s => Cyclone conditions => special treatment 
    257             zgt33 = 0.5 + SIGN( 0.5, (zw - 33.) )   ! If pw10 < 33. => 0, else => 1 
    258             ! 
    259             cd_neutral_10m(ji,jj) = 1.e-3 * ( & 
    260                &       (1. - zgt33)*( 2.7/zw + 0.142 + zw/13.09 - 3.14807E-10*zw6) & ! wind <  33 m/s 
    261                &      +    zgt33   *      2.34 )                                     ! wind >= 33 m/s 
    262             ! 
    263             cd_neutral_10m(ji,jj) = MAX(cd_neutral_10m(ji,jj), 1.E-6) 
     250            zgt33 = 0.5_wp + SIGN( 0.5_wp, (zw - 33._wp) )   ! If pw10 < 33. => 0, else => 1 
     251            ! 
     252            cd_neutral_10m(ji,jj) = 1.e-3_wp * ( & 
     253               &       (1._wp - zgt33)*( 2.7_wp/zw + 0.142_wp + zw/13.09_wp - 3.14807E-10_wp*zw6) & ! wind <  33 m/s 
     254               &      +    zgt33   *      2.34_wp )                                                 ! wind >= 33 m/s 
     255            ! 
     256            cd_neutral_10m(ji,jj) = MAX(cd_neutral_10m(ji,jj), 1.E-6_wp) 
    264257            ! 
    265258         END DO 
     
    273266      !! Universal profile stability function for momentum 
    274267      !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e) 
    275       !!      
    276       !! pzet0 : stability paramenter, z/L where z is altitude measurement                                           
     268      !! 
     269      !! pzeta : stability paramenter, z/L where z is altitude measurement 
    277270      !!         and L is M-O length 
    278271      !! 
    279       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    280       !!---------------------------------------------------------------------------------- 
    281       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pzeta 
    282       REAL(wp), DIMENSION(jpi,jpj)             ::   psi_m 
    283       ! 
    284       INTEGER  ::   ji, jj         ! dummy loop indices 
     272      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
     273      !!---------------------------------------------------------------------------------- 
     274      REAL(wp), DIMENSION(jpi,jpj) :: psi_m 
     275      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta 
     276      ! 
     277      INTEGER  ::   ji, jj    ! dummy loop indices 
    285278      REAL(wp) :: zx2, zx, zstab   ! local scalars 
    286279      !!---------------------------------------------------------------------------------- 
    287       ! 
    288280      DO jj = 1, jpj 
    289281         DO ji = 1, jpi 
    290             zx2 = SQRT( ABS( 1. - 16.*pzeta(ji,jj) ) ) 
    291             zx2 = MAX ( zx2 , 1. ) 
     282            zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) ) 
     283            zx2 = MAX( zx2 , 1._wp ) 
    292284            zx  = SQRT( zx2 ) 
    293             zstab = 0.5 + SIGN( 0.5 , pzeta(ji,jj) ) 
    294             ! 
    295             psi_m(ji,jj) =        zstab  * (-5.*pzeta(ji,jj))       &          ! Stable 
    296                &          + (1. - zstab) * (2.*LOG((1. + zx)*0.5)   &          ! Unstable 
    297                &               + LOG((1. + zx2)*0.5) - 2.*ATAN(zx) + rpi*0.5)  !    " 
     285            zstab = 0.5_wp + SIGN( 0.5_wp , pzeta(ji,jj) ) 
     286            ! 
     287            psi_m(ji,jj) =        zstab  * (-5._wp*pzeta(ji,jj))       &          ! Stable 
     288               &          + (1._wp - zstab) * (2._wp*LOG((1._wp + zx)*0.5_wp)   &          ! Unstable 
     289               &               + LOG((1._wp + zx2)*0.5_wp) - 2._wp*ATAN(zx) + rpi*0.5_wp)  !    " 
    298290            ! 
    299291         END DO 
    300292      END DO 
    301       ! 
    302293   END FUNCTION psi_m 
    303294 
     
    308299      !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e) 
    309300      !! 
    310       !! pzet0 : stability paramenter, z/L where z is altitude measurement                                           
     301      !! pzeta : stability paramenter, z/L where z is altitude measurement 
    311302      !!         and L is M-O length 
    312303      !! 
    313       !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    314       !!---------------------------------------------------------------------------------- 
     304      !! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
     305      !!---------------------------------------------------------------------------------- 
     306      REAL(wp), DIMENSION(jpi,jpj) :: psi_h 
    315307      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta 
    316       REAL(wp), DIMENSION(jpi,jpj)             :: psi_h 
    317       ! 
    318       INTEGER  ::   ji, jj    ! dummy loop indices 
     308      ! 
     309      INTEGER  ::   ji, jj     ! dummy loop indices 
    319310      REAL(wp) :: zx2, zstab  ! local scalars 
    320311      !!---------------------------------------------------------------------------------- 
     
    322313      DO jj = 1, jpj 
    323314         DO ji = 1, jpi 
    324             zx2 = SQRT( ABS( 1. - 16.*pzeta(ji,jj) ) ) 
    325             zx2 = MAX ( zx2 , 1. ) 
    326             zstab = 0.5 + SIGN( 0.5 , pzeta(ji,jj) ) 
    327             ! 
    328             psi_h(ji,jj) =         zstab  * (-5.*pzeta(ji,jj))        &  ! Stable 
    329                &           + (1. - zstab) * (2.*LOG( (1. + zx2)*0.5 ))   ! Unstable 
     315            zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) ) 
     316            zx2 = MAX( zx2 , 1._wp ) 
     317            zstab = 0.5_wp + SIGN( 0.5_wp , pzeta(ji,jj) ) 
     318            ! 
     319            psi_h(ji,jj) =         zstab  * (-5._wp*pzeta(ji,jj))        &  ! Stable 
     320               &           + (1._wp - zstab) * (2._wp*LOG( (1._wp + zx2)*0.5_wp ))   ! Unstable 
    330321            ! 
    331322         END DO 
    332323      END DO 
    333       ! 
    334324   END FUNCTION psi_h 
    335325 
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbccpl.F90

    r12150 r12182  
    451451      CASE( 'conservative'  ) 
    452452         srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 
    453          IF ( k_ice <= 1 )  srcv(jpr_ievp)%laction = .FALSE. 
     453         IF( k_ice <= 1 )  srcv(jpr_ievp)%laction = .FALSE. 
    454454      CASE( 'oce and ice'   )   ;   srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE. 
    455455      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 
     
    532532      !                                                      ! ------------------------- ! 
    533533      srcv(jpr_taum)%clname = 'O_TauMod'   ;   IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' )   srcv(jpr_taum)%laction = .TRUE. 
    534       lhftau = srcv(jpr_taum)%laction 
    535534      ! 
    536535      !                                                      ! ------------------------- ! 
     
    557556      srcv(jpr_botm )%clname = 'OBotMlt' 
    558557      IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 
    559          IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 
     558         IF( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 
    560559            srcv(jpr_topm:jpr_botm)%nct = nn_cats_cpl 
    561560         ELSE 
     
    568567      !                                                      ! ------------------------- ! 
    569568      srcv(jpr_ts_ice)%clname = 'OTsfIce'    ! needed by Met Office 
    570       IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' )   srcv(jpr_ts_ice)%laction = .TRUE. 
    571       IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' )   srcv(jpr_ts_ice)%nct     = nn_cats_cpl 
    572       IF ( TRIM( sn_rcv_emp%clcat    ) == 'yes' )   srcv(jpr_ievp)%nct       = nn_cats_cpl 
     569      IF( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' )   srcv(jpr_ts_ice)%laction = .TRUE. 
     570      IF( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' )   srcv(jpr_ts_ice)%nct     = nn_cats_cpl 
     571      IF( TRIM( sn_rcv_emp%clcat    ) == 'yes' )   srcv(jpr_ievp)%nct       = nn_cats_cpl 
    573572 
    574573      !                                                      ! ------------------------- ! 
     
    692691         ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere 
    693692         DO jn = 1, jprcv 
    694             IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 
     693            IF( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 
    695694         END DO 
    696695         ! 
     
    719718      ! =================================================== ! 
    720719      DO jn = 1, jprcv 
    721          IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
     720         IF( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
    722721      END DO 
    723722      ! Allocate taum part of frcv which is used even when not received as coupling field 
    724       IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
     723      IF( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
    725724      ! Allocate w10m part of frcv which is used even when not received as coupling field 
    726       IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
     725      IF( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
    727726      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
    728       IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
    729       IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
     727      IF( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
     728      IF( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
    730729      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
    731730      IF( k_ice /= 0 ) THEN 
    732          IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 
    733          IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 
    734       END IF 
     731         IF( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 
     732         IF( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 
     733      ENDIF 
    735734 
    736735      ! ================================ ! 
     
    756755      CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice' ) 
    757756         ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 
    758          IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = nn_cats_cpl 
     757         IF( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = nn_cats_cpl 
    759758      CASE( 'mixed oce-ice'                        )   ;   ssnd( jps_tmix )%laction = .TRUE. 
    760759      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 
     
    776775      !     1. sending mixed oce-ice albedo or 
    777776      !     2. receiving mixed oce-ice solar radiation  
    778       IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 
     777      IF( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 
    779778         CALL oce_alb( zaos, zacs ) 
    780779         ! Due to lack of information on nebulosity : mean clear/overcast sky 
     
    795794         ssnd(jps_fice1)%laction = .TRUE.                 ! First-order regridded ice concentration, to be used producing atmos-to-ice fluxes (Met Office requirement) 
    796795! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 
    797          IF ( TRIM( sn_snd_thick%clcat  ) == 'yes' ) ssnd(jps_fice)%nct  = nn_cats_cpl 
    798          IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl 
     796         IF( TRIM( sn_snd_thick%clcat  ) == 'yes' ) ssnd(jps_fice)%nct  = nn_cats_cpl 
     797         IF( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl 
    799798      ENDIF 
    800799       
    801       IF (TRIM( sn_snd_ifrac%cldes )  == 'coupled') ssnd(jps_ficet)%laction = .TRUE.  
     800      IF(TRIM( sn_snd_ifrac%cldes )  == 'coupled') ssnd(jps_ficet)%laction = .TRUE.  
    802801 
    803802      SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 
     
    805804      CASE( 'ice and snow' )  
    806805         ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 
    807          IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 
     806         IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 
    808807            ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 
    809808         ENDIF 
    810809      CASE ( 'weighted ice and snow' )  
    811810         ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 
    812          IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 
     811         IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 
    813812      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 
    814813      END SELECT 
     
    827826         ssnd(jps_a_p)%laction  = .TRUE.  
    828827         ssnd(jps_ht_p)%laction = .TRUE.  
    829          IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN  
     828         IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN  
    830829            ssnd(jps_a_p)%nct  = nn_cats_cpl  
    831830            ssnd(jps_ht_p)%nct = nn_cats_cpl  
    832831         ELSE  
    833             IF ( nn_cats_cpl > 1 ) THEN  
     832            IF( nn_cats_cpl > 1 ) THEN  
    834833               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' )  
    835834            ENDIF  
     
    838837         ssnd(jps_a_p)%laction  = .TRUE.  
    839838         ssnd(jps_ht_p)%laction = .TRUE.  
    840          IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN  
     839         IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN  
    841840            ssnd(jps_a_p)%nct  = nn_cats_cpl   
    842841            ssnd(jps_ht_p)%nct = nn_cats_cpl   
     
    913912      CASE ( 'ice only' )  
    914913         ssnd(jps_ttilyr)%laction = .TRUE.  
    915          IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN  
     914         IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN  
    916915            ssnd(jps_ttilyr)%nct = nn_cats_cpl  
    917916         ELSE  
    918             IF ( nn_cats_cpl > 1 ) THEN  
     917            IF( nn_cats_cpl > 1 ) THEN  
    919918               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' )  
    920919            ENDIF  
     
    922921      CASE ( 'weighted ice' )  
    923922         ssnd(jps_ttilyr)%laction = .TRUE.  
    924          IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl  
     923         IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl  
    925924      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes )  
    926925      END SELECT  
     
    932931      CASE ( 'ice only' )  
    933932         ssnd(jps_kice)%laction = .TRUE.  
    934          IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN  
     933         IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN  
    935934            ssnd(jps_kice)%nct = nn_cats_cpl  
    936935         ELSE  
    937             IF ( nn_cats_cpl > 1 ) THEN  
     936            IF( nn_cats_cpl > 1 ) THEN  
    938937               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' )  
    939938            ENDIF  
     
    941940      CASE ( 'weighted ice' )  
    942941         ssnd(jps_kice)%laction = .TRUE.  
    943          IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl  
     942         IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl  
    944943      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes )  
    945944      END SELECT  
     
    10021001         ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 
    10031002         DO jn = 1, jpsnd 
    1004             IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 
     1003            IF( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 
    10051004         END DO 
    10061005         ! 
     
    10291028      CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 
    10301029       
    1031       IF (ln_usecplmask) THEN  
     1030      IF(ln_usecplmask) THEN  
    10321031         xcplmask(:,:,:) = 0. 
    10331032         CALL iom_open( 'cplmask', inum ) 
     
    12661265     
    12671266          IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:)  ! correct this later (read from restart if possible)  
    1268       END IF  
     1267      ENDIF  
    12691268      ! 
    12701269      IF( ln_sdw ) THEN  ! Stokes Drift correction activated 
     
    14191418         ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
    14201419         ELSE                                       ;   zqns(:,:) = 0._wp 
    1421          END IF 
     1420         ENDIF 
    14221421         ! update qns over the free ocean with: 
    14231422         IF( nn_components /= jp_iam_opa ) THEN 
     
    16911690      ! --- evaporation over ice (kg/m2/s) --- ! 
    16921691      DO jl=1,jpl 
    1693          IF (sn_rcv_emp%clcat == 'yes') THEN   ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 
     1692         IF(sn_rcv_emp%clcat == 'yes') THEN   ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 
    16941693         ELSE                                  ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 )   ;   ENDIF 
    16951694      ENDDO 
     
    17901789      CASE( 'conservative' )     ! the required fields are directly provided 
    17911790         zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
    1792          IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
     1791         IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    17931792            zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 
    17941793         ELSE 
     
    17991798      CASE( 'oce and ice' )      ! the total flux is computed from ocean and ice fluxes 
    18001799         zqns_tot(:,:) =  ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
    1801          IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
     1800         IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    18021801            DO jl=1,jpl 
    18031802               zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
     
    19011900#endif 
    19021901      ! outputs 
    1903       IF ( srcv(jpr_cal)%laction       ) CALL iom_put('hflx_cal_cea'    , - frcv(jpr_cal)%z3(:,:,1) * rLfus )                      ! latent heat from calving 
    1904       IF ( srcv(jpr_icb)%laction       ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )                      ! latent heat from icebergs melting 
    1905       IF ( iom_use('hflx_rain_cea')    ) CALL iom_put('hflx_rain_cea'   , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average) 
    1906       IF ( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 
     1902      IF( srcv(jpr_cal)%laction       ) CALL iom_put('hflx_cal_cea'    , - frcv(jpr_cal)%z3(:,:,1) * rLfus )                      ! latent heat from calving 
     1903      IF( srcv(jpr_icb)%laction       ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )                      ! latent heat from icebergs melting 
     1904      IF( iom_use('hflx_rain_cea')    ) CALL iom_put('hflx_rain_cea'   , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average) 
     1905      IF( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 
    19071906           &                                                              * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) )            ! heat flux from evap (cell average) 
    1908       IF ( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  )               ! heat flux from snow (cell average) 
    1909       IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
     1907      IF( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  )               ! heat flux from snow (cell average) 
     1908      IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
    19101909           &                                                              * ( 1._wp - zsnw(:,:) )                  )               ! heat flux from snow (over ocean) 
    1911       IF ( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &  
     1910      IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &  
    19121911           &                                                              *           zsnw(:,:)                    )               ! heat flux from snow (over ice) 
    19131912      ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. 
     
    19201919      CASE( 'conservative' ) 
    19211920         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    1922          IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
     1921         IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    19231922            zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 
    19241923         ELSE 
     
    19321931      CASE( 'oce and ice' ) 
    19331932         zqsr_tot(:,:  ) =  ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
    1934          IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
     1933         IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    19351934            DO jl = 1, jpl 
    19361935               zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
     
    19881987      !                                                      ! ========================= ! 
    19891988      CASE ('coupled') 
    1990          IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 
     1989         IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 
    19911990            zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 
    19921991         ELSE 
     
    20672066      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 
    20682067          
    2069          IF ( nn_components == jp_iam_opa ) THEN 
     2068         IF( nn_components == jp_iam_opa ) THEN 
    20702069            ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm)   ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 
    20712070         ELSE 
     
    24722471      IF( ssnd(jps_ficet)%laction ) THEN  
    24732472         CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info )  
    2474       END IF  
     2473      ENDIF  
    24752474      !                                                      ! ------------------------- !  
    24762475      !                                                      !   Water levels to waves   !  
     
    24872486         ENDIF   
    24882487         CALL cpl_snd( jps_wlev  , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )  
    2489       END IF  
     2488      ENDIF  
    24902489      ! 
    24912490      !  Fields sent by OPA to SAS when doing OPA<->SAS coupling 
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcdcy.F90

    r10425 r12182  
    77   !!   NEMO    2.0  !  2006-02  (S. Masson, G. Madec)  adaptation to NEMO 
    88   !!           3.1  !  2009-07  (J.M. Molines)  adaptation to v3.1 
     9   !!           4.*  !  2019-10  (L. Brodeau)  nothing really new, but the routine 
     10   !!                ! "sbc_dcy_param" has been extracted from old function "sbc_dcy" 
     11   !!                ! => this allows the warm-layer param of COARE3* to know the time 
     12   !!                ! of dawn and dusk even if "ln_dm2dc=.false." (rdawn_dcy & rdusk_dcy 
     13   !!                ! are now public) 
    914   !!---------------------------------------------------------------------- 
    1015 
     
    2227   IMPLICIT NONE 
    2328   PRIVATE 
    24     
     29 
    2530   INTEGER, PUBLIC ::   nday_qsr   !: day when parameters were computed 
    26     
     31 
    2732   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   raa , rbb  , rcc  , rab     ! diurnal cycle parameters 
    28    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rtmd, rdawn, rdusk, rscal   !    -      -       - 
    29    
     33   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rtmd, rscal   !    -      -       - 
     34   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: rdawn_dcy, rdusk_dcy   !    -      -       - 
     35 
    3036   PUBLIC   sbc_dcy        ! routine called by sbc 
     37   PUBLIC   sbc_dcy_param  ! routine used here and called by warm-layer parameterization (sbcblk_skin_coare*) 
    3138 
    3239   !!---------------------------------------------------------------------- 
    3340   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    34    !! $Id$  
     41   !! $Id$ 
    3542   !! Software governed by the CeCILL license (see ./LICENSE) 
    3643   !!---------------------------------------------------------------------- 
    3744CONTAINS 
    3845 
    39       INTEGER FUNCTION sbc_dcy_alloc() 
    40          !!---------------------------------------------------------------------- 
    41          !!                ***  FUNCTION sbc_dcy_alloc  *** 
    42          !!---------------------------------------------------------------------- 
    43          ALLOCATE( raa (jpi,jpj) , rbb  (jpi,jpj) , rcc  (jpi,jpj) , rab  (jpi,jpj) ,     & 
    44             &      rtmd(jpi,jpj) , rdawn(jpi,jpj) , rdusk(jpi,jpj) , rscal(jpi,jpj) , STAT=sbc_dcy_alloc ) 
    45             ! 
    46          CALL mpp_sum ( 'sbcdcy', sbc_dcy_alloc ) 
    47          IF( sbc_dcy_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sbc_dcy_alloc: failed to allocate arrays' ) 
    48       END FUNCTION sbc_dcy_alloc 
     46   INTEGER FUNCTION sbc_dcy_alloc() 
     47      !!---------------------------------------------------------------------- 
     48      !!                ***  FUNCTION sbc_dcy_alloc  *** 
     49      !!---------------------------------------------------------------------- 
     50      ALLOCATE( raa (jpi,jpj) , rbb  (jpi,jpj) , rcc  (jpi,jpj) , rab  (jpi,jpj) ,     & 
     51         &      rtmd(jpi,jpj) , rdawn_dcy(jpi,jpj) , rdusk_dcy(jpi,jpj) , rscal(jpi,jpj) , STAT=sbc_dcy_alloc ) 
     52      ! 
     53      CALL mpp_sum ( 'sbcdcy', sbc_dcy_alloc ) 
     54      IF( sbc_dcy_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sbc_dcy_alloc: failed to allocate arrays' ) 
     55   END FUNCTION sbc_dcy_alloc 
    4956 
    5057 
     
    6067      !! 
    6168      !! reference  : Bernie, DJ, E Guilyardi, G Madec, JM Slingo, and SJ Woolnough, 2007 
    62       !!              Impact of resolving the diurnal cycle in an ocean--atmosphere GCM.  
     69      !!              Impact of resolving the diurnal cycle in an ocean--atmosphere GCM. 
    6370      !!              Part 1: a diurnally forced OGCM. Climate Dynamics 29:6, 575-590. 
    6471      !!---------------------------------------------------------------------- 
    6572      LOGICAL , OPTIONAL          , INTENT(in) ::   l_mask    ! use the routine for night mask computation 
    66       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqsrin    ! input daily QSR flux  
     73      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqsrin    ! input daily QSR flux 
    6774      REAL(wp), DIMENSION(jpi,jpj)             ::   zqsrout   ! output QSR flux with diurnal cycle 
    6875      !! 
    6976      INTEGER  ::   ji, jj                                       ! dummy loop indices 
    7077      INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask 
    71       REAL(wp) ::   ztwopi, zinvtwopi, zconvrad  
    7278      REAL(wp) ::   zlo, zup, zlousd, zupusd 
    73       REAL(wp) ::   zdsws, zdecrad, ztx, zsin, zcos 
    74       REAL(wp) ::   ztmp, ztmp1, ztmp2, ztest 
     79      REAL(wp) ::   ztmp, ztmp1, ztmp2 
    7580      REAL(wp) ::   ztmpm, ztmpm1, ztmpm2 
    76       !---------------------------statement functions------------------------ 
    77       REAL(wp) ::   fintegral, pt1, pt2, paaa, pbbb, pccc        ! dummy statement function arguments 
    78       fintegral( pt1, pt2, paaa, pbbb, pccc ) =                         & 
    79          &   paaa * pt2 + zinvtwopi * pbbb * SIN(pccc + ztwopi * pt2)   & 
    80          & - paaa * pt1 - zinvtwopi * pbbb * SIN(pccc + ztwopi * pt1) 
    8181      !!--------------------------------------------------------------------- 
    8282      ! 
    8383      ! Initialization 
    8484      ! -------------- 
    85       ztwopi    = 2._wp * rpi 
    86       zinvtwopi = 1._wp / ztwopi 
    87       zconvrad  = ztwopi / 360._wp 
    88  
    8985      ! When are we during the day (from 0 to 1) 
    9086      zlo = ( REAL(nsec_day, wp) - 0.5_wp * rdt ) / rday 
    9187      zup = zlo + ( REAL(nn_fsbc, wp)     * rdt ) / rday 
    92       !                                           
    93       IF( nday_qsr == -1 ) THEN       ! first time step only   
     88      ! 
     89      IF( nday_qsr == -1 ) THEN       ! first time step only 
    9490         IF(lwp) THEN 
    9591            WRITE(numout,*) 
     
    9894            WRITE(numout,*) 
    9995         ENDIF 
     96      ENDIF 
     97 
     98      ! Setting parameters for each new day: 
     99      CALL sbc_dcy_param() 
     100 
     101      !CALL iom_put( "rdusk_dcy", rdusk_dcy(:,:)*tmask(:,:,1) ) !LB 
     102      !CALL iom_put( "rdawn_dcy", rdawn_dcy(:,:)*tmask(:,:,1) ) !LB 
     103      !CALL iom_put( "rscal_dcy", rscal(:,:)*tmask(:,:,1) ) !LB 
     104 
     105 
     106      !     3. update qsr with the diurnal cycle 
     107      !     ------------------------------------ 
     108 
     109      imask_night(:,:) = 0 
     110      DO jj = 1, jpj 
     111         DO ji = 1, jpi 
     112            ztmpm = 0._wp 
     113            IF( ABS(rab(ji,jj)) < 1. ) THEN         ! day duration is less than 24h 
     114               ! 
     115               IF( rdawn_dcy(ji,jj) < rdusk_dcy(ji,jj) ) THEN       ! day time in one part 
     116                  zlousd = MAX(zlo, rdawn_dcy(ji,jj)) 
     117                  zlousd = MIN(zlousd, zup) 
     118                  zupusd = MIN(zup, rdusk_dcy(ji,jj)) 
     119                  zupusd = MAX(zupusd, zlo) 
     120                  ztmp = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
     121                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj) 
     122                  ztmpm = zupusd - zlousd 
     123                  IF( ztmpm .EQ. 0 ) imask_night(ji,jj) = 1 
     124                  ! 
     125               ELSE                                         ! day time in two parts 
     126                  zlousd = MIN(zlo, rdusk_dcy(ji,jj)) 
     127                  zupusd = MIN(zup, rdusk_dcy(ji,jj)) 
     128                  ztmp1 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
     129                  ztmpm1=zupusd-zlousd 
     130                  zlousd = MAX(zlo, rdawn_dcy(ji,jj)) 
     131                  zupusd = MAX(zup, rdawn_dcy(ji,jj)) 
     132                  ztmp2 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
     133                  ztmpm2 =zupusd-zlousd 
     134                  ztmp = ztmp1 + ztmp2 
     135                  ztmpm = ztmpm1 + ztmpm2 
     136                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj) 
     137                  IF(ztmpm .EQ. 0.) imask_night(ji,jj) = 1 
     138               ENDIF 
     139            ELSE                                   ! 24h light or 24h night 
     140               ! 
     141               IF( raa(ji,jj) > rbb(ji,jj) ) THEN           ! 24h day 
     142                  ztmp = fintegral(zlo, zup, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
     143                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj) 
     144                  imask_night(ji,jj) = 0 
     145                  ! 
     146               ELSE                                         ! No day 
     147                  zqsrout(ji,jj) = 0.0_wp 
     148                  imask_night(ji,jj) = 1 
     149               ENDIF 
     150            ENDIF 
     151         END DO 
     152      END DO 
     153      ! 
     154      IF( PRESENT(l_mask) .AND. l_mask ) THEN 
     155         zqsrout(:,:) = float(imask_night(:,:)) 
     156      ENDIF 
     157      ! 
     158   END FUNCTION sbc_dcy 
     159 
     160 
     161   SUBROUTINE sbc_dcy_param( ) 
     162      !! 
     163      INTEGER  ::   ji, jj                                       ! dummy loop indices 
     164      !INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask 
     165      REAL(wp) ::   zdsws, zdecrad, ztx, zsin, zcos 
     166      REAL(wp) ::   ztmp, ztest 
     167      !---------------------------statement functions------------------------ 
     168      ! 
     169      IF( nday_qsr == -1 ) THEN       ! first time step only 
    100170         ! allocate sbcdcy arrays 
    101171         IF( sbc_dcy_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_dcy_alloc : unable to allocate arrays' ) 
    102172         ! Compute rcc needed to compute the time integral of the diurnal cycle 
    103          rcc(:,:) = zconvrad * glamt(:,:) - rpi 
     173         rcc(:,:) = rad * glamt(:,:) - rpi 
    104174         ! time of midday 
    105175         rtmd(:,:) = 0.5_wp - glamt(:,:) / 360._wp 
     
    107177      ENDIF 
    108178 
    109       ! If this is a new day, we have to update the dawn, dusk and scaling function   
     179      ! If this is a new day, we have to update the dawn, dusk and scaling function 
    110180      !---------------------- 
    111      
    112       !     2.1 dawn and dusk   
    113  
    114       ! nday is the number of days since the beginning of the current month  
    115       IF( nday_qsr /= nday ) THEN  
     181 
     182      !     2.1 dawn and dusk 
     183 
     184      ! nday is the number of days since the beginning of the current month 
     185      IF( nday_qsr /= nday ) THEN 
    116186         ! save the day of the year and the daily mean of qsr 
    117          nday_qsr = nday  
    118          ! number of days since the previous winter solstice (supposed to be always 21 December)          
     187         nday_qsr = nday 
     188         ! number of days since the previous winter solstice (supposed to be always 21 December) 
    119189         zdsws = REAL(11 + nday_year, wp) 
    120190         ! declination of the earths orbit 
    121          zdecrad = (-23.5_wp * zconvrad) * COS( zdsws * ztwopi / REAL(nyear_len(1),wp) ) 
     191         zdecrad = (-23.5_wp * rad) * COS( zdsws * 2._wp*rpi / REAL(nyear_len(1),wp) ) 
    122192         ! Compute A and B needed to compute the time integral of the diurnal cycle 
    123193