167 integer,
parameter :: km=1
169 integer :: i, j, ii, jj, ij
170 integer :: ijmdl2, istart, iend, imid, iii
171 integer,
allocatable :: idum(:,:)
172 integer :: int_opt, ipopt(20), ibi(km)
173 integer :: kgds_mdl_tmp(200)
174 integer :: no, ibo(km), iret, nret
176 logical*1,
allocatable :: bitmap_mdl(:,:)
178 real :: gridi(1), gridj(1)
179 real :: lats(1), lons(1)
180 real,
allocatable :: lsmask_1d(:)
181 real,
allocatable :: snow_cvr_mdl_1d(:,:)
182 real,
allocatable :: snow_dep_mdl_tmp(:,:)
183 real :: sumc, sumd, x1, r, fraction, gridis, gridie
184 real,
parameter :: undefined_value = -999.
194 print*,
"- FATAL ERROR: MUST SELECT EITHER AFWA OR AUTOSNOW DATA FOR MODEL GRID WITH SH POINTS."
195 call w3tage(
'SNOW2MDL')
216 print*,
"- FATAL ERROR: MUST SELECT EITHER NESDIS/IMS OR AFWA DATA FOR MODEL GRID WITH NH POINTS."
217 call w3tage(
'SNOW2MDL')
241 print*,
"- INTERPOLATE NH NESDIS/IMS DATA TO MODEL GRID USING BUDGET METHOD."
247 kgds_mdl_tmp(1) = kgds_mdl_tmp(1) - 255
251 print*,
"- INTERPOLATE NH NESDIS/IMS DATA TO MODEL GRID USING NEIGHBOR METHOD."
259 allocate (snow_cvr_mdl_1d(
ijmdl,km))
260 snow_cvr_mdl_1d = 0.0
262 allocate (bitmap_mdl(
ijmdl,km))
267 call ipolates(int_opt, ipopt,
kgds_nesdis, kgds_mdl_tmp, &
271 snow_cvr_mdl_1d, iret)
276 print*,
"- FATAL ERROR: IN INTERPOLATION ROUTINE. IRET IS: ", iret
277 call w3tage(
'SNOW2MDL')
291 if (.not. bitmap_mdl(ij,km))
then
293 snow_cvr_mdl_1d(ij,km) = 0.0
297 call gdswzd(
kgds_nesdis,-1,1,undefined_value,gridi,gridj, &
300 print*,
"- WARNING: MODEL POINT OUTSIDE NESDIS/IMS GRID: ",
ipts_mdl(ij),
jpts_mdl(ij)
301 snow_cvr_mdl_1d(ij,km) = 0.0
306 snow_cvr_mdl_1d(ij,km) = 100.0
308 snow_cvr_mdl_1d(ij,km) = 0.0
316 deallocate (bitmap_mdl)
334 print*,
"- INTERPOLATE GLOBAL AFWA DATA TO MODEL GRID USING BUDGET METHOD."
337 ipopt(20) = nint(100.0 /
afwa_res) + 1
339 kgds_mdl_tmp(1) = kgds_mdl_tmp(1) - 255
343 print*,
"- INTERPOLATE GLOBAL AFWA DATA TO MODEL GRID USING NEIGHBOR METHOD."
344 ipopt(1) = nint(100.0 /
afwa_res) + 1
351 allocate (snow_dep_mdl_tmp(
ijmdl,km))
352 snow_dep_mdl_tmp = 0.0
354 allocate (bitmap_mdl(
ijmdl,km))
361 snow_dep_mdl_tmp, iret)
366 print*,
"- FATAL ERROR IN INTERPOLATION ROUTINE. IRET IS: ", iret
367 call w3tage(
'SNOW2MDL')
379 if (.not. bitmap_mdl(ij,km))
then
383 snow_dep_mdl_tmp(ij,km) = 0.0
388 deallocate(bitmap_mdl)
406 print*,
"- INTERPOLATE NH AFWA DATA TO MODEL GRID USING BUDGET METHOD."
409 ipopt(20) = nint(100.0 /
afwa_res) + 1
411 kgds_mdl_tmp(1) = kgds_mdl_tmp(1) - 255
415 print*,
"- INTERPOLATE NH AFWA DATA TO MODEL GRID USING NEIGHBOR METHOD."
416 ipopt(1) = nint(100.0 /
afwa_res) + 1
423 allocate (snow_dep_mdl_tmp(
ijmdl,km))
424 snow_dep_mdl_tmp = 0.0
426 allocate (bitmap_mdl(
ijmdl,km))
429 call ipolates(int_opt, ipopt,
kgds_afwa_nh, kgds_mdl_tmp, &
433 snow_dep_mdl_tmp, iret)
438 print*,
"- FATAL ERROR IN INTERPOLATION ROUTINE. IRET IS: ", iret
439 call w3tage(
'SNOW2MDL')
452 if (.not. bitmap_mdl(ij,km))
then
456 snow_dep_mdl_tmp(ij,km) = 0.0
462 deallocate(bitmap_mdl)
477 print*,
"- BLEND NESDIS/IMS AND AFWA DATA IN NH."
487 deallocate (snow_cvr_mdl_1d)
489 print*,
"- BLEND NESDIS/IMS AND AFWA DATA IN NH."
499 deallocate (snow_cvr_mdl_1d)
500 deallocate (snow_dep_mdl_tmp)
502 print*,
"- SET DEPTH/COVER FROM AFWA DATA IN NH."
505 if (snow_dep_mdl_tmp(ij,km) > 0.0)
then
512 print*,
"- SET DEPTH/COVER FROM AFWA DATA IN NH."
515 if (snow_dep_mdl_tmp(ij,km) > 0.0)
then
521 deallocate (snow_dep_mdl_tmp)
523 print*,
"- SET DEPTH/COVER FROM NESDIS/IMS DATA IN NH."
532 deallocate (snow_cvr_mdl_1d)
544 print*,
"- INTERPOLATE AUTOSNOW DATA TO MODEL GRID USING BUDGET METHOD."
550 kgds_mdl_tmp(1) = kgds_mdl_tmp(1) - 255
554 print*,
"- INTERPOLATE AUTOSNOW DATA TO MODEL GRID USING NEIGHBOR METHOD."
562 allocate (snow_cvr_mdl_1d(
ijmdl,km))
563 snow_cvr_mdl_1d = 0.0
565 allocate (bitmap_mdl(
ijmdl,km))
573 snow_cvr_mdl_1d, iret)
578 print*,
"- FATAL ERROR IN INTERPOLATION ROUTINE. IRET IS: ", iret
579 call w3tage(
'SNOW2MDL')
590 if (.not. bitmap_mdl(ij,km))
then
592 snow_cvr_mdl_1d(ij,km) = 0.0
594 snow_cvr_mdl_1d(ij,km) = 100.0
600 deallocate (bitmap_mdl)
618 print*,
"- INTERPOLATE SH AFWA DATA TO MODEL GRID USING BUDGET METHOD."
621 ipopt(20) = nint(100.0 /
afwa_res) + 1
623 kgds_mdl_tmp(1) = kgds_mdl_tmp(1) - 255
627 print*,
"- INTERPOLATE SH AFWA DATA TO MODEL GRID USING NEIGHBOR METHOD."
628 ipopt(1) = nint(100.0 /
afwa_res) + 1
635 allocate (snow_dep_mdl_tmp(
ijmdl,km))
636 snow_dep_mdl_tmp = 0.0
638 allocate (bitmap_mdl(
ijmdl,km))
641 call ipolates(int_opt, ipopt,
kgds_afwa_sh, kgds_mdl_tmp, &
645 snow_dep_mdl_tmp, iret)
648 print*,
"- FATAL ERROR IN INTERPOLATION ROUTINE. IRET IS: ", iret
649 call w3tage(
'SNOW2MDL')
662 if (.not. bitmap_mdl(ij,km))
then
666 snow_dep_mdl_tmp(ij,km) = 0.0
672 deallocate(bitmap_mdl)
682 print*,
"- BLEND AUTOSNOW AND AFWA DATA IN SH."
692 deallocate (snow_cvr_mdl_1d)
693 deallocate (snow_dep_mdl_tmp)
695 print*,
"- SET DEPTH/COVER FROM AFWA DATA IN SH."
698 if (snow_dep_mdl_tmp(ij,km) > 0.0)
then
704 deallocate (snow_dep_mdl_tmp)
706 print*,
"- SET DEPTH/COVER FROM AUTOSNOW IN SH."
715 deallocate (snow_cvr_mdl_1d)
727 allocate (snow_cvr_mdl_1d(ijmdl2,km))
728 allocate (lsmask_1d(ijmdl2))
729 allocate (snow_dep_mdl_tmp(ijmdl2,km))
732 snow_cvr_mdl_1d = 0.0
733 snow_dep_mdl_tmp = 0.0
753 if (ii == istart)
then
754 fraction = 0.5 - (gridis - float(istart))
755 elseif (ii == iend)
then
756 fraction = 0.5 + (gridie - float(iend))
760 if (fraction < 0.0001) cycle
762 if (iii < 1) iii =
imdl + iii
766 snow_cvr_mdl_1d(ij,km) = sumc / r
767 snow_dep_mdl_tmp(ij,km) = 0.0
784 deallocate(snow_cvr_mdl_1d)
786 deallocate(snow_dep_mdl_tmp)
796 print*,
"- OUTPUT SNOW ANALYSIS DATA IN GRIB2 FORMAT"
799 print*,
"- OUTPUT SNOW ANALYSIS DATA IN GRIB1 FORMAT"
829 character(len=1),
allocatable :: cgrib(:)
831 integer,
parameter :: numcoord = 0
833 integer :: coordlist(numcoord)
834 integer :: lugb, lcgrib, iret
836 integer :: listsec0(2)
837 integer :: listsec1(13)
838 integer :: ideflist, idefnum, ipdsnum, idrsnum
839 integer :: igdstmplen, ipdstmplen, idrstmplen
840 integer :: ipdstmpl(15)
841 integer,
allocatable :: igdstmpl(:), idrstmpl(:)
842 integer :: ngrdpts, ibmap, lengrib
844 logical*1,
allocatable :: bmap(:), bmap2d(:,:)
846 real,
allocatable :: fld(:)
854 allocate(igdstmpl(igdstmplen))
858 listsec0, listsec1, igds, ipdstmpl, ipdsnum, igdstmpl, &
859 igdstmplen, idefnum, ideflist, ngrdpts)
862 allocate(cgrib(lcgrib))
870 print*,
"- CREATE SECTIONS 0 AND 1"
871 call gribcreate(cgrib,lcgrib,listsec0,listsec1,iret)
872 if (iret /= 0)
goto 900
878 print*,
"- CREATE SECTION 3"
879 call addgrid(cgrib,lcgrib,igds,igdstmpl,igdstmplen, &
880 ideflist,idefnum,iret)
881 if (iret /= 0)
goto 900
889 allocate (idrstmpl(idrstmplen))
893 allocate(fld(ngrdpts))
900 allocate(bmap(ngrdpts))
901 bmap = reshape(bmap2d, (/
imdl*
jmdl/) )
914 print*,
"- CREATE SECTIONS 4 AND 5 FOR SNOW COVER"
915 call addfield(cgrib,lcgrib,ipdsnum,ipdstmpl,ipdstmplen, &
916 coordlist,numcoord,idrsnum,idrstmpl, &
917 idrstmplen,fld,ngrdpts,ibmap,bmap,iret)
918 if (iret /= 0)
goto 900
943 print*,
"- CREATE SECTIONS 4 AND 5 FOR SNOW DEPTH"
944 call addfield(cgrib,lcgrib,ipdsnum,ipdstmpl,ipdstmplen, &
945 coordlist,numcoord,idrsnum,idrstmpl, &
946 idrstmplen,fld,ngrdpts,ibmap,bmap,iret)
947 if (iret /= 0)
goto 900
955 call gribend(cgrib,lcgrib,lengrib,iret)
956 if (iret /= 0)
goto 900
967 print*,
'- FATAL ERROR: BAD OPEN OF OUTPUT GRIB FILE. IRET IS ', iret
968 call w3tage(
'SNOW2MDL')
972 print*,
'- WRITE OUTPUT GRIB FILE.'
973 call wryte(lugb, lengrib, cgrib)
975 call baclose (lugb, iret)
977 deallocate(fld, bmap, idrstmpl, igdstmpl, cgrib)
982 print*,
'- FATAL ERROR CREATING GRIB2 MESSAGE. IRET IS ', iret
983 call w3tage(
'SNOW2MDL')
1008 integer,
parameter :: lugb = 64
1009 integer :: kpds(200)
1011 logical*1 :: lbms(imdl,jmdl)
1058 print*,
'- FATAL ERROR OPENING OUTPUT GRIB FILE. IRET IS ', iret
1059 call w3tage(
'SNOW2MDL')
1064 call putgb (lugb, (imdl*jmdl), kpds,
kgds_mdl, lbms, &
1068 print*,
'- FATAL ERROR WRITING OUTPUT GRIB FILE. IRET IS ', iret
1069 call w3tage(
'SNOW2MDL')
1084 call putgb (lugb, (imdl*jmdl), kpds,
kgds_mdl, lbms, &
1088 print*,
'- FATAL ERROR WRITING OUTPUT GRIB FILE. IRET IS ', iret
1089 call w3tage(
'SNOW2MDL')
1093 88
call baclose(lugb, iret)
1119 integer,
intent(in) :: len
1120 integer,
intent(in) :: iord
1121 integer,
intent(in) :: lonl
1122 integer,
intent(in) :: latd
1123 integer,
intent(in) :: lonsperlat(latd/2)
1124 integer,
intent(in) :: kmsk(lonl*latd)
1125 integer :: j,lons,jj,latd2,ii,i
1127 real,
intent(in) :: fi(len)
1128 real,
intent(out) :: f(lonl,latd)
1136 if (j .gt. latd2) jj = latd - j + 1
1139 if(lons.ne.lonl)
then
1140 call intlon(iord,1,1,lons,lonl,kmsk(ii),fi(ii),f(1,j))
1166 subroutine intlon(iord,imon,imsk,m1,m2,k1,f1,f2)
1170 integer,
intent(in) :: iord,imon,imsk,m1,m2
1171 integer,
intent(in) :: k1(m1)
1172 integer :: i2,in,il,ir
1174 real,
intent(in) :: f1(m1)
1175 real,
intent(out) :: f2(m2)
1183 if(iord.eq.2.and.(imsk.eq.0.or.k1(il).eq.k1(ir)))
then
1184 f2(i2)=f1(il)*(il-x1)+f1(ir)*(x1-il+1)
1186 in=mod(nint(x1),m1)+1
subroutine grib2_check(kgds, igdstmplen)
Determine length of grib2 gds template array, which is a function of the map projection.
subroutine init_grib2(century, year, month, day, hour, kgds, lat11, latlast, lon11, lonlast, listsec0, listsec1, igds, ipdstmpl, ipdsnum, igdstmpl, igdstmplen, idefnum, ideflist, ngrdpts)
Initialize grib2 arrays required by the ncep g2 library according to grib1 gds information.
Read in data defining the model grid.
integer, dimension(:), allocatable jpts_mdl
j index of point on full grid
real lonlast
Corner point longitude (imdl,jmdl) of model grid.
integer jmdl
j-dimension of model grid
integer, dimension(:), allocatable lonsperlat_mdl
Number of longitudes (i-points) for each latitude (row).
integer imdl
i-dimension of model grid
real latlast
Corner point latitude (imdl,jmdl) of model grid.
real, dimension(:,:), allocatable lsmask_mdl
land mask of model grid (0 - non land, 1-land) for global grids run thinned, will contain a modified ...
real, dimension(:), allocatable lats_mdl
Latitudes of model grid points.
logical thinned
When true, global grids will run thinned (number of i points decrease toward pole)
real, dimension(:,:), allocatable lsmask_mdl_sav
saved copy of land mask of model grid (0 - non land, 1-land) only used for global thinned grids.
integer ijmdl
total number of model land points
integer, dimension(200) kgds_mdl
holds grib gds info of model grid
real resol_mdl
approximate model resolution in km.
real lat11
Corner point latitude (1,1) of model grid.
integer, dimension(:), allocatable ipts_mdl
i index of point on full grid
integer grid_id_mdl
grib id of model grid, 4-gaussian, 203-egrid
real lon11
Corner point longitude (1,1) of model grid.
real, dimension(:), allocatable lons_mdl
longitudes of model grid points
This module reads in data from the program's configuration namelist.
integer, public grib_day
date of the final merged snow product that will be placed in grib header.
real, public lat_threshold
equatorward of this latitude, model points with undefined cover or depth (because the interpolation r...
character *200, public model_snow_file
path/name nesdis/ims snow cover
integer, public grib_year
date of the final merged snow product that will be placed in grib header.
real, public min_snow_depth
minimum snow depth in meters at model points with coverage exceeding threshold.
real, public snow_cvr_threshold
if percent coverage according to nesdis/ims or autosnow exceeds this value, then non-zero snow depth ...
logical, public output_grib2
when true, output model snow analysis is grib 2.
integer, public grib_month
date of the final merged snow product that will be placed in grib header.
integer, public grib_century
date of the final merged snow product that will be placed in grib header.
integer, public grib_hour
date of the final merged snow product that will be placed in grib header.
Interpolate snow data to model grid and grib the result.
subroutine, public interp
Interpolate snow data to model grid.
real, dimension(:,:), allocatable snow_cvr_mdl
snow cover on model grid in percent
real, dimension(:,:), allocatable snow_dep_mdl
snow depth on model grid in meters
subroutine intlon(iord, imon, imsk, m1, m2, k1, f1, f2)
Convert data from the thinned (or reduced) to the full grid along a single row.
subroutine write_grib1
Write grib1 snow cover and depth on the model grid.
subroutine write_grib2
Write grib2 snow cover and depth on the model grid.
subroutine uninterpred(iord, kmsk, fi, f, lonl, latd, len, lonsperlat)
Fills out full grid using thinned grid data.
Read and qc afwa, nesdis/ims and autosnow snow data.
integer iafwa
i-dimension of afwa grid
real autosnow_res
Resolution of autosnow in km.
integer jnesdis
j-dimension of nesdis grid
logical *1, dimension(:,:), allocatable bitmap_afwa_sh
The southern hemisphere afwa data grib bitmap.
logical *1, dimension(:,:), allocatable bitmap_afwa_nh
The northern hemisphere afwa data grib bitmap.
integer mesh_nesdis
nesdis/ims data is 96th mesh (or bediant)
logical bad_afwa_sh
When true, the southern hemisphere afwa data failed its quality control check.
logical use_nesdis
True if nesdis/ims data to be used.
logical *1, dimension(:,:), allocatable bitmap_afwa_global
The global afwa data grib bitmap.
real, dimension(:,:), allocatable snow_dep_afwa_nh
Northern hemisphere afwa snow depth.
logical *1, dimension(:,:), allocatable bitmap_nesdis
nesdis data grib bitmap (false-non land, true-land).
logical use_autosnow
True if autosnow data to be used.
integer jafwa
j-dimension of afwa grid
integer iautosnow
i-dimension of autosnow grid
logical use_sh_afwa
True if southern hemisphere afwa data to be used.
logical use_global_afwa
True if global hemisphere afwa data to be used.
real afwa_res
Resolution of afwa data in km.
real nesdis_res
Resolution of the nesdis data in km.
integer, dimension(200) kgds_afwa_sh
grib1 grid description section for southern hemisphere 16th mesh afwa data.
real, dimension(:,:), allocatable snow_dep_afwa_sh
Southern hemisphere afwa snow depth.
integer *1, dimension(:,:), allocatable sea_ice_nesdis
nesdis/ims sea ice flag (0-open water, 1-ice)
logical *1, dimension(:,:), allocatable bitmap_autosnow
autosnow data grib bitmap (false-non land, true-land).
integer jautosnow
j-dimension of autosnow grid
integer inesdis
i-dimension of nesdis grid
real, dimension(:,:), allocatable snow_cvr_nesdis
nesdis/ims snow cover flag (0-no, 100-yes)
integer, dimension(200) kgds_autosnow
autosnow grid description section (grib section 2)
integer, dimension(200) kgds_afwa_nh
grib1 grid description section for northern hemisphere 16th mesh afwa data.
integer, dimension(200) kgds_nesdis
nesdis/ims grid description section (grib section 2)
integer, dimension(200) kgds_afwa_global
grib1 grid description section for global afwa data.
real, dimension(:,:), allocatable snow_cvr_autosnow
autosnow snow cover flag (0-no, 100-yes)
real, dimension(:,:), allocatable snow_dep_afwa_global
The global afwa snow depth.
logical use_nh_afwa
True if northern hemisphere afwa data to be used.
logical bad_afwa_nh
When true, the northern hemisphere afwa data failed its quality control check.