47 subroutine gfs_radiation_surface_run ( &
48 ialb, im, nf_albd, frac_grid, lslwr, lsswr, lsm, lsm_noahmp, &
49 lsm_ruc, xlat, xlon, slmsk, lndp_type, n_var_lndp, sfc_alb_pert,&
50 lndp_var_list, lndp_prt_list, landfrac, snodl, snodi, sncovr, &
51 sncovr_ice, fice, zorl, hprime, tsfg, tsfa, tisfc, coszen, &
52 cplice, min_seaice, min_lakeice, lakefrac, use_lake_model, &
53 alvsf, alnsf, alvwf, alnwf, facsf, facwf, &
54 semis_lnd, semis_ice, semis_wat, snoalb, use_cice_alb, con_ttp, &
55 albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, &
56 albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, &
57 semisbase, semis, sfcalb, sfc_alb_dif, errmsg, errflg)
65 integer,
intent(in) :: im, nf_albd, ialb
66 logical,
intent(in) :: frac_grid, lslwr, lsswr, use_cice_alb, cplice
67 integer,
intent(in) :: lsm, lsm_noahmp, lsm_ruc, lndp_type, n_var_lndp
68 real(kind=kind_phys),
intent(in) :: min_seaice, min_lakeice, con_ttp
69 integer,
dimension(:),
intent(in) :: use_lake_model
71 real(kind=kind_phys),
dimension(:),
intent(in) :: xlat, xlon, slmsk, &
74 snodl, snodi, sncovr, &
75 sncovr_ice, fice, zorl, &
76 hprime, tsfg, tsfa, tisfc, &
77 coszen, alvsf, alnsf, alvwf, &
78 alnwf, facsf, facwf, snoalb
79 real(kind=kind_phys),
dimension(:),
intent(in),
optional :: lndp_prt_list
80 character(len=3) ,
dimension(:),
intent(in),
optional :: lndp_var_list
81 real(kind=kind_phys),
dimension(:),
intent(in),
optional :: albdvis_ice, albdnir_ice, &
82 albivis_ice, albinir_ice
84 real(kind=kind_phys),
dimension(:),
intent(inout) :: albdvis_lnd, albdnir_lnd, &
85 albivis_lnd, albinir_lnd, &
86 semis_lnd, semis_ice, semis_wat
87 real(kind=kind_phys),
dimension(:),
intent(inout) :: semisbase, semis
88 real(kind=kind_phys),
dimension(:,:),
intent(inout) :: sfcalb
89 real(kind=kind_phys),
dimension(:),
intent(inout) :: sfc_alb_dif
91 character(len=*),
intent(out) :: errmsg
92 integer,
intent(out) :: errflg
96 real(kind=kind_phys) :: lndp_alb
97 real(kind=kind_phys),
dimension(im) :: cimin, fracl, fraci, fraco
98 logical,
dimension(im) :: icy
105 if (.not. lsswr .and. .not. lslwr)
return
108 if (lakefrac(i) >
f_zero)
then
109 cimin(i) = min_lakeice
111 cimin(i) = min_seaice
116 if (.not. frac_grid)
then
118 if (slmsk(i) == 1)
then
126 if(fice(i) < cimin(i))
then
130 fraci(i) = fraco(i) * fice(i)
133 fraco(i) = max(
f_zero, fraco(i)-fraci(i))
138 fracl(i) = landfrac(i)
140 if(fice(i) < cimin(i))
then
144 fraci(i) = fraco(i) * fice(i)
147 fraco(i) = max(
f_zero, fraco(i)-fraci(i))
155 use_lake_model, lakefrac, xlon, xlat, slmsk, &
157 snodl, snodi, sncovr, sncovr_ice, zorl, tsfg, &
158 tsfa, hprime, semis_lnd, semis_ice, semis_wat,&
159 im, fracl, fraco, fraci, icy, &
166 if (lndp_type==1)
then
168 if (lndp_var_list(i) ==
'alb')
then
169 lndp_alb = lndp_prt_list(i)
177 call setalb (slmsk, lsm, lsm_noahmp,
lsm_ruc, use_cice_alb, snodi, sncovr, sncovr_ice, &
178 snoalb, zorl, coszen, tsfg, tsfa, hprime, frac_grid, lakefrac, &
179 alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, &
180 albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, &
181 albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, &
182 im, nf_albd, sfc_alb_pert, lndp_alb, fracl, fraco, fraci, icy, ialb, &
187 sfc_alb_dif(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4)))
subroutine, public setemis(lsm, lsm_noahmp, lsm_ruc, frac_grid, cplice, use_lake_model, lakefrac, xlon, xlat, slmsk, snodl, snodi, sncovr, sncovr_ice, zorlf, tsknf, tairf, hprif, semis_lnd, semis_ice, semis_wat, imax, fracl, fraco, fraci, icy, semisbase, sfcemis)
This subroutine computes surface emissivity for LW radiation.
subroutine, public setalb(slmsk, lsm, lsm_noahmp, lsm_ruc, use_cice_alb, snodi, sncovr, sncovr_ice, snoalb, zorlf, coszf, tsknf, tairf, hprif, frac_grid, lakefrac, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, icealbdvis, icealbdnir, icealbivis, icealbinir, imax, nf_albd, albppert, pertalb, fracl, fraco, fraci, icy, ialbflg, con_ttp, sfcalb)
This subroutine computes four components of surface albedos (i.e., vis-nir, direct-diffused) accordin...