subroutine get_ob_lists(miter,cgrid,mype,npe,mpi_comm_new)
!
! to compile:
! xlf90 get_ob_lists.f -L/nwprod/lib -lw3_8
!
! abstract:
! read in from original unformatted gsi diagnostic files
! and write out formatted streamlined files. Valid for
! gsi release 200609.
use controlvars, only: igust,ivis,ipblh,idist, &
iwspd10m,itd2m,imxtm,imitm, &
ipmsl,ihowv,itcamt,ilcbas, &
iuwnd10m,ivwnd10m
implicit none
integer(4),intent(in):: miter
integer(4),intent(in):: mype,npe,mpi_comm_new
character(60),intent(in):: cgrid
integer(4),parameter::nflds=6+14 !add gust,vis,pblh,dist,wspd10m,
!td2m,mxtm,mitm,pmsl,howv,tcamt,lcbas
!uwnd10m,vwnd10m
integer(4),parameter::lun_t=10
integer(4),parameter::lun_q=11
integer(4),parameter::lun_ps=12
integer(4),parameter::lun_u=13
integer(4),parameter::lun_v=14
integer(4),parameter::lun_spd=15
integer(4),parameter::lun_gust=16
integer(4),parameter::lun_vis=17
integer(4),parameter::lun_pblh=18
integer(4),parameter::lun_dist=19
integer(4),parameter::lun_wspd10m=20
integer(4),parameter::lun_td2m=21
integer(4),parameter::lun_mxtm=22
integer(4),parameter::lun_mitm=23
integer(4),parameter::lun_pmsl=24
integer(4),parameter::lun_howv=25
integer(4),parameter::lun_tcamt=26
integer(4),parameter::lun_lcbas=27
integer(4),parameter::lun_uwnd10m=28
integer(4),parameter::lun_vwnd10m=29
integer(4),parameter::nrejectmax=20000
integer(4),parameter::nmplower=-10000
integer(4),parameter::nmpupper=+100
character(8),allocatable,dimension(:):: cdiagbuf
character(8),allocatable,dimension(:):: cprvstg
character(8),allocatable,dimension(:):: csprvstg
character(3) otype
character(8) cstation
character(8) cprovider,csubprovider
character(3) clun3
character(2) ctvts
character(80) filename
character(15) clistorig
character(18) caux18
character(15) cblank15
character(1) cblank1
character(1) chvar1
character(10) chvar10
character(90) cfmt
integer(4) idate,nchar,nreal,i,ii,mypegsi,lun,lun2,n,m,k,naux
integer(4) itype
integer(4) ntrjs,nqrjs,nprjs,nwrjs,nmxtmrjs,nmitmrjs
integer(4) ntot(nflds),nmp(nmplower:nmpupper,0:3,nflds)
integer(4) ngross(nflds)
integer(4) kuse,ifld,kfrac
integer(4) kk
integer(4) iter,ierror
integer(4) it_pe, iq_pe, ips_pe, iw_pe, ispd_pe, &
igust_pe, ivis_pe, ipblh_pe, idist_pe, iwspd10m_pe, &
itd2m_pe, imxtm_pe, imitm_pe, ipmsl_pe, ihowv_pe, &
itcamt_pe, ilcbas_pe, iuwnd10m_pe,ivwnd10m_pe
logical t_pe, q_pe, ps_pe, w_pe, spd_pe, &
gust_pe, vis_pe, pblh_pe, dist_pe, wspd10m_pe, &
td2m_pe, mxtm_pe, mitm_pe, pmsl_pe, howv_pe, &
tcamt_pe, lcbas_pe, uwnd10m_pe, vwnd10m_pe
real(4),allocatable,dimension(:,:)::rdiagbuf
real(4) rlat,rlon,oberr,oberr2,ob,ob_model,ddiff, &
dudiff,dvdiff,rmuse,xx,yy
real(4) uob,uob_model,vob,vob_model,rfactor,qtflg
real(8) rlat8,rlon8,xx8,yy8
real(8) da8,alat18,elon18,elonv8,alatan8
real(4) shgt0 !station height
real(4) hgt0 !observation elevation
real(4) hgt !model terrain at ob location
real(4) slm !dominant surface type
real(4) dtime
real(4) percnumber
real(4) rsign
character(90) t_rjlist(nrejectmax)
character(90) q_rjlist(nrejectmax)
character(90) p_rjlist(nrejectmax)
character(90) w_rjlist(nrejectmax)
character(90) mitm_rjlist(nrejectmax)
character(90) mxtm_rjlist(nrejectmax)
logical tlistexist,qlistexist,plistexist,wlistexist,&
mxtmlistexist,mitmlistexist
logical diagexist
logical fexist, r15887_diagfile_fmt
namelist/diagfile_fmt/r15887_diagfile_fmt
data r15887_diagfile_fmt/.true./
inquire(file='diagfile_fmt_input',exist=fexist)
if (fexist) then
open (55,file='diagfile_fmt_input',form='formatted')
read(55,*) r15887_diagfile_fmt
close(55)
endif
if (mype==0) print*,'in get_ob_lists:: cgrid,miter,r15887_diagfile_fmt=', &
&trim(cgrid),miter,r15887_diagfile_fmt
if (mype==0) print*,'npe,mpi_comm_new=',npe,mpi_comm_new
do 5000 iter=1,miter+1
if (iter==1) clun3='ges'
if (iter>1) then
if((iter-1)==miter) then
clun3='anl'
else
clun3=' '
write(clun3(1:2),'(i2.2)')iter
endif
endif
if (mype==0) print*,'in get_ob_lists:: iter,clun3=',iter,trim(clun3)
diagexist=.false.
inquire(file='diag_conv_'//trim(clun3)//'.dat',exist=diagexist)
if (diagexist) open (7,file='diag_conv_'//trim(clun3)//'.dat',form='unformatted')
if (.not.diagexist) cycle
if (iter .eq. 1) clun3='01' !rename after reading from diag_conv_ges to keep old filenaming
!----------------------------------------------------------------------------------
it_pe=0 ; iq_pe=1 ; ips_pe=2 ; iw_pe=3 ; ispd_pe=4
igust_pe=-999 ; ivis_pe=-999 ; ipblh_pe=-999 ; idist_pe=-999 ; iwspd10m_pe=-999
itd2m_pe=-999 ; imxtm_pe=-999 ; imitm_pe=-999 ; ipmsl_pe=-999 ; ihowv_pe=-999
itcamt_pe=-999 ; ilcbas_pe=-999; iuwnd10m_pe=-999 ; ivwnd10m_pe=-999
n=4
if (igust > 0) then ; n=n+1 ; igust_pe=n ; endif
if (ivis > 0) then ; n=n+1 ; ivis_pe=n ; endif
if (ipblh > 0) then ; n=n+1 ; ipblh_pe=n ; endif
if (idist > 0) then ; n=n+1 ; idist_pe=n ; endif
if (iwspd10m > 0) then ; n=n+1 ; iwspd10m_pe=n ; endif
if (itd2m > 0) then ; n=n+1 ; itd2m_pe=n ; endif
if (imxtm > 0) then ; n=n+1 ; imxtm_pe=n ; endif
if (imitm > 0) then ; n=n+1 ; imitm_pe=n ; endif
if (ipmsl > 0) then ; n=n+1 ; ipmsl_pe=n ; endif
if (ihowv > 0) then ; n=n+1 ; ihowv_pe=n ; endif
if (itcamt > 0) then ; n=n+1 ; itcamt_pe=n ; endif
if (ilcbas > 0) then ; n=n+1 ; ilcbas_pe=n ; endif
if (iuwnd10m > 0) then ; n=n+1 ; iuwnd10m_pe=n ; endif
if (ivwnd10m > 0) then ; n=n+1 ; ivwnd10m_pe=n ; endif
!----------------------------------------------------------------------------------
t_pe = mype==mod(it_pe , npe)
q_pe = mype==mod(iq_pe , npe)
ps_pe = mype==mod(ips_pe , npe)
w_pe = mype==mod(iw_pe , npe)
spd_pe = mype==mod(ispd_pe , npe)
gust_pe = igust > 0 .and. mype==mod(igust_pe , npe)
vis_pe = ivis > 0 .and. mype==mod(ivis_pe , npe)
pblh_pe = ipblh > 0 .and. mype==mod(ipblh_pe , npe)
dist_pe = idist > 0 .and. mype==mod(idist_pe , npe)
wspd10m_pe = iwspd10m > 0 .and. mype==mod(iwspd10m_pe , npe)
td2m_pe = itd2m > 0 .and. mype==mod(itd2m_pe , npe)
mxtm_pe = imxtm > 0 .and. mype==mod(imxtm_pe , npe)
mitm_pe = imitm > 0 .and. mype==mod(imitm_pe , npe)
pmsl_pe = ipmsl > 0 .and. mype==mod(ipmsl_pe , npe)
howv_pe = ihowv > 0 .and. mype==mod(ihowv_pe , npe)
tcamt_pe = itcamt > 0 .and. mype==mod(itcamt_pe , npe)
lcbas_pe = ilcbas > 0 .and. mype==mod(ilcbas_pe , npe)
uwnd10m_pe = iuwnd10m > 0 .and. mype==mod(iuwnd10m_pe , npe)
vwnd10m_pe = ivwnd10m > 0 .and. mype==mod(ivwnd10m_pe , npe)
!----------------------------------------------------------------------------------
if (t_pe) call open_and_header (lun_t, 't', clun3)
if (q_pe) call open_and_header (lun_q, 'q', clun3)
if (ps_pe) call open_and_header (lun_ps, 'ps', clun3)
if (w_pe) call open_and_header (lun_u, 'u', clun3)
if (w_pe) call open_and_header (lun_v, 'v', clun3) !single pe handling u & v
if (spd_pe) call open_and_header (lun_spd, 'spd', clun3)
if (gust_pe) call open_and_header (lun_gust, 'gust', clun3)
if (vis_pe) call open_and_header (lun_vis, 'vis', clun3)
if (pblh_pe) call open_and_header (lun_pblh, 'pblh', clun3)
if (dist_pe) call open_and_header (lun_dist, 'dist', clun3)
if (wspd10m_pe) call open_and_header (lun_wspd10m, 'wspd10m', clun3)
if (td2m_pe) call open_and_header (lun_td2m, 'td2m', clun3)
if (mxtm_pe) call open_and_header (lun_mxtm, 'mxtm', clun3)
if (mitm_pe) call open_and_header (lun_mitm, 'mitm', clun3)
if (pmsl_pe) call open_and_header (lun_pmsl, 'pmsl', clun3)
if (howv_pe) call open_and_header (lun_howv, 'howv', clun3)
if (tcamt_pe) call open_and_header (lun_tcamt, 'tcamt', clun3)
if (lcbas_pe) call open_and_header (lun_lcbas, 'lcbas', clun3)
if (uwnd10m_pe) call open_and_header (lun_uwnd10m, 'uwnd10m', clun3)
if (vwnd10m_pe) call open_and_header (lun_vwnd10m, 'vwnd10m', clun3)
!----------------------------------------------------------------------------------
if (t_pe) then
filename='t_rejectlist'
call readin_rjlist(filename,t_rjlist,nrejectmax,tlistexist,ntrjs)
print*,'in get_ob_lists: mype,tlistexist,ntrjs=',mype,tlistexist,ntrjs
endif
if (q_pe) then
filename='q_rejectlist'
call readin_rjlist(filename,q_rjlist,nrejectmax,qlistexist,nqrjs)
print*,'in get_ob_lists: mype,qlistexist,nqrjs=',mype,qlistexist,nqrjs
endif
if (ps_pe) then
filename='p_rejectlist'
call readin_rjlist(filename,p_rjlist,nrejectmax,plistexist,nprjs)
print*,'in get_ob_lists: mype,plistexist,nprjs=',mype,plistexist,nprjs
endif
if (w_pe .or. spd_pe .or. gust_pe) then
filename='w_rejectlist'
call readin_rjlist(filename,w_rjlist,nrejectmax,wlistexist,nwrjs)
print*,'in get_ob_lists: mype, wlistexist,nwrjs=',mype,wlistexist,nwrjs
endif
if (mxtm_pe) then
filename='mxtm_rejectlist'
call readin_rjlist(filename,mxtm_rjlist,nrejectmax,mxtmlistexist,nmxtmrjs)
print*,'in get_ob_lists: mype,mxtmlistexist,nmxtmrjs=',mype,mxtmlistexist,nmxtmrjs
endif
if (mitm_pe) then
filename='mitm_rejectlist'
call readin_rjlist(filename,mitm_rjlist,nrejectmax,mitmlistexist,nmitmrjs)
print*,'in get_ob_lists: mype,mitmlistexist,nmitmrjs=',mype,mitmlistexist,nmitmrjs
endif
cblank1=' '
cblank15=' '
ntot=0
nmp(nmplower:nmpupper,0:3,1:nflds)=0
ngross=0
call proj_info(cgrid,da8,alat18,elon18,elonv8,alatan8)
if (t_pe) &
print*,'in get_ob_lists: da8,alat18,elon18,elonv8,alatan8=', &
da8,alat18,elon18,elonv8,alatan8
read(7,end=200) idate
loop_read_obs: do
read(7,end=200)otype,nchar,nreal,ii,mypegsi
! print*,'in get_ob_lists, idate=',idate
! print*,'in get_ob_lists, otype,nchar,nreal,ii,mypegsi=', &
! otype,nchar,nreal,ii,mypegsi
if (ii==0) then
read(7,end=200)
if (r15887_diagfile_fmt) read(7,end=200)
cycle loop_read_obs
endif
allocate(cdiagbuf(ii))
allocate(cprvstg(ii))
allocate(csprvstg(ii))
allocate(rdiagbuf(nreal,ii))
if (r15887_diagfile_fmt) then
read(7) cdiagbuf,rdiagbuf
read(7) cprvstg,csprvstg
else
read(7) cdiagbuf,rdiagbuf,cprvstg,csprvstg
endif
if (otype(1:3)==' t' .and. t_pe) then
lun=lun_t
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
if (rmuse < -1.) call read_rejfileorig(itype,cstation,t_rjlist,nrejectmax,ntrjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
slm=rdiagbuf(21,i)
hgt=rdiagbuf(22,i)
ctvts='tv'
if (qtflg .gt. 0.) ctvts='ts'
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
! write(lun,124) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig,ctvts
caux18=clistorig//cblank1//ctvts !use this to get around formatting pbs in write statement
write(lun,124) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,caux18
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=1
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(1:3)==' q' .and. q_pe) then
lun=lun_q
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
if (rmuse < -1.) call read_rejfileorig(itype,cstation,q_rjlist,nrejectmax,nqrjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
slm=rdiagbuf(22,i)
hgt=rdiagbuf(23,i)
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
write(lun,123) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=2
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(2:3)=='ps' .and. ps_pe) then
lun=lun_ps
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
if (rmuse < -1.) call read_rejfileorig(itype,cstation,p_rjlist,nrejectmax,nprjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
slm=rdiagbuf(21,i)
hgt=rdiagbuf(22,i)
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=(1./oberr)*100. !convert to Pa
ob=ob*100. !convert to Pa
ob_model=ob_model*100.! convert to Pa
write(lun,123) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=3
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(2:3)=='uv' .and. w_pe) then
lun=lun_u
lun2=lun_v
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
if (rmuse < -1.) call read_rejfileorig(itype,cstation,w_rjlist,nrejectmax,nwrjs,clistorig)
oberr=rdiagbuf(16,i)
uob=rdiagbuf(17,i)
dudiff=rdiagbuf(18,i)
uob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
vob=rdiagbuf(20,i)
dvdiff=rdiagbuf(21,i)
vob_model=rdiagbuf(20,i)-rdiagbuf(21,i)
rfactor=rdiagbuf(23,i)
slm=rdiagbuf(26,i)
hgt=rdiagbuf(27,i)
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
write(lun,125) cstation,itype,rlat,rlon,dtime,oberr2,uob,uob_model,rmuse,clistorig,rfactor
write(lun2,125) cstation,itype,rlat,rlon,dtime,oberr2,vob,vob_model,rmuse,clistorig,rfactor
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
if (iter==1) call add2auxlist(lun2*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=4
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(1:3)=='spd' .and. spd_pe) then
lun=lun_spd
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
if (rmuse < -1.) call read_rejfileorig(itype,cstation,w_rjlist,nrejectmax,nwrjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
rfactor=rdiagbuf(20,i)
slm=rdiagbuf(22,i)
hgt=rdiagbuf(23,i)
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
write(lun,125) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig,rfactor
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=6
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(1:3)=='gst' .and. gust_pe) then
lun=lun_gust
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
if (rmuse < -1.) call read_rejfileorig(itype,cstation,w_rjlist,nrejectmax,nwrjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
rfactor=rdiagbuf(20,i)
slm=rdiagbuf(21,i)
hgt=rdiagbuf(22,i)
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
write(lun,125) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig,rfactor
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=7
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(1:3)=='vis' .and. vis_pe) then
lun=lun_vis
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
! if (rmuse < -1.) call read_rejfileorig(itype,cstation,vis_rjlist,nrejectmax,nwrjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
slm=rdiagbuf(21,i)
hgt=rdiagbuf(22,i)
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
write(lun,123) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=8
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(1:3)=='pbl' .and. pblh_pe) then
lun=lun_pblh
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
! if (rmuse < -1.) call read_rejfileorig(itype,cstation,pblh_rjlist,nrejectmax,nwrjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
slm=-999.00000
hgt=-999.00000
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
write(lun,123) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=9
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(1:3)=='cei' .and. dist_pe) then
lun=lun_dist
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
! if (rmuse < -1.) call read_rejfileorig(itype,cstation,dist_rjlist,nrejectmax,nwrjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
slm=rdiagbuf(21,i)
hgt=rdiagbuf(22,i)
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
write(lun,123) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=10
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(1:3)=='wst' .and. wspd10m_pe) then
lun=lun_wspd10m
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
! if (rmuse < -1.) call read_rejfileorig(itype,cstation,wspd10m_rjlist,nrejectmax,nwrjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
rfactor=rdiagbuf(20,i)
slm=rdiagbuf(21,i)
hgt=rdiagbuf(22,i)
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
write(lun,125) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig,rfactor
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=11
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(1:3)=='td2' .and. td2m_pe) then
lun=lun_td2m
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
! if (rmuse < -1.) call read_rejfileorig(itype,cstation,td2m_rjlist,nrejectmax,nwrjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
slm=rdiagbuf(20,i)
hgt=rdiagbuf(21,i)
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
write(lun,123) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=12
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(1:3)=='mxt' .and. mxtm_pe) then
lun=lun_mxtm
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
if (rmuse < -1.) call read_rejfileorig(itype,cstation,mxtm_rjlist,nrejectmax,nmxtmrjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
slm=rdiagbuf(20,i)
hgt=rdiagbuf(21,i)
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
write(lun,123) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=13
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(1:3)=='mit' .and. mitm_pe) then
lun=lun_mitm
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
if (rmuse < -1.) call read_rejfileorig(itype,cstation,mitm_rjlist,nrejectmax,nmitmrjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
slm=rdiagbuf(20,i)
hgt=rdiagbuf(21,i)
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
write(lun,123) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=14
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(1:3)=='psl' .and. pmsl_pe) then
lun=lun_pmsl
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
! if (rmuse < -1.) call read_rejfileorig(itype,cstation,pmsl_rjlist,nrejectmax,nwrjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
slm=rdiagbuf(20,i)
hgt=rdiagbuf(21,i)
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
write(lun,123) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=15
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(1:3)=='hwv' .and. howv_pe) then
lun=lun_howv
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
! if (rmuse < -1.) call read_rejfileorig(itype,cstation,howv_rjlist,nrejectmax,nwrjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
slm=rdiagbuf(20,i)
hgt=rdiagbuf(21,i)
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
write(lun,123) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=16
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(1:3)=='tca' .and. tcamt_pe) then
lun=lun_tcamt
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
! if (rmuse < -1.) call read_rejfileorig(itype,cstation,tcamt_rjlist,nrejectmax,nwrjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
slm=rdiagbuf(21,i)
hgt=rdiagbuf(22,i)
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
!**********************************************
!temporary fix for goes skycover data
if (itype==154) then
cstation='GOESSKY'
cprovider='GOESSKY'
csubprovider='GOESSKY'
shgt0=-99999.
hgt0=-99999.
endif
!**********************************************
write(lun,123) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=17
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(1:3)=='lcb' .and. lcbas_pe) then
lun=lun_lcbas
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
! if (rmuse < -1.) call read_rejfileorig(itype,cstation,lcbas_rjlist,nrejectmax,nwrjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
slm=rdiagbuf(21,i)
hgt=rdiagbuf(22,i)
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
write(lun,123) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=18
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(1:3)=='uwn' .and. uwnd10m_pe) then
lun=lun_uwnd10m
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
! if (rmuse < -1.) call read_rejfileorig(itype,cstation,uwnd10m_rjlist,nrejectmax,nwrjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
rfactor=rdiagbuf(23,i)
slm=rdiagbuf(24,i)
hgt=rdiagbuf(25,i)
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
write(lun,125) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig,rfactor
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=19
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
elseif (otype(1:3)=='vwn' .and. vwnd10m_pe) then
lun=lun_vwnd10m
do i=1,ii
cstation=cdiagbuf(i)
cprovider=cprvstg(i)
csubprovider=csprvstg(i)
itype=nint(rdiagbuf(1,i))
rlat=rdiagbuf(3,i)
rlon=rdiagbuf(4,i)
dtime=rdiagbuf(8,i)
shgt0=rdiagbuf(5,i)
hgt0=rdiagbuf(7,i)
qtflg=rdiagbuf(10,i)
if (rdiagbuf(11,i) .gt. 1.) then
rmuse=rdiagbuf(11,i)*rdiagbuf(12,i)
else
rsign=1.
if (rdiagbuf(12,i) /= 0 ) rsign=rdiagbuf(12,i)/abs(rdiagbuf(12,i))
rmuse=rdiagbuf(12,i)+rsign*(rdiagbuf(11,i)-float(int(rdiagbuf(11,i))))
endif
clistorig=cblank15
! if (rmuse < -1.) call read_rejfileorig(itype,cstation,vwnd10m_rjlist,nrejectmax,nwrjs,clistorig)
oberr=rdiagbuf(16,i)
ob=rdiagbuf(17,i)
ddiff=rdiagbuf(18,i)
ob_model=rdiagbuf(17,i)-rdiagbuf(18,i)
rfactor=rdiagbuf(23,i)
slm=rdiagbuf(24,i)
hgt=rdiagbuf(25,i)
rlat8=rlat*1._8
rlon8=rlon*1._8
call latlon_to_grid(da8,alat18,elon18,elonv8,alatan8, &
rlat8,rlon8,cgrid,xx8,yy8)
xx=xx8
yy=yy8
oberr2=1.e10
if (oberr.gt.1.e-05) oberr2=1./oberr
write(lun,125) cstation,itype,rlat,rlon,dtime,oberr2,ob,ob_model,rmuse,clistorig,rfactor
if (iter==1) call add2auxlist(lun*10,cstation,cprovider,csubprovider,itype,shgt0,hgt0,hgt,slm)
ifld=20
ntot(ifld)=ntot(ifld)+1
kuse=int(rmuse)
kfrac=nint (abs(rmuse-float(kuse))/0.25 + 0.001 )
nmp(kuse,kfrac,ifld)=nmp(kuse,kfrac,ifld)+1
if ( (kuse>=-3 .and. kuse<=-1) .and. oberr2 > 1.e09) ngross(ifld)=ngross(ifld)+1
enddo
end if
deallocate(cdiagbuf,rdiagbuf)
deallocate(cprvstg,csprvstg)
enddo loop_read_obs
200 continue
!v-wind component
ntot(5)=ntot(4)
nmp(:,:,5)=nmp(:,:,4)
do n=1,nflds
if ( n==1 .and. t_pe ) then ; lun=lun_t
elseif ( n==2 .and. q_pe ) then ; lun=lun_q
elseif ( n==3 .and. ps_pe ) then ; lun=lun_ps
elseif ( n==4 .and. w_pe ) then ; lun=lun_u
elseif ( n==5 .and. w_pe ) then ; lun=lun_v !single pe handling u & v
elseif ( n==6 .and. spd_pe ) then ; lun=lun_spd
elseif ( n==7 .and. gust_pe ) then ; lun=lun_gust
elseif ( n==8 .and. vis_pe ) then ; lun=lun_vis
elseif ( n==9 .and. pblh_pe ) then ; lun=lun_pblh
elseif ( n==10 .and. dist_pe ) then ; lun=lun_dist
elseif ( n==11 .and. wspd10m_pe ) then ; lun=lun_wspd10m
elseif ( n==12 .and. td2m_pe ) then ; lun=lun_td2m
elseif ( n==13 .and. mxtm_pe ) then ; lun=lun_mxtm
elseif ( n==14 .and. mitm_pe ) then ; lun=lun_mitm
elseif ( n==15 .and. pmsl_pe ) then ; lun=lun_pmsl
elseif ( n==16 .and. howv_pe ) then ; lun=lun_howv
elseif ( n==17 .and. tcamt_pe ) then ; lun=lun_tcamt
elseif ( n==18 .and. lcbas_pe ) then ; lun=lun_lcbas
elseif ( n==19 .and. uwnd10m_pe ) then ; lun=lun_uwnd10m
elseif ( n==20 .and. vwnd10m_pe ) then ; lun=lun_vwnd10m
else
cycle
endif
write (lun,'(a)') '=================================================================================================='
write (lun,'(a)') '=================================================================================================='
write (lun,'(1x,a,i8)') 'total number of obs :', ntot(n)
naux=sum(nmp(1:3,0:3,n))
write (lun,'(1x,a,i8)') 'number of obs assimilated :', naux
percnumber=0.
if (ntot(n) .gt. 0) percnumber=(float(naux)/float(ntot(n)))*100.
write (lun,'(1x,a,3x,f8.3,a)') 'percentage of obs assimilated :',percnumber,'%'
write (lun,'(1x,a,i8)') 'number of obs rejected by gross error check :', ngross(n)
percnumber=0.
if (ngross(n) .gt. 0) percnumber=(float(ngross(n))/float(ntot(n)))*100.
write (lun,'(1x,a,3x,f8.3,a)') 'percentage of obs rejected by gross error check:',percnumber,'%'
do m=nmplower,nmpupper !-499,+10 !-1
do k=0,3
if ( nmp(m,k,n) .gt. 0) then
write(chvar10,'(i10)') nmp(m,k,n)
chvar10=adjustl(chvar10)
kk=len_trim(chvar10)
chvar1='8'
cfmt="(1x,"//"'number of obs with rmuse ='"//',f9.2,'//"' :'"//',i'//chvar1//")"
if (m < 0) write (lun,cfmt) float(m)-0.25*float(k),nmp(m,k,n)
if (m >= 0) write (lun,cfmt) float(m)+0.25*float(k),nmp(m,k,n)
endif
enddo
enddo
if (n.ne.4 .and. n.ne.5 .and. (n.ne.7 .or. igust.le.0)) then
write (lun,'(1x,a,i8)') 'number of obs in the all day reject list :', sum(nmp(-5000,0:3,n))
write (lun,'(1x,a,i8)') 'number of obs in the diurnal reject list :', sum(nmp(-5100,0:3,n))
endif
if (n.eq.4 .or. n.eq.5 .or. (n.eq.7 .and. igust.gt.0)) then
write (lun,'(1x,a,i8)') 'number of non-mesonets in the reject list :', sum(nmp(-5000,0:3,n))
write (lun,'(1x,a,i8)') 'number of mesonet winds in none of the uselists and also not in the reject list:', &
sum(nmp(-6000,0:3,n))
write (lun,'(1x,a,i8)') 'number of mesonets winds in the rejectlist and in at least one of the uselists :', &
sum(nmp(-6100,0:3,n))
write (lun,'(1x,a,9x,i8)') 'number of mesonets winds in the rejectlist but in none of the uselists:', &
sum(nmp(-6200,0:3,n))
endif
write (lun,'(1x,a,i8)') 'sum of all obs :', sum(nmp(nmplower:nmpupper,0:3,n))
enddo
!123 format(a8,2x,i3,3(2x,f6.2),3(2x,f9.2))
!123 format(a8,2x,i3,2(2x,f6.2),4(2x,E11.4))
!123 format(a8,4x,i3,2x,2(2x,f6.2),3(2x,E11.4),2x,f5.1)
!123 format(a8,4x,i3,4x,f6.2,4x,f6.2,2x,3(2x,E11.4),2x,f5.1)
!123 format(a8,4x,i3,4x,f6.2,4x,f6.2,4x,f6.2,2x,3(2x,E11.4),2x,f5.1)
!123 format(a8,4x,i3,4x,f6.2,4x,f6.2,4x,f6.2,2x,3(2x,E11.4),2x,f8.1)
!124 format(a8,4x,i3,4x,f6.2,4x,f6.2,4x,f6.2,2x,3(2x,E11.4),2x,f8.1,7x,a2)
123 format(a8,4x,i3,4x,f6.2,4x,f6.2,4x,f6.2,2x,3(2x,E11.4),2x,f8.2,1x,a15)
124 format(a8,4x,i3,4x,f6.2,4x,f6.2,4x,f6.2,2x,3(2x,E11.4),2x,f8.2,1x,a18)
!124 format(a8,4x,i3,4x,f6.2,4x,f6.2,4x,f6.2,2x,3(2x,E11.4),2x,f8.1,1x,a15,' ',a2)
!124 format(a8,4x,i3,4x,f6.2,4x,f6.2,4x,f6.2,2x,3(2x,E11.4),2x,f8.1,1x,a15,1x,a2)
!124 format(a8,4x,i3,4x,f6.2,4x,f6.2,4x,f6.2,2x,3(2x,E11.4),2x,f8.1,1x,a17,a2)
125 format(a8,4x,i3,4x,f6.2,4x,f6.2,4x,f6.2,2x,3(2x,E11.4),2x,f8.2,1x,a15,1x,f5.2)
if (t_pe) then
close(lun_t)
if (iter==1) close(lun_t*10)
endif
if (q_pe) then
close(lun_q)
if (iter==1) close(lun_q*10)
endif
if (ps_pe) then
close(lun_ps)
if (iter==1) close(lun_ps*10)
endif
if (w_pe) then
close(lun_u)
close(lun_v)
if (iter==1) then
close(lun_u*10)
close(lun_v*10)
endif
endif
if (spd_pe) then
close(lun_spd)
if (iter==1) close(lun_spd*10)
endif
if (gust_pe) then
close(lun_gust)
if (iter==1) close(lun_gust*10)
endif
if (vis_pe) then
close(lun_vis)
if (iter==1) close(lun_vis*10)
endif
if (pblh_pe) then
close(lun_pblh)
if (iter==1) close(lun_pblh*10)
endif
if (dist_pe) then
close(lun_dist)
if (iter==1) close(lun_dist*10)
endif
if (wspd10m_pe) then
close(lun_wspd10m)
if (iter==1) close(lun_wspd10m*10)
endif
if (td2m_pe) then
close(lun_td2m)
if (iter==1) close(lun_td2m*10)
endif
if (mxtm_pe) then
close(lun_mxtm)
if (iter==1) close(lun_mxtm*10)
endif
if (mitm_pe) then
close(lun_mitm)
if (iter==1) close(lun_mitm*10)
endif
if (pmsl_pe) then
close(lun_pmsl)
if (iter==1) close(lun_pmsl*10)
endif
if (howv_pe) then
close(lun_howv)
if (iter==1) close(lun_howv*10)
endif
if (tcamt_pe) then
close(lun_tcamt)
if (iter==1) close(lun_tcamt*10)
endif
if (lcbas_pe) then
close(lun_lcbas)
if (iter==1) close(lun_lcbas*10)
endif
if (uwnd10m_pe) then
close(lun_uwnd10m)
if (iter==1) close(lun_uwnd10m*10)
endif
if (vwnd10m_pe) then
close(lun_vwnd10m)
if (iter==1) close(lun_vwnd10m*10)
endif
close(7)
call mpi_barrier(mpi_comm_new,ierror)
5000 continue
return
end
!***************************************************************
subroutine open_and_header(lun,cvar,clun3)
implicit none
integer(4),intent(in):: lun
character(*),intent(in)::cvar
character(3),intent(in)::clun3
character(70) cnames(30),cname0
character(96) cheader
character(96) cheader_1,cheader_2,cheader_3,cheader_4,cheader_5, &
cheader_6,cheader_7,cheader_8,cheader_9
character(96) cheader_10
integer(4) n
!======================================================================================
cnames(1)='TEMPERATURE' ; cnames(10)='CEILING HGHT'
cnames(2)='SPECIFIC HUMIDITY' ; cnames(11)='WSPD10M'
cnames(3)='SURFACE PRESSURE' ; cnames(12)='TD2M'
cnames(4)='U-WIND' ; cnames(13)='MAX TEMP'
cnames(5)='V-WIND' ; cnames(14)='MIN TEMP'
cnames(6)='WIND SPEED' ; cnames(15)='PMSL'
cnames(7)='WIND GUST' ; cnames(16)='SIGNIFICANT WAVE HGHT'
cnames(8)='VISIBILITY' ; cnames(17)='TOTAL CLOUD AMOUNT OBS'
cnames(9)='PBLH' ; cnames(18)='LOWEST CLOUD BASE OBS'
cnames(19)='UWND10M'
cnames(20)='VWND10M'
cheader_1='shgt0 ==> station height'
cheader_2='hgt0 ==> observation elevation'
cheader_3='hgt ==> model terrain at ob (x,y) location'
cheader_4='slm ==> dominant surface type. this is the surface type of the grid point'
cheader_5=' of the enclosing box nearest to the observation.'
cheader_6=' slm is 0 for water and 1 for land. note: must subtract 3 if slm>=3'
cheader_7=' values of slm>=3 are used to indicate that at least two of the'
cheader_8=' grid points of the enclosing box are of different surface types.'
cheader_9=' '
! cheader_10='stnname obtype provider subprovider shgt0 hgt0 hgt slm'
cheader_10='stnname obtype provider subprovider shgt0 hgt0 hgt slm'
open (lun,file=trim(cvar)//'_obs.listing_iter_'//trim(clun3),form='formatted') !output file
cheader='stnname obtype lat(dg) lon(dg E) dtime oberr ob guess rmuse'
if (trim(cvar)=='t') then
n=1
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess are K. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000. ==> ob was in the reject list ; rmuse=-5100. ==> in diurnal list'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list.'
write(lun,'(a)') 'tv=virtual T, and ts=sensible T. Note that the GSI can assimilate obs as either tv or ts'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist tv-or-ts'
elseif (trim(cvar)=='q') then
n=2
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess are g/Kg. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000. ==> ob was in the reject list ; rmuse=-5100. ==> in diurnal list'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: lists of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist'
elseif (trim(cvar)=='ps') then
n=3
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess are Pa. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000. ==> ob was in the reject list'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist'
elseif (trim(cvar)=='u') then
n=4
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess are m/s. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000.==> this non-mesonet wind was was in the reject list'
write(lun,'(a)') 'rmuse=-6000.==> this mesonet wind did not belong to any of the GSD uselists, and neither was it'
write(lun,'(a)') ' in the reject list'
write(lun,'(a)') 'rmuse=-6100.==> this mesonet wind was in the reject list and in at least one of the GSD uselists'
write(lun,'(a)') 'rmuse=-6200.==> this mesonet wind was in the reject list and in neither one of the GSD uselists'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist factw'
elseif (trim(cvar)=='v') then
n=5
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess are m/s. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000.==> this non-mesonet wind was was in the reject list'
write(lun,'(a)') 'rmuse=-6000.==> this mesonet wind did not belong to any of the GSD uselists, and neither was it'
write(lun,'(a)') ' in the reject list'
write(lun,'(a)') 'rmuse=-6100.==> this mesonet wind was in the reject list and on at least one of the GSD uselists'
write(lun,'(a)') 'rmuse=-6200.==> this mesonet wind was in the reject list and on neither one of the GSD uselists'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist factw'
elseif (trim(cvar)=='spd') then
n=6
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess are m/s. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-500. ==> ob was in the reject list'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist factw'
elseif (trim(cvar)=='gust') then
n=7
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess are m/s. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000.==> this non-mesonet wind was was in the reject list'
write(lun,'(a)') 'rmuse=-6000.==> this mesonet wind did not belong to any of the GSD uselists, and neither was it'
write(lun,'(a)') ' in the reject list'
write(lun,'(a)') 'rmuse=-6100.==> this mesonet wind was in the reject list and on at least one of the GSD uselists'
write(lun,'(a)') 'rmuse=-6200.==> this mesonet wind was in the reject list and on neither one of the GSD uselists'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist factw'
elseif (trim(cvar)=='vis') then
n=8
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess is m. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000.==> this non-mesonet wind was was in the reject list'
write(lun,'(a)') 'rmuse=-6000.==> this mesonet wind did not belong to any of the GSD uselists, and neither was it'
write(lun,'(a)') ' in the reject list'
write(lun,'(a)') 'rmuse=-6100.==> this mesonet wind was in the reject list and on at least one of the GSD uselists'
write(lun,'(a)') 'rmuse=-6200.==> this mesonet wind was in the reject list and on neither one of the GSD uselists'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist'
elseif (trim(cvar)=='pblh') then
n=9
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess is m. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000.==> this non-mesonet wind was was in the reject list'
write(lun,'(a)') 'rmuse=-6000.==> this mesonet wind did not belong to any of the GSD uselists, and neither was it'
write(lun,'(a)') ' in the reject list'
write(lun,'(a)') 'rmuse=-6100.==> this mesonet wind was in the reject list and on at least one of the GSD uselists'
write(lun,'(a)') 'rmuse=-6200.==> this mesonet wind was in the reject list and on neither one of the GSD uselists'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist'
elseif (trim(cvar)=='dist') then
n=10
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess is m. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000.==> this non-mesonet wind was was in the reject list'
write(lun,'(a)') 'rmuse=-6000.==> this mesonet wind did not belong to any of the GSD uselists, and neither was it'
write(lun,'(a)') ' in the reject list'
write(lun,'(a)') 'rmuse=-6100.==> this mesonet wind was in the reject list and on at least one of the GSD uselists'
write(lun,'(a)') 'rmuse=-6200.==> this mesonet wind was in the reject list and on neither one of the GSD uselists'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist'
elseif (trim(cvar)=='wspd10m') then
n=11
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess are m/s. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000.==> this non-mesonet wind was not on the reject list'
write(lun,'(a)') 'rmuse=-6000.==> this mesonet wind did not belong to any of the GSD uselists, and neither was it'
write(lun,'(a)') ' in the reject list'
write(lun,'(a)') 'rmuse=-6100.==> this mesonet wind was in the reject list and in at least one of the GSD uselists'
write(lun,'(a)') 'rmuse=-6200.==> this mesonet wind was in the reject list and in neither one of the GSD uselists'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist factw'
elseif (trim(cvar)=='td2m') then
n=12
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess are K. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000. ==> ob was in the reject list'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist'
elseif (trim(cvar)=='mxtm') then
n=13
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess are K. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000. ==> ob was in the reject list'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist'
elseif (trim(cvar)=='mitm') then
n=14
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess are K. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000. ==> ob was in the reject list'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist'
elseif (trim(cvar)=='pmsl') then
n=15
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess are Pa. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000. ==> ob was in the reject list'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist'
elseif (trim(cvar)=='howv') then
n=16
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess are m. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000. ==> ob was in the reject list'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist'
elseif (trim(cvar)=='tcamt') then
n=17
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess are %. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000. ==> ob was in the reject list'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist'
elseif (trim(cvar)=='lcbas') then
n=18
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess are m. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000. ==> ob was in the reject list'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist'
elseif (trim(cvar)=='uwnd10m') then
n=19
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess are m/s. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000.==> this non-mesonet wind was not on the reject list'
write(lun,'(a)') 'rmuse=-6000.==> this mesonet wind did not belong to any of the GSD uselists, and neither was it'
write(lun,'(a)') ' in the reject list'
write(lun,'(a)') 'rmuse=-6100.==> this mesonet wind was in the reject list and in at least one of the GSD uselists'
write(lun,'(a)') 'rmuse=-6200.==> this mesonet wind was in the reject list and in neither one of the GSD uselists'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist factw'
elseif (trim(cvar)=='vwnd10m') then
n=20
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun,'(a)') trim(cname0)
write(lun,'(a)') 'UNITS of oberr, ob, and guess are m/s. Ob is used only if rmuse=+1.0 or +2.0'
write(lun,'(a)') 'rmuse=-100. ==> user chose to monitor this ob and see how well it agrees with the guess'
write(lun,'(a)') 'rmuse=-150. ==> ob is being monitored. Internally selected based on MADIS QC flag values'
write(lun,'(a)') 'rmuse=-5000.==> this non-mesonet wind was not on the reject list'
write(lun,'(a)') 'rmuse=-6000.==> this mesonet wind did not belong to any of the GSD uselists, and neither was it'
write(lun,'(a)') ' in the reject list'
write(lun,'(a)') 'rmuse=-6100.==> this mesonet wind was in the reject list and in at least one of the GSD uselists'
write(lun,'(a)') 'rmuse=-6200.==> this mesonet wind was in the reject list and in neither one of the GSD uselists'
write(lun,'(a)') 'dtime is the hour relative to the valid analysis time. For example, dtime=-0.1'
write(lun,'(a)') ' means 0.1h (i.e. 6 minutes) before the valid analysis time'
write(lun,'(a)') 'rejectlist: list of sub-standard obs where ob was found. It can be (i) static (sta),'
write(lun,'(a)') ' (ii) from weather forecast office (wfo), (iii) global based on MADIS QC stats (glb), or'
write(lun,'(a)') ' (iv) dynamic (dyn). Note that the ob can be in more than one reject list'
write(lun,'(a)') ' '
write(lun,'(a)') cheader//' rejectlist factw'
endif
if (trim(clun3)=='01') then
open(lun*10,file=trim(cvar)//'_obs.listing_iter_'//trim(clun3)//'_aux',form='formatted')
cname0='RTMA '//trim(cnames(n))//' OBS'
write(lun*10,'(a)') trim(cname0)
write(lun*10,'(a)') trim(cheader_1)
write(lun*10,'(a)') trim(cheader_2)
write(lun*10,'(a)') trim(cheader_3)
write(lun*10,'(a)') trim(cheader_4)
write(lun*10,'(a)') trim(cheader_5)
write(lun*10,'(a)') trim(cheader_6)
write(lun*10,'(a)') trim(cheader_7)
write(lun*10,'(a)') trim(cheader_8)
write(lun*10,'(a)') trim(cheader_9)
write(lun*10,'(a)') trim(cheader_10)
endif
return
end
!***************************************************************
subroutine readin_rjlist(filename,rjlist,nmax,fexist,nrjs)
implicit none
integer(4),intent(in)::nmax
integer(4),intent(out)::nrjs
character(80),intent(in)::filename
character(90),intent(out)::rjlist(nmax)
logical,intent(out)::fexist
integer(4),parameter::meso_unit=61
integer(4) ncount,m,n
character(1),parameter::cblank=' '
character(90) cstring
character(80) filename2
character(1) cvar
integer(4) nrjs0
do n=1,nmax
do m=1,90
rjlist(n)(m:m)=cblank
enddo
enddo
nrjs=0
fexist=.false.
inquire(file=trim(filename),exist=fexist)
if(fexist) then
open (meso_unit,file=trim(filename),form='formatted')
ncount=0
do m=1,3
read(meso_unit,*,end=151) cstring
enddo
do
ncount=ncount+1
read(meso_unit,*,end=151) rjlist(ncount)
enddo
151 continue
nrjs=ncount-1 ; nrjs=max(nrjs,0)
endif
close(meso_unit)
print*,'in readin_rjlist: filename,nrjs=',trim(filename),nrjs
if(trim(filename)=='t_rejectlist' .or. &
trim(filename)=='q_rejectlist') then
! cvar=trim(filename)(1:1)
cvar=filename(1:1)
do n=1,2
if (n==1) filename2=cvar//'_day_rejectlist'
if (n==2) filename2=cvar//'_night_rejectlist'
inquire(file=trim(filename2),exist=fexist)
if (fexist) then
open (meso_unit,file=trim(filename2),form='formatted')
ncount=nrjs ; nrjs0=nrjs
do m=1,3
read(meso_unit,*,end=251) cstring
enddo
do
ncount=ncount+1
read(meso_unit,*,end=251) rjlist(ncount)
enddo
251 continue
nrjs=ncount-1 ; nrjs=max(nrjs,nrjs0)
close(meso_unit)
print*,'in readin_rjlist: add diurnal lists:n,filename2,nrjs=',n,trim(filename2),nrjs
endif
enddo
endif
return
end
!***************************************************************
subroutine read_rejfileorig(kx,c_station_id,rjlist,nmax,nrjs,clistorig)
implicit none
character(8),intent(in)::c_station_id
character(90),intent(in)::rjlist(nmax)
character(15),intent(out)::clistorig
integer(4),intent(in)::kx,nmax,nrjs
character(8) ch8
integer(4) m,nlen
do m=1,nrjs
ch8(1:8)=rjlist(m)(1:8)
nlen=len_trim(ch8)
if ((trim(c_station_id) == trim(ch8)) .or. &
((kx==188.or.kx==288.or.kx==195.or.kx==295) .and. c_station_id(1:nlen)==ch8(1:nlen))) then !handle wfo's mesonets which never end with
clistorig(1:15)=rjlist(m)(70:84) !an "a" or "x" in the eight position following blanks
exit
endif
enddo
return
end
!***************************************************************
!note:
!***************************************************************
subroutine add2auxlist(lun,cstation,cprovider,csubprovider, &
itype,shgt0,hgt0,hgt,slm)
implicit none
character(8),intent(in):: cstation
character(8),intent(inout):: cprovider,csubprovider
integer(4),intent(in):: lun,itype
real(4),intent(in):: shgt0,hgt0,hgt,slm
if (cprovider(1:4)=='B7Hv' .or. cprovider(5:8)=='vH7B') then !this provider name comes with strange characters
cprovider(1:4)='B7Hv'
cprovider(5:8)=' '
endif
if (csubprovider(1:4)=='B7Hv' .or. csubprovider(5:8)=='vH7B') then
csubprovider(1:4)='B7Hv'
csubprovider(5:8)=' '
endif
write(lun,121) cstation,itype,cprovider,csubprovider,shgt0,hgt0,hgt,slm
!121 format(a8,4x,i3,4x,a8,4x,a8,4x,f10.3,2x,e10.3,2x,f10.3,2x,f7.3)
121 format(a8,4x,i3,4x,a8,4x,a8,4x,f11.3,2x,f11.3,2x,f10.3,2x,f7.3)
return
end
!***************************************************************
!***************************************************************