Changeset 7813 for trunk/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2017-03-20T17:17:45+01:00 (7 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 4 edited
-
DOM/phycst.F90 (modified) (3 diffs)
-
SBC/albedo.F90 (modified) (9 diffs)
-
SBC/sbccpl.F90 (modified) (2 diffs)
-
ZDF/zdftke.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r7761 r7813 64 64 #if defined key_lim3 || defined key_cice 65 65 REAL(wp), PUBLIC :: rhoic = 917._wp !: volumic mass of sea ice [kg/m3] 66 REAL(wp), PUBLIC :: rcdic = 2.034396_wp !: thermal conductivity of fresh ice 67 REAL(wp), PUBLIC :: rcdsn = 0.31_wp !: thermal conductivity of snow 68 REAL(wp), PUBLIC :: cpic = 2067.0_wp !: specific heat for ice 66 REAL(wp), PUBLIC :: rcdic = 2.034396_wp !: thermal conductivity of fresh ice [W/m/K] 67 REAL(wp), PUBLIC :: cpic = 2067.0_wp !: specific heat of fresh ice [J/kg/K] 69 68 REAL(wp), PUBLIC :: lsub = 2.834e+6_wp !: pure ice latent heat of sublimation [J/kg] 70 69 REAL(wp), PUBLIC :: lfus = 0.334e+6_wp !: latent heat of fusion of fresh ice [J/kg] … … 82 81 REAL(wp), PUBLIC :: xlic = 300.33e+6_wp !: volumetric latent heat fusion of ice [J/m3] 83 82 REAL(wp), PUBLIC :: xsn = 2.8e+6_wp !: volumetric latent heat of sublimation of snow [J/m3] 83 #endif 84 #if defined key_cice 85 REAL(wp), PUBLIC :: rcdsn = 0.31_wp !: thermal conductivity of snow [W/m/K], now namelist parameter for LIM3 84 86 #endif 85 87 #if defined key_lim3 … … 157 159 IF(lwp) THEN 158 160 WRITE(numout,*) 161 #if defined key_cice 159 162 WRITE(numout,*) ' thermal conductivity of the snow = ', rcdsn , ' J/s/m/K' 160 WRITE(numout,*) ' thermal conductivity of the ice = ', rcdic , ' J/s/m/K' 163 #endif 164 WRITE(numout,*) ' thermal conductivity of pure ice = ', rcdic , ' J/s/m/K' 161 165 WRITE(numout,*) ' fresh ice specific heat = ', cpic , ' J/kg/K' 162 166 WRITE(numout,*) ' latent heat of fusion of fresh ice / snow = ', lfus , ' J/kg' -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
r7753 r7813 39 39 ! !!* namelist namsbc_alb 40 40 INTEGER :: nn_ice_alb 41 REAL(wp) :: rn_alb ice41 REAL(wp) :: rn_alb_sdry, rn_alb_smlt, rn_alb_idry, rn_alb_imlt 42 42 43 43 !!---------------------------------------------------------------------- … … 89 89 INTEGER :: ji, jj, jl ! dummy loop indices 90 90 INTEGER :: ijpl ! number of ice categories (3rd dim of ice input arrays) 91 REAL(wp) :: ralb_im, ralb_sf, ralb_sm, ralb_if92 91 REAL(wp) :: zswitch, z1_c1, z1_c2 93 92 REAL(wp) :: zalb_sm, zalb_sf, zalb_st ! albedo of snow melting, freezing, total … … 100 99 101 100 IF( albd_init == 0 ) CALL albedo_init ! initialization 102 103 101 104 102 SELECT CASE ( nn_ice_alb ) … … 109 107 CASE( 0 ) 110 108 111 ralb_sf = 0.80 ! dry snow112 ralb_sm = 0.65 ! melting snow113 ralb_if = 0.72 ! bare frozen ice114 ralb_im = rn_albice ! bare puddled ice115 116 109 ! Computation of ice albedo (free of snow) 117 WHERE ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice ) ; zalb(:,:,:) = r alb_im118 ELSE WHERE ; zalb(:,:,:) = r alb_if110 WHERE ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice ) ; zalb(:,:,:) = rn_alb_imlt 111 ELSE WHERE ; zalb(:,:,:) = rn_alb_idry 119 112 END WHERE 120 113 … … 132 125 ! freezing snow 133 126 ! no effect of underlying ice layer IF snow thickness > c1. Albedo does not depend on snow thick if > c2 134 ! ! freezing snow135 127 zswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( ph_snw(ji,jj,jl) - c1 ) ) ) 136 128 zalb_sf = ( 1._wp - zswitch ) * ( zalb_it(ji,jj,jl) & 137 & + ph_snw(ji,jj,jl) * ( r alb_sf- zalb_it(ji,jj,jl) ) / c1 ) &138 & + zswitch * r alb_sf129 & + ph_snw(ji,jj,jl) * ( rn_alb_sdry - zalb_it(ji,jj,jl) ) / c1 ) & 130 & + zswitch * rn_alb_sdry 139 131 140 132 ! melting snow 141 133 ! no effect of underlying ice layer. Albedo does not depend on snow thick IF > c2 142 134 zswitch = MAX( 0._wp , SIGN( 1._wp , ph_snw(ji,jj,jl) - c2 ) ) 143 zalb_sm = ( 1._wp - zswitch ) * ( r alb_im + ph_snw(ji,jj,jl) * ( ralb_sm - ralb_im) / c2 ) &144 & + zswitch * r alb_sm135 zalb_sm = ( 1._wp - zswitch ) * ( rn_alb_imlt + ph_snw(ji,jj,jl) * ( rn_alb_smlt - rn_alb_imlt ) / c2 ) & 136 & + zswitch * rn_alb_smlt 145 137 ! 146 138 ! snow albedo … … 163 155 CASE( 1 ) 164 156 165 ralb_im = rn_albice ! bare puddled ice166 157 ! compilation of values from literature 167 ralb_sf= 0.85 ! dry snow168 ralb_sm= 0.75 ! melting snow169 ralb_if= 0.60 ! bare frozen ice158 ! rn_alb_sdry = 0.85 ! dry snow 159 ! rn_alb_smlt = 0.75 ! melting snow 160 ! rn_alb_idry = 0.60 ! bare frozen ice 170 161 ! Perovich et al 2002 (Sheba) => the only dataset for which all types of ice/snow were retrieved 171 ! ralb_sf = 0.85! dry snow172 ! ralb_sm = 0.72! melting snow173 ! ralb_if = 0.65! bare frozen ice162 ! rn_alb_sdry = 0.85 ! dry snow 163 ! rn_alb_smlt = 0.72 ! melting snow 164 ! rn_alb_idry = 0.65 ! bare frozen ice 174 165 ! Brandt et al 2005 (East Antarctica) 175 ! ralb_sf= 0.87 ! dry snow176 ! ralb_sm= 0.82 ! melting snow177 ! ralb_if= 0.54 ! bare frozen ice166 ! rn_alb_sdry = 0.87 ! dry snow 167 ! rn_alb_smlt = 0.82 ! melting snow 168 ! rn_alb_idry = 0.54 ! bare frozen ice 178 169 ! 179 170 ! Computation of ice albedo (free of snow) 180 171 z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) ) 181 172 z1_c2 = 1. / 0.05 182 WHERE ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice ) ; zalb = r alb_im183 ELSE WHERE ; zalb = r alb_if173 WHERE ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice ) ; zalb = rn_alb_imlt 174 ELSE WHERE ; zalb = rn_alb_idry 184 175 END WHERE 185 176 … … 196 187 DO jj = 1, jpj 197 188 DO ji = 1, jpi 198 zalb_sf = r alb_sf - ( ralb_sf- zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c1 );199 zalb_sm = r alb_sm - ( ralb_sm- zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c2 );200 201 189 zalb_sf = rn_alb_sdry - ( rn_alb_sdry - zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c1 ); 190 zalb_sm = rn_alb_smlt - ( rn_alb_smlt - zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c2 ); 191 192 ! snow albedo 202 193 zswitch = MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) ) 203 194 zalb_st = zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf … … 248 239 !!---------------------------------------------------------------------- 249 240 INTEGER :: ios ! Local integer output status for namelist read 250 NAMELIST/namsbc_alb/ nn_ice_alb, rn_alb ice241 NAMELIST/namsbc_alb/ nn_ice_alb, rn_alb_sdry, rn_alb_smlt, rn_alb_idry , rn_alb_imlt 251 242 !!---------------------------------------------------------------------- 252 243 ! … … 267 258 WRITE(numout,*) '~~~~~~~' 268 259 WRITE(numout,*) ' Namelist namsbc_alb : albedo ' 269 WRITE(numout,*) ' choose the albedo parameterization nn_ice_alb = ', nn_ice_alb 270 WRITE(numout,*) ' albedo of bare puddled ice rn_albice = ', rn_albice 260 WRITE(numout,*) ' choose the albedo parameterization nn_ice_alb = ', nn_ice_alb 261 WRITE(numout,*) ' albedo of dry snow rn_alb_sdry = ', rn_alb_sdry 262 WRITE(numout,*) ' albedo of melting snow rn_alb_smlt = ', rn_alb_smlt 263 WRITE(numout,*) ' albedo of dry ice rn_alb_idry = ', rn_alb_idry 264 WRITE(numout,*) ' albedo of bare puddled ice rn_alb_imlt = ', rn_alb_imlt 271 265 ENDIF 272 266 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r7788 r7813 1803 1803 WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 1804 1804 1805 ! --- heat flux associated with emp (W/m2) --- ! 1806 zqemp_oce(:,:) = - zevap_oce(:,:) * zcptn(:,:) & ! evap 1807 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip 1808 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean + snow melting 1809 ! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1810 ! & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1811 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice (only) 1812 ! qevap_ice=0 since we consider Tice=0degC 1813 1805 ! Heat content per unit mass of snow (J/kg) 1806 WHERE( SUM( a_i, dim=3 ) > 1.e-10 ) ; zcptsnw(:,:) = cpic * SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1807 ELSEWHERE ; zcptsnw(:,:) = zcptn(:,:) 1808 ENDWHERE 1809 ! Heat content per unit mass of rain (J/kg) 1810 zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * p_frld(:,:) ) 1811 1814 1812 ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1815 zqprec_ice(:,:) = rhosn * ( zcpt n(:,:) - lfus )1813 zqprec_ice(:,:) = rhosn * ( zcptsnw(:,:) - lfus ) 1816 1814 1817 1815 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 1818 1816 DO jl = 1, jpl 1819 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0degC1817 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but atm. does not take it into account 1820 1818 END DO 1821 1819 1820 ! --- heat flux associated with emp (W/m2) --- ! 1821 zqemp_oce(:,:) = - zevap_oce(:,:) * zcptn (:,:) & ! evap 1822 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptrain(:,:) & ! liquid precip 1823 & + zsprecip(:,:) * ( 1._wp - zsnw ) * zqprec_ice(:,:) * r1_rhosn ! solid precip over ocean + snow melting 1824 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhosn ! solid precip over ice (qevap_ice=0 since atm. does not take it into account) 1825 !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptsnw (:,:) & ! ice evap 1826 !! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhosn ! solid precip over ice 1827 1822 1828 ! --- total non solar flux (including evap/precip) --- ! 1823 1829 zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:) … … 1974 1980 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1975 1981 1976 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, z icefr, zmsk, zsnw )1982 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zcptrain, zcptsnw, zicefr, zmsk, zsnw ) 1977 1983 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1978 1984 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r7753 r7813 323 323 zwlc = zind * rn_lc * zus * SIN( rpi * gdepw_n(ji,jj,jk) / zhlc(ji,jj) ) 324 324 ! ! TKE Langmuir circulation source term 325 en(ji,jj,jk) = en(ji,jj,jk) + rdt * (1._wp -fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) &325 en(ji,jj,jk) = en(ji,jj,jk) + rdt * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) & 326 326 & / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 327 327 END DO … … 454 454 DO ji = fs_2, fs_jpim1 ! vector opt. 455 455 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) ) & 456 & * ( 1._wp -fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)456 & * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 457 457 END DO 458 458 END DO … … 463 463 jk = nmln(ji,jj) 464 464 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) ) & 465 & * ( 1._wp -fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)465 & * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 466 466 END DO 467 467 END DO … … 476 476 zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add ) ! apply some modifications... 477 477 en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) ) & 478 & * ( 1._wp -fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)478 & * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 479 479 END DO 480 480 END DO
Note: See TracChangeset
for help on using the changeset viewer.
