From abb6f8c083dc8ab450848ca75f1d0f2ada1ca7e9 Mon Sep 17 00:00:00 2001 From: eric james Date: Fri, 13 Aug 2021 12:51:45 +0000 Subject: [PATCH 1/4] Modifications to SURFCE.f to check for existence of FFG files. --- sorc/ncep_post.fd/SURFCE.f | 175 ++++++++++++++----------------------- 1 file changed, 66 insertions(+), 109 deletions(-) diff --git a/sorc/ncep_post.fd/SURFCE.f b/sorc/ncep_post.fd/SURFCE.f index b3eafa0a8..5102912df 100644 --- a/sorc/ncep_post.fd/SURFCE.f +++ b/sorc/ncep_post.fd/SURFCE.f @@ -142,24 +142,21 @@ SUBROUTINE SURFCE real, allocatable, dimension(:,:,:) :: sleet, rain, freezr, snow ! real, dimension(im,jm,nalg) :: sleet, rain, freezr, snow real, allocatable, dimension(:,:) :: ylat, xlon - real, allocatable, dimension(:) :: msclon, msclat !GSD REAL totprcp, snowratio,t2,rainl ! - integer NLON,NLAT,NTOT,var_scale + integer NLON,NLAT,NTOT integer I,J,IWX,ITMAXMIN,IFINCR,ISVALUE,II,JJ, & ITPREC,ITSRFC,L,LS,IVEG,LLMH, & IVG,IRTN,ISEED, icat, cnt_snowratio(10),icnt_snow_rain_mixed, & - NX,NY,NZ,MSCNLON,MSCNLAT,MSCNLEV,HEIGHT + NX,NY,NZ,MSCNLON,MSCNLAT,HEIGHT real RDTPHS,TLOW,TSFCK,QSAT,DTOP,DBOT,SNEQV,RRNUM,SFCPRS,SFCQ, & RC,SFCTMP,SNCOVR,FACTRS,SOLAR, s,tk,tl,w,t2c,dlt,APE, & qv,e,dwpt,dum1,dum2,dum3,dum1s,dum3s,dum21,dum216,es, & RLONMIN,RLATMAX,RLAT,RLON - real*8 RDX,RDY,DLON,DLAT,LONMIN,LATMIN,LONMAX,LATMAX - character(len=256) :: ffgfile logical, parameter :: debugprint = .false. @@ -3674,33 +3671,23 @@ SUBROUTINE SURFCE ! thresholds IF (IGET(913).GT.0) THEN ffgfile='ffg_01h.grib2' - call read_grib2_head(ffgfile,nx,ny,nz,rlonmin,rlatmax,& - rdx,rdy) - var_scale=1 - mscNlon=nx - mscNlat=ny - mscNlev=nz - dlon=rdx - dlat=rdy - lonMin=rlonmin - lonMax=lonMin+dlon*(mscNlon-1) - latMax=rlatmax - latMin=latMax-dlat*(mscNlat-1) - if (.not. allocated(msclon)) then - allocate(msclon(mscNlon)) - allocate(msclat(mscNlat)) - allocate(mscValue(mscNlon,mscNlat)) + INQUIRE(FILE=ffgfile, EXIST=file_exists) + if (file_exists) then + call read_grib2_head(ffgfile,nx,ny,nz,rlonmin,rlatmax,& + rdx,rdy) + mscNlon=nx + mscNlat=ny + if (.not. allocated(mscValue)) then + allocate(mscValue(mscNlon,mscNlat)) + endif + ntot = nx*ny + call read_grib2_sngle(ffgfile,ntot,height,mscValue) + else + write(*,*) 'WARNING: 1h FFG file not available' + mscValue = AVGPREC_CONT(I,J)*FLOAT(IFHR)*3600.*10000./DTQ2 endif - DO i=1,mscNlon - msclon(i)=lonMin+(i-1)*dlon - ENDDO - DO i=1,mscNlat - msclat(i)=latMin+(i-1)*dlat - ENDDO - ntot = nx*ny - call read_grib2_sngle(ffgfile,ntot,height,mscValue) - write(*,*) '1H FFG MAX, MIN:', & - maxval(mscValue),minval(mscValue) +! write(*,*) '1H FFG MAX, MIN:', & +! maxval(mscValue),minval(mscValue) ID(1:25) = 0 ITPREC = NINT(TPREC) !mp @@ -3766,33 +3753,23 @@ SUBROUTINE SURFCE ENDIF IF (IGET(914).GT.0) THEN ffgfile='ffg_03h.grib2' - call read_grib2_head(ffgfile,nx,ny,nz,rlonmin,rlatmax,& - rdx,rdy) - var_scale=1 - mscNlon=nx - mscNlat=ny - mscNlev=nz - dlon=rdx - dlat=rdy - lonMin=rlonmin - lonMax=lonMin+dlon*(mscNlon-1) - latMax=rlatmax - latMin=latMax-dlat*(mscNlat-1) - if (.not. allocated(msclon)) then - allocate(msclon(mscNlon)) - allocate(msclat(mscNlat)) - allocate(mscValue(mscNlon,mscNlat)) + INQUIRE(FILE=ffgfile, EXIST=file_exists) + if (file_exists) then + call read_grib2_head(ffgfile,nx,ny,nz,rlonmin,rlatmax,& + rdx,rdy) + mscNlon=nx + mscNlat=ny + if (.not. allocated(mscValue)) then + allocate(mscValue(mscNlon,mscNlat)) + endif + ntot = nx*ny + call read_grib2_sngle(ffgfile,ntot,height,mscValue) + else + write(*,*) 'WARNING: 3h FFG file not available' + mscValue = AVGPREC_CONT(I,J)*FLOAT(IFHR)*3600.*10000./DTQ2 endif - DO i=1,mscNlon - msclon(i)=lonMin+(i-1)*dlon - ENDDO - DO i=1,mscNlat - msclat(i)=latMin+(i-1)*dlat - ENDDO - ntot = nx*ny - call read_grib2_sngle(ffgfile,ntot,height,mscValue) - write(*,*) '3H FFG MAX, MIN:', & - maxval(mscValue),minval(mscValue) +! write(*,*) '3H FFG MAX, MIN:', & +! maxval(mscValue),minval(mscValue) ID(1:25) = 0 ITPREC = NINT(TPREC) !mp @@ -3851,33 +3828,23 @@ SUBROUTINE SURFCE ENDIF IF (IGET(915).GT.0) THEN ffgfile='ffg_06h.grib2' - call read_grib2_head(ffgfile,nx,ny,nz,rlonmin,rlatmax,& - rdx,rdy) - var_scale=1 - mscNlon=nx - mscNlat=ny - mscNlev=nz - dlon=rdx - dlat=rdy - lonMin=rlonmin - lonMax=lonMin+dlon*(mscNlon-1) - latMax=rlatmax - latMin=latMax-dlat*(mscNlat-1) - if (.not. allocated(msclon)) then - allocate(msclon(mscNlon)) - allocate(msclat(mscNlat)) - allocate(mscValue(mscNlon,mscNlat)) + INQUIRE(FILE=ffgfile, EXIST=file_exists) + if (file_exists) then + call read_grib2_head(ffgfile,nx,ny,nz,rlonmin,rlatmax,& + rdx,rdy) + mscNlon=nx + mscNlat=ny + if (.not. allocated(mscValue)) then + allocate(mscValue(mscNlon,mscNlat)) + endif + ntot = nx*ny + call read_grib2_sngle(ffgfile,ntot,height,mscValue) + else + write(*,*) 'WARNING: 6h FFG file not available' + mscValue = AVGPREC_CONT(I,J)*FLOAT(IFHR)*3600.*10000./DTQ2 endif - DO i=1,mscNlon - msclon(i)=lonMin+(i-1)*dlon - ENDDO - DO i=1,mscNlat - msclat(i)=latMin+(i-1)*dlat - ENDDO - ntot = nx*ny - call read_grib2_sngle(ffgfile,ntot,height,mscValue) - write(*,*) '6H FFG MAX, MIN:', & - maxval(mscValue),minval(mscValue) +! write(*,*) '6H FFG MAX, MIN:', & +! maxval(mscValue),minval(mscValue) ID(1:25) = 0 ITPREC = NINT(TPREC) !mp @@ -3935,33 +3902,23 @@ SUBROUTINE SURFCE ENDIF IF (IGET(916).GT.0) THEN ffgfile='ffg_12h.grib2' - call read_grib2_head(ffgfile,nx,ny,nz,rlonmin,rlatmax,& - rdx,rdy) - var_scale=1 - mscNlon=nx - mscNlat=ny - mscNlev=nz - dlon=rdx - dlat=rdy - lonMin=rlonmin - lonMax=lonMin+dlon*(mscNlon-1) - latMax=rlatmax - latMin=latMax-dlat*(mscNlat-1) - if (.not. allocated(msclon)) then - allocate(msclon(mscNlon)) - allocate(msclat(mscNlat)) - allocate(mscValue(mscNlon,mscNlat)) + INQUIRE(FILE=ffgfile, EXIST=file_exists) + if (file_exists) then + call read_grib2_head(ffgfile,nx,ny,nz,rlonmin,rlatmax,& + rdx,rdy) + mscNlon=nx + mscNlat=ny + if (.not. allocated(mscValue)) then + allocate(mscValue(mscNlon,mscNlat)) + endif + ntot = nx*ny + call read_grib2_sngle(ffgfile,ntot,height,mscValue) + else + write(*,*) 'WARNING: 12h FFG file not available' + mscValue = AVGPREC_CONT(I,J)*FLOAT(IFHR)*3600.*10000./DTQ2 endif - DO i=1,mscNlon - msclon(i)=lonMin+(i-1)*dlon - ENDDO - DO i=1,mscNlat - msclat(i)=latMin+(i-1)*dlat - ENDDO - ntot = nx*ny - call read_grib2_sngle(ffgfile,ntot,height,mscValue) - write(*,*) '12H FFG MAX, MIN:', & - maxval(mscValue),minval(mscValue) +! write(*,*) '12H FFG MAX, MIN:', & +! maxval(mscValue),minval(mscValue) ID(1:25) = 0 ITPREC = NINT(TPREC) !mp From adbbf6acd7bf0ac5065b9de8a3a69f32e2601d1f Mon Sep 17 00:00:00 2001 From: eric james Date: Fri, 13 Aug 2021 15:44:45 +0000 Subject: [PATCH 2/4] Bug fixes for FFG file existence check, and changes to handle rotated lat-lon grid interpolation for FFG --- sorc/ncep_post.fd/SURFCE.f | 6 +++++- sorc/ncep_post.fd/grib2_module.f | 21 +++++++++++++++++++++ 2 files changed, 26 insertions(+), 1 deletion(-) diff --git a/sorc/ncep_post.fd/SURFCE.f b/sorc/ncep_post.fd/SURFCE.f index 5102912df..6f1963e72 100644 --- a/sorc/ncep_post.fd/SURFCE.f +++ b/sorc/ncep_post.fd/SURFCE.f @@ -155,10 +155,14 @@ SUBROUTINE SURFCE real RDTPHS,TLOW,TSFCK,QSAT,DTOP,DBOT,SNEQV,RRNUM,SFCPRS,SFCQ, & RC,SFCTMP,SNCOVR,FACTRS,SOLAR, s,tk,tl,w,t2c,dlt,APE, & qv,e,dwpt,dum1,dum2,dum3,dum1s,dum3s,dum21,dum216,es, & - RLONMIN,RLATMAX,RLAT,RLON + RLONMIN,RLATMAX + + real*8 RDX,RDY character(len=256) :: ffgfile + logical file_exists + logical, parameter :: debugprint = .false. !**************************************************************************** diff --git a/sorc/ncep_post.fd/grib2_module.f b/sorc/ncep_post.fd/grib2_module.f index d0ca00419..35c064c53 100644 --- a/sorc/ncep_post.fd/grib2_module.f +++ b/sorc/ncep_post.fd/grib2_module.f @@ -1105,6 +1105,17 @@ subroutine read_grib2_head(filenameG2,nx,ny,nz,rlonmin,rlatmax,rdx,rdy) rlonmin = gfld%igdtmpl(13)/scale_factor ! write(*,*) 'nx,ny=',nx,ny ! write(*,*) 'dx,dy=',rdx,rdy +! write(*,*) 'lat1,lon1=',rlatmax,rlonmin + else if (gfld%igdtnum.eq.1) then ! Rotated Lat Lon Grid (RRFS_NA) + nx = gfld%igdtmpl(8) + ny = gfld%igdtmpl(9) + nz = 1 + rdx = gfld%igdtmpl(17)/scale_factor + rdy = gfld%igdtmpl(18)/scale_factor + rlatmax = gfld%igdtmpl(12)/scale_factor + rlonmin = gfld%igdtmpl(13)/scale_factor +! write(*,*) 'nx,ny=',nx,ny +! write(*,*) 'dx,dy=',rdx,rdy ! write(*,*) 'lat1,lon1=',rlatmax,rlonmin else if (gfld%igdtnum.eq.30) then ! Lambert Conformal Grid (HRRR) nx = gfld%igdtmpl(8) @@ -1249,6 +1260,16 @@ subroutine read_grib2_sngle(filenameG2,ntot,height,var) ! write(*,*) 'nx,ny=',nx,ny ! write(*,*) 'dx,dy=',dx,dy ! write(*,*) 'lat1,lon1=',lat1,lon1 + else if (gfld%igdtnum.eq.1) then ! Rotated Lat Lon Grid (RRFS_NA) + nx = gfld%igdtmpl(8) + ny = gfld%igdtmpl(9) + dx = gfld%igdtmpl(17)/scale_factor + dy = gfld%igdtmpl(18)/scale_factor + lat1 = gfld%igdtmpl(12)/scale_factor + lon1 = gfld%igdtmpl(13)/scale_factor +! write(*,*) 'nx,ny=',nx,ny +! write(*,*) 'dx,dy=',rdx,rdy +! write(*,*) 'lat1,lon1=',rlatmax,rlonmin else if (gfld%igdtnum.eq.30) then ! Lambert Conformal Grid (HRRR) nx = gfld%igdtmpl(8) ny = gfld%igdtmpl(9) From 1762cb065d286d8021e8db3a777fc81167368de9 Mon Sep 17 00:00:00 2001 From: eric james Date: Fri, 13 Aug 2021 16:17:39 +0000 Subject: [PATCH 3/4] Bug fixes for FFG existence checks in SURFCE.f --- sorc/ncep_post.fd/SURFCE.f | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/sorc/ncep_post.fd/SURFCE.f b/sorc/ncep_post.fd/SURFCE.f index 6f1963e72..e732c98b8 100644 --- a/sorc/ncep_post.fd/SURFCE.f +++ b/sorc/ncep_post.fd/SURFCE.f @@ -3688,7 +3688,8 @@ SUBROUTINE SURFCE call read_grib2_sngle(ffgfile,ntot,height,mscValue) else write(*,*) 'WARNING: 1h FFG file not available' - mscValue = AVGPREC_CONT(I,J)*FLOAT(IFHR)*3600.*10000./DTQ2 +! In this case, set mscValue to a large number + mscValue = AVGPREC_CONT*FLOAT(IFHR)*3600.*10000./DTQ2 endif ! write(*,*) '1H FFG MAX, MIN:', & ! maxval(mscValue),minval(mscValue) @@ -3770,7 +3771,8 @@ SUBROUTINE SURFCE call read_grib2_sngle(ffgfile,ntot,height,mscValue) else write(*,*) 'WARNING: 3h FFG file not available' - mscValue = AVGPREC_CONT(I,J)*FLOAT(IFHR)*3600.*10000./DTQ2 +! In this case, set mscValue to a large number + mscValue = AVGPREC*FLOAT(ID(19)-ID(18))*3600.*10000./DTQ2 endif ! write(*,*) '3H FFG MAX, MIN:', & ! maxval(mscValue),minval(mscValue) @@ -3845,7 +3847,8 @@ SUBROUTINE SURFCE call read_grib2_sngle(ffgfile,ntot,height,mscValue) else write(*,*) 'WARNING: 6h FFG file not available' - mscValue = AVGPREC_CONT(I,J)*FLOAT(IFHR)*3600.*10000./DTQ2 +! In this case, set mscValue to a large number + mscValue = AVGPREC*FLOAT(ID(19)-ID(18))*3600.*10000./DTQ2 endif ! write(*,*) '6H FFG MAX, MIN:', & ! maxval(mscValue),minval(mscValue) @@ -3919,7 +3922,8 @@ SUBROUTINE SURFCE call read_grib2_sngle(ffgfile,ntot,height,mscValue) else write(*,*) 'WARNING: 12h FFG file not available' - mscValue = AVGPREC_CONT(I,J)*FLOAT(IFHR)*3600.*10000./DTQ2 +! In this case, set mscValue to a large number + mscValue = AVGPREC*FLOAT(ID(19)-ID(18))*3600.*10000./DTQ2 endif ! write(*,*) '12H FFG MAX, MIN:', & ! maxval(mscValue),minval(mscValue) From 54e5dc9f1f5b3d7186bd4f31150e8f28b7331ba8 Mon Sep 17 00:00:00 2001 From: eric james Date: Fri, 13 Aug 2021 19:10:51 +0000 Subject: [PATCH 4/4] Another bug fix for SURFCE.f --- sorc/ncep_post.fd/SURFCE.f | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/sorc/ncep_post.fd/SURFCE.f b/sorc/ncep_post.fd/SURFCE.f index e732c98b8..c74f8720b 100644 --- a/sorc/ncep_post.fd/SURFCE.f +++ b/sorc/ncep_post.fd/SURFCE.f @@ -3772,7 +3772,7 @@ SUBROUTINE SURFCE else write(*,*) 'WARNING: 3h FFG file not available' ! In this case, set mscValue to a large number - mscValue = AVGPREC*FLOAT(ID(19)-ID(18))*3600.*10000./DTQ2 + mscValue = AVGPREC*FLOAT(IFHR)*3600.*10000./DTQ2 endif ! write(*,*) '3H FFG MAX, MIN:', & ! maxval(mscValue),minval(mscValue) @@ -3848,7 +3848,7 @@ SUBROUTINE SURFCE else write(*,*) 'WARNING: 6h FFG file not available' ! In this case, set mscValue to a large number - mscValue = AVGPREC*FLOAT(ID(19)-ID(18))*3600.*10000./DTQ2 + mscValue = AVGPREC*FLOAT(IFHR)*3600.*10000./DTQ2 endif ! write(*,*) '6H FFG MAX, MIN:', & ! maxval(mscValue),minval(mscValue) @@ -3923,7 +3923,7 @@ SUBROUTINE SURFCE else write(*,*) 'WARNING: 12h FFG file not available' ! In this case, set mscValue to a large number - mscValue = AVGPREC*FLOAT(ID(19)-ID(18))*3600.*10000./DTQ2 + mscValue = AVGPREC*FLOAT(IFHR)*3600.*10000./DTQ2 endif ! write(*,*) '12H FFG MAX, MIN:', & ! maxval(mscValue),minval(mscValue)