diff --git a/physics/GFS_radiation_surface.F90 b/physics/GFS_radiation_surface.F90 index 7da6e5df7..11703c23c 100644 --- a/physics/GFS_radiation_surface.F90 +++ b/physics/GFS_radiation_surface.F90 @@ -62,7 +62,7 @@ subroutine GFS_radiation_surface_run ( & sncovr_ice, fice, zorl, hprime, tsfg, tsfa, tisfc, coszen, & min_seaice, min_lakeice, lakefrac, & alvsf, alnsf, alvwf, alnwf, facsf, facwf, & - semis_lnd, semis_ice, snoalb, & + semis_lnd, semis_ice, snoalb, use_cice_alb, & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & semisbase, semis, sfcalb, sfc_alb_dif, errmsg, errflg) @@ -74,7 +74,7 @@ subroutine GFS_radiation_surface_run ( & implicit none integer, intent(in) :: im - logical, intent(in) :: frac_grid, lslwr, lsswr + logical, intent(in) :: frac_grid, lslwr, lsswr, use_cice_alb integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc, lndp_type, n_var_lndp real(kind=kind_phys), intent(in) :: min_seaice, min_lakeice @@ -160,7 +160,8 @@ subroutine GFS_radiation_surface_run ( & !> - Call module_radiation_surface::setemis(),to set up surface !! emissivity for LW radiation. call setemis (lsm, lsm_noahmp, lsm_ruc, vtype, & - frac_grid, min_seaice, xlon, xlat, slmsk, & + frac_grid, xlon, xlat, slmsk, & +! frac_grid, min_seaice, xlon, xlat, slmsk, & snowd, sncovr, sncovr_ice, zorl, tsfg, tsfa, & hprime, semis_lnd, semis_ice, im, & fracl, fraco, fraci, icy, & ! --- inputs @@ -181,13 +182,14 @@ subroutine GFS_radiation_surface_run ( & !> - Call module_radiation_surface::setalb(),to set up surface !! albedor for SW radiation. - call setalb (slmsk, lsm, lsm_noahmp, lsm_ruc, snowd, sncovr, sncovr_ice, snoalb, & - zorl, coszen, tsfg, tsfa, hprime, frac_grid, min_seaice, & - alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & - albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & - albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & - IM, sfc_alb_pert, lndp_alb, fracl, fraco, fraci, icy, & ! --- inputs - sfcalb ) ! --- outputs + call setalb (slmsk, lsm, lsm_noahmp, lsm_ruc, use_cice_alb, snowd, sncovr, sncovr_ice, & + snoalb, zorl, coszen, tsfg, tsfa, hprime, frac_grid, lakefrac, & +! snoalb, zorl, coszen, tsfg, tsfa, hprime, frac_grid, min_seaice, & + alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & + albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & + albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & + IM, sfc_alb_pert, lndp_alb, fracl, fraco, fraci, icy, & ! --- inputs + sfcalb ) ! --- outputs !> -# Approximate mean surface albedo from vis- and nir- diffuse values. sfc_alb_dif(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) diff --git a/physics/GFS_radiation_surface.meta b/physics/GFS_radiation_surface.meta index eacec3e01..f021cfe4d 100644 --- a/physics/GFS_radiation_surface.meta +++ b/physics/GFS_radiation_surface.meta @@ -404,6 +404,14 @@ kind = kind_phys intent = in optional = F +[use_cice_alb] + standard_name = flag_for_cice_albedo + long_name = flag for using ice albedos form CICE when coupled (default on) + units = flag + dimensions = () + type = logical + intent = in + optional = F [albdvis_lnd] standard_name = surface_albedo_direct_visible_over_land long_name = direct surface albedo visible band over land diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 998fa8684..d5673509b 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -29,7 +29,7 @@ end subroutine GFS_surface_composites_pre_finalize !! subroutine GFS_surface_composites_pre_run (im, flag_init, flag_restart, lkm, lsm, lsm_noahmp, lsm_ruc, frac_grid, & flag_cice, cplflx, cplice, cplwav2atm, landfrac, lakefrac, lakedepth, oceanfrac, frland, & - dry, icy, lake, use_flake, ocean, wet, hice, cice, zorlo, zorll, zorli, & + dry, icy, lake, use_flake, wet, hice, cice, zorlo, zorll, zorli, & snowd, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & tprcp_lnd, tprcp_ice, uustar, uustar_wat, uustar_lnd, uustar_ice, & weasd, weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_wat, & @@ -45,7 +45,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, flag_restart, lkm, lsm integer, intent(in ) :: lsm, lsm_noahmp, lsm_ruc logical, intent(in ) :: flag_init, flag_restart, frac_grid, cplflx, cplice, cplwav2atm logical, dimension(:), intent(inout) :: flag_cice - logical, dimension(:), intent(inout) :: dry, icy, lake, use_flake, ocean, wet + logical, dimension(:), intent(inout) :: dry, icy, lake, use_flake, wet real(kind=kind_phys), dimension(:), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac real(kind=kind_phys), dimension(:), intent(inout) :: cice, hice real(kind=kind_phys), dimension(:), intent( out) :: frland @@ -62,7 +62,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, flag_restart, lkm, lsm real(kind=kind_phys), dimension(:), intent(in ) :: semis_rad real(kind=kind_phys), dimension(:), intent(inout) :: semis_wat, semis_lnd, semis_ice, slmsk real(kind=kind_phys), dimension(:), intent(inout) :: emis_lnd, emis_ice - real(kind=kind_phys), intent(in ) :: min_lakeice, min_seaice + real(kind=kind_phys), intent(in ) :: min_lakeice, min_seaice ! real(kind=kind_phys), dimension(:), intent(inout) :: zorlo, zorll, zorli ! @@ -129,21 +129,21 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, flag_restart, lkm, lsm endif endif else ! all land - cice(i) = zero - hice(i) = zero + cice(i) = zero + hice(i) = zero islmsk_cice(i) = 1 islmsk(i) = 1 wet(i) = .false. icy(i) = .false. flag_cice(i) = .false. endif - enddo + enddo else do i = 1, IM if (islmsk(i) == 1) then -! tsfcl(i) = tsfc(i) +! tsfcl(i) = tsfc(i) dry(i) = .true. frland(i) = one cice(i) = zero diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 5bb1f2485..860d4e69b 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -180,14 +180,6 @@ type = logical intent = inout optional = F -[ocean] - standard_name = flag_nonzero_ocean_surface_fraction - long_name = flag indicating presence of some ocean surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical - intent = inout - optional = F [wet] standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index b6dd30cfe..1ec7ff784 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -149,7 +149,6 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, soiltyp(i) = int( stype(i)+0.5_kind_phys ) vegtype(i) = int( vtype(i)+0.5_kind_phys ) slopetyp(i) = int( slope(i)+0.5_kind_phys ) !! clu: slope -> slopetyp - if (soiltyp(i) < 1) soiltyp(i) = 14 if (vegtype(i) < 1) vegtype(i) = 17 if (slopetyp(i) < 1) slopetyp(i) = 1 endif diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index 718b375af..608147c4b 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -124,9 +124,10 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, ! if (frac_grid) then do ix=1,npts - if (landfrac(ix) > -1.0e-8_kind_phys) then - slmskl(ix) = ceiling(landfrac(ix)-1.0e-8_kind_phys) - slmskw(ix) = floor(landfrac(ix)+1.0e-8_kind_phys) +! if (landfrac(ix) > -1.0e-8_kind_phys) then + if (landfrac(ix) > 0.0_kind_phys) then + slmskl(ix) = ceiling(landfrac(ix)-1.0e-6_kind_phys) + slmskw(ix) = floor(landfrac(ix)+1.0e-6_kind_phys) else if (nint(slmsk(ix)) == 1) then slmskl(ix) = 1.0_kind_phys diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 78525c1de..750c54dd6 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -332,9 +332,10 @@ end subroutine sfc_init !! @{ !----------------------------------- subroutine setalb & - & ( slmsk,lsm,lsm_noahmp,lsm_ruc,snowf, & ! --- inputs: + & ( slmsk,lsm,lsm_noahmp,lsm_ruc,use_cice_alb,snowf, & ! --- inputs: & sncovr,sncovr_ice,snoalb,zorlf,coszf, & - & tsknf,tairf,hprif,frac_grid,min_seaice, & + & tsknf,tairf,hprif,frac_grid, lakefrac, & +! & tsknf,tairf,hprif,frac_grid,min_seaice, & & alvsf,alnsf,alvwf,alnwf,facsf,facwf,fice,tisfc, & & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, & & icealbdvis, icealbdnir, icealbivis, icealbinir, & @@ -406,15 +407,16 @@ subroutine setalb & ! --- inputs integer, intent(in) :: IMAX integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc - logical, intent(in) :: frac_grid + logical, intent(in) :: use_cice_alb, frac_grid real (kind=kind_phys), dimension(:), intent(in) :: & + & lakefrac, & & slmsk, snowf, zorlf, coszf, tsknf, tairf, hprif, & & alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & & icealbdvis, icealbdnir, icealbivis, icealbinir, & & sncovr, sncovr_ice, snoalb, albPpert ! sfc-perts, mgehne real (kind=kind_phys), intent(in) :: pertalb ! sfc-perts, mgehne - real (kind=kind_phys), intent(in) :: min_seaice +! real (kind=kind_phys), intent(in) :: min_seaice real (kind=kind_phys), dimension(:), intent(in) :: & & fracl, fraco, fraci real (kind=kind_phys), dimension(:),intent(inout) :: & @@ -438,7 +440,8 @@ subroutine setalb & real (kind=kind_phys) :: alndnb, alndnd, alndvb, alndvd - real (kind=kind_phys) ffw, dtgd + real (kind=kind_phys) ffw, dtgd, icealb + real (kind=kind_phys), parameter :: epsln=1.0e-8_kind_phys integer :: i, k, kk, iflag @@ -464,49 +467,59 @@ subroutine setalb & asenb_wat = asevb_wat endif - if (icy(i)) then - !-- Computation of ice albedo - asnow = 0.02*snowf(i) - argh = min(0.50, max(.025, 0.01*zorlf(i))) - hrgh = min(f_one,max(0.20,1.0577-1.1538e-3*hprif(i))) - fsno0 = asnow / (argh + asnow) * hrgh ! snow fraction on ice - ! diffused - if (tsknf(i) > 271.1 .and. tsknf(i) < 271.5) then - !tgs: looks like albedo reduction from puddles on ice - a1 = (tsknf(i) - 271.1)**2 - asevd_ice = 0.7 - 4.0*a1 - asend_ice = 0.65 - 3.6875*a1 + if (icy(i)) then !-- Computation of ice albedo + + if (use_cice_alb .and. lakefrac(i) < epsln) then + icealb = icealbivis(i) else - asevd_ice = 0.70 - asend_ice = 0.65 + icealb = f_zero endif - ! direct - asevb_ice = asevd_ice - asenb_ice = asend_ice - - if (fsno0 > f_zero) then - ! Snow on ice - dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) )) - b1 = 0.03 * dtgd - asnvd = (asevd_ice + b1) ! diffused snow albedo - asnnd = (asend_ice + b1) - if (coszf(i) > 0.0001 .and. coszf(i) < 0.5) then ! direct snow albedo - csnow = 0.5 * (3.0 / (f_one+4.0*coszf(i)) - f_one) - asnvb = min( 0.98, asnvd+(f_one-asnvd)*csnow ) - asnnb = min( 0.98, asnnd+(f_one-asnnd)*csnow ) + if (icealb > epsln) then !-- use ice albedo from CICE for sea-ice + asevd_ice = icealbivis(i) + asend_ice = icealbinir(i) + asevb_ice = icealbdvis(i) + asenb_ice = icealbdnir(i) + else + asnow = 0.02*snowf(i) + argh = min(0.50, max(.025, 0.01*zorlf(i))) + hrgh = min(f_one,max(0.20,1.0577-1.1538e-3*hprif(i))) + fsno0 = asnow / (argh + asnow) * hrgh ! snow fraction on ice + ! diffused + if (tsknf(i) > 271.1 .and. tsknf(i) < 271.5) then + !tgs: looks like albedo reduction from puddles on ice + a1 = (tsknf(i) - 271.1)**2 + asevd_ice = 0.7 - 4.0*a1 + asend_ice = 0.65 - 3.6875*a1 else - asnvb = asnvd - asnnb = asnnd + asevd_ice = 0.70 + asend_ice = 0.65 endif + ! direct + asevb_ice = asevd_ice + asenb_ice = asend_ice - ! composite ice and snow albedos - asevd_ice = asevd_ice * (1. - fsno0) + asnvd * fsno0 - asend_ice = asend_ice * (1. - fsno0) + asnnd * fsno0 - asevb_ice = asevb_ice * (1. - fsno0) + asnvb * fsno0 - asenb_ice = asenb_ice * (1. - fsno0) + asnnb * fsno0 - endif ! snow - else - ! icy = false, fill in values + if (fsno0 > f_zero) then ! Snow on ice + dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) )) + b1 = 0.03 * dtgd + asnvd = (asevd_ice + b1) ! diffused snow albedo + asnnd = (asend_ice + b1) + if (coszf(i) > 0.0001 .and. coszf(i) < 0.5) then ! direct snow albedo + csnow = 0.5 * (3.0 / (f_one+4.0*coszf(i)) - f_one) + asnvb = min( 0.98, asnvd+(f_one-asnvd)*csnow ) + asnnb = min( 0.98, asnnd+(f_one-asnnd)*csnow ) + else + asnvb = asnvd + asnnb = asnnd + endif + + ! composite ice and snow albedos + asevd_ice = asevd_ice * (1. - fsno0) + asnvd * fsno0 + asend_ice = asend_ice * (1. - fsno0) + asnnd * fsno0 + asevb_ice = asevb_ice * (1. - fsno0) + asnvb * fsno0 + asenb_ice = asenb_ice * (1. - fsno0) + asnnb * fsno0 + endif ! snow + endif ! if (use_cice_alb .and. lakefrac < epsln) + else ! icy = false, fill in values asevd_ice = 0.70 asend_ice = 0.65 asevb_ice = 0.70 @@ -586,9 +599,17 @@ subroutine setalb & !tgs: this part of the code needs the input from the ice ! model. Otherwise it uses the backup albedo computation ! from ialbflg = 1. - if (icy(i)) then - if(lsm == lsm_ruc ) then - !-- use ice albedo from the RUC ice model + + if (icy(i)) then !-- Computation of ice albedo + + if (use_cice_alb .and. lakefrac(i) < epsln) then + icealb = icealbivis(i) + else + icealb = f_zero + endif + + if (lsm == lsm_ruc .or. icealb > epsln) then !-- use ice albedo from the RUC ice model or + !-- use ice albedo from CICE for sea-ice asevd_ice = icealbivis(i) asend_ice = icealbinir(i) asevb_ice = icealbdvis(i) @@ -706,7 +727,8 @@ end subroutine setalb !----------------------------------- subroutine setemis & & ( lsm,lsm_noahmp,lsm_ruc,vtype,frac_grid, & ! --- inputs: - & min_seaice,xlon,xlat,slmsk,snowf,sncovr,sncovr_ice, & + & xlon,xlat,slmsk,snowf,sncovr,sncovr_ice, & +! & min_seaice,xlon,xlat,slmsk,snowf,sncovr,sncovr_ice, & & zorlf,tsknf,tairf,hprif, & & semis_lnd,semis_ice,IMAX,fracl,fraco,fraci,icy, & & semisbase, sfcemis & ! --- outputs: @@ -763,7 +785,7 @@ subroutine setemis & integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc logical, intent(in) :: frac_grid real (kind=kind_phys), dimension(:), intent(in) :: vtype - real (kind=kind_phys), intent(in) :: min_seaice +! real (kind=kind_phys), intent(in) :: min_seaice real (kind=kind_phys), dimension(:), intent(in) :: & & xlon,xlat, slmsk, snowf,sncovr, sncovr_ice, & diff --git a/physics/sfcsub.F b/physics/sfcsub.F index 002103e10..b0aefb858 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -1197,7 +1197,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! ! set ocean/land/sea-ice mask ! - call setlsi(slmskw,aisclm,len,aicice,sliclm) + call setlsi(slmskl,aisclm,len,aicice,sliclm) ! if(lprnt) print *,' aisclm=',aisclm(iprnt),' sliclm=' ! &,sliclm(iprnt),' slmskw=',slmskw(iprnt) @@ -1285,7 +1285,8 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call getsmc(wetclm,len,lsoil,smcclm,me) endif do k=1,lsoil - call qcmxmn(message('stc',k),smcclm(1,k),sliclm,snoclm,icefl1, +! call qcmxmn(message('stc',k),smcclm(1,k),sliclm,snoclm,icefl1, + call qcmxmn(message('stc',k),smcclm(1,k),slmskl,snoclm,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1295,20 +1296,24 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call getstc(tsfclm,tg3clm,sliclm,len,lsoil,stcclm,tsfimx) endif do k=1,lsoil - call qcmxmn(message('stc',k),stcclm(1,k),sliclm,snoclm,icefl1, +! call qcmxmn(message('stc',k),stcclm(1,k),sliclm,snoclm,icefl1, + call qcmxmn(message('stc',k),stcclm(1,k),slmskl,snoclm,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo - call qcmxmn('vegc ',vegclm,sliclm,snoclm,icefl1, +! call qcmxmn('vegc ',vegclm,sliclm,snoclm,icefl1, + call qcmxmn('vegc ',vegclm,slmskl,snoclm,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, & vegjmx,vegjmn,vegsmx,vegsmn,epsveg, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vetc ',vetclm,sliclm,snoclm,icefl1, +! call qcmxmn('vetc ',vetclm,sliclm,snoclm,icefl1, + call qcmxmn('vetc ',vetclm,slmskl,snoclm,icefl1, & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn, & vetjmx,vetjmn,vetsmx,vetsmn,epsvet, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sotc ',sotclm,sliclm,snoclm,icefl1, +! call qcmxmn('sotc ',sotclm,sliclm,snoclm,icefl1, + call qcmxmn('sotc ',sotclm,slmskl,snoclm,icefl1, & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn, & sotjmx,sotjmn,sotsmx,sotsmn,epssot, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1322,15 +1327,18 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! & sicjmx,sicjmn,sicsmx,sicsmn,epssic, ! & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+16l] --------------------------------------------------------------- - call qcmxmn('vmnc ',vmnclm,sliclm,snoclm,icefl1, +! call qcmxmn('vmnc ',vmnclm,sliclm,snoclm,icefl1, + call qcmxmn('vmnc ',vmnclm,slmskl,snoclm,icefl1, & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn, & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vmxc ',vmxclm,sliclm,snoclm,icefl1, +! call qcmxmn('vmxc ',vmxclm,sliclm,snoclm,icefl1, + call qcmxmn('vmxc ',vmxclm,slmskl,snoclm,icefl1, & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn, & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('slpc ',slpclm,sliclm,snoclm,icefl1, +! call qcmxmn('slpc ',slpclm,sliclm,snoclm,icefl1, + call qcmxmn('slpc ',slpclm,slmskl,snoclm,icefl1, & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn, & slpjmx,slpjmn,slpsmx,slpsmn,epsslp, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1522,9 +1530,10 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & slianl(i) = 0. ! print *,'cycle - ice free: fice=',sicanl(i) elseif (nint(slianl(i)) == 1 .and. sicanl(i) >= crit) then - if (nint(slmskw(i)) == 0) then ! can happen only for fractional grid - slianl(i) = 2.0_kind_io8 - else +! if (nint(slmskw(i)) == 0) then ! can happen only for fractional grid +! slianl(i) = 2.0_kind_io8 +! else + if (nint(slmskw(i)) /= 0) then ! can happen only for fractional grid ! print *,'cycle - land covered by sea-ice: fice=',sicanl(i) sicanl(i) = 0.0_kind_io8 endif @@ -1552,7 +1561,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! ! set ocean/land/sea-ice mask ! - call setlsi(slmskw,aisanl,len,aicice,slianl) + call setlsi(slmskl,aisanl,len,aicice,slianl) ! if(lprnt) print *,' aisanl=',aisanl(iprnt),' slianl=' & ! &,slianl(iprnt),' slmskwl=',slmskw(iprnt),slmskl(iprnt) @@ -1560,7 +1569,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! do k=1,lsoil do i=1,len - if (slianl(i) .eq. 0) then + if (slianl(i) == 0 .and. nint(slmskl(i)) /= 1) then smcanl(i,k) = smcomx stcanl(i,k) = tsfanl(i) endif @@ -1651,7 +1660,8 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! & plrjmx,plrjmn,plrsmx,plrsmn,epsplr, ! & rla,rlo,len,kqcm,percrit,lgchek,me) ! endif - call qcmxmn('tg3a ',tg3anl,slianl,snoanl,icefl1, +! call qcmxmn('tg3a ',tg3anl,slianl,snoanl,icefl1, + call qcmxmn('tg3a ',tg3anl,slmskl,snoanl,icefl1, & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3imx,tg3imn, & tg3jmx,tg3jmn,tg3smx,tg3smn,epstg3, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1663,7 +1673,8 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & endif !-- soil moisture do k=1,lsoil - call qcmxmn(message('smca',k),smcanl(1,1),slianl,snoanl,icefl1, +! call qcmxmn(message('smca',k),smcanl(1,1),slianl,snoanl,icefl1, + call qcmxmn(message('smca',k),smcanl(1,1),slmskl,snoanl,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1673,33 +1684,40 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call getstc(tsfanl,tg3anl,slianl,len,lsoil,stcanl,tsfimx) endif do k=1,lsoil - call qcmxmn(message('stca',k),stcanl(1,1),slianl,snoanl,icefl1, +! call qcmxmn(message('stca',k),stcanl(1,1),slianl,snoanl,icefl1, + call qcmxmn(message('stca',k),stcanl(1,1),slmskl,snoanl,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo - call qcmxmn('vega ',veganl,slianl,snoanl,icefl1, +! call qcmxmn('vega ',veganl,slianl,snoanl,icefl1, + call qcmxmn('vega ',veganl,slmskl,snoanl,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, & vegjmx,vegjmn,vegsmx,vegsmn,epsveg, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('veta ',vetanl,slianl,snoanl,icefl1, +! call qcmxmn('veta ',vetanl,slianl,snoanl,icefl1, + call qcmxmn('veta ',vetanl,slmskl,snoanl,icefl1, & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn, & vetjmx,vetjmn,vetsmx,vetsmn,epsvet, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sota ',sotanl,slianl,snoanl,icefl1, +! call qcmxmn('sota ',sotanl,slianl,snoanl,icefl1, + call qcmxmn('sota ',sotanl,slmskl,snoanl,icefl1, & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn, & sotjmx,sotjmn,sotsmx,sotsmn,epssot, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+16l]---------------------------------------------------------------------- - call qcmxmn('vmna ',vmnanl,slianl,snoanl,icefl1, +! call qcmxmn('vmna ',vmnanl,slianl,snoanl,icefl1, + call qcmxmn('vmna ',vmnanl,slmskl,snoanl,icefl1, & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn, & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vmxa ',vmxanl,slianl,snoanl,icefl1, +! call qcmxmn('vmxa ',vmxanl,slianl,snoanl,icefl1, + call qcmxmn('vmxa ',vmxanl,slmskl,snoanl,icefl1, & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn, & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('slpa ',slpanl,slianl,snoanl,icefl1, +! call qcmxmn('slpa ',slpanl,slianl,snoanl,icefl1, + call qcmxmn('slpa ',slpanl,slmskl,snoanl,icefl1, & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn, & slpjmx,slpjmn,slpsmx,slpsmn,epsslp, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1796,11 +1814,13 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn, & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc1f ',stcfcs(1,1),slifcs,snofcs,icefl1, +! call qcmxmn('stc1f ',stcfcs(1,1),slifcs,snofcs,icefl1, + call qcmxmn('stc1f ',stcfcs(1,1),slmskl,snofcs,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc2f ',stcfcs(1,2),slifcs,snofcs,icefl1, +! call qcmxmn('stc2f ',stcfcs(1,2),slifcs,snofcs,icefl1, + call qcmxmn('stc2f ',stcfcs(1,2),slmskl,snofcs,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1882,7 +1902,8 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! & plrjmx,plrjmn,plrsmx,plrsmn,epsplr, ! & rla,rlo,len,kqcm,percrit,lgchek,me) ! endif - call qcmxmn('tg3f ',tg3fcs,slifcs,snofcs,icefl1, +! call qcmxmn('tg3f ',tg3fcs,slifcs,snofcs,icefl1, + call qcmxmn('tg3f ',tg3fcs,slmskl,snofcs,icefl1, & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3imx,tg3imn, & tg3jmx,tg3jmn,tg3smx,tg3smn,epstg3, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1897,7 +1918,8 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! & rla,rlo,len,kqcm,percrit,lgchek,me) !-- soil moisture forecast do k=1,lsoil - call qcmxmn(message('smcfcw',k),smcfcs(1,k),slifcs, +! call qcmxmn(message('smcfcw',k),smcfcs(1,k),slifcs, + call qcmxmn(message('smcfcw',k),smcfcs(1,k),slmskl, & snofcs,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, @@ -1905,35 +1927,42 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & enddo !-- soil temperature forecast do k=1,lsoil - call qcmxmn(message('stcf',k),stcfcs(1,k),slifcs, +! call qcmxmn(message('stcf',k),stcfcs(1,k),slifcs, + call qcmxmn(message('stcf',k),stcfcs(1,k),slmskl, & snofcs,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo - call qcmxmn('vegf ',vegfcs,slifcs,snofcs,icefl1, +! call qcmxmn('vegf ',vegfcs,slifcs,snofcs,icefl1, + call qcmxmn('vegf ',vegfcs,slmskl,snofcs,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, & vegjmx,vegjmn,vegsmx,vegsmn,epsveg, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vetf ',vetfcs,slifcs,snofcs,icefl1, +! call qcmxmn('vetf ',vetfcs,slifcs,snofcs,icefl1, + call qcmxmn('vetf ',vetfcs,slmskl,snofcs,icefl1, & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn, & vetjmx,vetjmn,vetsmx,vetsmn,epsvet, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sotf ',sotfcs,slifcs,snofcs,icefl1, +! call qcmxmn('sotf ',sotfcs,slifcs,snofcs,icefl1, + call qcmxmn('sotf ',sotfcs,slmskl,snofcs,icefl1, & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn, & sotjmx,sotjmn,sotsmx,sotsmn,epssot, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+16l] --------------------------------------------------------------- - call qcmxmn('vmnf ',vmnfcs,slifcs,snofcs,icefl1, +! call qcmxmn('vmnf ',vmnfcs,slifcs,snofcs,icefl1, + call qcmxmn('vmnf ',vmnfcs,slmskl,snofcs,icefl1, & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn, & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vmxf ',vmxfcs,slifcs,snofcs,icefl1, +! call qcmxmn('vmxf ',vmxfcs,slifcs,snofcs,icefl1, + call qcmxmn('vmxf ',vmxfcs,slmskl,snofcs,icefl1, & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn, & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('slpf ',slpfcs,slifcs,snofcs,icefl1, +! call qcmxmn('slpf ',slpfcs,slifcs,snofcs,icefl1, + call qcmxmn('slpf ',slpfcs,slmskl,snofcs,icefl1, & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn, & slpjmx,slpjmn,slpsmx,slpsmn,epsslp, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -2117,27 +2146,32 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! & rla,rlo,len,kqcm,percrit,lgchek,me) ! endif do k=1,lsoil - call qcmxmn(message('stcm',k),stcanl(1,k),slianl,snoanl,icefl1, +! call qcmxmn(message('stcm',k),stcanl(1,k),slianl,snoanl,icefl1, + call qcmxmn(message('stcm',k),stcanl(1,k),slmskl,snoanl,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo do k=1,lsoil - call qcmxmn(message('smcm',k),smcanl(1,k),slianl,snoanl,icefl1, +! call qcmxmn(message('smcm',k),smcanl(1,k),slianl,snoanl,icefl1, + call qcmxmn(message('smcm',k),smcanl(1,k),slmskl,snoanl,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo kqcm = 1 - call qcmxmn('vegm ',veganl,slianl,snoanl,icefl1, +! call qcmxmn('vegm ',veganl,slianl,snoanl,icefl1, + call qcmxmn('vegm ',veganl,slmskl,snoanl,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, & vegjmx,vegjmn,vegsmx,vegsmn,epsveg, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vetm ',vetanl,slianl,snoanl,icefl1, +! call qcmxmn('vetm ',vetanl,slianl,snoanl,icefl1, + call qcmxmn('vetm ',vetanl,slmskl,snoanl,icefl1, & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn, & vetjmx,vetjmn,vetsmx,vetsmn,epsvet, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sotm ',sotanl,slianl,snoanl,icefl1, +! call qcmxmn('sotm ',sotanl,slianl,snoanl,icefl1, + call qcmxmn('sotm ',sotanl,slmskl,snoanl,icefl1, & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn, & sotjmx,sotjmn,sotsmx,sotsmn,epssot, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -2151,15 +2185,18 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! & sicjmx,sicjmn,sicsmx,sicsmn,epssic, ! & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+16l] add vmn, vmx, slp, abs - call qcmxmn('vmnm ',vmnanl,slianl,snoanl,icefl1, +! call qcmxmn('vmnm ',vmnanl,slianl,snoanl,icefl1, + call qcmxmn('vmnm ',vmnanl,slmskl,snoanl,icefl1, & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn, & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vmxm ',vmxanl,slianl,snoanl,icefl1, +! call qcmxmn('vmxm ',vmxanl,slianl,snoanl,icefl1, + call qcmxmn('vmxm ',vmxanl,slmskl,snoanl,icefl1, & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn, & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('slpm ',slpanl,slianl,snoanl,icefl1, +! call qcmxmn('slpm ',slpanl,slianl,snoanl,icefl1, + call qcmxmn('slpm ',slpanl,slmskl,snoanl,icefl1, & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn, & slpjmx,slpjmn,slpsmx,slpsmn,epsslp, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -4441,13 +4478,12 @@ subroutine filfcs(tsffcs,wetfcs,snofcs,zorfcs,albfcs, & end !>\ingroup mod_sfcsub - subroutine bktges(smcfcs,slianl,stcfcs,len,lsoil) + subroutine bktges(smcfcs,stcfcs,len,lsoil) ! use machine , only : kind_io8,kind_io4 implicit none integer i,j,len,lsoil,k - real (kind=kind_io8) smcfcs(len,lsoil), stcfcs(len,lsoil), & - & slianl(len) + real (kind=kind_io8) smcfcs(len,lsoil), stcfcs(len,lsoil) ! ! note that smfcs comes in with the original unit (cm?) (not grib file) ! @@ -5022,7 +5058,7 @@ subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, & ! ! snow over sea ice is cycled ! - if(slianl(i).eq.2.) then + if (nint(slianl(i)) == 2) then snoanl(i) = snofcs(i) endif ! @@ -5053,7 +5089,7 @@ subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, & ! do k = 1, 4 do i=i1_t,i2_t - if(slianl(i).eq.0.) then + if (nint(slianl(i)) == 0) then albanl(i,k) = albfcs(i,k)*ralbs + albanl(i,k)*qalbs else albanl(i,k) = albfcs(i,k)*ralbl + albanl(i,k)*qalbl @@ -5063,7 +5099,7 @@ subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, & ! do k = 1, 2 do i=i1_t,i2_t - if(slianl(i).eq.0.) then + if (nint(slianl(i)) == 0) then alfanl(i,k) = alffcs(i,k)*ralfs + alfanl(i,k)*qalfs else alfanl(i,k) = alffcs(i,k)*ralfl + alfanl(i,k)*qalfl @@ -5073,7 +5109,7 @@ subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, & ! do k = 1, lsoil do i=i1_t,i2_t - if(slianl(i).eq.0.) then + if (nint(slianl(i)) == 0) then smcanl(i,k) = smcfcs(i,k)*rsmcs(k) + smcanl(i,k)*qsmcs(k) stcanl(i,k) = stcfcs(i,k)*rstcs(k) + stcanl(i,k)*qstcs(k) else @@ -7040,7 +7076,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & cvbclm(i) = 0.0 cvtclm(i) = 0.0 cnpclm(i) = 0.0 - sliclm(i) = 0.0 + sliclm(i) = slmskl(i) scvclm(i) = 0.0 vmnclm(i) = 0.0 vmxclm(i) = 0.0