!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE PREPUAOBS ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE prepuaobs(nx,ny,nz,nvar,nzua,mxua,mxztab,nsrcua,mxuafile, & 3,33
anx,xs,ys,zp,su,sv,st,spres,shght,sqv,sqvsat, &
nuafile,uafname,srcua, &
stnua,elevua,xua,yua,hgtua,obsua, &
qsrcua,hgtqsrc,nlevtab, &
qobsua,qualua,isrcua,nlevsua, &
rmiss,nobsua,istatus)
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Control reading upper-air observations and preparation
! of upper-air data for analysis.
!
!-----------------------------------------------------------------------
!
! AUTHOR: Keith Brewster, CAPS
! July, 1995
!
! MODIFICATION HISTORY:
!
! Jan, 1996 (K. Brewster)
! Added full documentation.
!
! Nov, 1997 (KB)
! Changed arguments to be arrays of upper-air data filenames
! rather than one each of a raob and profiler file.
!
!-----------------------------------------------------------------------
!
! nvar Number of analysis variables
! nzua Maximum number of levels
! mxua Maximum number of multiple-level profiles
! mxztab Maximum number of levels in the data error table
! nsrcua Number of multiple-level data sources
! mxuafile Maximum number of multiple-level data files
! nuafile Number of multiple-level data files
! uafname File names of data files
! stnua Station name
! elevua Station elevation
! xua X-coordinate of station
! yua Y-coordinate of station
! hgtua Height of each level in data
! obsua Multiple-level observations
! qsrcua Standard error for each data source
! hgtqsrc Height of data in error table
! nlevtab Number of levels in error table
! qobsua Standard error for each datum
! qualua Quality indicator for each datum
! isrcua Source number for each station
! nlevsua Number of level for each station
! rmiss Missing data flag value
! nobsua Number of observations
! istatus Return status
!
!-----------------------------------------------------------------------
!
! Variable Declarations:
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
INTEGER :: nx,ny,nz
INTEGER :: nvar,nzua,mxua,mxztab,nsrcua
INTEGER :: mxuafile,nuafile
REAL :: anx(nvar,nx,ny,nz)
REAL :: xs(nx)
REAL :: ys(ny)
REAL :: zp(nx,ny,nz)
REAL :: su(nz)
REAL :: sv(nz)
REAL :: st(nz)
REAL :: spres(nz)
REAL :: shght(nz)
REAL :: sqv(nz)
REAL :: sqvsat(nz)
CHARACTER (LEN=256) :: uafname(mxuafile)
CHARACTER (LEN=8) :: srcua(nsrcua)
CHARACTER (LEN=5) :: stnua(mxua)
REAL :: elevua(mxua)
REAL :: xua(mxua)
REAL :: yua(mxua)
REAL :: hgtua(nzua,mxua)
REAL :: obsua(nvar,nzua,mxua)
REAL :: qsrcua(nvar,mxztab,nsrcua)
REAL :: hgtqsrc(mxztab,nsrcua)
REAL :: qobsua(nvar,nzua,mxua)
INTEGER :: qualua(nvar,nzua,mxua)
INTEGER :: isrcua(mxua)
INTEGER :: nlevsua(mxua)
INTEGER :: nlevtab(nsrcua)
INTEGER :: nobsua
REAL :: rmiss
INTEGER :: istatus
!
!-----------------------------------------------------------------------
!
! Misc. local variables
!
!-----------------------------------------------------------------------
!
CHARACTER (LEN=12) :: suffix
INTEGER :: ista,ilev,ivar,ifile,isrc,nprev,ntotal,ktab
INTEGER :: maxsuf,lenfnm,dotloc,lensuf
REAL :: wthi,wtlo
LOGICAL :: found
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
ntotal = 0
DO ista=1,mxua
isrcua(ista)=0
DO ilev=1,nzua
DO ivar=1,nvar
qobsua(ivar,ilev,ista)=999999.
END DO
END DO
END DO
!
nprev=0
maxsuf=LEN(suffix)
!
DO ifile=1,nuafile
lenfnm=LEN(uafname(ifile))
CALL strlnth
(uafname(ifile),lenfnm)
CALL exsufx(uafname(ifile),lenfnm,suffix,maxsuf,dotloc,lensuf)
IF(lensuf == 3 .AND. suffix(1:3) == 'snd') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'NWS RAOB') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find NWS RAOB', &
' among upper air sources in input file'
CALL arpsstop("data problem",1)
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 3 .AND. suffix(1:3) == 'pro') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'WPDN PRO') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find WPDN PRO', &
' among upper air sources in input file'
CALL arpsstop("data problem",1)
END IF
CALL rdprof(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 3 .AND. suffix(1:3) == 'gps') THEN
CALL rdgps(nx,ny,nz,nvar,nzua,mxua,nsrcua,uafname(ifile), &
anx,xs,ys,zp,su,sv,st,spres,shght,sqv,sqvsat, &
srcua,stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
print *, ' Back from rdgps, ntotal=',ntotal
ELSE IF(lensuf == 3 .AND. suffix(1:3) == 'air') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AIRS') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AIRS', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AO_0001') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AO_0001') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AO_0001', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AL_0001') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AL_0001') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AL_0001', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AM_0001') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AM_0001') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AM_0001', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AO_0011') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AO_0011') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AO_0011', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AL_0011') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AL_0011') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AL_0011', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AM_0011') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AM_0011') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AM_0011', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AO_2222') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AO_2222') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AO_2222', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AL_2222') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AL_2222') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AL_2222', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AM_2222') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AM_2222') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AM_2222', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AO_0002') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AO_0002') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AO_0002', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AL_0002') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AL_0002') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AL_0002', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AM_0002') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AM_0002') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AM_0002', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AO_0012') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AO_0012') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AO_0012', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AL_0012') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AL_0012') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AL_0012', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AM_0012') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AM_0012') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AM_0012', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AO_0022') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AO_0022') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AO_0022', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AL_0022') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AL_0022') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AL_0022', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AM_0022') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AM_0022') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AM_0022', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AO_0222') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AO_0222') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AO_0222', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AL_0222') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AL_0222') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AL_0222', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AM_0222') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AM_0222') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AM_0222', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AO_0000') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AO_0000') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AO_0000', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AL_0000') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AL_0000') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AL_0000', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
ELSE IF(lensuf == 7 .AND. suffix(1:7) == 'AM_0000') THEN
found=.false.
DO isrc=1,nsrcua
IF(srcua(isrc) == 'AM_0000') THEN
found=.true.
EXIT
END IF
END DO
IF(.NOT. found) THEN
WRITE(6,'(a,a)') ' Could not find AM_0000', &
' among upper air sources in input file'
STOP
END IF
CALL rdraob(nvar,nzua,mxua,isrc,uafname(ifile), &
stnua,elevua,xua,yua,hgtua,obsua, &
qualua,isrcua,nlevsua, &
rmiss,nprev,ntotal,istatus)
END IF
nprev=ntotal
END DO
!
nobsua=ntotal
!
!-----------------------------------------------------------------------
!
! Set qobs based on source and height
!
!-----------------------------------------------------------------------
!
DO ista=1,nobsua
IF(isrcua(ista) > 0) THEN
isrc=isrcua(ista)
IF(nlevtab(isrc) < 2) THEN
WRITE(6,'(a,a,i6,/a,i3)') &
' Problem with error table for ', &
' upper-level data source',isrc, &
' nlevtab(isrc) =',nlevtab(isrc)
CALL arpsstop("data problem",1)
END IF
DO ilev=1,nzua
DO ktab=2,nlevtab(isrc)-1
IF(hgtqsrc(ktab,isrc) > hgtua(ilev,ista)) EXIT
END DO
! 126 CONTINUE
wthi= (hgtua(ilev,ista)-hgtqsrc(ktab-1,isrc))/ &
(hgtqsrc(ktab,isrc)-hgtqsrc(ktab-1,isrc))
wthi=AMAX1(wthi,0.0)
wthi=AMIN1(wthi,1.0)
wtlo=1.0-wthi
DO ivar=1,nvar
qobsua(ivar,ilev,ista)= &
wthi*qsrcua(ivar,ktab, isrc) + &
wtlo*qsrcua(ivar,ktab-1,isrc)
END DO
END DO
END IF
END DO
RETURN
END SUBROUTINE prepuaobs