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)
1115 subroutine uninterpred(iord,kmsk,fi,f,lonl,latd,len,lonsperlat)
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
real, dimension(:,:), allocatable snow_dep_afwa_sh
Southern hemisphere afwa snow depth.
This module reads in data from the program's configuration namelist.
logical bad_afwa_sh
When true, the southern hemisphere afwa data failed its quality control check.
real, dimension(:,:), allocatable snow_cvr_mdl
snow cover on model grid in percent
integer, dimension(200) kgds_afwa_nh
grib1 grid description section for northern hemisphere 16th mesh afwa data.
integer mesh_nesdis
nesdis/ims data is 96th mesh (or bediant)
real, public snow_cvr_threshold
if percent coverage according to nesdis/ims or autosnow exceeds this value, then non-zero snow depth ...
real, public min_snow_depth
minimum snow depth in meters at model points with coverage exceeding threshold.
real lonlast
Corner point longitude (imdl,jmdl) of model grid.
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.
subroutine grib2_check(kgds, igdstmplen)
Determine length of grib2 gds template array, which is a function of the map projection.
real, dimension(:,:), allocatable snow_cvr_autosnow
autosnow snow cover flag (0-no, 100-yes)
integer *1, dimension(:,:), allocatable sea_ice_nesdis
nesdis/ims sea ice flag (0-open water, 1-ice)
real, dimension(:,:), allocatable snow_dep_afwa_global
The global afwa snow depth.
integer, public grib_century
date of the final merged snow product that will be placed in grib header.
integer jmdl
j-dimension of model grid
integer, dimension(200) kgds_nesdis
nesdis/ims grid description section (grib section 2)
logical *1, dimension(:,:), allocatable bitmap_nesdis
nesdis data grib bitmap (false-non land, true-land).
integer, dimension(:), allocatable lonsperlat_mdl
Number of longitudes (i-points) for each latitude (row).
logical thinned
When true, global grids will run thinned (number of i points decrease toward pole) ...
real afwa_res
Resolution of afwa data in km.
real, dimension(:), allocatable lats_mdl
Latitudes of model grid points.
integer, dimension(200) kgds_afwa_global
grib1 grid description section for global afwa data.
Read in data defining the model grid.
integer, dimension(200) kgds_autosnow
autosnow grid description section (grib section 2)
integer jafwa
j-dimension of afwa grid
integer iautosnow
i-dimension of autosnow grid
Read and qc afwa, nesdis/ims and autosnow snow data.
integer iafwa
i-dimension of afwa 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 ...
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 uninterpred(iord, kmsk, fi, f, lonl, latd, len, lonsperlat)
Fills out full grid using thinned grid data.
logical *1, dimension(:,:), allocatable bitmap_autosnow
autosnow data grib bitmap (false-non land, true-land).
real nesdis_res
Resolution of the nesdis data in km.
integer, public grib_month
date of the final merged snow product that will be placed in grib header.
logical *1, dimension(:,:), allocatable bitmap_afwa_sh
The southern hemisphere afwa data grib bitmap.
real, dimension(:), allocatable lons_mdl
longitudes of model grid points
real, dimension(:,:), allocatable snow_dep_afwa_nh
Northern hemisphere afwa snow depth.
real resol_mdl
approximate model resolution in km.
logical use_sh_afwa
True if southern hemisphere afwa data to be used.
Interpolate snow data to model grid and grib the result.
subroutine write_grib2
Write grib2 snow cover and depth on the model grid.
integer inesdis
i-dimension of nesdis grid
integer imdl
i-dimension of model grid
integer, public grib_day
date of the final merged snow product that will be placed in grib header.
integer jautosnow
j-dimension of autosnow grid
real, public lat_threshold
equatorward of this latitude, model points with undefined cover or depth (because the interpolation r...
logical use_nh_afwa
True if northern hemisphere afwa data to be used.
logical use_nesdis
True if nesdis/ims data to be used.
logical, public output_grib2
when true, output model snow analysis is grib 2.
subroutine write_grib1
Write grib1 snow cover and depth on the model grid.
real lon11
Corner point longitude (1,1) of model grid.
integer ijmdl
total number of model land points
logical use_autosnow
True if autosnow data to be used.
logical *1, dimension(:,:), allocatable bitmap_afwa_global
The global afwa data grib bitmap.
character *200, public model_snow_file
path/name nesdis/ims snow cover
integer, dimension(:), allocatable jpts_mdl
j index of point on full grid
integer, dimension(200) kgds_mdl
holds grib gds info of model grid
integer, public grib_year
date of the final merged snow product that will be placed in grib header.
integer jnesdis
j-dimension of nesdis grid
real latlast
Corner point latitude (imdl,jmdl) of model grid.
integer, dimension(:), allocatable ipts_mdl
i index of point on full grid
integer, public grib_hour
date of the final merged snow product that will be placed in grib header.
logical bad_afwa_nh
When true, the northern hemisphere afwa data failed its quality control check.
integer, dimension(200) kgds_afwa_sh
grib1 grid description section for southern hemisphere 16th mesh afwa data.
real autosnow_res
Resolution of autosnow in km.
logical *1, dimension(:,:), allocatable bitmap_afwa_nh
The northern hemisphere afwa data grib bitmap.
real, dimension(:,:), allocatable snow_dep_mdl
snow depth on model grid in meters
integer grid_id_mdl
grib id of model grid, 4-gaussian, 203-egrid
logical use_global_afwa
True if global hemisphere afwa data to be used.
real lat11
Corner point latitude (1,1) of model grid.
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...
real, dimension(:,:), allocatable snow_cvr_nesdis
nesdis/ims snow cover flag (0-no, 100-yes)
subroutine, public interp
Interpolate snow data to model grid.