Changeset 11360


Ignore:
Timestamp:
2019-07-26T20:07:25+02:00 (13 months ago)
Author:
gsamson
Message:

dev_r11265_ABL : see #2131

  • use the same tm_su everywhere (Lupkes 2015 bulk and abl)
  • cosmetic changes in sbcblk.F90
  • change the results when using L15 because of tm_su calculation differences
  • identical results when using constant sea-ice drag coefficient
Location:
NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ABL/sbcabl.F90

    r11348 r11360  
    335335   
    336336#if defined key_si3 
    337       CALL blk_ice_1(  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),   &   !   <<= in 
    338          &            tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),   &   !   <<= in 
    339          &            sf(jp_slp)%fnow(:,:,1)  ,  u_ice, v_ice           ,   &   !   <<= in 
    340          &            pseni=zseni, pevpi=zevpi, ptsui=tm_su             ,   &   !   <<= out 
    341          &            pssqi=zssqi, pcd_dui=zcd_dui                      )       !   =>> out 
     337      CALL blk_ice_1(  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),    &   !   <<= in 
     338         &            tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),    &   !   <<= in 
     339         &            sf(jp_slp)%fnow(:,:,1)  ,  u_ice, v_ice, tm_su    ,    &   !   <<= in 
     340         &            pseni=zseni, pevpi=zevpi, pssqi=zssqi, pcd_dui=zcd_dui )   !   <<= out 
    342341#endif   
    343342 
     
    364363      !!-------------------------------------------------------------------------------------------    
    365364 
    366       CALL blk_oce_2( kt, tq_abl(:,:,2,nt_n,jp_ta),                            & 
    367          &                sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1),   & 
    368          &                sf(jp_prec)%fnow(:,:,1) , sf(jp_snow)%fnow(:,:,1),   & 
    369          &                sst_m, zsen, zevp                                ) 
     365      CALL blk_oce_2( tq_abl(:,:,2,nt_n,jp_ta),                            & 
     366         &            sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1),   & 
     367         &            sf(jp_prec)%fnow(:,:,1) , sf(jp_snow)%fnow(:,:,1),   & 
     368         &            sst_m, zsen, zevp                                ) 
    370369 
    371370#if defined key_si3 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ICE/icesbc.F90

    r11348 r11360  
    7272         CASE( jp_usr     )   ;    CALL usrdef_sbc_ice_tau( kt )                 ! user defined formulation 
    7373         CASE( jp_blk     )   ;    CALL blk_ice_1( sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   & 
    74             &                                      sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1),   & 
    75             &                                      u_ice, v_ice,   &    ! inputs 
    76             &                                      putaui = utau_ice, pvtaui = vtau_ice )    ! outputs                              
     74            &                                      sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),   & 
     75            &                                      sf(jp_slp )%fnow(:,:,1), u_ice, v_ice, tm_su    ,   &   ! inputs 
     76            &                                      putaui = utau_ice, pvtaui = vtau_ice            )       ! outputs                              
    7777 !        CASE( jp_abl     )    utau_ice & vtau_ice are computed in ablmod 
    7878         CASE( jp_purecpl )   ;    CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled      formulation 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/DIA/diawri.F90

    r11348 r11360  
    7575   INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file 
    7676   INTEGER ::   nid_W, nz_W, nh_W                    ! grid_W file 
    77    INTEGER ::   ndim_A, ndim_hA   ! grid_T file    
     77   INTEGER ::   ndim_A, ndim_hA                      ! ABL file    
    7878   INTEGER ::   nid_A, nz_A, nh_A                    ! grid_ABL file    
    7979   INTEGER ::   ndex(1)                              ! ??? 
    80    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV, ndex_hA 
    81    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V, ndex_A 
     80   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV 
     81   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL 
     82   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V 
    8283   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT 
    8384 
     
    445446      INTEGER  ::   ji, jj, jk                               ! dummy loop indices 
    446447      INTEGER  ::   ierr                                     ! error code return from allocation 
    447       INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma, ipka   ! local integers 
     448      INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers 
     449      INTEGER  ::   ipka                                     ! ABL 
    448450      INTEGER  ::   jn, ierror                               ! local integers 
    449451      REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars 
     
    451453      REAL(wp), DIMENSION(jpi,jpj)   :: zw2d       ! 2D workspace 
    452454      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d       ! 3D workspace 
    453       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl   ! 3D workspace 
     455      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl   ! ABL 3D workspace 
    454456      !!---------------------------------------------------------------------- 
    455457      !  
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/IOM/iom.F90

    r11304 r11360  
    112112      ! 
    113113      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 
    114       REAL(wp), DIMENSION(2   ,jpkam1)      ::   za_bnds     ! ABL vertical boundaries 
     114      REAL(wp), DIMENSION(2,jpkam1)         :: za_bnds   ! ABL vertical boundaries 
    115115      LOGICAL ::   ll_tmppatch = .TRUE.    !: seb: patch before we remove periodicity 
    116116      INTEGER ::   nldi_save, nlei_save    !:      and close boundaries in output files 
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/SBC/sbcblk.F90

    r11348 r11360  
    4848   USE lib_fortran    ! to use key_nosignedzero 
    4949#if defined key_si3 
    50    USE ice     , ONLY :   jpl, a_i_b, at_i_b, t_su, rn_cnd_s, hfx_err_dif 
     50   USE ice     , ONLY :   jpl, a_i_b, at_i_b, rn_cnd_s, hfx_err_dif 
    5151   USE icethd_dh      ! for CALL ice_thd_snwblow 
    5252#endif 
     
    7777#endif  
    7878 
    79    INTERFACE cp_air 
    80       MODULE PROCEDURE cp_air_0d, cp_air_2d 
    81    END INTERFACE 
     79  INTERFACE cp_air 
     80    MODULE PROCEDURE cp_air_0d, cp_air_2d 
     81  END INTERFACE 
    8282 
    8383   !                                   !!* Namelist namsbc_blk : bulk parameters 
     
    106106   REAL(wp)        , PARAMETER ::   Cp_dry = 1005.0        !  Specic heat of dry air, constant pressure      [J/K/kg] 
    107107   REAL(wp)        , PARAMETER ::   Cp_vap = 1860.0        !  Specic heat of water vapor, constant pressure  [J/K/kg] 
    108    REAL(wp), PUBLIC, PARAMETER ::   R_dry  = 287.05_wp     !: Specific gas constant for dry air              [J/K/kg] 
     108   REAL(wp), PUBLIC, PARAMETER ::   R_dry = 287.05_wp     !: Specific gas constant for dry air              [J/K/kg] 
    109109   REAL(wp)        , PARAMETER ::   R_vap  = 461.495_wp    !  Specific gas constant for water vapor          [J/K/kg] 
    110110   REAL(wp)        , PARAMETER ::   reps0  = R_dry/R_vap   !  ratio of gas constant for dry air and water vapor => ~ 0.622 
    111    REAL(wp), PUBLIC, PARAMETER ::   rctv0  = R_vap/R_dry   !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 
     111   REAL(wp), PUBLIC, PARAMETER ::   rctv0 = R_vap/R_dry   !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 
    112112   !                                                      !!! Bulk parameters 
    113113   REAL(wp)        , PARAMETER ::   cpa    = 1000.5        ! specific heat of air (only used for ice fluxes now...) 
    114114   REAL(wp)        , PARAMETER ::   Ls     =    2.839e6    ! latent heat of sublimation 
    115115   REAL(wp)        , PARAMETER ::   Stef   =    5.67e-8    ! Stefan Boltzmann constant 
    116    REAL(wp)        , PARAMETER ::   Cd_ice =    1.4e-3     ! transfer coefficient over ice 
     116   REAL(wp)        , PARAMETER ::   rcdice =    1.4e-3     ! transfer coefficient over ice 
    117117   REAL(wp)        , PARAMETER ::   albo   =    0.066      ! ocean albedo assumed to be constant 
    118118   ! 
    119    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Cd_atm , Ch_atm , Ce_atm   ! transfer coeffs. for momentum, sensible heat, and evaporation 
    120    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Cdn_oce, Chn_oce, Cen_oce  ! neutral  coeffs (needed for Lupkes et al. 2015 bulk scheme) 
    121    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_zu, q_zu                 ! air temp. and spec. hum. at wind speed height (needed for Lupkes 2015 bulk scheme) 
     119   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   Cd_ice , Ch_ice , Ce_ice   ! transfert coefficients over ice 
     120   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   Cdn_oce, Chn_oce, Cen_oce  ! neutral coeffs over ocean (L15 bulk scheme) 
     121   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   t_zu, q_zu                 ! air temp. and spec. hum. at wind speed height (L15 bulk scheme) 
    122122 
    123123   INTEGER , PUBLIC, PARAMETER ::   jpfld   =11   !: maximum number of files to read 
     
    149149      !!             ***  ROUTINE sbc_blk_alloc *** 
    150150      !!------------------------------------------------------------------- 
    151       ALLOCATE( Cd_atm (jpi,jpj), Ch_atm (jpi,jpj), Ce_atm (jpi,jpj), t_zu(jpi,jpj), q_zu(jpi,jpj), & 
    152          &      Cdn_oce(jpi,jpj), Chn_oce(jpi,jpj), Cen_oce(jpi,jpj), STAT=sbc_blk_alloc ) 
     151      ALLOCATE( t_zu(jpi,jpj), q_zu(jpi,jpj),                                            & 
     152         &      Cdn_oce(jpi,jpj), Chn_oce(jpi,jpj), Cen_oce(jpi,jpj),                    & 
     153         &      Cd_ice (jpi,jpj), Ch_ice (jpi,jpj), Ce_ice (jpi,jpj), STAT=sbc_blk_alloc ) 
    153154      ! 
    154155      CALL mpp_sum ( 'sbcblk', sbc_blk_alloc ) 
     
    268269         rn_zu  = ght_abl(2) 
    269270         IF(lwp) WRITE(numout,*) 
    270          IF(lwp) WRITE(numout,*) '  ABL formulation:   overwrite rn_zqt & rn_zu with ABL first level altitude' 
    271       ENDIF 
    272       !            
     271         IF(lwp) WRITE(numout,*) '   ABL formulation: overwrite rn_zqt & rn_zu with ABL first level altitude' 
     272      ENDIF 
     273      ! 
     274      ! set transfer coefficients to default sea-ice values 
     275      Cd_ice(:,:) = rcdice 
     276      Ch_ice(:,:) = rcdice 
     277      Ce_ice(:,:) = rcdice 
     278      ! 
    273279      IF(lwp) THEN                     !** Control print 
    274280         ! 
     
    349355            &                zssq, zcd_du, zsen, zevp )                              !   =>> out 
    350356          
    351          CALL blk_oce_2( kt, sf(jp_tair)%fnow(:,:,1), sf(jp_qsr )%fnow(:,:,1),   &   !   <<= in 
     357         CALL blk_oce_2(     sf(jp_tair)%fnow(:,:,1), sf(jp_qsr )%fnow(:,:,1),   &   !   <<= in 
    352358            &                sf(jp_qlw )%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1),   &   !   <<= in 
    353359            &                sf(jp_snow)%fnow(:,:,1), sst_m,                     &   !   <<= in 
     
    410416      REAL(wp), DIMENSION(jpi,jpj) ::   ztpot             ! potential temperature of air at z=rn_zqt [K] 
    411417      REAL(wp), DIMENSION(jpi,jpj) ::   zrhoa             ! density of air   [kg/m^3] 
     418      REAL(wp), DIMENSION(jpi,jpj) ::   zcd_oce           ! momentum transfert coefficient over ocean 
     419      REAL(wp), DIMENSION(jpi,jpj) ::   zch_oce           ! sensible heat transfert coefficient over ocean 
     420      REAL(wp), DIMENSION(jpi,jpj) ::   zce_oce           ! latent   heat transfert coefficient over ocean 
    412421      !!--------------------------------------------------------------------- 
    413422      ! 
     
    461470      ! 
    462471      CASE( np_NCAR      )   ;   CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, pssq, phumi, wndm,   &  ! NCAR-COREv2 
    463          &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 
     472         &                                           zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 
    464473      CASE( np_COARE_3p0 )   ;   CALL turb_coare   ( rn_zqt, rn_zu, zst, ztpot, pssq, phumi, wndm,   &  ! COARE v3.0 
    465          &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 
     474         &                                           zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 
    466475      CASE( np_COARE_3p5 )   ;   CALL turb_coare3p5( rn_zqt, rn_zu, zst, ztpot, pssq, phumi, wndm,   &  ! COARE v3.5 
    467          &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 
     476         &                                           zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 
    468477      CASE( np_ECMWF     )   ;   CALL turb_ecmwf   ( rn_zqt, rn_zu, zst, ztpot, pssq, phumi, wndm,   &  ! ECMWF 
    469          &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 
     478         &                                           zcd_oce, zch_oce, zce_oce, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 
    470479      CASE DEFAULT 
    471480         CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' ) 
     
    479488               zztmp = zU_zu(ji,jj) !* tmask(ji,jj,1) 
    480489               wndm(ji,jj)   = zztmp                   ! Store zU_zu in wndm to compute ustar2 in ablmod  
    481                pcd_du(ji,jj) = zztmp * Cd_atm(ji,jj) 
    482                psen(ji,jj)   = zztmp * Ch_atm(ji,jj) 
    483                pevp(ji,jj)   = zztmp * Ce_atm(ji,jj)        
     490               pcd_du(ji,jj) = zztmp * zcd_oce(ji,jj) 
     491               psen(ji,jj)   = zztmp * zch_oce(ji,jj) 
     492               pevp(ji,jj)   = zztmp * zce_oce(ji,jj)        
    484493            END DO 
    485494         END DO 
     
    498507               zztmp         = zrhoa(ji,jj) * zU_zu(ji,jj) 
    499508!!gm to be done by someone: check the efficiency of the call of cp_air within do loops  
    500                psen  (ji,jj) = cp_air( q_zu(ji,jj) ) * zztmp * Ch_atm(ji,jj) * (  zst(ji,jj) - t_zu(ji,jj) ) 
    501                pevp  (ji,jj) = rn_efac*MAX( 0._wp,     zztmp * Ce_atm(ji,jj) * ( pssq(ji,jj) - q_zu(ji,jj) ) ) 
    502                zztmp         = zztmp * Cd_atm(ji,jj) 
     509               psen  (ji,jj) = cp_air( q_zu(ji,jj) ) * zztmp * zch_oce(ji,jj) * (  zst(ji,jj) - t_zu(ji,jj) ) 
     510               pevp  (ji,jj) = rn_efac*MAX( 0._wp,     zztmp * zce_oce(ji,jj) * ( pssq(ji,jj) - q_zu(ji,jj) ) ) 
     511               zztmp         = zztmp * zcd_oce(ji,jj) 
    503512               pcd_du(ji,jj) = zztmp 
    504513               taum  (ji,jj) = zztmp * wndm  (ji,jj)  
     
    540549 
    541550 
    542    SUBROUTINE blk_oce_2( kt, ptair, pqsr, pqlw, pprec,   &   ! <<= in 
    543               &              psnow, pst , psen, pevp     )   ! <<= in 
     551   SUBROUTINE blk_oce_2( ptair, pqsr, pqlw, pprec,   &   ! <<= in 
     552              &          psnow, pst , psen, pevp     )   ! <<= in 
    544553      !!--------------------------------------------------------------------- 
    545554      !!                     ***  ROUTINE blk_oce_2  *** 
     
    557566      !!              - emp     : evaporation minus precipitation       (kg/m2/s) 
    558567      !!--------------------------------------------------------------------- 
    559       INTEGER , INTENT(in)                 ::   kt    ! time step index 
    560568      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptair 
    561569      REAL(wp), INTENT(in), DIMENSION(:,:) ::   pqsr 
     
    639647         CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce_2: zqla  : ', tab2d_2=qsr  , clinfo2=' qsr   : ') 
    640648         CALL prt_ctl(tab2d_1=emp  , clinfo1=' blk_oce_2: emp   : ') 
    641       ENDIF  
    642      ! 
     649      ENDIF 
     650      ! 
    643651   END SUBROUTINE blk_oce_2 
    644652 
     
    789797   !!---------------------------------------------------------------------- 
    790798 
    791    SUBROUTINE blk_ice_1( pwndi, pwndj, ptair, phumi, pslp , puice, pvice,       &    ! inputs 
    792       &                  putaui, pvtaui, pseni, pevpi, ptsui, pssqi, pcd_dui   )    ! outputs 
     799   SUBROUTINE blk_ice_1( pwndi, pwndj, ptair, phumi, pslp , puice, pvice, ptsui,  &   ! inputs 
     800      &                  putaui, pvtaui, pseni, pevpi, pssqi, pcd_dui             )   ! optional outputs 
    793801      !!--------------------------------------------------------------------- 
    794802      !!                     ***  ROUTINE blk_ice_1  *** 
     
    807815      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   puice   ! sea-ice velocity on I or C grid [m/s] 
    808816      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pvice   ! " 
     817      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   ptsui   ! sea-ice surface temperature [K] 
    809818      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   putaui  ! if ln_blk 
    810819      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pvtaui  ! if ln_blk 
    811820      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pseni   ! if ln_abl 
    812821      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pevpi   ! if ln_abl 
    813       REAL(wp) , INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   ptsui   ! if ln_abl  
    814822      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pssqi   ! if ln_abl 
    815823      REAL(wp) , INTENT(  out), DIMENSION(:,:  ), OPTIONAL ::   pcd_dui ! if ln_abl  
    816824      ! 
    817825      INTEGER  ::   ji, jj    ! dummy loop indices 
    818       REAL(wp) ::   zwndi_t , zwndj_t, zootm_su, zztmp1, zztmp2 ! relative wind components at T-point 
     826      REAL(wp) ::   zwndi_t , zwndj_t             ! relative wind components at T-point 
     827      REAL(wp) ::   zootm_su                      ! sea-ice surface mean temperature 
     828      REAL(wp) ::   zztmp1, zztmp2                ! temporary arrays 
    819829      REAL(wp), DIMENSION(jpi,jpj) ::   zrhoa     ! transfer coefficient for momentum      (tau) 
    820       REAL(wp), DIMENSION(jpi,jpj) ::   zcd_dui     ! transfer coefficient for momentum      (tau) 
    821       !!--------------------------------------------------------------------- 
    822       ! 
    823       ! set transfer coefficients to default sea-ice values 
    824       Cd_atm(:,:) = Cd_ice 
    825       Ch_atm(:,:) = Cd_ice 
    826       Ce_atm(:,:) = Cd_ice 
     830      REAL(wp), DIMENSION(jpi,jpj) ::   zcd_dui   ! transfer coefficient for momentum      (tau) 
     831      !!--------------------------------------------------------------------- 
    827832 
    828833      ! ------------------------------------------------------------ ! 
     
    841846      ! Make ice-atm. drag dependent on ice concentration 
    842847      IF    ( ln_Cd_L12 ) THEN   ! calculate new drag from Lupkes(2012) equations 
    843          CALL Cdn10_Lupkes2012( Cd_atm ) 
    844          Ch_atm(:,:) = Cd_atm(:,:)       ! momentum and heat transfer coef. are considered identical 
     848         CALL Cdn10_Lupkes2012( Cd_ice ) 
     849         Ch_ice(:,:) = Cd_ice(:,:)       ! momentum and heat transfer coef. are considered identical 
     850         Ce_ice(:,:) = Cd_ice(:,:) 
    845851      ELSEIF( ln_Cd_L15 ) THEN   ! calculate new drag from Lupkes(2015) equations 
    846          CALL Cdn10_Lupkes2015( Cd_atm, Ch_atm )  
    847       ENDIF 
    848  
    849 !!      CALL iom_put( "Cd_ice", Cd_atm)  ! output value of pure ice-atm. transfer coef. 
    850 !!      CALL iom_put( "Ch_ice", Ch_atm)  ! output value of pure ice-atm. transfer coef. 
     852         CALL Cdn10_Lupkes2015( ptsui, Cd_ice, Ch_ice )  
     853         Ce_ice(:,:) = Ch_ice(:,:)       ! sensible and latent heat transfer coef. are considered identical 
     854      ENDIF 
     855 
     856      IF ( iom_use("Cd_ice") ) CALL iom_put("Cd_ice", Cd_ice)   ! output value of pure ice-atm. transfer coef. 
     857      IF ( iom_use("Ch_ice") ) CALL iom_put("Ch_ice", Ch_ice)   ! output value of pure ice-atm. transfer coef. 
    851858 
    852859      ! local scalars ( place there for vector optimisation purposes) 
    853860      ! Computing density of air! Way denser that 1.2 over sea-ice !!! 
    854861      zrhoa  (:,:) = rho_air( ptair(:,:), phumi(:,:), pslp(:,:) ) 
    855       zcd_dui(:,:) = wndm_ice(:,:) * Cd_atm(:,:) 
     862      zcd_dui(:,:) = wndm_ice(:,:) * Cd_ice(:,:) 
    856863       
    857864      IF( ln_blk ) THEN  
     
    876883      ELSE 
    877884         zztmp1 = 11637800.0_wp 
    878        zztmp2 =    -5897.8_wp 
    879       DO jj = 1, jpj 
     885    zztmp2 =    -5897.8_wp 
     886        DO jj = 1, jpj 
    880887            DO ji = 1, jpi 
    881888               pcd_dui(ji,jj) = zcd_dui (ji,jj) 
    882                pseni  (ji,jj) = wndm_ice(ji,jj) * Ch_atm(ji,jj) 
    883                pevpi  (ji,jj) = wndm_ice(ji,jj) * Ce_atm(ji,jj) 
    884             zootm_su       = zztmp2 / ptsui(ji,jj)   ! ptsui is in K (it can't be zero ??) 
    885             pssqi  (ji,jj) = zztmp1 * EXP( zootm_su ) / zrhoa(ji,jj) 
     889               pseni  (ji,jj) = wndm_ice(ji,jj) * Ch_ice(ji,jj) 
     890               pevpi  (ji,jj) = wndm_ice(ji,jj) * Ce_ice(ji,jj) 
     891               zootm_su       = zztmp2 / ptsui(ji,jj)   ! ptsui is in K (it can't be zero ??) 
     892               pssqi  (ji,jj) = zztmp1 * EXP( zootm_su ) / zrhoa(ji,jj) 
    886893            END DO 
    887894         END DO 
     
    905912      !! caution : the net upward water flux has with mm/day unit 
    906913      !!--------------------------------------------------------------------- 
    907       REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu   ! sea ice surface temperature 
     914      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu   ! sea ice surface temperature [K] 
    908915      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phs    ! snow thickness 
    909916      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness 
     
    959966               ! ----------------------------! 
    960967 
    961                ! ... turbulent heat fluxes with Ch_atm recalculated in blk_ice_1 
     968               ! ... turbulent heat fluxes with Ch_ice recalculated in blk_ice_1 
    962969               ! Sensible Heat 
    963                z_qsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_atm(ji,jj) * wndm_ice(ji,jj) * (ptsu(ji,jj,jl) - ptair(ji,jj)) 
     970               z_qsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_ice(ji,jj) * wndm_ice(ji,jj) * (ptsu(ji,jj,jl) - ptair(ji,jj)) 
    964971               ! Latent Heat 
    965972               zztmp2 = EXP( -5897.8 * z1_st(ji,jj,jl) ) 
    966                qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls  * Ce_atm(ji,jj) * wndm_ice(ji,jj) *  & 
     973               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls  * Ce_ice(ji,jj) * wndm_ice(ji,jj) *  & 
    967974                  &                ( 11637800. * zztmp2 / zrhoa(ji,jj) - phumi(ji,jj) ) ) 
    968975               ! Latent heat sensitivity for ice (Dqla/Dt) 
    969976               IF( qla_ice(ji,jj,jl) > 0._wp ) THEN 
    970                   dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ce_atm(ji,jj) * wndm_ice(ji,jj) *  & 
     977                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ce_ice(ji,jj) * wndm_ice(ji,jj) *  & 
    971978                     &                 z1_st(ji,jj,jl) * z1_st(ji,jj,jl) * zztmp2 
    972979               ELSE 
     
    975982 
    976983               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    977                z_dqsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_atm(ji,jj) * wndm_ice(ji,jj) 
     984               z_dqsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_ice(ji,jj) * wndm_ice(ji,jj) 
    978985                
    979986               ! ----------------------------! 
     
    11511158    
    11521159 
    1153    SUBROUTINE Cdn10_Lupkes2012( Cd ) 
     1160   SUBROUTINE Cdn10_Lupkes2012( pcd ) 
    11541161      !!---------------------------------------------------------------------- 
    11551162      !!                      ***  ROUTINE  Cdn10_Lupkes2012  *** 
     
    11811188      !! 
    11821189      !!---------------------------------------------------------------------- 
    1183       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Cd 
     1190      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pcd 
    11841191      REAL(wp), PARAMETER ::   zCe   = 2.23e-03_wp 
    11851192      REAL(wp), PARAMETER ::   znu   = 1._wp 
     
    11961203 
    11971204      ! ice-atm drag 
    1198       Cd(:,:) = Cd_ice +  &                                                         ! pure ice drag 
    1199          &      zCe    * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)  ! change due to sea-ice morphology 
     1205      pcd(:,:) = rcdice +  &                                                         ! pure ice drag 
     1206          &      zCe     * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)  ! change due to sea-ice morphology 
    12001207       
    12011208   END SUBROUTINE Cdn10_Lupkes2012 
    12021209 
    12031210 
    1204    SUBROUTINE Cdn10_Lupkes2015( Cd, Ch ) 
     1211   SUBROUTINE Cdn10_Lupkes2015( ptm_su, pcd, pch ) 
    12051212      !!---------------------------------------------------------------------- 
    12061213      !!                      ***  ROUTINE  Cdn10_Lupkes2015  *** 
     
    12231230      !!---------------------------------------------------------------------- 
    12241231      ! 
    1225       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Cd 
    1226       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Ch 
    1227       REAL(wp), DIMENSION(jpi,jpj)            ::   ztm_su, zst, zqo_sat, zqi_sat 
     1232      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   ptm_su ! sea-ice surface temperature [K] 
     1233      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pcd    ! momentum transfert coefficient 
     1234      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pch    ! heat transfert coefficient 
     1235      REAL(wp), DIMENSION(jpi,jpj)            ::   zst, zqo_sat, zqi_sat 
    12281236      ! 
    12291237      ! ECHAM6 constants 
     
    12521260      REAL(wp) ::   zCdn_form_tmp 
    12531261      !!--------------------------------------------------------------------------- 
    1254       ! fl: global variable tm_su could be used directly instead of recomputing it  
    1255      ! 
    1256       ! mean temperature 
    1257       WHERE( at_i_b(:,:) > 1.e-20 )   ;   ztm_su(:,:) = SUM( t_su(:,:,:) * a_i_b(:,:,:) , dim=3 ) / at_i_b(:,:) 
    1258       ELSEWHERE                       ;   ztm_su(:,:) = rt0 
    1259       ENDWHERE 
    1260        
     1262      ! 
    12611263      ! Momentum Neutral Transfert Coefficients (should be a constant) 
    12621264      zCdn_form_tmp = zce10 * ( LOG( 10._wp / z0_form_ice + 1._wp ) / LOG( rn_zu / z0_form_ice + 1._wp ) )**2   ! Eq. 40 
    12631265      zCdn_skin_ice = ( vkarmn                                      / LOG( rn_zu / z0_skin_ice + 1._wp ) )**2   ! Eq. 7 
    1264       zCdn_ice      = zCdn_skin_ice   ! Eq. 7 (cf Lupkes email for details) 
     1266      zCdn_ice      = zCdn_skin_ice   ! Eq. 7 
    12651267      !zCdn_ice     = 1.89e-3         ! old ECHAM5 value (cf Eq. 32) 
    12661268 
    12671269      ! Heat Neutral Transfert Coefficients 
    1268       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) 
     1270      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 
    12691271      
    12701272      ! Atmospheric and Surface Variables 
    12711273      zst(:,:)     = sst_m(:,:) + rt0                                        ! convert SST from Celcius to Kelvin 
    12721274      zqo_sat(:,:) = 0.98_wp * q_sat( zst(:,:)   , sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ocean [kg/kg] 
    1273       zqi_sat(:,:) = 0.98_wp * q_sat( ztm_su(:,:), sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ice   [kg/kg] 
    1274       ! 
    1275       DO jj = 2, jpjm1           ! reduced loop is necessary for reproducibility 
     1275      zqi_sat(:,:) = 0.98_wp * q_sat( ptm_su(:,:), sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ice   [kg/kg] 
     1276      ! 
     1277      DO jj = 2, jpjm1           ! reduced loop is necessary for reproductibility 
    12761278         DO ji = fs_2, fs_jpim1 
    12771279            ! Virtual potential temperature [K] 
    12781280            zthetav_os = zst(ji,jj)    * ( 1._wp + rctv0 * zqo_sat(ji,jj) )   ! over ocean 
    1279             zthetav_is = ztm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice 
     1281            zthetav_is = ptm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice 
    12801282            zthetav_zu = t_zu (ji,jj)  * ( 1._wp + rctv0 * q_zu(ji,jj)    )   ! at zu 
    12811283             
     
    12901292            ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead) 
    12911293            z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water 
    1292             z0i = z0_skin_ice                                             ! over ice (cf Lupkes email for details) 
     1294            z0i = z0_skin_ice                                             ! over ice 
    12931295            IF( zrib_o <= 0._wp ) THEN 
    12941296               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 
     
    13091311             
    13101312            ! Momentum Transfert Coefficients (Eq. 38) 
    1311             Cd(ji,jj) = zCdn_skin_ice *   zfmi +  & 
    1312                &        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) ) 
     1313            pcd(ji,jj) = zCdn_skin_ice *   zfmi +  & 
     1314                &        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) ) 
    13131315             
    13141316            ! Heat Transfert Coefficients (Eq. 49) 
    1315             Ch(ji,jj) = zChn_skin_ice *   zfhi +  & 
    1316                &        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) ) 
     1317            pch(ji,jj) = zChn_skin_ice *   zfhi +  & 
     1318                &        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) ) 
    13171319            ! 
    13181320         END DO 
    13191321      END DO 
    1320       CALL lbc_lnk_multi( 'sbcblk', Cd, 'T',  1., Ch, 'T', 1. ) 
     1322      ! 
     1323      CALL lbc_lnk_multi( 'sbcblk', pcd, 'T',  1., pch, 'T', 1. ) 
    13211324      ! 
    13221325   END SUBROUTINE Cdn10_Lupkes2015 
Note: See TracChangeset for help on using the changeset viewer.