New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13472 for NEMO/trunk/src/OCE/SBC/sbcblk.F90 – NEMO

Ignore:
Timestamp:
2020-09-16T15:05:19+02:00 (22 months ago)
Author:
smasson
Message:

trunk: commit changes from r4.0-HEAD from 13284 to 13449, see #2523

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/SBC/sbcblk.F90

    r13305 r13472  
    4444   USE lib_fortran    ! to use key_nosignedzero 
    4545#if defined key_si3 
    46    USE ice     , ONLY :   jpl, a_i_b, at_i_b, rn_cnd_s, hfx_err_dif 
    47    USE icethd_dh      ! for CALL ice_thd_snwblow 
     46   USE ice     , ONLY :   u_ice, v_ice, jpl, a_i_b, at_i_b, t_su, rn_cnd_s, hfx_err_dif, nn_qtrice 
     47   USE icevar         ! for CALL ice_var_snwblow 
    4848#endif 
    4949   USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009) 
     
    8787   INTEGER , PUBLIC, PARAMETER ::   jp_voatm = 11   ! index of surface current (j-component) 
    8888   !                                                !          seen by the atmospheric forcing (m/s) at T-point 
    89    INTEGER , PUBLIC, PARAMETER ::   jp_hpgi  = 12   ! index of ABL geostrophic wind or hpg (i-component) (m/s) at T-point 
    90    INTEGER , PUBLIC, PARAMETER ::   jp_hpgj  = 13   ! index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point 
    91    INTEGER , PUBLIC, PARAMETER ::   jpfld    = 13   ! maximum number of files to read 
     89   INTEGER , PUBLIC, PARAMETER ::   jp_cc    = 12   ! index of cloud cover                     (-)      range:0-1 
     90   INTEGER , PUBLIC, PARAMETER ::   jp_hpgi  = 13   ! index of ABL geostrophic wind or hpg (i-component) (m/s) at T-point 
     91   INTEGER , PUBLIC, PARAMETER ::   jp_hpgj  = 14   ! index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point 
     92   INTEGER , PUBLIC, PARAMETER ::   jpfld    = 14   ! maximum number of files to read 
    9293 
    9394   ! Warning: keep this structure allocatable for Agrif... 
     
    175176      TYPE(FLD_N) ::   sn_qlw , sn_tair , sn_prec, sn_snow     !       "                        " 
    176177      TYPE(FLD_N) ::   sn_slp , sn_uoatm, sn_voatm             !       "                        " 
    177       TYPE(FLD_N) ::   sn_hpgi, sn_hpgj                        !       "                        " 
     178      TYPE(FLD_N) ::   sn_cc, sn_hpgi, sn_hpgj                 !       "                        " 
    178179      INTEGER     ::   ipka                                    ! number of levels in the atmospheric variable 
    179180      NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw ,                &   ! input fields 
    180181         &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_uoatm, sn_voatm,     & 
    181          &                 sn_hpgi, sn_hpgj,                                          & 
     182         &                 sn_cc, sn_hpgi, sn_hpgj,                                   & 
    182183         &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p6, ln_ECMWF,             &   ! bulk algorithm 
    183184         &                 cn_dir , rn_zqt, rn_zu,                                    & 
     
    260261      slf_i(jp_tair ) = sn_tair    ;   slf_i(jp_humi ) = sn_humi 
    261262      slf_i(jp_prec ) = sn_prec    ;   slf_i(jp_snow ) = sn_snow 
    262       slf_i(jp_slp  ) = sn_slp 
     263      slf_i(jp_slp  ) = sn_slp     ;   slf_i(jp_cc   ) = sn_cc 
    263264      slf_i(jp_uoatm) = sn_uoatm   ;   slf_i(jp_voatm) = sn_voatm 
    264265      slf_i(jp_hpgi ) = sn_hpgi    ;   slf_i(jp_hpgj ) = sn_hpgj 
     
    289290         ! 
    290291         IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN    !--  not used field  --!   (only now allocated and set to default) 
    291             IF(     jfpr == jp_slp  ) THEN 
     292            IF(     jfpr == jp_slp ) THEN 
    292293               sf(jfpr)%fnow(:,:,1:ipka) = 101325._wp   ! use standard pressure in Pa 
    293294            ELSEIF( jfpr == jp_prec .OR. jfpr == jp_snow .OR. jfpr == jp_uoatm .OR. jfpr == jp_voatm ) THEN 
     
    295296            ELSEIF( ( jfpr == jp_hpgi .OR. jfpr == jp_hpgj ) .AND. .NOT. ln_abl ) THEN 
    296297               DEALLOCATE( sf(jfpr)%fnow )              ! deallocate as not used in this case 
     298            ELSEIF( jfpr == jp_cc  ) THEN 
     299               sf(jp_cc)%fnow(:,:,1:ipka) = pp_cldf 
    297300            ELSE 
    298301               WRITE(ctmp1,*) 'sbc_blk_init: no default value defined for field number', jfpr 
     
    303306            ! 
    304307            IF( sf(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * sf(jfpr)%freqh), nn_fsbc * NINT(rn_Dt) ) /= 0 )   & 
    305                &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rn_Dt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   & 
    306                &                 '               This is not ideal. You should consider changing either rn_Dt or nn_fsbc value...' ) 
     308         &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rn_Dt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   & 
     309         &                 '               This is not ideal. You should consider changing either rn_Dt or nn_fsbc value...' ) 
    307310         ENDIF 
    308311      END DO 
     
    559562      ptsk(:,:) = pst(:,:) + rt0  ! by default: skin temperature = "bulk SST" (will remain this way if NCAR algorithm used!) 
    560563 
     564      ! --- cloud cover --- ! 
     565      cloud_fra(:,:) = sf(jp_cc)%fnow(:,:,1) 
     566 
    561567      ! ----------------------------------------------------------------------------- ! 
    562568      !      0   Wind components and module at T-point relative to the moving ocean   ! 
     
    10191025      REAL(wp) ::   zcoef_dqlw, zcoef_dqla   !   -      - 
    10201026      REAL(wp) ::   zztmp, zztmp2, z1_rLsub  !   -      - 
    1021       REAL(wp) ::   zfr1, zfr2               ! local variables 
    10221027      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_st         ! inverse of surface temperature 
    10231028      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_qlw         ! long wave heat flux over ice 
     
    10281033      REAL(wp), DIMENSION(jpi,jpj)     ::   zqair         ! specific humidity of air at z=rn_zqt [kg/kg] !LB 
    10291034      REAL(wp), DIMENSION(jpi,jpj)     ::   ztmp, ztmp2 
     1035      REAL(wp), DIMENSION(jpi,jpj)     ::   ztri 
    10301036      !!--------------------------------------------------------------------- 
    10311037      ! 
     
    11121118      ! --- evaporation minus precipitation --- ! 
    11131119      zsnw(:,:) = 0._wp 
    1114       CALL ice_thd_snwblow( (1.-at_i_b(:,:)), zsnw )  ! snow distribution over ice after wind blowing 
     1120      CALL ice_var_snwblow( (1.-at_i_b(:,:)), zsnw )  ! snow distribution over ice after wind blowing 
    11151121      emp_oce(:,:) = ( 1._wp - at_i_b(:,:) ) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 
    11161122      emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 
     
    11391145      END DO 
    11401146 
    1141       ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 
    1142       zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )            ! transmission when hi>10cm 
    1143       zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1 
    1144       ! 
    1145       WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm 
    1146          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
    1147       ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm 
    1148          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 
    1149       ELSEWHERE                                                         ! zero when hs>0 
    1150          qtr_ice_top(:,:,:) = 0._wp 
    1151       END WHERE 
    1152       ! 
    1153  
     1147      ! --- shortwave radiation transmitted thru the surface scattering layer (W/m2) --- ! 
     1148      IF( nn_qtrice == 0 ) THEN 
     1149         ! formulation derived from Grenfell and Maykut (1977), where transmission rate 
     1150         !    1) depends on cloudiness 
     1151         !    2) is 0 when there is any snow 
     1152         !    3) tends to 1 for thin ice 
     1153         ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm 
     1154         DO jl = 1, jpl 
     1155            WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm   
     1156               qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 
     1157            ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )     ! constant (ztri) when hi>10cm 
     1158               qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 
     1159            ELSEWHERE                                                         ! zero when hs>0 
     1160               qtr_ice_top(:,:,jl) = 0._wp  
     1161            END WHERE 
     1162         ENDDO 
     1163      ELSEIF( nn_qtrice == 1 ) THEN 
     1164         ! formulation is derived from the thesis of M. Lebrun (2019). 
     1165         !    It represents the best fit using several sets of observations 
     1166         !    It comes with snow conductivities adapted to freezing/melting conditions (see icethd_zdf_bl99.F90) 
     1167         qtr_ice_top(:,:,:) = 0.3_wp * qsr_ice(:,:,:) 
     1168      ENDIF 
     1169      ! 
    11541170      IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) THEN 
    11551171         ztmp(:,:) = zevap(:,:) * ( 1._wp - at_i_b(:,:) ) 
Note: See TracChangeset for help on using the changeset viewer.