31 afwa_snow_global_file, &
34 afwa_lsmask_nh_file, &
46 integer :: kgds_afwa_global(200)
48 integer :: kgds_afwa_nh(200)
50 integer :: kgds_afwa_nh_8th(200)
52 integer :: kgds_afwa_sh(200)
54 integer :: kgds_afwa_sh_8th(200)
56 integer :: kgds_autosnow(200)
57 integer :: kgds_nesdis(200)
58 integer :: mesh_nesdis
59 integer*1,
allocatable :: sea_ice_nesdis(:,:)
60 logical :: bad_afwa_nh
62 logical :: bad_afwa_sh
66 logical :: bad_afwa_global
68 logical*1,
allocatable :: bitmap_afwa_global(:,:)
70 logical*1,
allocatable :: bitmap_afwa_nh(:,:)
72 logical*1,
allocatable :: bitmap_afwa_sh(:,:)
74 logical*1,
allocatable :: bitmap_nesdis(:,:)
75 logical*1,
allocatable :: bitmap_autosnow(:,:)
77 logical :: use_nh_afwa
78 logical :: use_sh_afwa
79 logical :: use_global_afwa
80 logical :: use_autosnow
86 real,
allocatable :: snow_cvr_nesdis(:,:)
87 real,
allocatable :: snow_cvr_autosnow(:,:)
88 real,
allocatable :: snow_dep_afwa_global(:,:)
89 real,
allocatable :: snow_dep_afwa_nh(:,:)
90 real,
allocatable :: snow_dep_afwa_sh(:,:)
95 data kgds_afwa_nh_8th/5,2*512,-20826,145000,8,-80000,2*47625,0, &
97 data kgds_afwa_sh_8th/5,2*512,20826,-125000,8,-80000,2*47625,128, &
122 type(gribfield
) :: gfld
124 integer :: iret, j, k, lugb, lugi
125 integer :: jdisc, jgdtn, jpdtn
126 integer :: jids(200), jgdt(200), jpdt(200)
130 use_autosnow = .true.
132 if ( len_trim(autosnow_file) == 0 )
then
133 print*,
"- WILL NOT USE AUTOSNOW DATA."
134 use_autosnow = .false.
138 print*,
"- OPEN AND READ AUTOSNOW FILE ", trim(autosnow_file)
141 call baopenr(lugb,autosnow_file,iret)
144 print*,
'- FATAL ERROR: BAD OPEN OF FILE, IRET IS ', iret
145 call w3tage(
'SNOW2MDL')
163 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
164 unpack, k, gfld, iret)
167 print*,
'- FATAL ERROR: BAD DEGRIB OF FILE, IRET IS ', iret
168 call w3tage(
'SNOW2MDL')
172 print*,
"- DATA VALID AT (YYYYMMDDHH): ", gfld%idsect(6),gfld%idsect(7), &
173 gfld%idsect(8),gfld%idsect(9)
175 call baclose(lugb, iret)
182 call
gdt_to_gds(gfld%igdtnum, gfld%igdtmpl, gfld%igdtlen, kgds_autosnow, &
183 iautosnow, jautosnow, autosnow_res)
185 allocate (bitmap_autosnow(iautosnow,jautosnow))
186 bitmap_autosnow = reshape(gfld%bmap , (/iautosnow,jautosnow/) )
188 allocate (snow_cvr_autosnow(iautosnow,jautosnow))
189 snow_cvr_autosnow = reshape(gfld%fld , (/iautosnow,jautosnow/) )
227 integer,
parameter :: iunit = 13
228 integer,
parameter :: iunit2 = 43
230 integer*4,
allocatable :: dummy4(:,:)
236 integer,
parameter :: lugi = 0
237 integer :: jdisc, jgdtn, jpdtn, k
238 integer :: jids(200), jgdt(200), jpdt(200)
241 integer :: message_num
248 real,
allocatable :: dummy(:,:)
251 type(gribfield
) :: gfld
255 if ( len_trim(nesdis_snow_file) == 0 )
then
256 print*,
"- WILL NOT USE NESDIS/IMS DATA."
261 print*,
"- OPEN AND READ NESDIS/IMS SNOW FILE ", trim(nesdis_snow_file)
266 print*,
'- FATAL ERROR: IMS FILE MUST BE GRIB 1 OR GRIB2 FORMAT'
267 call w3tage(
'SNOW2MDL')
271 call baopenr(iunit, nesdis_snow_file, iret)
274 print*,
'- FATAL ERROR: BAD OPEN OF FILE, IRET IS ', iret
275 call w3tage(
'SNOW2MDL')
292 print*,
"- GET GRIB HEADER"
294 call getgbh(iunit, lugi, lskip, jpds, jgds, numbytes, &
295 numpts, message_num, kpds, kgds, iret)
298 print*,
"- FATAL ERROR: BAD DEGRIB OF HEADER. IRET IS ", iret
299 call w3tage(
'SNOW2MDL')
307 mesh_nesdis = inesdis / 64
308 nesdis_res = 381. / float(mesh_nesdis)
310 print*,
"- DATA VALID AT (YYMMDDHH): ", kpds(8:11)
312 allocate (dummy(inesdis,jnesdis))
313 allocate (sea_ice_nesdis(inesdis,jnesdis))
314 allocate (bitmap_nesdis(inesdis,jnesdis))
316 print*,
"- DEGRIB SEA ICE."
318 call getgb(iunit, lugi, (inesdis*jnesdis), lskip, jpds, jgds, &
319 numpts, lskip, kpds, kgds, bitmap_nesdis, dummy, iret)
322 print*,
"- FATAL ERROR: BAD DEGRIB OF DATA. IRET IS ", iret
323 call w3tage(
'SNOW2MDL')
327 sea_ice_nesdis = nint(dummy)
337 allocate (snow_cvr_nesdis(inesdis,jnesdis))
339 print*,
"- DEGRIB SNOW COVER."
341 call getgb(iunit, lugi, (inesdis*jnesdis), lskip, jpds, jgds, &
342 numpts, lskip, kpds, kgds, bitmap_nesdis, snow_cvr_nesdis, iret)
345 print*,
"- FATAL ERROR: BAD DEGRIB OF DATA. IRET IS ", iret
346 call w3tage(
'SNOW2MDL')
350 elseif (isgrib==2)
then
352 print*,
"- DEGRIB SNOW COVER."
367 call getgb2(iunit, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
368 unpack, k, gfld, iret)
371 print*,
'- FATAL ERROR: BAD DEGRIB OF FILE, IRET IS ', iret
372 call w3tage(
'SNOW2MDL')
376 print*,
"- DATA VALID AT (YYYYMMDDHH): ", gfld%idsect(6),gfld%idsect(7), &
377 gfld%idsect(8),gfld%idsect(9)
384 call
gdt_to_gds(gfld%igdtnum, gfld%igdtmpl, gfld%igdtlen, kgds_nesdis, &
385 inesdis, jnesdis, dum)
387 mesh_nesdis = inesdis / 64
388 nesdis_res = 381. / float(mesh_nesdis)
390 if (mesh_nesdis==16) kgds_nesdis(6)=136
395 allocate (snow_cvr_nesdis(inesdis,jnesdis))
396 allocate (sea_ice_nesdis(inesdis,jnesdis))
397 allocate (bitmap_nesdis(inesdis,jnesdis))
399 bitmap_nesdis = reshape(gfld%bmap , (/inesdis,jnesdis/) )
400 snow_cvr_nesdis = reshape(gfld%fld , (/inesdis,jnesdis/) )
404 print*,
"- DEGRIB SEA ICE."
417 call getgb2(iunit, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
418 unpack, k, gfld, iret)
421 print*,
'- FATAL ERROR: BAD DEGRIB OF FILE, IRET IS ', iret
422 call w3tage(
'SNOW2MDL')
426 sea_ice_nesdis = reshape(gfld%fld , (/inesdis,jnesdis/) )
432 call baclose(iunit,iret)
440 if (mesh_nesdis == 16)
then
442 print*,
"- OPEN NESDIS/IMS 16TH MESH LAND MASK: ", trim(nesdis_lsmask_file)
444 open(iunit2, file=trim(nesdis_lsmask_file), form=
"formatted", &
448 print*,
"- FATAL ERROR OPENING NESDIS/IMS LAND MASK FILE. ISTAT IS: ", iret
452 print*,
"- READ NESDIS/IMS 16TH MESH LAND MASK."
454 allocate (dummy4(inesdis,jnesdis))
457 read(iunit2, 123, iostat=iret) (dummy4(i,j),i=1,1024)
459 print*,
"- FATAL ERROR READING NESDIS/IMS LAND MASK FILE. ISTAT IS: ", iret
471 bitmap_nesdis=.false.
474 if (dummy4(i,j) == 1) bitmap_nesdis(i,j) = .true.
485 call
nh_climo_check(kgds_nesdis,snow_cvr_nesdis,bitmap_nesdis,inesdis,jnesdis,2,bad_nesdis)
498 print*,
'- FATAL ERROR: NESDIS/IMS DATA BAD, DO NOT USE.'
499 print*,
'- DONT RUN PROGRAM.'
501 call w3tage(
'SNOW2MDL')
534 integer,
parameter :: iunit=11
535 integer :: jgds(200), jpds(200), kgds(200), kpds(200)
537 integer :: lugi, lskip, numbytes, numpts, message_num
542 bad_afwa_global=.false.
544 use_global_afwa=.true.
548 if (len_trim(afwa_snow_nh_file) == 0 .and. &
549 len_trim(afwa_snow_sh_file) == 0 .and. &
550 len_trim(afwa_snow_global_file) == 0)
then
551 print*,
"- WILL NOT USE AFWA DATA."
552 use_nh_afwa = .false.
553 use_sh_afwa = .false.
554 use_global_afwa = .false.
558 if ( len_trim(afwa_snow_global_file) > 0 )
then
560 print*,
"- OPEN AND READ AFWA SNOW FILE ", trim(afwa_snow_global_file)
561 call baopenr(iunit, afwa_snow_global_file, istat)
563 print*,
'- FATAL ERROR: BAD OPEN OF FILE, ISTAT IS ', istat
564 call w3tage(
'SNOW2MDL')
580 print*,
"- GET GRIB HEADER"
581 call getgbh(iunit, lugi, lskip, jpds, jgds, numbytes, &
582 numpts, message_num, kpds, kgds, istat)
585 print*,
"- FATAL ERROR: BAD DEGRIB OF HEADER. ISTAT IS ", istat
586 call w3tage(
'SNOW2MDL')
592 afwa_res = float(kgds(10))*0.001*111.0
594 print*,
"- DATA VALID AT (YYMMDDHH): ", kpds(8:11)
595 print*,
"- DEGRIB SNOW DEPTH."
597 allocate(bitmap_afwa_global(iafwa,jafwa))
598 allocate(snow_dep_afwa_global(iafwa,jafwa))
600 call getgb(iunit, lugi, (iafwa*jafwa), lskip, jpds, jgds, &
601 numpts, lskip, kpds, kgds, bitmap_afwa_global, snow_dep_afwa_global, istat)
604 print*,
"- FATAL ERROR: BAD DEGRIB OF DATA. ISTAT IS ", istat
605 call w3tage(
'SNOW2MDL')
609 kgds_afwa_global = kgds
611 call baclose(iunit, istat)
613 call
nh_climo_check(kgds_afwa_global,snow_dep_afwa_global,bitmap_afwa_global,iafwa,jafwa,1,bad_afwa_global)
615 if (bad_afwa_global)
then
616 print*,
'- WARNING: AFWA DATA BAD, DO NOT USE.'
617 use_global_afwa = .false.
627 use_global_afwa=.false.
631 if ( len_trim(afwa_snow_nh_file) > 0 )
then
640 kgds_afwa_nh = kgds_afwa_nh_8th
642 allocate (snow_dep_afwa_nh(iafwa,jafwa))
645 allocate (bitmap_afwa_nh(iafwa,jafwa))
650 print*,
"- OPEN AND READ AFWA SNOW FILE ", trim(afwa_snow_nh_file)
652 call baopenr(iunit, afwa_snow_nh_file, istat)
655 print*,
'- FATAL ERROR: BAD OPEN OF FILE, ISTAT IS ', istat
656 call w3tage(
'SNOW2MDL')
672 print*,
"- GET GRIB HEADER"
673 call getgbh(iunit, lugi, lskip, jpds, jgds, numbytes, &
674 numpts, message_num, kpds, kgds, istat)
677 print*,
"- FATAL ERROR: BAD DEGRIB OF HEADER. ISTAT IS ", istat
678 call w3tage(
'SNOW2MDL')
684 afwa_res = float(kgds(8))*0.001
686 print*,
"- DATA VALID AT (YYMMDDHH): ", kpds(8:11)
688 print*,
"- DEGRIB SNOW DEPTH."
690 allocate(bitmap_afwa_nh(iafwa,jafwa))
691 allocate(snow_dep_afwa_nh(iafwa,jafwa))
693 call getgb(iunit, lugi, (iafwa*jafwa), lskip, jpds, jgds, &
694 numpts, lskip, kpds, kgds, bitmap_afwa_nh, snow_dep_afwa_nh, istat)
697 print*,
"- FATAL ERROR: BAD DEGRIB OF DATA. ISTAT IS ", istat
698 call w3tage(
'SNOW2MDL')
704 kgds_afwa_nh(7) = -80000
707 call baclose(iunit, istat)
711 call
nh_climo_check(kgds_afwa_nh,snow_dep_afwa_nh,bitmap_afwa_nh,iafwa,jafwa,1,bad_afwa_nh)
723 if ( len_trim(afwa_snow_sh_file) > 0 )
then
732 kgds_afwa_sh = kgds_afwa_sh_8th
734 allocate (snow_dep_afwa_sh(iafwa,jafwa))
737 allocate (bitmap_afwa_sh(iafwa,jafwa))
742 print*,
"- OPEN AND READ AFWA SNOW FILE ", trim(afwa_snow_sh_file)
744 call baopenr(iunit, afwa_snow_sh_file, istat)
747 print*,
'- FATAL ERROR: BAD OPEN OF FILE, ISTAT IS ', istat
748 call w3tage(
'SNOW2MDL')
764 print*,
"- GET GRIB HEADER"
765 call getgbh(iunit, lugi, lskip, jpds, jgds, numbytes, &
766 numpts, message_num, kpds, kgds, istat)
769 print*,
"- FATAL ERROR: BAD DEGRIB OF HEADER. ISTAT IS ", istat
770 call w3tage(
'SNOW2MDL')
776 afwa_res = float(kgds(8))*0.001
778 print*,
"- DATA VALID AT (YYMMDDHH): ", kpds(8:11)
780 print*,
"- DEGRIB SNOW DEPTH."
782 allocate(bitmap_afwa_sh(iafwa,jafwa))
783 allocate(snow_dep_afwa_sh(iafwa,jafwa))
785 call getgb(iunit, lugi, (iafwa*jafwa), lskip, jpds, jgds, &
786 numpts, lskip, kpds, kgds, bitmap_afwa_sh, snow_dep_afwa_sh, istat)
789 print*,
"- FATAL ERROR: BAD DEGRIB OF DATA. ISTAT IS ", istat
790 call w3tage(
'SNOW2MDL')
796 kgds_afwa_sh(7) = -80000
799 call baclose(iunit, istat)
807 use_sh_afwa = .false.
815 if (bad_afwa_nh .or. bad_afwa_sh)
then
816 print*,
'- WARNING: AFWA DATA BAD, DO NOT USE.'
817 use_nh_afwa = .false.
818 use_sh_afwa = .false.
854 grib_year, grib_month, grib_day, &
862 integer,
parameter :: iclim = 1080
863 integer,
parameter :: jclim = 270
864 real,
parameter :: lat11_clim = 90.0
865 real,
parameter :: lon11_clim = -180.0
866 real,
parameter :: dx_clim = 1./3.
867 real,
parameter :: dy_clim = 1./3.
869 integer,
intent(in) :: idata, jdata, kgds_data(200), isrc
870 logical*1,
intent(in) :: bitmap_data(idata,jdata)
871 logical,
intent(out) :: bad
872 real,
intent(in) :: snow_data(idata,jdata)
875 integer :: idat(8), jdow, jdoy, jday
876 integer :: century, year, week, iret, lugb, i, j, ii, jj
877 integer :: lugi, jdisc, jpdtn, jgdtn, k, nret
878 integer :: jids(200), jgdt(200), jpdt(200)
879 integer :: count_nosnow_climo, count_nosnow_data
880 integer :: count_snow_climo, count_snow_data, count_grosschk_data
882 logical*1,
allocatable :: bitmap_clim(:,:)
885 real,
allocatable :: climo(:,:)
886 real :: fill, percent, x, y
887 real,
allocatable :: xpts(:,:),ypts(:,:),rlon_data(:,:),rlat_data(:,:)
888 real :: thresh_gross, thresh
890 type(gribfield
) :: gfld
893 if (len_trim(climo_qc_file)==0)
return
895 print*,
"- QC SNOW DATA IN NH."
899 elseif (isrc==2)
then
904 allocate(xpts(idata,jdata))
905 allocate(ypts(idata,jdata))
906 allocate(rlon_data(idata,jdata))
907 allocate(rlat_data(idata,jdata))
915 print*,
"- CALC LAT/LONS OF SOURCE POINTS."
916 call gdswzd(kgds_data,1,(idata*jdata),fill,xpts,ypts,rlon_data,rlat_data,nret)
918 deallocate(xpts,ypts)
920 if (nret /= (idata*jdata))
then
921 print*,
"- WARNING: CALC FAILED. WILL NOT PERFORM QC."
922 deallocate (rlon_data,rlat_data)
926 count_grosschk_data=0
929 if (rlat_data(i,j)>0.0 .and. bitmap_data(i,j))
then
930 if (snow_data(i,j) < 0.0 .or. snow_data(i,j) > thresh_gross)
then
931 count_grosschk_data=count_grosschk_data+1
937 if (count_grosschk_data > 1)
then
938 print*,
'- NUMBER OF DATA POINTS THAT FAIL GROSS CHECK ',count_grosschk_data
939 deallocate (rlon_data,rlat_data)
944 print*,
"- QC DATA SOURCE AGAINST CLIMO."
945 print*,
"- OPEN CLIMO SNOW COVER FILE ",trim(climo_qc_file)
947 call baopenr(lugb,climo_qc_file,iret)
950 print*,
"- WARNING: BAD OPEN, WILL NOT PERFORM QC ", iret
951 deallocate (rlon_data,rlat_data)
960 if (grib_year == 100)
then
961 century = grib_century
963 century = grib_century-1
966 year = century*100 + grib_year
973 call w3doxdat(idat,jdow,jdoy,jday)
977 week = nint((jdoy+3.)/7.)
981 print*,
"- READ CLIMO FOR WEEK ",week
996 jgdt(12) = nint(lat11_clim * 1e6)
997 jgdt(13) = nint(abs(lon11_clim) * 1e6)
1004 call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
1005 unpack, k, gfld, iret)
1008 print*,
"- WARNING: PROBLEM READING GRIB FILE ", iret
1009 print*,
"- WILL NOT PERFORM QC."
1010 deallocate(rlon_data,rlat_data)
1011 deallocate(climo, bitmap_clim)
1012 call baclose(lugb,iret)
1016 call baclose(lugb,iret)
1018 allocate(climo(iclim,jclim))
1019 climo = reshape(gfld%fld , (/iclim,jclim/) )
1020 allocate(bitmap_clim(iclim,jclim))
1021 bitmap_clim = reshape(gfld%bmap , (/iclim,jclim/) )
1038 count_nosnow_climo=0
1045 elseif (isrc==2)
then
1051 if (rlat_data(i,j)>0.0 .and. bitmap_data(i,j))
then
1052 y = (lat11_clim-rlat_data(i,j))/dy_clim + 1.0
1053 if (rlon_data(i,j)>180.0) rlon_data(i,j)=rlon_data(i,j)-360.0
1054 x = (rlon_data(i,j)-lon11_clim)/dx_clim + 1.0
1057 if (jj>jclim) jj=jclim
1059 if (ii<1) ii=ii+iclim
1060 if (ii>iclim) ii=ii-iclim
1061 if (bitmap_clim(ii,jj))
then
1062 if (climo(ii,jj) <1.0)
then
1063 count_nosnow_climo=count_nosnow_climo+1
1064 if (snow_data(i,j) == 0.0)
then
1065 count_nosnow_data=count_nosnow_data+1
1068 if (climo(ii,jj) > 99.)
then
1069 count_snow_climo=count_snow_climo+1
1070 if (snow_data(i,j) >thresh)
then
1071 count_snow_data=count_snow_data+1
1079 percent = float(count_snow_climo-count_snow_data) / float(count_snow_climo)
1080 percent = percent*100.
1081 write(6,200)
'- NUMBER OF DATA POINTS THAT SHOULD HAVE SNOW',count_snow_climo
1082 write(6,201)
'- NUMBER OF THESE POINTS THAT ARE BARE GROUND',(count_snow_climo-count_snow_data), &
1085 200
format(1x,a45,1x,i10)
1086 201
format(1x,a45,1x,i10,1x,a2,1x,f6.2,a1)
1088 if (percent>50.0)
then
1089 print*,
"- WARNING: PERCENTAGE OF BARE GROUND POINTS EXCEEDS ACCEPTABLE LEVEL."
1090 print*,
"- WILL NOT USE SOURCE DATA."
1094 percent = float(count_nosnow_climo-count_nosnow_data) / float(count_nosnow_climo)
1095 percent = percent*100.
1096 write(6,202)
'- NUMBER OF DATA POINTS THAT SHOULD *NOT* HAVE SNOW',count_nosnow_climo
1097 write(6,203)
'- NUMBER OF THESE POINTS WITH SNOW',(count_nosnow_climo-count_nosnow_data), &
1100 202
format(1x,a51,1x,i10)
1101 203
format(1x,a34,1x,i10,1x,a2,1x,f6.2,a1)
1103 if (percent>20.0)
then
1104 print*,
"- WARNING: PERCENTAGE OF POINTS WITH SNOW EXCEEDS ACCEPTABLE LEVEL."
1105 print*,
"- WILL NOT USE SOURCE DATA."
1109 if (
allocated(rlat_data))
deallocate (rlat_data)
1110 if (
allocated(rlon_data))
deallocate (rlon_data)
1111 if (
allocated(climo))
deallocate (climo)
1112 if (
allocated(bitmap_clim))
deallocate (bitmap_clim)
1127 integer,
intent(in) :: hemi
1128 integer :: kgds(200), nret
1129 integer,
parameter :: npts=1
1131 real :: fill, xpts(npts), ypts(npts)
1132 real :: rlon(npts), rlat(npts)
1138 print*,
'- QC DATA IN NH.'
1142 call gdswzd(kgds,(-1),npts,fill,xpts,ypts,rlon,rlat,nret)
1143 if (snow_dep_afwa_nh(nint(xpts(1)),nint(ypts(1))) < 0.001)
then
1144 print*,
'- WARNING: NO SNOW IN GREENLAND: ',snow_dep_afwa_nh(nint(xpts),nint(ypts))
1145 print*,
'- DONT USE AFWA DATA.'
1150 call gdswzd(kgds,(-1),npts,fill,xpts,ypts,rlon,rlat,nret)
1151 if (snow_dep_afwa_nh(nint(xpts(1)),nint(ypts(1))) > 0.0)
then
1152 print*,
'- WARNING: SNOW IN S AMERICA: ',snow_dep_afwa_nh(nint(xpts),nint(ypts))
1153 print*,
'- DONT USE AFWA DATA.'
1158 call gdswzd(kgds,(-1),npts,fill,xpts,ypts,rlon,rlat,nret)
1159 if (snow_dep_afwa_nh(nint(xpts(1)),nint(ypts(1))) > 0.0)
then
1160 print*,
'- WARNING: SNOW IN SAHARA: ',snow_dep_afwa_nh(nint(xpts),nint(ypts))
1161 print*,
'- DONT USE AFWA DATA.'
1166 call gdswzd(kgds,(-1),npts,fill,xpts,ypts,rlon,rlat,nret)
1167 if (snow_dep_afwa_nh(nint(xpts(1)),nint(ypts(1))) > 0.0)
then
1168 print*,
'- WARNING: SNOW IN S INDIA: ',snow_dep_afwa_nh(nint(xpts),nint(ypts))
1169 print*,
'- DONT USE AFWA DATA.'
1175 print*,
'- QC DATA IN SH.'
1179 call gdswzd(kgds,(-1),npts,fill,xpts,ypts,rlon,rlat,nret)
1180 if (snow_dep_afwa_sh(nint(xpts(1)),nint(ypts(1))) < 0.001)
then
1181 print*,
'- WARNING: NO SNOW IN ANTARCTICA: ',snow_dep_afwa_sh(nint(xpts),nint(ypts))
1182 print*,
'- DONT USE AFWA DATA.'
1187 call gdswzd(kgds,(-1),npts,fill,xpts,ypts,rlon,rlat,nret)
1188 if (snow_dep_afwa_sh(nint(xpts(1)),nint(ypts(1))) > 0.0)
then
1189 print*,
'- WARNING: SNOW IN SOUTH AMERICA: ',snow_dep_afwa_sh(nint(xpts),nint(ypts))
1190 print*,
'- DONT USE AFWA DATA.'
1195 call gdswzd(kgds,(-1),npts,fill,xpts,ypts,rlon,rlat,nret)
1196 if (snow_dep_afwa_sh(nint(xpts(1)),nint(ypts(1))) > 0.0)
then
1197 print*,
'- WARNING: SNOW IN AUSTRALIA: ',snow_dep_afwa_sh(nint(xpts),nint(ypts))
1198 print*,
'- DONT USE AFWA DATA.'
1203 call gdswzd(kgds,(-1),npts,fill,xpts,ypts,rlon,rlat,nret)
1204 if (snow_dep_afwa_sh(nint(xpts(1)),nint(ypts(1))) > 0.0)
then
1205 print*,
'- WARNING: SNOW IN AFRICA: ',snow_dep_afwa_sh(nint(xpts),nint(ypts))
1206 print*,
'- DONT USE AFWA DATA.'
1234 character*8 :: afwa_file_info(2)
1235 character*(*),
intent(in) :: file_name
1237 integer*2,
allocatable :: dummy(:,:)
1238 integer :: i,j, istat
1239 integer,
parameter :: iafwa = 512
1240 integer,
parameter :: jafwa = 512
1241 integer,
parameter :: iunit=11
1243 real,
intent(out) :: snow_dep_afwa(iafwa,jafwa)
1245 print*,
"- OPEN AFWA BINARY FILE ", trim(file_name)
1246 open (iunit, file=trim(file_name), access=
"direct", recl=iafwa*2, iostat=istat)
1248 if (istat /= 0)
then
1249 print*,
'- FATAL ERROR: BAD OPEN. ISTAT IS ',istat
1250 call w3tage(
'SNOW2MDL')
1254 print*,
"- READ AFWA BINARY FILE ", trim(file_name)
1255 read(iunit, rec=2, iostat = istat) afwa_file_info
1257 if (istat /= 0)
then
1258 print*,
'- FATAL ERROR: BAD READ. ISTAT IS ',istat
1259 call w3tage(
'SNOW2MDL')
1263 print*,
"- AFWA DATA IS ", afwa_file_info(1),
" AT TIME ", afwa_file_info(2)(2:7)
1265 allocate(dummy(iafwa,jafwa))
1268 read(iunit, rec=j+2, iostat=istat) (dummy(i,j),i=1,iafwa)
1269 if (istat /= 0)
then
1270 print*,
'- FATAL ERROR: BAD READ. ISTAT IS ',istat
1271 call w3tage(
'SNOW2MDL')
1282 where (dummy == 4090) dummy = 0
1284 snow_dep_afwa = float(dummy)
1291 snow_dep_afwa = snow_dep_afwa * 2.54 / 1000.0
1316 character*(*),
intent(in) :: file_name
1318 integer,
parameter :: iunit=11
1319 integer,
parameter :: iafwa = 512
1320 integer,
parameter :: jafwa = 512
1321 integer :: i, j, istat
1322 integer*4,
allocatable :: dummy4(:,:)
1324 logical*1,
intent(out) :: bitmap_afwa(iafwa,jafwa)
1326 allocate (dummy4(iafwa,jafwa))
1328 print*,
'- OPEN AFWA MASK FILE ', trim(file_name)
1329 open(iunit, file=trim(file_name), access=
'direct', &
1330 recl=iafwa*jafwa*4, iostat=istat)
1332 if (istat /= 0)
then
1333 print*,
'- FATAL ERROR: BAD OPEN. ISTAT IS ', istat
1334 call w3tage(
'SNOW2MDL')
1338 print*,
'- READ AFWA MASK FILE ', trim(file_name)
1339 read(iunit, rec=1, iostat=istat) dummy4
1341 if (istat /= 0)
then
1342 print*,
'- FATAL ERROR: BAD READ. ISTAT IS ', istat
1343 call w3tage(
'SNOW2MDL')
1353 bitmap_afwa = .false.
1357 if (dummy4(i,j) > 1)
then
1358 bitmap_afwa(i,j) = .true.
subroutine read_afwa_binary(file_name, snow_dep_afwa)
Read afwa binary snow depth file.
subroutine grib2_null(gfld)
Nullify the grib2 gribfield pointers.
subroutine readafwa
Read snow depth data and masks.
subroutine readnesdis
Read nesdis/ims snow cover/ice data.
subroutine nh_climo_check(kgds_data, snow_data, bitmap_data, idata, jdata, isrc, bad)
Check for corrupt nh snow cover data.
Read in data defining the model grid.
subroutine read_afwa_mask(file_name, bitmap_afwa)
Read afwa land mask file to get a bitmap.
subroutine gdt_to_gds(igdtnum, igdstmpl, igdtlen, kgds, ni, nj, res)
Convert from the grib2 grid description template array used by the ncep grib2 library, to the grib1 grid description section array used by ncep ipolates library.
subroutine grib2_free(gfld)
Deallocate the grib2 gribfield pointers.
This module reads in data from the program's configuration namelist.
subroutine afwa_check(hemi)
Check for corrupt afwa data.
Read and qc afwa, nesdis/ims and autosnow snow data.
subroutine grib_check(file_name, isgrib)
Determine whether file is grib or not.
subroutine readautosnow
Read autosnow snow cover.