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 !*************************************************************** !***************************************************************