25 vtype_save, stype_save,scolor_save, slope_save, errmsg, errflg)
30 integer,
intent(in) :: nthreads, im, isot, ivegsrc
31 real(kind_phys),
dimension(:),
intent(in) :: slmsk
32 integer,
dimension(:),
intent(inout) :: vtype, stype, scolor,slope
33 integer,
dimension(:),
intent(out) :: vtype_save, stype_save,scolor_save, slope_save
36 character(len=*),
intent(out) :: errmsg
37 integer,
intent(out) :: errflg
40 integer,
dimension(1:im) :: islmsk
50 vtype_save(:) = vtype(:)
51 stype_save(:) = stype(:)
52 scolor_save(:) = scolor(:)
53 slope_save(:) = slope(:)
62 subroutine gfs_surface_generic_pre_run (nthreads, im, levs, vfrac, islmsk, isot, ivegsrc, stype, scolor,vtype, slope, &
63 prsik_1, prslk_1, tsfc, phil, con_g, sigmaf, work3, zlvl, &
64 lndp_type, n_var_lndp, sfc_wts, lndp_var_list, lndp_prt_list, &
65 z01d, zt1d, bexp1d, xlai1d, vegf1d, lndp_vgf, &
66 cplflx, flag_cice, islmsk_cice, slimskin_cpl, &
67 wind, u1, v1, cnvwind, smcwlt2, smcref2, vtype_save, stype_save,scolor_save, slope_save, &
75 integer,
intent(in) :: nthreads, im, levs, isot, ivegsrc
76 integer,
dimension(:),
intent(in) :: islmsk
78 real(kind=kind_phys),
intent(in) :: con_g
79 real(kind=kind_phys),
dimension(:),
intent(in) :: vfrac, prsik_1, prslk_1
80 integer,
dimension(:),
intent(inout) :: vtype, stype,scolor, slope
81 integer,
dimension(:),
intent(out) :: vtype_save(:), stype_save(:),scolor_save(:), slope_save(:)
83 real(kind=kind_phys),
dimension(:),
intent(inout) :: tsfc
84 real(kind=kind_phys),
dimension(:,:),
intent(in) :: phil
86 real(kind=kind_phys),
dimension(:),
intent(inout) :: sigmaf, work3, zlvl
89 integer,
intent(in) :: lndp_type, n_var_lndp
90 character(len=3),
dimension(:),
intent(in),
optional :: lndp_var_list
91 real(kind=kind_phys),
dimension(:),
intent(in),
optional :: lndp_prt_list
92 real(kind=kind_phys),
dimension(:,:),
intent(in),
optional :: sfc_wts
93 real(kind=kind_phys),
dimension(:),
intent(out) :: z01d
94 real(kind=kind_phys),
dimension(:),
intent(out) :: zt1d
95 real(kind=kind_phys),
dimension(:),
intent(out) :: bexp1d
96 real(kind=kind_phys),
dimension(:),
intent(out) :: xlai1d
97 real(kind=kind_phys),
dimension(:),
intent(out) :: vegf1d
98 real(kind=kind_phys),
intent(out) :: lndp_vgf
100 logical,
intent(in) :: cplflx
101 real(kind=kind_phys),
dimension(:),
intent(in),
optional :: slimskin_cpl
102 logical,
dimension(:),
intent(inout) :: flag_cice
103 integer,
dimension(:),
intent(out) :: islmsk_cice
105 real(kind=kind_phys),
dimension(:),
intent(out) :: wind
106 real(kind=kind_phys),
dimension(:),
intent(in ) :: u1, v1
108 real(kind=kind_phys),
dimension(:),
intent(inout ),
optional :: cnvwind
110 real(kind=kind_phys),
dimension(:),
intent(out) :: smcwlt2, smcref2
113 character(len=*),
intent(out) :: errmsg
114 integer,
intent(out) :: errflg
118 real(kind=kind_phys) :: onebg, cdfz
131 if (lndp_type==1)
then
133 select case(lndp_var_list(k))
135 z01d(:) = lndp_prt_list(k)* sfc_wts(:,k)
137 zt1d(:) = lndp_prt_list(k)* sfc_wts(:,k)
139 bexp1d(:) = lndp_prt_list(k) * sfc_wts(:,k)
141 xlai1d(:) = lndp_prt_list(k)* sfc_wts(:,k)
145 call cdfnor(sfc_wts(i,k),cdfz)
148 lndp_vgf = lndp_prt_list(k)
156 vtype_save(:) = vtype(:)
157 stype_save(:) = stype(:)
158 scolor_save(:) = scolor(:)
159 slope_save(:) = slope(:)
164 sigmaf(i) = max(vfrac(i), 0.01_kind_phys)
165 islmsk_cice(i) = islmsk(i)
167 work3(i) = prsik_1(i) / prslk_1(i)
169 zlvl(i) = phil(i,1) * onebg
173 wind(i) = max(sqrt(u1(i)*u1(i) + v1(i)*v1(i)) &
174 + max(zero, min(cnvwind(i), 30.0_kind_phys)), one)
184 islmsk_cice(i) = nint(slimskin_cpl(i))
185 flag_cice(i) = (islmsk_cice(i) == 4)
195 integer,
intent(in) :: nthreads, im, isot, ivegsrc, islmsk(:)
196 integer,
intent(inout) :: vtype(:), stype(:),scolor(:), slope(:)
205 if (islmsk(i) == 2)
then
211 if (ivegsrc == 0 .or. ivegsrc == 4)
then
213 elseif (ivegsrc == 1)
then
215 elseif (ivegsrc == 2)
then
217 elseif (ivegsrc == 3 .or. ivegsrc == 5)
then
222 if (vtype(i) < 1) vtype(i) = 17
223 if (slope(i) < 1) slope(i) = 1
subroutine, public gfs_surface_generic_pre_run(nthreads, im, levs, vfrac, islmsk, isot, ivegsrc, stype, scolor, vtype, slope, prsik_1, prslk_1, tsfc, phil, con_g, sigmaf, work3, zlvl, lndp_type, n_var_lndp, sfc_wts, lndp_var_list, lndp_prt_list, z01d, zt1d, bexp1d, xlai1d, vegf1d, lndp_vgf, cplflx, flag_cice, islmsk_cice, slimskin_cpl, wind, u1, v1, cnvwind, smcwlt2, smcref2, vtype_save, stype_save, scolor_save, slope_save, errmsg, errflg)
subroutine, public gfs_surface_generic_pre_init(nthreads, im, slmsk, isot, ivegsrc, stype, scolor, vtype, slope, vtype_save, stype_save, scolor_save, slope_save, errmsg, errflg)