!########################################################################
!########################################################################
!###### ######
!###### PROGRAM QPFMASK ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!########################################################################
!########################################################################
PROGRAM QPFMASK,3
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Reads in HDF file created by INTQPF, and creates a binary bitmap
! file listing which grid points have missing data. The bitmap
! file is then read in by QPFSTATS and used to exclude certain
! grid points from the statistical calculations.
!
! AUTHOR: Eric Kemp, March 2000.
!
! MODIFICATION HISTORY:
! Eric Kemp, 31 March 2000.
! Added lat/lon coordinates of four corners for NCL plotting.
!
!-----------------------------------------------------------------------
!
! Variable Declarations:
!
!-----------------------------------------------------------------------
IMPLICIT NONE
INTEGER :: date(6)
INTEGER,ALLOCATABLE :: timesec(:)
INTEGER :: mapproj
REAL :: scale
REAL :: trulat1, trulat2, trulon
REAL :: dx,dy
CHARACTER*8 :: model
CHARACTER*4 :: grid
CHARACTER*4,ALLOCATABLE,DIMENSION(:) :: id_p,id_sfc,idmask_sfc
CHARACTER*32,ALLOCATABLE,DIMENSION(:) :: name_p,unit_p, &
name_sfc,unit_sfc, &
namemask_sfc,unitmask_sfc
REAL,ALLOCATABLE, DIMENSION(:,:,:,:,:) :: var_p
REAL,ALLOCATABLE, DIMENSION(:,:,:,:) :: var_sfc
REAL,ALLOCATABLE, DIMENSION(:) :: pressure
REAL,ALLOCATABLE, DIMENSION(:,:) :: lat2d,lon2d
REAL :: scswlat,scswlon
REAL :: mapswlat,mapswlon,mapnwlat,mapnwlon, &
mapselat,mapselon,mapnelat,mapnelon
INTEGER :: npreslevel,nvar_p,nvar_sfc
INTEGER :: flag_p,flag_sfc
INTEGER :: status
REAL,ALLOCATABLE :: mask(:,:,:,:)
INTEGER :: i,j,k,l
REAL,PARAMETER :: missing = -9999.
!-----------------------------------------------------------------------
!
! Namelists
!
!-----------------------------------------------------------------------
INTEGER :: nx,ny,ntime
CHARACTER*256 :: infilename
NAMELIST /hdf_input/ nx,ny,ntime,infilename
CHARACTER*256 :: outfilename
NAMELIST /output/ outfilename
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
WRITE(6,'(//5x,a)') &
&'###################################################################'
WRITE(6,'(5x,a,/5x,a)') &
&'# #',&
&'# Welcome to QPFMASK, a program that reads in an interpolated #'
WRITE(6,'(5x,a)') &
&'# precipitation HDF file from INTQPF and creates a binary bitmap #'
WRITE(6,'(5x,a)') &
&'# file for use by QPFSTATS. #', &
&'# #',&
&'###################################################################'
WRITE(6,*)
!-----------------------------------------------------------------------
!
! Read in namelist
!
!-----------------------------------------------------------------------
PRINT *, 'Reading NAMELIST hdf_input'
READ(5,hdf_input)
PRINT *, 'Reading NAMELIST output'
READ(5,output)
!-----------------------------------------------------------------------
!
! Read precipitation data.
!
!-----------------------------------------------------------------------
CALL rd_verif_dims(nx,ny,npreslevel,ntime,nvar_p,nvar_sfc, &
infilename)
ALLOCATE (timesec(ntime), pressure(npreslevel), &
var_p(nx,ny,npreslevel,ntime,nvar_p), &
var_sfc(nx,ny,ntime,nvar_sfc), &
lat2d(nx,ny),lon2d(nx,ny), &
id_p(nvar_p),name_p(nvar_p),unit_p(nvar_p), &
id_sfc(nvar_sfc),name_sfc(nvar_sfc), &
unit_sfc(nvar_sfc), &
STAT=status)
IF (status /= 0) CALL alloc_fail
(status, 'f1')
CALL rdverif
( nx,ny,npreslevel,ntime,nvar_p,nvar_sfc, &
infilename,model,grid,date,timesec,pressure, &
mapproj, scale, trulat1, trulat2,trulon, dx,dy, &
scswlat,scswlon, &
mapswlat,mapswlon,mapnwlat,mapnwlon, &
mapselat,mapselon,mapnelat,mapnelon, &
flag_p,var_p, id_p, name_p, unit_p, &
flag_sfc,var_sfc, id_sfc, name_sfc, unit_sfc )
IF (flag_sfc == 0) THEN
WRITE(6,*)'ERROR: Could not find surface data in HDF file.'
WRITE(6,*)'Aborting...'
STOP
ENDIF
!-----------------------------------------------------------------------
!
! Make bit map
!
!-----------------------------------------------------------------------
ALLOCATE(mask(nx,ny,ntime,nvar_sfc),idmask_sfc(nvar_sfc), &
namemask_sfc(nvar_sfc),unitmask_sfc(nvar_sfc),&
STAT=status)
DO l = 1,nvar_sfc
DO k = 1,ntime
DO j = 1,ny
DO i = 1,nx
IF (var_sfc(i,j,k,l).ne.missing) THEN
mask(i,j,k,l) = 1
ELSE
mask(i,j,k,l) = 0
END IF
END DO
END DO
END DO
idmask_sfc(l) = 'MASK'
namemask_sfc(l) = 'Mask for verification'
unitmask_sfc(l) = 'none'
END DO
!-----------------------------------------------------------------------
!
! Output bit map.
!
!-----------------------------------------------------------------------
flag_p = 0 ! Don't output pressure level data
flag_sfc = 1
CALL wrtverif
(nx,ny,npreslevel,ntime,nvar_p,nvar_sfc, missing, &
outfilename,model,grid,date,timesec,pressure, &
mapproj, scale, trulat1,trulat2,trulon, &
dx,dy,scswlat,scswlon, &
mapswlat,mapswlon,mapnwlat,mapnwlon, &
mapselat,mapselon,mapnelat,mapnelon, &
flag_p,id_p, name_p, unit_p, var_p, &
flag_sfc,idmask_sfc, namemask_sfc, unitmask_sfc, &
mask)
!-----------------------------------------------------------------------
!
! The end.
!
!-----------------------------------------------------------------------
WRITE(6,*)'Program QPFMASK successfully completed.'
END PROGRAM qpfmask