From 95f00dbd41cfed6b4cd062f62f0818450f65ddd6 Mon Sep 17 00:00:00 2001 From: Ricardo Todling Date: Mon, 30 Oct 2023 10:18:33 -0400 Subject: [PATCH 1/5] moved from ODS to be able to link to bfr lib and create bfr file --- src/Applications/SABER_App/CMakeLists.txt | 12 + src/Applications/SABER_App/m_pbutil.f | 241 +++++ src/Applications/SABER_App/m_saber.f | 986 ++++++++++++++++++ src/Applications/SABER_App/mlsh5bfrT.f | 544 ++++++++++ src/Applications/SABER_App/saber2ods.f90 | 330 ++++++ .../SABER_App/saber_prepbufr_table | 931 +++++++++++++++++ 6 files changed, 3044 insertions(+) create mode 100644 src/Applications/SABER_App/CMakeLists.txt create mode 100644 src/Applications/SABER_App/m_pbutil.f create mode 100644 src/Applications/SABER_App/m_saber.f create mode 100644 src/Applications/SABER_App/mlsh5bfrT.f create mode 100644 src/Applications/SABER_App/saber2ods.f90 create mode 100644 src/Applications/SABER_App/saber_prepbufr_table diff --git a/src/Applications/SABER_App/CMakeLists.txt b/src/Applications/SABER_App/CMakeLists.txt new file mode 100644 index 00000000..dc370196 --- /dev/null +++ b/src/Applications/SABER_App/CMakeLists.txt @@ -0,0 +1,12 @@ +# This is equivalent to FOPT=$(FOPT3) in GNU Make +if (CMAKE_Fortran_COMPILER_ID MATCHES Intel) + set (CMAKE_Fortran_FLAGS_RELEASE "${FOPT3} ${EXTENDED_SOURCE} ${BIG_ENDIAN} ${BYTERECLEN} ${FP_MODEL_STRICT} ${ALIGNCOM}") +endif () + +ecbuild_add_executable ( + TARGET saber2ods.x + SOURCES saber2ods.f90 m_saber.f m_pbutil.f + LIBS GMAO_ods GMAO_mpeu NCEP_bufr_r8i4 NCEP_w3_r8i4 NetCDF::NetCDF_Fortran) +# LIBS GMAO_ods GMAO_mpeu NetCDF::NetCDF_Fortran ) + + diff --git a/src/Applications/SABER_App/m_pbutil.f b/src/Applications/SABER_App/m_pbutil.f new file mode 100644 index 00000000..9b62b42f --- /dev/null +++ b/src/Applications/SABER_App/m_pbutil.f @@ -0,0 +1,241 @@ +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! NASA/GSFC, Global Modeling and Assimilation Office, Code 900.3 ! +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: m_pbutil --- utility routines for BUFR, PREPBUFR +! +! !INTERFACE: +! + + MODULE m_pbutil + +! !USES: + + use m_ioutil, only : luavail + implicit none + +! !DESCRIPTION: +! +! Utility routines for PREPBUFR that are shared by the PB writing +! modules - open and close the files +! +! +! !REVISION HISTORY: +! +! 16Apr2004 Meta Added i_bfr, r_bfr related definitions to handle +! calling BUFRLIB compiled with different options +! (specifically, -i8) than the module. +! 08Nov2004 Meta Copied from m_pbmin module +! +!EOP +!------------------------------------------------------------------------- + + integer, parameter :: i_bfr = 4 ! size of integer for bufrlib + integer, parameter :: r_bfr = 4 ! size of real for bufrlib + + integer ludx ! unit number for table file + integer(i_bfr) ludx_b ! unit number for table file + integer lu ! unit number for output file + integer(i_bfr) lu_b ! unit number for output file + + real(8) :: missing = 10.e10 + + real(r_bfr) pgm_code ! 'program code' to use for data + + CONTAINS + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! NASA/GSFC, Global Modeling and Assimilation Office, Code 900.3 ! +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: init_bufr --- open BUFR file and set up for writing +! +! !INTERFACE: + + subroutine init_bufr(outputfile, + & tablefile, isbufr, append, bfrunit, pcode) ! optional + +! !INPUT PARAMETERS + + character(len=*),intent(in) :: outputfile ! name of output BUFR file + character(len=*), optional, intent(in) :: tablefile ! BUFR table file + logical, optional, intent(in) :: isbufr ! BUFR table file indicator + logical, optional, intent(in) :: append ! append to prev. file if true + integer(i_bfr),optional :: bfrunit ! pre-opened BUFR file unit + ! number to read table from + real, optional, intent(in) :: pcode + +! !DESCRIPTION: +! +! Open user specified file, and set up for writing BUFR +! +! !REVISION HISTORY: +! +! 07Apr2004 Meta Initial code +! 14Jul2004 Meta Add code for using tables from pre-existing BUFR file +! 9Dec2004 Meta Now can send unit number of previously opened +! BUFR file to supply the BUFR table +! 8Nov2007 Meta Add option to append to existing file, will use +! BUFR table from that file if found. +! 14Nov2007 Meta Some refinements to 'append' and other options +! +!EOP +!------------------------------------------------------------------------- + + character(len=200) bufrtable + integer(i_bfr) idtlen + logical usebufr + logical apnfile, ex + character(len=8) io + + usebufr = .false. + apnfile = .false. + + if (present(tablefile)) then + bufrtable = tablefile + else + bufrtable="prepobs_prep.bufrtable" + endif + + if (present(isbufr)) then + usebufr = isbufr + endif + + if (present(append)) then + apnfile = append +! if true, inquire about output file. if not exist, set false +! IF true will use 'apn' when opening bufr file. + if (apnfile) then + inquire(file=outputfile,exist=ex) + if (.not. ex) then + print *,'File does not exist: ',outputfile + apnfile = .false. + endif + endif + endif + +! find unit numbers for files + lu = luavail() + lu_b = lu + io = 'OUT' + if (apnfile) then + open(unit=lu,file=outputfile,form='unformatted', + & action='readwrite') + else + open(unit=lu,file=outputfile,form='unformatted',action='write') + endif + + if (apnfile) then ! will use same bufr unit for bufr table + ludx_b = lu + io = 'APX' + usebufr = .false. + else if (present(bfrunit)) then + usebufr = .false. + ludx_b = bfrunit + else + ludx = luavail() + if ( usebufr ) then + open(unit=ludx,file=bufrtable,action='read', + & form='unformatted') + else + open(unit=ludx,file=bufrtable,action='read',form='formatted') + endif + ludx_b = ludx + endif + + idtlen = 10 + call datelen(idtlen) + +! if using table file for BUFR tables, open it + if (usebufr) call openbf(ludx_b,'IN ',ludx_b) + + call openbf(lu_b,io,ludx_b) + +! close input BUFR file used for tables, if opened + if (usebufr) then + call closbf(ludx_b) + else if ( .not. present(bfrunit) .and. .not. apnfile) then + close(ludx) + endif + + if (present(pcode)) then + pgm_code = pcode + endif + + return + + end subroutine init_bufr + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! NASA/GSFC, Global Modeling and Assimilation Office, Code 900.3 ! +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: end_bufr --- flush and close BUFR file +! +! !INTERFACE: + + subroutine end_bufr() + +! !DESCRIPTION: +! +! Close files opened by subroutine 'init_bufr' +! +! !REVISION HISTORY: +! +! 07Apr2004 Meta Initial code +! +!EOP +!------------------------------------------------------------------------- + +! close(ludx) + +! closbf will close and write last BUFR message, then close the file. + + call closbf(lu_b) + + return + + end subroutine end_bufr + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! NASA/GSFC, Global Modeling and Assimilation Office, Code 900.3 ! +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: touch_date --- write a date record to BUFR file +! +! !INTERFACE: + + subroutine touch_date(subset, idate) + +! !INPUT PARAMETERS + character(len=8),intent(in) :: subset + integer,intent(in) :: idate + +! !DESCRIPTION: +! +! Open and initialize a new BUFR message with a given date/time +! stamp. +! +! +! !REVISION HISTORY: +! +! 29Oct2004 Meta Initial code +! +!EOP +!------------------------------------------------------------------------- + + integer(i_bfr) ibdate + + ibdate = idate + + call openmg (lu_b, subset, ibdate) + + return + + end subroutine touch_date + + end module m_pbutil diff --git a/src/Applications/SABER_App/m_saber.f b/src/Applications/SABER_App/m_saber.f new file mode 100644 index 00000000..c57c919c --- /dev/null +++ b/src/Applications/SABER_App/m_saber.f @@ -0,0 +1,986 @@ +!------------------------------------------------------------------------- +! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! +!------------------------------------------------------------------------- +!BOP +! +! !MODULE: m_saber --- Reads SABER data and writes it into an ODS vector +! +! !INTERFACE: +! + + module m_saber + + use m_ods + use m_odsmeta, only: H_DESCEND, H_ASCEND + + implicit none + +! +! !PUBLIC MEMBER FUNCTIONS: +! + PUBLIC saber_get + +! +! !DESCRIPTION: +! \label{SABER:Mod} +! This module ingests SABER data and writes it into ODS vectors +! +! !REVISION HISTORY: +! +! 12Mar2003 T. King First crack. +! +!EOP +!------------------------------------------------------------------------- + +! Overloaded Interfaces +! --------------------- + Interface SABER_Get + module procedure SABER_Get1_ + module procedure SABER_GetM_ + end Interface + + integer, parameter :: std_levels = 400 + integer, parameter :: max_allevents = 2500 + real, dimension(std_levels,max_allevents) :: lat, lon + integer, dimension(std_levels,max_allevents) :: time, date + integer, dimension(max_allevents) :: tpAD + real, dimension(std_levels,max_allevents) :: pres, temp, + $ density, h2o + real, dimension(std_levels,max_allevents) :: pres_e, + $ temp_e, density_e, h2o_e + integer start_pt + + CONTAINS + +!------------------------------------------------------------------------- +! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: SABER_Get1_ --- Reads data from a single SABER file and returns +! an ODS vector. +! +! !INTERFACE: + + subroutine SABER_Get1_ ( version, fname, nymd, nhms, ods, rc) + implicit none + +! !INPUT PARAMETERS: +! + character(len=*), intent(in) :: version ! SABER version + character(len=*), intent(in) :: fname ! SABER file name + integer, intent(in) :: nymd ! year-month-day, e.g., 19990701 + integer, intent(in) :: nhms ! hour-min-sec, e.g., 120000 + +! !OUTPUT PARAMETERS: +! + + type(ods_vect), intent(out) :: ods ! ODS vector + + integer, intent(out) :: rc ! Error return code: + ! = 0 - all is well + +! !DESCRIPTION: +! \label{SABER:GetM} +! This routine reads data from 1 SABER HDF files, allocates the necessary +! memory for the ODS vector, and loads the data for the synoptic time +! (nymd,nhms). +! +! !REVISION HISTORY: +! +! 12Mar2003 T. King Initial code is conceptually based on that of the +! m_roms.90 module for reading in ODS files. +! +!EOP +!------------------------------------------------------------------------- + + integer :: s_julian,s_date ! Selected date and synoptic time + integer :: n,m,i,k,oc + integer :: min_bnd(2) + integer :: timediff,year,jan01,jul_day,doy,ksnum,iminutes + integer, parameter :: dist_tol = 0.001 + real :: minutes,ob_array(3) + logical :: levflag,skipflag,skipall + integer, external :: ODS_Julian + integer, external :: ODS_Caldat + +! Set meta data attributes + call SABER_meta_(ods%meta%kt_names,ods%meta%kt_units, + $ ods%meta%kx_names,ods%meta%kx_meta,ods%meta%qcx_names) + + rc=0 + start_pt=1 + + call readfile ( version, fname ) + + if(nhms.eq.000000)then + min_bnd(1)=-180 + min_bnd(2)=180 + elseif(nhms.eq.060000)then + min_bnd(1)=180 + min_bnd(2)=540 + elseif(nhms.eq.120000)then + min_bnd(1)=540 + min_bnd(2)=900 + elseif(nhms.eq.180000)then + min_bnd(1)=900 + min_bnd(2)=1260 + else + print *,'Synoptic time ',nhms,'Z is not a valid time.' + stop + endif + s_julian=ODS_Julian(nymd) + +! print *, 'Total number of events=',start_pt-1 + +! Begin writing to ODS vector. + + oc=1 + ksnum=1 + ! Cycle through the events. + do n=1,start_pt-1 + levflag=.false. ! This flag is activated when processing reaches + ! somewhere near the end of the "level" portion of + ! this input data array. This allows the program + ! to search for old unflushed data. + + skipflag=.false. ! This allows the processing to skip past all + ! unflushed values in the level portion of the + ! input data array. + + skipall=.false. ! This flag allows for the skipping over sets + ! of obs with impossible locations. + + ! Cycle through the levels. + do m=1,std_levels + + ! Find the end of the number of levels for which there are data. + if(abs(lat(m,n)).ge.dist_tol.and.abs(lon(m,n)).ge. + $ dist_tol.and.time(m,n).ne.0)then + + ! Use only data below 0.01 mb + if(pres(m,n).ge.0.01)then + + ! Because netcdf arrays were not flushed, removed junk + ! from then ends. + if(m.gt.320)then + levflag=.true. + timediff=time(m,n)-time(m-1,n) + else + timediff=0 + endif + + ! If the current observation time is not significantly + ! less than the previous time we continue onward, + ! otherwise we've hit unflushed data and it's time to + ! skip the rest of the array go to the next data event. + if(.not.skipflag.and.timediff.ge.-15000)then + +! Start to get the internal time information out of the file for comparison +! with what was specified in the argument list. + + ! This strips off the "doy" and gives you the year. + year=date(m,n)/1000 + + ! This gives you the doy. + doy=date(m,n)-year*1000 + + ! Get the date of Jan 1st of the current year + jan01=(year*10000)+101 + + ! Then we get the Julian day and add back on the doy + + jul_day=ODS_Julian(jan01)+doy-1 + ! Because minutes can be greater than 1440 in the + ! last file of a day, make the subtract 1440 from + ! these numbers and increment the julian day. + + ! Get time into minutes + minutes=real(time(m,n))/60000.0 + if(minutes.ge.1260)then + minutes=minutes-1440.0 + jul_day=jul_day+1 + endif + iminutes=anint(minutes) + + ! If the times in the file match our temporal search + ! criteria write them to the ods arrays. + if(jul_day.eq.s_julian.and.iminutes.ge.min_bnd(1). + $ and.iminutes.lt.min_bnd(2))then + + ! Obs types to be written to ods. + ! Do some quick quality checks on the data +! if(temp(m,n).lt.0.and.temp(m,n).gt.1000)then + ob_array(1)=temp(m,n) +! else +! ob_array(1)=1.0e+15 +! endif + + ob_array(2)=density(m,n) + ob_array(3)=h2o(m,n) + + ! Convert lon from 0 to 360 into -180 to 180 + if(lon(m,n).gt.180)then + lon(m,n)=lon(m,n)-360 + endif + + ! Do a quick range check of lat and lon + if(abs(lon(m,n)).gt.180)then + print*,'Longitude out of range',lon(m,n) + skipall=.true. + elseif(abs(lat(m,n)).gt.90)then + print*,'Latitude out of range',lat(m,n) + skipall=.true. + endif + + ! If location is possible, continue onward. + if(.not.skipall)then + + do k=1,3 + + ! If data are not out of range, write them + ! to the ods structure. + if(ob_array(k).gt.0)then + ods%data%lat(oc)=lat(m,n) + ods%data%lon(oc)=lon(m,n) + ods%data%lev(oc)=pres(m,n) + ods%data%xm(oc)=0.0 + ods%data%obs(oc)=ob_array(k) + ods%data%time(oc)=iminutes + ods%data%ks(oc)=ksnum + if(k.eq.1)then + ods%data%kt(oc)=8 + elseif(k.eq.2)then + ods%data%kt(oc)=43 + else + ods%data%kt(oc)=7 + endif + ods%data%kx(oc)=294 + ods%data%qcexcl(oc)=0 + select case (tpAD(n)) + case (0) + ods%data%qchist(oc)=H_ASCEND + case (1) + ods%data%qchist(oc)=H_DESCEND + case default + ods%data%qchist(oc)=0 + end select + oc=oc+1 + endif ! Good data to write to ods structure. + enddo ! Cycle through obs loop. + ksnum=ksnum+1 + endif ! Location check. + skipall=.false. + endif ! Meet time criteria. + else + skipflag=.true. + endif ! Skip over unflushed data. + endif ! Pressure greater than 0.01. + + endif ! Check current level for valid data. + enddo ! Reading level array. + if(.not.levflag)then + print*,"Warning: current array has less than 320 levels." + print*,"File may be incomplete." + endif + enddo ! Reading event array. + + if(oc.eq.1)then + rc=1 ! No data were found matching the requested time and date. + else + ods%data%nobs=oc-1 + endif + return + end subroutine SABER_Get1_ + + +!------------------------------------------------------------------------- +! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: SABER_GetM_ --- Reads data from a multiple SABER files and +! returns an ODS vector. +! +! !INTERFACE: + + subroutine SABER_GetM_ ( version, nfiles, fnames, nymd, nhms, + $ ods, rc) + implicit none + +! !INPUT PARAMETERS: +! + character(len=*), intent(in) :: version ! SABER version + integer, intent(in) :: nfiles ! number of input files + character(len=*), intent(in) :: fnames(nfiles) ! SABER file name + integer, intent(in) :: nymd ! year-month-day, e.g., 19990701 + integer, intent(in) :: nhms ! hour-min-sec, e.g., 120000 + +! !OUTPUT PARAMETERS: +! + + type(ods_vect), intent(out) :: ods ! ODS vector + + integer, intent(out) :: rc ! Error return code: + ! = 0 - all is well + +! !DESCRIPTION: +! \label{SABER:GetM} +! This routine reads data from 1 SABER HDF files, allocates the necessary +! memory for the ODS vector, and loads the data for the synoptic time +! (nymd,nhms). +! +! !REVISION HISTORY: +! +! 12Mar2003 T. King Initial code is conceptually based on that of the +! m_roms.90 module for reading in ODS files. +! +!EOP +!------------------------------------------------------------------------- + + character*255 fname + integer :: s_julian,s_date ! Selected date and synoptic time + integer :: n,m,i,k,oc + integer :: min_bnd(2) + integer :: timediff,year,jan01,jul_day,doy,ksnum,iminutes + integer, parameter :: dist_tol = 0.001 + real :: minutes,ob_array(3) + logical :: levflag,skipflag,skipall + integer, external :: ODS_Julian + integer, external :: ODS_Caldat + +! Set meta data attributes + call SABER_meta_(ods%meta%kt_names,ods%meta%kt_units, + $ ods%meta%kx_names,ods%meta%kx_meta,ods%meta%qcx_names) + + rc=0 + start_pt=1 + + do i=1,nfiles + fname=fnames(i) + call readfile ( version, fname ) + enddo + + if(nhms.eq.000000)then + min_bnd(1)=-180 + min_bnd(2)=180 + elseif(nhms.eq.060000)then + min_bnd(1)=180 + min_bnd(2)=540 + elseif(nhms.eq.120000)then + min_bnd(1)=540 + min_bnd(2)=900 + elseif(nhms.eq.180000)then + min_bnd(1)=900 + min_bnd(2)=1260 + else + print *,'Synoptic time ',nhms,'Z is not a valid time.' + stop + endif + s_julian=ODS_Julian(nymd) + +! print *, 'Total number of events=',start_pt-1 + +! Begin writing to ODS vector. + + oc=1 + ksnum=1 + ! Cycle through the events. + do n=1,start_pt-1 + levflag=.false. ! This flag is activated when processing reaches + ! somewhere near the end of the "level" portion of + ! this input data array. This allows the program + ! to search for old unflushed data. + + skipflag=.false. ! This allows the processing to skip past all + ! unflushed values in the level portion of the + ! input data array. + + skipall=.false. ! This flag allows for the skipping over sets + ! of obs with impossible locations. + + ! Cycle through the levels. + do m=1,std_levels + + ! Find the end of the number of levels for which there are data. + if(abs(lat(m,n)).ge.dist_tol.and.abs(lon(m,n)).ge. + $ dist_tol.and.time(m,n).ne.0)then + + ! Use only data below 0.01 mb + if(pres(m,n).ge.0.01)then + + ! Because netcdf arrays were not flushed, removed junk + ! from then ends. + if(m.gt.320)then + levflag=.true. + timediff=time(m,n)-time(m-1,n) + else + timediff=0 + endif + + ! If the current observation time is not significantly + ! less than the previous time we continue onward, + ! otherwise we've hit unflushed data and it's time to + ! skip the rest of the array go to the next data event. + if(.not.skipflag.and.timediff.ge.-15000)then + +! Start to get the internal time information out of the file for comparison +! with what was specified in the argument list. + + ! This strips off the "doy" and gives you the year. + year=date(m,n)/1000 + + ! This gives you the doy. + doy=date(m,n)-year*1000 + + ! Get the date of Jan 1st of the current year + jan01=(year*10000)+101 + + ! Then we get the Julian day and add back on the doy + + jul_day=ODS_Julian(jan01)+doy-1 + ! Because minutes can be greater than 1440 in the + ! last file of a day, make the subtract 1440 from + ! these numbers and increment the julian day. + + ! Get time into minutes + minutes=real(time(m,n))/60000.0 + if(minutes.ge.1260)then + minutes=minutes-1440.0 + jul_day=jul_day+1 + endif + iminutes=anint(minutes) + + ! If the times in the file match our temporal search + ! criteria write them to the ods arrays. + if(jul_day.eq.s_julian.and.iminutes.ge.min_bnd(1). + $ and.iminutes.lt.min_bnd(2))then + + ! Obs types to be written to ods. + ! Do some quick quality checks on the data +! if(temp(m,n).lt.0.and.temp(m,n).gt.1000)then + ob_array(1)=temp(m,n) +! else +! ob_array(1)=1.0e+15 +! endif + + ob_array(2)=density(m,n) + ob_array(3)=h2o(m,n) + + ! Convert lon from 0 to 360 into -180 to 180 + if(lon(m,n).gt.180)then + lon(m,n)=lon(m,n)-360 + endif + + ! Do a quick range check of lat and lon + if(abs(lon(m,n)).gt.180)then + print*,'Longitude out of range',lon(m,n) + skipall=.true. + elseif(abs(lat(m,n)).gt.90)then + print*,'Latitude out of range',lat(m,n) + skipall=.true. + endif + + ! If location is possible, continue onward. + if(.not.skipall)then + + do k=1,3 + + ! If data are not out of range, write them + ! to the ods structure. + if(ob_array(k).gt.0)then + ods%data%lat(oc)=lat(m,n) + ods%data%lon(oc)=lon(m,n) + ods%data%lev(oc)=pres(m,n) + ods%data%xm(oc)=0.0 + ods%data%obs(oc)=ob_array(k) + ods%data%time(oc)=iminutes + ods%data%ks(oc)=ksnum + if(k.eq.1)then + ods%data%kt(oc)=8 + elseif(k.eq.2)then + ods%data%kt(oc)=43 + else + ods%data%kt(oc)=7 + endif + ods%data%kx(oc)=294 + ods%data%qcexcl(oc)=0 + ods%data%qchist(oc)=0 + oc=oc+1 + endif ! Good data to write to ods structure. + enddo ! Cycle through obs loop. + ksnum=ksnum+1 + endif ! Location check. + skipall=.false. + endif ! Meet time criteria. + else + skipflag=.true. + endif ! Skip over unflushed data. + endif ! Pressure greater than 0.01. + + endif ! Check current level for valid data. + enddo ! Reading level array. + if(.not.levflag)then + print*,"Warning: current array has less than 320 levels." + print*,"File may be incomplete." + endif + enddo ! Reading event array. + + if(oc.eq.1)then + rc=1 ! No data were found matching the requested time and date. + else + ods%data%nobs=oc-1 + endif + return + end subroutine SABER_GetM_ + + + subroutine readfile ( version, fname ) + character(len=*), intent(in) :: version + character(len=*), intent(in) :: fname + select case (trim(version)) + case ("1.0") + call read_v1_(fname) + case ("2.0") + call read_v2_(fname) + case default + call read_v1_(fname) + end select + + endsubroutine readfile + + subroutine read_v1_ ( fname ) + implicit none + include 'netcdf.inc' + +! +! !INPUT PARAMETERS: +! + + character(len=*) fname ! File name + +! Variables for ncopn + + integer fid + integer rc + +! Variables for ncinq + + integer ndims, nvars, ngatts, dimid + +! Variables for ncdid + + integer event_id, n_events, date_id + integer alt_id, n_levels + integer varid + character*100 varname + character*100 dimname + integer dimsize + + integer vartype, nvdims, vdims(MAXVDIMS), nvatts + +! Variables for data + + integer tdate + real buf (400,100) + integer ibuf (400,100) + integer start1D, start2D(2), edge2D(2) + +! Other vars + + integer i,j,end_pt + +! call ncpopt(NCVERBOS) + + fid = ncopn (fname, NCNOWRIT, rc) + call ncinq (fid, ndims, nvars, ngatts, dimid, rc) + event_id = ncdid (fid, "event", rc) + + alt_id = ncdid (fid, "altitude", rc) + + call ncdinq (fid, event_id, varname, n_events, rc) + end_pt = start_pt + n_events - 1 + if (end_pt .GT. max_allevents) then + print *, end_pt,' events is too many. Increase + $ size of max_allevents.' + stop + endif + + call ncdinq (fid, alt_id, varname, n_levels, rc) + +! Get date + + date_id = ncvid (fid, "date", rc) + call ncvgt (fid,date_id,1,1,tdate,rc) + if ( rc .ne. 0 ) then + print *, 'get date rc=',rc + endif +! print *, TRIM(fname), tdate +! print *, 'Number of events =',n_events +! print *, 'Number of levels=',n_levels + date(:,:)=tdate + + +! Set hyperslab dimensions + + start2D(1)=1 + start2D(2)=1 + edge2D(1)=n_levels + edge2D(2)=n_events + +! Get pressure & error + + varid = ncvid (fid, "pressure", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get pres rc=',rc + endif + pres(:,start_pt:end_pt)=buf(:,1:n_events) + + varid = ncvid (fid, "pressure_error", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get pres_e rc=',rc + endif + pres_e(:,start_pt:end_pt)=buf(:,1:n_events) + +! Get temperature & error + + varid = ncvid (fid, "ktemp", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get temp rc=',rc + endif + temp(:,start_pt:end_pt)=buf(:,1:n_events) + + varid = ncvid (fid, "ktemp_error", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get temp_e rc=',rc + endif + temp_e(:,start_pt:end_pt)=buf(:,1:n_events) + +! Get density and error + + varid = ncvid (fid, "density", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get density rc=',rc + endif + density(:,start_pt:end_pt)=buf(:,1:n_events) + + varid = ncvid (fid, "density_error", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get density_e rc=',rc + endif + density_e(:,start_pt:end_pt)=buf(:,1:n_events) + +! Get h2o and error + + varid = ncvid (fid, "H2O", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get h2o rc=',rc + endif + h2o(:,start_pt:end_pt)=buf(:,1:n_events) + + varid = ncvid (fid, "H2O_error", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get h2o_e rc=',rc + endif + h2o_e(:,start_pt:end_pt)=buf(:,1:n_events) + +! Get latitude + + varid = ncvid (fid, "tplatitude", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get lat rc=',rc + endif + lat(:,start_pt:end_pt)=buf(:,1:n_events) + +! Get longitude + + varid = ncvid (fid, "tplongitude", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get lon rc=',rc + endif + lon(:,start_pt:end_pt)=buf(:,1:n_events) + +! Get time + + varid = ncvid (fid, "time", rc) + call ncvgt (fid,varid,start2D,edge2D,ibuf,rc) + if ( rc .ne. 0 ) then + print *, 'get time rc=',rc + endif + time(:,start_pt:end_pt)=ibuf(:,1:n_events) + + call ncclos (fid, rc) + start_pt = start_pt + n_events + + return + end subroutine read_v1_ + + subroutine read_v2_ ( fname ) + implicit none + include 'netcdf.inc' + +! +! !INPUT PARAMETERS: +! + + character(len=*) fname ! File name + +! Variables for ncopn + + integer fid + integer rc + +! Variables for ncinq + + integer ndims, nvars, ngatts, dimid + +! Variables for ncdid + + integer event_id, n_events, date_id + integer alt_id, n_levels + integer varid + character*100 varname + character*100 dimname + integer dimsize + + integer vartype, nvdims, vdims(MAXVDIMS), nvatts + +! Variables for data + + integer tdate + real buf (400,100) + integer ibuf (400,100) + integer*2 cbuf (1,100) + integer start1D, start2D(2), edge2D(2) + +! Other vars + + integer i,j,end_pt + +! call ncpopt(NCVERBOS) + + fid = ncopn (fname, NCNOWRIT, rc) + call ncinq (fid, ndims, nvars, ngatts, dimid, rc) + event_id = ncdid (fid, "event", rc) + + alt_id = ncdid (fid, "altitude", rc) + + call ncdinq (fid, event_id, varname, n_events, rc) + end_pt = start_pt + n_events - 1 + if (end_pt .GT. max_allevents) then + print *, end_pt,' events is too many. Increase + $ size of max_allevents.' + stop + endif + + call ncdinq (fid, alt_id, varname, n_levels, rc) + +! Get date + + date_id = ncvid (fid, "date", rc) + call ncvgt (fid,date_id,1,1,tdate,rc) + if ( rc .ne. 0 ) then + print *, 'get date rc=',rc + endif +! print *, TRIM(fname), tdate +! print *, 'Number of events =',n_events +! print *, 'Number of levels=',n_levels + date(:,:)=tdate + + +! Set hyperslab dimensions + + start2D(1)=1 + start2D(2)=1 + edge2D(1)=n_levels + edge2D(2)=n_events + +! Get ascending/descending info + + varid = ncvid (fid, "tpAD", rc) + call ncvgt (fid,varid,start2D(2),edge2D(2),cbuf,rc) + if ( rc .ne. 0 ) then + print *, 'get tpAD rc=',rc + endif + tpAD(start_pt:end_pt)=cbuf(1,1:n_events) + +! Get pressure & error + + varid = ncvid (fid, "pressure", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get pres rc=',rc + endif + pres(:,start_pt:end_pt)=buf(:,1:n_events) + +!_RT varid = ncvid (fid, "pressure_error", rc) +!_RT call ncvgt (fid,varid,start2D,edge2D,buf,rc) +!_RT if ( rc .ne. 0 ) then +!_RT print *, 'get pres_e rc=',rc +!_RT endif +!_RT pres_e(:,start_pt:end_pt)=buf(:,1:n_events) + pres_e(:,start_pt:end_pt)=99999. + +! Get temperature & error + + varid = ncvid (fid, "ktemp", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get temp rc=',rc + endif + temp(:,start_pt:end_pt)=buf(:,1:n_events) + +!_RT varid = ncvid (fid, "ktemp_error", rc) +!_RT call ncvgt (fid,varid,start2D,edge2D,buf,rc) +!_RT if ( rc .ne. 0 ) then +!_RT print *, 'get temp_e rc=',rc +!_RT endif +!_RT temp_e(:,start_pt:end_pt)=buf(:,1:n_events) + temp_e(:,start_pt:end_pt)=1.0 + +! Get density and error + + varid = ncvid (fid, "density", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get density rc=',rc + endif + density(:,start_pt:end_pt)=buf(:,1:n_events) + +!_RT varid = ncvid (fid, "density_error", rc) +!_RT call ncvgt (fid,varid,start2D,edge2D,buf,rc) +!_RT if ( rc .ne. 0 ) then +!_RT print *, 'get density_e rc=',rc +!_RT endif +!_RT density_e(:,start_pt:end_pt)=buf(:,1:n_events) + density_e(:,start_pt:end_pt)=1.e15 + +! Get h2o and error + + varid = ncvid (fid, "H2O", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get h2o rc=',rc + endif + h2o(:,start_pt:end_pt)=buf(:,1:n_events) + +!_RT varid = ncvid (fid, "H2O_error", rc) +!_RT call ncvgt (fid,varid,start2D,edge2D,buf,rc) +!_RT if ( rc .ne. 0 ) then +!_RT print *, 'get h2o_e rc=',rc +!_RT endif +!_RT h2o_e(:,start_pt:end_pt)=buf(:,1:n_events) + h2o_e(:,start_pt:end_pt)=1.e15 + +! Get latitude + + varid = ncvid (fid, "tplatitude", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get lat rc=',rc + endif + lat(:,start_pt:end_pt)=buf(:,1:n_events) + +! Get longitude + + varid = ncvid (fid, "tplongitude", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get lon rc=',rc + endif + lon(:,start_pt:end_pt)=buf(:,1:n_events) + +! Get time + + varid = ncvid (fid, "time", rc) + call ncvgt (fid,varid,start2D,edge2D,ibuf,rc) + if ( rc .ne. 0 ) then + print *, 'get time rc=',rc + endif + time(:,start_pt:end_pt)=ibuf(:,1:n_events) + + call ncclos (fid, rc) + start_pt = start_pt + n_events + + return + end subroutine read_v2_ + + subroutine SABER_meta_(ktnames,ktunits,kxnames,kxmeta,qcxnames) + + implicit none + + character (len=*), intent(out), dimension(:) :: ktnames + character (len=*), intent(out), dimension(:) :: ktunits + character (len=*), intent(out), dimension(:) :: kxnames + character (len=*), intent(out), dimension(:) :: kxmeta + character (len=*), intent(out), dimension(:) :: qcxnames + + qcxnames = ' ' + kxnames = ' ' + kxmeta = ' ' + ktnames = ' ' + ktunits = ' ' + + kxnames(294)= + $'SABER - Sounding of the Atmosphere Broadband Emission Radiometer' + + ktnames(7)='Upper-air water vapor mixing ratio' + ktunits(7)='g/kg' + ktnames(8)='Upper-air temperature' + ktunits(8)='Kelvin' + ktnames(43)='Density of atmosphere' + ktunits(43)='1/cm*3' + + qcxnames(1)='clear' + qcxnames(2)='unspecified preprocessing flag' + qcxnames(3)='impossible location' + qcxnames(4)='gcm deep underground' + qcxnames(5)='observation value undefined' + qcxnames(6)='forecast value undefined' + qcxnames(7)='observation level too high' + qcxnames(8)='passive data type' + qcxnames(9)='outside active time window' + qcxnames(10)='not an analysis variable' + qcxnames(11)='NCEP CQC bad observation' + qcxnames(12)='NCEP PREPDATA bad observation' + qcxnames(13)='NCEP CQC bad pressure' + qcxnames(14)='NCEP PREPDATA bad pressure' + qcxnames(15)='DAO range check failed' + qcxnames(16)='DAO duplicate obs. (>1 in 6 hr)' + qcxnames(17)='DAO failed hydrostatic check' + qcxnames(18)='SQC: buddy check' + qcxnames(19)='SQC: wind check' + qcxnames(20)='SQC: invalid error stats' + qcxnames(21)='SQC: profile check' + qcxnames(22)='SQC: background check' + qcxnames(23)='SQC: obsolete' + qcxnames(24)='SQC: obsolete' + qcxnames(25)='SQC: obsolete' + qcxnames(26)='SQC: obsolete' + qcxnames(27)='SQC: obsolete' + qcxnames(28)='invalid qsat' + qcxnames(29)='moisture from bad temp' + qcxnames(30)='thinned' + qcxnames(31)='unphysical value' + qcxnames(32)='Red list' + qcxnames(33)='obs could not be simulated' + qcxnames(34)='excluded by PSAS' + + return + end subroutine SABER_meta_ + + + end module m_saber + + + diff --git a/src/Applications/SABER_App/mlsh5bfrT.f b/src/Applications/SABER_App/mlsh5bfrT.f new file mode 100644 index 00000000..7c6d0022 --- /dev/null +++ b/src/Applications/SABER_App/mlsh5bfrT.f @@ -0,0 +1,544 @@ + program mlsh5bfrT +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! NASA/GSFC, Global Modeling and Assimilation Office, Code 610.1 ! +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: mlsh5bfrT: write MLS HDF5 temperature in prepBUFR format +! +! !INTERFACE: +! +! Usage: mlsh5txtT.x [-f] [-v] [-d yyyymmdd] [-p prefix] h5filename +! +! -f optional: force write regardless of screening +! -v optional: flag for verbose output +! -d yyyymmdd optional: date to process +! -p prefix optional: filename prefix (default: MLSt) +! h5filename name of input HDF5 file +! +! Output file name has format: (prefix).yyyymmdd.tHHz.blk +! +! !USES: +! + use hdf5 + use readmlsh5 + use timefix_mod + use m_pbutil + + implicit none + +! +! !DESCRIPTION: +! +! Read MLS HDF5 temperature data files and write out text format. +! Input files contain one day of retrievals, from +! 00:00:00 to 23:59:59.99 UTC. Output files are separated into 6-hr +! segments centered on 00, 05, 12, 18. For the 00UTC data, the program +! will append to a previously existing text file containing the retrievals +! after 21UTC from the previous day. +! +! If executed with the '-d' flag, the program tries to read data from +! the specified date from the input file. Otherwise the program uses +! date information within the file to determine the date to use. +! +! Screening QC based on info from v2.2 Quality document. +! +! !REVISION HISTORY: +! 19 Oct 2006 Meta Original ozone conversion routine +! 9 Jan 2007 Meta Adapted program for temperature data +! 8 Nov 2007 Meta Modify for v2.2 data files, changes from +! ozone processing (-v, -f and time handling) +! add prologues +! 15 Nov 2007 Meta Text routine modifed to write prepBUFR, +! including modified BUFR table for EOSMLS +! 07 Feb 2008 Meta Added screening out of pressure levels above +! 'plvmin' - obs get QM of 9 (if not already bad) +! 19 Feb 2008 Meta Add command line flag -P to set top level for +! 'plvmin' and set default 'plvmin' to zero +! 19 Apr 2012 JJJ Read MLS v3 temperature, and +! set typ = 315. +! 11 Jun 2012 JJJ Modified date determination ( tcheck ), +! see JJJ x1. +! 12 Jun 2012 JJJ Add screening out of pressure levels below (larger than) +! 'plvmax' - obs get QM of 9 (if not already bad) +! 03 Sep 2012 JJJ reset the type # (315 => 311), because 315 is set for +! AMSU-A brightness temperature. +! 25 Apr 2013 j.jin flag profiles has zero procision (<0.1) in addition to negative +! precisions. These zero errors make GSI crash. +! +!EOP +!----------------------------------------------------------------------- + + + character*250 filename,argv + character*20 wanted + character*50 prefix, plvstr + character*80 outfile + character*8 ymdstr + + integer(HID_T) fid ! file identifier + + integer, parameter :: maxtimes = 10000 + integer, parameter :: maxlevs = 100 + integer, parameter :: lvmin = 8 ! 261 mb level + integer, parameter :: lvmax = 49 ! 49 is 0.001 mb + + integer nlevs ! number of levels + integer ntimes ! number of times + + integer ier, jer ! error return code + + real, parameter :: plvmindef = 0.0 + real, parameter :: plvmaxdef = 5.0 + real plvmin, plvmax + +! variables for hdf5 read + real(8) time(maxtimes), tcheck + real latitude(maxtimes) + real longitude(maxtimes) + real quality(maxtimes) + real convergence(maxtimes) + real pres(maxlevs) + real precision(maxlevs,maxtimes) + real value(maxlevs,maxtimes) + integer istatus(maxtimes) + +! variable for BUFR file writing + real pob(42),tob(42),tqm(42),tprec(42), qmt, qmret + real rstat, xob, yob, dhr, typ + integer ib, idate + character*8 stnid, subset + + integer jtm, llv +! integer mflg + real tk + real std + real sec + + integer iyr,mon,iday, itoday(8), inow(8) + integer isthr, ihr + integer isnd + integer id1, id2 + real rinc(5) + + integer nrec(5),nr + + real(8) tai93_0z, hrmax, hrcnt, dayend, dt + + integer iout ! output unit number + character*89 fmt + + integer argc, iargc, iarg, i + logical ffound + + logical verbose, notforce, ex + + nrec = 0 + wanted = 'Temperature' ! name of the swath to read in + prefix = 'MLSt.' ! default output filename prefix + iout = 10 + fmt='(i5,4i3,f6.2,i7,i5,f10.4,f11.4,f16.7,i7,i5,g16.7,g15.7,f6.3)' + subset = 'EOSMLS' + !typ = 304. ! 304 as set of o3lev. JJJ, 4/19/12. + !typ = 311. ! MLS temperature. JJJ x0 4/19/2012. + typ = 311. ! Changed to 304, 4/24/2013. + call datelen(10) + + itoday = 0 + ffound = .false. + verbose = .false. + notforce = .true. + plvmin = plvmindef + plvmax = plvmaxdef + argc = iargc() + if (argc < 1 .or. argc > 6) then + call usage() + endif + iarg = 0 + do while (iarg < argc) + iarg = iarg + 1 + call getarg( iarg, argv ) + if (index(argv,'-d') > 0) then + if ( iarg+1 > argc ) call usage() + iarg = iarg + 1 + call getarg( iarg,ymdstr ) + read(ymdstr,'(i4,i2,i2)',iostat=ier) iyr, mon, iday + itoday(1) = iyr + itoday(2) = mon + itoday(3) = iday + else if (index( argv, '-p') > 0) then + if ( iarg+1 > argc ) call usage() + iarg = iarg + 1 + call getarg( iarg, prefix ) + else if (index( argv, '-P') > 0) then + if ( iarg+1 > argc ) call usage() + iarg = iarg + 1 + call getarg( iarg, plvstr ) + read(plvstr,*) plvmin + else if (index(argv, '-v') > 0) then + verbose = .true. + else if (index(argv, '-f') > 0) then + notforce = .false. + else + if (ffound) call usage() + filename = argv + ffound = .true. + endif + end do + + if ( .not. ffound ) call usage() + +! initialize HDF interface + call h5open_f(ier) + if (ier .lt. 0) then + print *,'Problem initializing hdf5.' + stop + endif + +! open the HDF5 file + + call h5fopen_f(filename,H5F_ACC_RDONLY_F,fid,ier) + + if (ier .ne. 0) then + print *,'error reading file ',trim(filename) + stop + else + print *,'Successfully opened file ',trim(filename) + endif + + call getfilespecs(fid,iyr,mon,iday,tai93_0z,ier) + + if (ier .eq. 0 .and. tai93_0z .gt. 0.1) then +! fill in year, month, day and check if they match (any) requested date + print *,'Filename: ',trim(filename) + print *,'Year,month,day: ',iyr,mon,iday + print *,'TAI at 0z: ',tai93_0z + if (itoday(1) == 0) then + itoday(1) = iyr + itoday(2) = mon + itoday(3) = iday + else if ( itoday(1) /= iyr .or. itoday(2) /= mon + & .or. itoday(3) /= iday) then + print *,'Requested date: ',itoday(1:3) + print *,'File date: ',iyr,mon,iday + print *,'Date mismatch, stopping program.' + call h5fclose_f(fid,jer) + call h5close_f(jer) + stop + endif + else if (itoday(1) /=0 ) then + call ymd2tai(itoday(1),itoday(2),itoday(3),0,0,0.0, + & tai93_0z,ier) + print *,'Filename: ',trim(filename) + print *,'Requested Year,month,day: ',(itoday(i),i=1,3) + print *,'Requested TAI at 0z: ',tai93_0z + endif + +! if (ier .ne. 0) stop + + call rdmlsh5(fid, wanted, maxtimes, maxlevs, time, + & latitude, longitude, quality, convergence, pres, + & precision, value, istatus, ntimes, nlevs, ier) + + call h5fclose_f(fid,ier) + + call h5close_f(ier) + + if (ier /= 0) then ! problem reading the data + print *,'error reading data from file ',trim(filename) + stop + else + print *,'Successful read of obs data from ',trim(filename) + endif + + if (itoday(1) == 0 ) then ! metadata missing, date from data + ! JJJ x1, 11 JUN 2012 + ! Because a few "time" data are set to be -999.99 (e.g., 2004d228), + ! it produces wrong time to average the fist and the last values. + ! Now use the mean of the huge and the tine values (both are + ! positive values). + ! + ! tcheck = 0.5*(time(1)+time(ntimes)) + tcheck = 0.5*(huge(time)+tiny(time)) + ! JJJ x1 end. + + if (verbose) print *,'Check TAI time ',tcheck + call tai2ymd(tcheck,iyr,mon,iday,id1,id2,sec,ier) + if (verbose) print *,'Year,month,day: ',iyr,mon,iday + call ymd2tai(iyr,mon,iday,0,0,0.0,tai93_0z,ier) + itoday(1) = iyr + itoday(2) = mon + itoday(3) = iday + endif + + dayend = tai93_0z+86400. + isthr = 1 + isnd = 0 + + do ihr = 0,24,6 + + nr = ihr/6+1 + print *,'Start processing ihr = ', ihr + if (ihr .lt. 24) then + write(outfile,'(a,i4.4,i2.2,i2.2,''.t'',i2.2,''z.blk'')') + & trim(prefix),itoday(1:3),ihr + idate = (((itoday(1)*100)+itoday(2))*100+itoday(3))*100+ihr + else + call w3movdat( (/1.,0.,0.,0.,0./),itoday,inow) + write(outfile,'(a,i4.4,i2.2,i2.2,''.t'',i2.2,''z.blk'')') + & trim(prefix),inow(1),inow(2),inow(3),0 + idate = (((inow(1)*100)+inow(2))*100+inow(3))*100 + endif + + +c$$$ if (ihr .eq. 0) then +c$$$ open(iout, file=outfile, form='formatted', +c$$$ & position='append') +c$$$ else +c$$$ open(iout, file=outfile, form='formatted') +c$$$ endif + + if (ihr .eq. 0) then + inquire(file=outfile,exist=ex) + if (ex) then + print *,'Append to output file ',trim(outfile) + call init_bufr(outfile,append=.true.) + else + print *,'Create new output file ',trim(outfile) + call init_bufr(outfile,tablefile='mls_prepbufr_table', + & append=.false.) + endif + else + print *,'Create new output file ',trim(outfile) + call init_bufr(outfile,tablefile='mls_prepbufr_table') + endif + + hrmax = (ihr + 3) * 3600. + hrcnt = ihr * 3600. + tai93_0z + +! Process data for this time window, exit when end time is reached. + + do jtm = isthr, ntimes + + if (time(jtm) .lt. tai93_0z .or. + & time(jtm) .gt. dayend) then + print *,'Skip invalid time for ',jtm, time(jtm) + cycle + endif + + dt = time(jtm) - tai93_0z + if (dt .gt. hrmax) then + isthr = jtm + print *,'Start time ',ihr+6,' at index ',isthr + call end_bufr() + exit + endif + + rinc(4) = dt + call w3movdat(rinc, itoday, inow) + sec = inow(7) + 1.e-3 * inow(8) + qmret = 0.0 + +! skip retrievals where istatus is an odd number + if (mod(istatus(jtm),2) .ne. 0) then + if (notforce) then + cycle + else + qmret = 13. + endif + endif + rstat = istatus(jtm) + +! Quality field: quality < 0.65 do not use +! + if (quality(jtm) .lt. 0.65 ) then + if (notforce) then + cycle + else + qmret = 14 + endif + endif +! mflg = int(quality(jtm) * 100.) + +! Convergence field: Only use if convergence < 1.2 + + if ( convergence(jtm) .ge. 1.2) then + if (notforce) then + cycle + else + qmret = 12. + endif + endif + + isnd = isnd + 1 + + ib = 0 + +! cycle through the levels of this retrieval + do llv = lvmin, lvmax + +! do not use data for pressure > or = 147 hPa if status is 32 (due to cloud) + if ( llv .le. 10 ) then + if (jtm .le. ntimes-1 ) then + if ( istatus(jtm+1) .eq. 32 ) then + if (notforce) then + cycle + else + qmret = 13. + endif + endif + endif + if (jtm .le. ntimes-2 ) then + if ( istatus(jtm+2) .eq. 32 ) then + if (notforce) then + cycle + else + qmret = 13. + endif + endif + endif + endif + +c$$$ add here any profile based screening (low level screening, for instance) +c$$$ + qmt = qmret + +! mark high levels (p plvmax .and. qmret .eq. 0.) then + qmt = 9. + endif + + if (precision(llv,jtm) .lt. 0.1) then + print *,'Neg precision at lev ',llv, + & ' profile ',jtm + qmt = 15. + if (notforce) cycle + endif + + tk = value(llv, jtm) + std = precision(llv,jtm) + +c$$$ write(iout,fmt) inow(1:3),inow(5:6),sec,isnd,llv, +c$$$ & latitude(jtm),longitude(jtm),tk,istatus(jtm), +c$$$ & mflg,std,pres(llv) + + ib = ib + 1 + pob(ib) = pres(llv) + tob(ib) = tk - 273.15 + tprec(ib) = std + if(tprec(ib) < 0.1) write(*,*) llv,ib,pres(llv),tprec(ib) + tqm(ib) = max(qmt, 2.0) + + + end do ! loop over levels of retrieval + + if (ib .gt. 0) then + + dhr = (time(jtm)-hrcnt) / 3600. + yob = latitude(jtm) + xob = longitude(jtm) + if (xob .lt. 0.) xob = xob + 360. + + write(stnid,'(''ML'',i6.6)') isnd + nrec(nr) = nrec(nr) + 1 + + call write_bfr(stnid, xob, yob, dhr, typ, ib, + & rstat, quality(jtm), convergence(jtm), + & pob, tob, tqm, tprec, subset, idate) + + endif + + end do ! loop over times in file + + end do + + call end_bufr() + + print *,'Total obs at synoptic times: ',nrec + + stop + contains + + subroutine usage() + print *, 'Usage: mlsh5bfrT.x [-f] [-d yyyymmdd] [-p prefix] \ ' + print *, ' h5filename ' + print *, ' -f optional: force write w/o quality chk ' + print *, ' -d yyyymmdd optional: date to process ' + print *, ' -p prefix optional: filename prefix ' + print *, ' h5filename name of input HDF5 file ' + stop + + end subroutine usage + + subroutine write_bfr(stnid, xob, yob, dhr, typ, ib, + & rstat, qual, conv, + & pob, tob, tqm, tprec, subset, idate) + + integer idate, ib, l + character(len=8) stnid, subset + real xob, yob, dhr, typ, rstat, qual, conv + real pob(ib), tob(ib), tqm(ib), tprec(ib) + + real(8), dimension(8) :: hdr ! observation header + real(8) :: rid + real(8), dimension(8,255) :: pobs, tobs + + integer, parameter :: MXBLVL = 255 ! max no. of report levels allowed + integer(i_bfr), parameter :: iarr = 8 ! size of bfr arrays + integer(i_bfr), parameter :: i1 = 1 ! single level + integer(i_bfr), parameter :: ilv = MXBLVL ! multiple level + integer(i_bfr) ibdate + integer(i_bfr) ilevs + integer(i_bfr) iret + + character(len=40) hdstr, pobstr, tobstr + data hdstr /'SID XOB YOB DHR TYP MLST MLSQ MLSC'/ + data pobstr /'POB PQM PPC PRC CAT'/ + data tobstr /'TOB TQM TPC TRC MLSPT'/ + + hdr(1) = transfer(stnid, rid) + hdr(2) = xob + hdr(3) = yob + hdr(4) = dhr + hdr(5) = typ + hdr(6) = rstat + hdr(7) = qual + hdr(8) = conv + + pobs = missing + tobs = missing + + do l = 1,ib + pobs(1,l) = pob(l) + pobs(2,l) = tqm(l) ! use same as T + pobs(3,l) = 1. + pobs(4,l) = 1. + pobs(5,l) = 2. + tobs(1,l) = tob(l) + tobs(2,l) = tqm(l) + tobs(3,l) = 1. + tobs(4,l) = 1. + tobs(5,l) = tprec(l) + end do + + ibdate = idate + ilevs = ib + + call openmb(lu_b, subset, ibdate) + call ufbint(lu_b, hdr, iarr, i1 , iret, hdstr) + call ufbint(lu_b, pobs, iarr, ilevs, iret, pobstr) + call ufbint(lu_b, tobs, iarr, ilevs, iret, tobstr) + + call writsb(lu_b) + + return + + + end subroutine write_bfr + + + end program mlsh5bfrT + + diff --git a/src/Applications/SABER_App/saber2ods.f90 b/src/Applications/SABER_App/saber2ods.f90 new file mode 100644 index 00000000..57a157bb --- /dev/null +++ b/src/Applications/SABER_App/saber2ods.f90 @@ -0,0 +1,330 @@ +!------------------------------------------------------------------------- +! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! +!------------------------------------------------------------------------- +!BOP +! +! !PROGRAM: saber2ods.x --- Reads a SABER data files and writes ODS files +! +! !DESCRIPTION: +! This module ingests SABER data files and writes ODS files. It uses +! the m_saber.f module. +! +! !USAGE: saber2ods.x [-o odstmpl] saber_ncfile(s) +! +! where: odstmpl template for ODS output file(s) +! saber_ncfile(s) Input netcdf SABER file(s)" +! +! +! !REVISION HISTORY: +! +! 18Mar2003 T. King First crack. +! 29Oct2023 R. Todling - Add support for v2.0(7) - not too different +! than original; indeed original code should +! work for this except that errors are not +! available. +! - Pulled code into own directory (out of ODS) +! (need to link to bufr lib) +! - Output ODS now 6-hrly instead of daily files +! +! To do: +! 1. generate corresponding prepbufr file +! +!EOP +!------------------------------------------------------------------------- + + program saber2ods + + use m_saber + use m_ods + use m_StrTemplate + use m_pbutil + + implicit none + + integer :: i,j,k,l + integer :: num_options,nhms(5),nymd,iargc,pos + integer :: rc_saber_get,rc_ods_clean,rc_ods_init, & + rc_ods_put,rc_ods_get,rc_ods_open,rc_ods_close + integer :: ierr_write,ierr_app,rc + integer :: ncid + integer :: fyear,fdoy,fjul_day,fcal_day,fjul_day_p1,fcal_day_p1, & + jul_day, hh + integer :: ODS_Julian,ODS_Caldat + character(len=180) fnames(200),tempfname,arg,fn,odsname,bfrfname + character(len=180) odstmpl,bfrtmpl + character(len=8) cnymd + character(len=4) cfyear + character(len=3) cfdoy + character(len=9) ftype + character(len=10) s_string + character(len=3) version + logical :: found,append,hit + logical :: verbose,bexist + type(ods_vect) :: ods_struct,ods_old ! ODS vector + integer :: tnobs,fc + +! Initialize variables + version = "2.0" + verbose = .false. + tnobs=450000 + ncid=11 + ftype='pre_anal' + nhms(1)=000000 + nhms(2)=060000 + nhms(3)=120000 + nhms(4)=180000 + nhms(5)=000000 + i=1 + fc=1 + s_string='SABER_L2A_' + bfrtmpl='saber.l2a.obs.%y4%m2%d2_%h2z.bfr' + bfrtmpl='NULL' +! Process argument list + num_options = iargc() + if (num_options .eq. 0 ) then + print *, "usage: saber2ods.x [-o odstmpl] saber_ncfile(s)" + print *, "odstmpl template for ODS output file(s)" + print *, "saber_ncfile(s) Input netcdf SABER file(s)" + stop + endif + odstmpl='' + do while (i .le. num_options) + call getarg (i,arg) + pos=index(arg,'-o') + if (i.eq.1.and.pos.gt.0)then + call getarg (2,arg) + odstmpl=arg + i=3 + else + if(len(trim(odstmpl)).eq.0)then + odstmpl='saber.l2a.obs.%y4%m2%d2_%h2z.ods' + endif + fnames(fc)=trim(arg) + fc=fc+1 + i=i+1 + endif + enddo + +! Begin reading files. + do j=1,fc-1 + +! Search for date string in the filename. + pos=index(fnames(j),s_string) + tempfname=fnames(j) + cfyear=tempfname(pos+10:pos+13) + cfdoy=tempfname(pos+14:pos+16) + read(cfyear,204)fyear + 204 format(i4) + read(cfdoy,204)fdoy + 205 format(i3) + fyear=(10000*fyear)+101 + + fjul_day=ODS_Julian(fyear)+fdoy-1 + fjul_day_p1=ODS_Julian(fyear)+fdoy + + fcal_day=ODS_Caldat(fjul_day) + fcal_day_p1=ODS_Caldat(fjul_day_p1) + hit=.false. + do k=1,5 ! Cycle through the possible synoptic times in the file + found=.false. + append=.false. + nymd=fcal_day + if(k.eq.5)then + nymd=fcal_day_p1 + endif + + ! Create ods file name from template + call StrTemplate ( odsname, odstmpl, 'GRADS', xid="saber", & + nymd=nymd, nhms=nhms(k), stat=rc ) + + ! generate/update ODS file w/ SABER data + call saberods_(odsname) + + ! generate bufr file if desired + call StrTemplate ( bfrfname, bfrtmpl, 'GRADS', xid="saber", & + nymd=nymd, nhms=nhms(k), stat=rc ) + if ( trim(bfrfname) /= "NULL" ) then + if(verbose) print*,'Writing data at ',nymd,nhms(k),'Z to ',bfrfname + inquire(file=bfrfname,exist=bexist) + if (bexist) then + print *,'Append to output bfr file ',trim(bfrfname) + call init_bufr(bfrfname,append=.true.) + else + print *,'Create output bfr file ',trim(bfrfname) + call init_bufr(bfrfname,tablefile='saber_prepbufr_table',append=.false.) + endif + +! call write_bfr(stnid, xob, yob, dhr, typ, ib, & +! rstat, quality(jtm), convergence(jtm), & +! pob, tob, tqm, tprec, subset, idate) + endif + + + enddo + if(.not.hit)then + print*, 'Warning! No data matching the files date and times were found.' + endif + enddo + +contains + subroutine saberods_ (odsname) + + character(len=*), intent(in) :: odsname +! Initialize ods vector + call ODS_Init(ods_struct,tnobs,rc_ods_init) + call SABER_Get(version,fnames(j),nymd,nhms(k),ods_struct, & + rc_saber_get) + +! If data matching the selected synoptic time were found, continue. + if(rc_saber_get.eq.0)then ! If something was read from the file, continue + hit=.true. + +! Check to see if ods file already exists. + inquire(file=odsname,exist=found) + if(found)then + +! If the file is present read it and get the number of obs +! and then add those nobs to the ks values so ks is unique +! throughout the synoptic time. We also need to know if +! there are already obs written for the current synoptic +! time. If so, we have to set append=.true. + + call ODS_Get(odsname,nymd,nhms(k),ftype,ods_old, & + rc_ods_get) + if(verbose) print*, 'rc_ods_get = ',rc_ods_get + if(verbose) print*,'number of obs found for ',nhms(k),'Z is ', & + ods_old%data%nobs + if(ods_old%data%nobs.eq.0)then + print*,'Writing data at ',nymd,nhms(k),'Z to ',trim(odsname) + call ODS_Put(odsname,ftype,nymd,nhms(k),ods_struct, & + rc_ods_put) + if(verbose) print*,'rc_ods_put = ',rc_ods_put + else + print*,'Appending data at ',nymd,nhms(k),'Z to ',trim(odsname) + do l=1,ods_struct%data%nobs + ods_struct%data%ks(l)=ods_old%data%ks(ods_old%data%nobs) & + +ods_struct%data%ks(l) + enddo +! Append data to the current synoptic time. + call ODS_Open(ncid,odsname,'w',rc_ods_open) + if(verbose) print*,'rc_ods_open=',rc_ods_open + call ODS_Append(ncid,ods_struct%data%nobs,ierr_app) + if(verbose) print*,'ierr_app=',ierr_app + jul_day=ODS_Julian(nymd) + call ODS_PutR(ncid,'lat',jul_day,nhms(k)/10000,ods_struct%data%nobs, & + ods_struct%data%lat,ierr_write) + if(verbose) print*,'ierr_write=',ierr_write + call ODS_PutR(ncid,'lon',jul_day,nhms(k)/10000,ods_struct%data%nobs, & + ods_struct%data%lon,ierr_write) + if(verbose) print*,'ierr_write=',ierr_write + call ODS_PutR(ncid,'lev',jul_day,nhms(k)/10000,ods_struct%data%nobs, & + ods_struct%data%lev,ierr_write) + if(verbose) print*,'ierr_write=',ierr_write + call ODS_PutI(ncid,'time',jul_day,nhms(k)/10000,ods_struct%data%nobs, & + ods_struct%data%time,ierr_write) + if(verbose) print*,'ierr_write=',ierr_write + call ODS_PutI(ncid,'kt',jul_day,nhms(k)/10000,ods_struct%data%nobs, & + ods_struct%data%kt,ierr_write) + if(verbose) print*,'ierr_write=',ierr_write + call ODS_PutI(ncid,'kx',jul_day,nhms(k)/10000,ods_struct%data%nobs, & + ods_struct%data%kx,ierr_write) + if(verbose) print*,'ierr_write=',ierr_write + call ODS_PutI(ncid,'ks',jul_day,nhms(k)/10000,ods_struct%data%nobs, & + ods_struct%data%ks,ierr_write) + if(verbose) print*,'ierr_write=',ierr_write + call ODS_PutR(ncid,'xm',jul_day,nhms(k)/10000,ods_struct%data%nobs, & + ods_struct%data%xm,ierr_write) + if(verbose) print*,'ierr_write=',ierr_write + call ODS_PutI(ncid,'qcexcl',jul_day,nhms(k)/10000,ods_struct%data%nobs, & + ods_struct%data%qcexcl,ierr_write) + if(verbose) print*,'ierr_write=',ierr_write + call ODS_PutI(ncid,'qchist',jul_day,nhms(k)/10000,ods_struct%data%nobs, & + ods_struct%data%qchist,ierr_write) + if(verbose) print*,'ierr_write=',ierr_write + call ODS_PutR(ncid,'obs',jul_day,nhms(k)/10000,ods_struct%data%nobs, & + ods_struct%data%obs,ierr_write) + if(verbose) print*,'ierr_write=',ierr_write + + call ODS_Close(ncid,'SABER',rc_ods_close) + if(verbose) print*,'rc_ods_close=',rc_ods_close + endif + else +! Write data to an entirely NEW ods file + call ODS_Put(odsname,ftype,nymd,nhms(k),ods_struct,rc_ods_put) + if(verbose) print*,'rc_ods_put = ',rc_ods_put + endif + else + if(verbose) print*,'No data at ',nymd,nhms(k) + endif +! Deallocate the ods vector + call ODS_Clean(ods_struct,rc_ods_clean) + + return + end subroutine saberods_ + + subroutine write_bfr(stnid, xob, yob, dhr, typ, ib, & + rstat, qual, conv, & + pob, tob, tqm, tprec, subset, idate) + + integer idate, ib, l + character(len=8) stnid, subset + real xob, yob, dhr, typ, rstat, qual, conv + real pob(ib), tob(ib), tqm(ib), tprec(ib) + + real(8), dimension(8) :: hdr ! observation header + real(8) :: rid + real(8), dimension(8,255) :: pobs, tobs + + integer, parameter :: MXBLVL = 255 ! max no. of report levels allowed + integer(i_bfr), parameter :: iarr = 8 ! size of bfr arrays + integer(i_bfr), parameter :: i1 = 1 ! single level + integer(i_bfr), parameter :: ilv = MXBLVL ! multiple level + integer(i_bfr) ibdate + integer(i_bfr) ilevs + integer(i_bfr) iret + + character(len=40) hdstr, pobstr, tobstr + data hdstr /'SID XOB YOB DHR TYP SABERT SABERQ SABERC'/ + data pobstr /'POB PQM PPC PRC CAT'/ + data tobstr /'TOB TQM TPC TRC SABERRT'/ + + hdr(1) = transfer(stnid, rid) + hdr(2) = xob + hdr(3) = yob + hdr(4) = dhr + hdr(5) = typ + hdr(6) = rstat + hdr(7) = qual + hdr(8) = conv + + pobs = missing + tobs = missing + + do l = 1,ib + pobs(1,l) = pob(l) + pobs(2,l) = tqm(l) ! use same as T + pobs(3,l) = 1. + pobs(4,l) = 1. + pobs(5,l) = 2. + tobs(1,l) = tob(l) + tobs(2,l) = tqm(l) + tobs(3,l) = 1. + tobs(4,l) = 1. + tobs(5,l) = tprec(l) + end do + + ibdate = idate + ilevs = ib + + call openmb(lu_b, subset, ibdate) + call ufbint(lu_b, hdr, iarr, i1 , iret, hdstr) + call ufbint(lu_b, pobs, iarr, ilevs, iret, pobstr) + call ufbint(lu_b, tobs, iarr, ilevs, iret, tobstr) + + call writsb(lu_b) + + return + end subroutine write_bfr + + end program saber2ods + diff --git a/src/Applications/SABER_App/saber_prepbufr_table b/src/Applications/SABER_App/saber_prepbufr_table new file mode 100644 index 00000000..e60443eb --- /dev/null +++ b/src/Applications/SABER_App/saber_prepbufr_table @@ -0,0 +1,931 @@ +.------------------------------------------------------------------------------. +| ------------ USER DEFINITIONS FOR TABLE-A TABLE-B TABLE D -------------- | +|------------------------------------------------------------------------------| +| MNEMONIC | NUMBER | DESCRIPTION | +|----------|--------|----------------------------------------------------------| +| | | | +| ADPUPA | A60230 | UPPER-AIR (RAOB, PIBAL, RECCO, DROPS) REPORTS | +| AIRCAR | A60231 | MDCRS ACARS AIRCRAFT REPORTS | +| AIRCFT | A60232 | AIREP/PIREP, AMDAR(ASDAR/ACARS), E-ADAS(AMDAR BUFR) ACF | +| SATWND | A60233 | SATELLITE-DERIVED WIND REPORTS | +| PROFLR | A60234 | WIND PROFILER REPORTS | +| VADWND | A60235 | VAD (NEXRAD) WIND REPORTS | +| SATEMP | A60236 | TOVS SATELLITE DATA (SOUNDINGS, RETRIEVALS, RADIANCES) | +| ADPSFC | A60237 | SURFACE LAND (SYNOPTIC, METAR) REPORTS | +| SFCSHP | A60238 | SURFACE MARINE (SHIP, BUOY, C-MAN PLATFORM) REPORTS | +| SFCBOG | A60239 | MEAN SEA-LEVEL PRESSURE BOGUS REPORTS | +| SPSSMI | A60240 | SSM/I RETRIEVAL PRODUCTS (REPROCESSED WIND SPEED, TPW) | +| SYNDAT | A60241 | SYNTHETIC TROPICAL CYCLONE BOGUS REPORTS | +| ERS1DA | A60242 | ERS SCATTEROMETER DATA (REPROCESSED WIND SPEED) | +| GOESND | A60243 | GOES SATELLITE DATA (SOUNDINGS, RETRIEVALS, RADIANCES) | +| QKSWND | A60244 | QUIKSCAT SCATTEROMETER DATA (REPROCESSED WIND SPEED) | +| MSONET | A60245 | MESONET SURFACE REPORTS (COOPERATIVE NETWORKS) | +| GPSIPW | A60246 | GLOBAL POSITIONING SATELLITE-INTEGRATED PRECIP. WATER | +| RASSDA | A60247 | RADIO ACOUSTIC SOUNDING SYSTEM (RASS) TEMP PROFILE RPTS | +| EOSSABER | A60254 | EOS-SABER SATELLITE DATA (SOUNDINGS, RETRIEVALS) | +| | | | +| HEADR | 361001 | REPORT HEADER SEQUENCE | +| PRSLEVEL | 361002 | PRESSURE LEVEL SEQUENCE (ALL TYPES EXCEPT GOESND) | +| PMSL_SEQ | 361003 | MEAN SEA LEVEL PRESSURE SEQUENCE | +| BTMPLEVL | 361004 | BRIGHTNESS TEMPERATURE "LEVEL" SEQUENCE | +| ALTIMSEQ | 361005 | ALTIMETER SETTING SEQUENCE | +| TURB1SEQ | 361006 | TURBULENCE SEQUENCE # 1 | +| TURB2SEQ | 361007 | TURBULENCE SEQUENCE # 2 | +| ACFT_SEQ | 361008 | AIRCRAFT SUPPLEMENTARY DATA SEQUENCE | +| RFFL_SEQ | 361009 | NESDIS RECURSIVE FILTER FLAG SEQUENCE | +| WSPD_SEQ | 361010 | WIND SPEED SEQUENCE | +| PRSLEVLG | 361011 | GOESND PRESSURE LEVEL SEQUENCE | +| TOPC_SEQ | 361012 | TOTAL PRECIPITATION/TOTAL WATER EQUIVALENT SEQUENCE | +| PREWXSEQ | 361013 | PRESENT WEATHER SEQUENCE | +| CLOUDSEQ | 361014 | OBSERVED CLOUD SEQUENCE # 1 | +| HOCT_SEQ | 361015 | HEIGHT OF TOP OF CLOUD SEQUENCE | +| TMXMNSEQ | 361016 | MAXIMUM/MINIMUM TEMPERATURE SEQUENCE | +| SWELLSEQ | 361017 | SWELL WAVE SEQUENCE | +| DBSS_SEQ | 361018 | DEPTH BELOW SEA SURFACE SEQUENCE | +| VISB1SEQ | 361019 | VISIBILITY SEQUENCE # 1 | +| VISB2SEQ | 361020 | VISIBILITY SEQUENCE # 2 | +| VTVI_SEQ | 361021 | VERTICAL VISIBILITY SEQUENCE | +| PSTWXSEQ | 361022 | PAST WEATHER SEQUENCE | +| PKWNDSEQ | 361023 | PEAK WIND SEQUENCE | +| GUST1SEQ | 361024 | MAXIMUM WIND GUST SEQUENCE # 1 | +| GUST2SEQ | 361025 | MAXIMUM WIND GUST SEQUENCE # 2 | +| TPRECSEQ | 361026 | TOTAL PRECIPITATION SEQUENCE | +| TP12_SEQ | 361027 | TOTAL PRECIPITATION PAST 12 HOURS SEQUENCE | +| SUNSHSEQ | 361028 | TOTAL SUNSHINE SEQUENCE | +| CLOU2SEQ | 361029 | OBSERVED CLOUD SEQUENCE # 2 | +| XWSPDSEQ | 361030 | EXTRAPOLATED WIND SPEED SEQUENCE | +| SWINDSEQ | 361031 | SURFACE WIND SEQUENCE | +| SNOW_SEQ | 361032 | SNOW DEPTH SEQUENCE | +| WAVE_SEQ | 361033 | WAVE SEQUENCE | +| SHIP_SEQ | 361034 | SHIP DIRECTION/SPEED SEQUENCE | +| PTENDSEQ | 361035 | PRESSURE TENDENCY SEQUENCE | +| PTE24SEQ | 361036 | 24 HOUR PRESSURE TENDENCY SEQUENCE | +| PREC_SEQ | 361098 | SABERRET PRECISION SEQUENCE | +| PRSLEVLM | 361099 | MLSRET PRESSURE LEVEL SEQUENCE | +| RSRD_SEQ | 361101 | RESTRICTIONS ON REDISTRIBUTION SEQUENCE | +| PM__INFO | 362031 | PRESSURE (MLS) INFORMATION | +| P___INFO | 362001 | PRESSURE INFORMATION | +| Q___INFO | 362002 | SPECIFIC HUMIDITY INFORMATION | +| T___INFO | 362003 | TEMPERATURE INFORMATION | +| TM__INFO | 362033 | TEMPERATURE INFORMATION (MLS) | +| Z___INFO | 362004 | HEIGHT INFORMATION | +| W___INFO | 362005 | WIND INFORMATION | +| PW__INFO | 362006 | PRECIPITABLE WATER INFORMATION | +| PWT_INFO | 362007 | TOTAL PRECIPITABLE WATER INFORMATION | +| PWL_INFO | 362008 | LAYER PRECIPITABLE WATER INFORMATION | +| PW1_INFO | 362009 | 1.0 TO 0.9 SIGMA LAYER PRECIPITABLE WATER INFORMATION | +| PW2_INFO | 362010 | 0.9 TO 0.7 SIGMA LAYER PRECIPITABLE WATER INFORMATION | +| PW3_INFO | 362011 | 0.7 TO 0.3 SIGMA LAYER PRECIPITABLE WATER INFORMATION | +| PW4_INFO | 362012 | 0.3 TO 0.0 SIGMA LAYER PRECIPITABLE WATER INFORMATION | +| BTMPINFO | 362014 | TOVS OR GOES BRIGHTNESS TEMPERATURE INFORMATION | +| SCATINFO | 362015 | SCATTEROMETER DATA INFORMATION | +| DRFTINFO | 362016 | RADIOSONDE DRIFT INFORMATION | +| RRT_INFO | 362017 | RAIN RATE INFORMATION | +| CTP_INFO | 362018 | CLOUD TOP INFORMATION | +| SST_INFO | 362019 | SEA TEMPERATURE INFORMATION | +| PM_EVENT | 362131 | PRESSURE EVENT SEQUENCE (MLS) | +| P__EVENT | 362101 | PRESSURE EVENT SEQUENCE | +| Q__EVENT | 362102 | SPECIFIC HUMIDITY EVENT SEQUENCE | +| TM_EVENT | 362133 | TEMPERATURE EVENT SEQUENCE (MLS) | +| T__EVENT | 362103 | TEMPERATURE EVENT SEQUENCE | +| Z__EVENT | 362104 | HEIGHT EVENT SEQUENCE | +| W__EVENT | 362105 | WIND EVENT SEQUENCE | +| DF_EVENT | 362106 | WIND (DIRECTION/SPEED) EVENT SEQUENCE | +| PWTEVENT | 362107 | TOTAL PRECIPITABLE WATER EVENT SEQUENCE | +| PW1EVENT | 362108 | 1.0 TO 0.9 PRECIPITABLE WATER EVENT SEQUENCE | +| PW2EVENT | 362109 | 0.9 TO 0.7 PRECIPITABLE WATER EVENT SEQUENCE | +| PW3EVENT | 362110 | 0.7 TO 0.3 PRECIPITABLE WATER EVENT SEQUENCE | +| PW4EVENT | 362111 | 0.3 TO 0.0 PRECIPITABLE WATER EVENT SEQUENCE | +| RRTEVENT | 362112 | RATE RATE EVENT SEQUENCE | +| CTPEVENT | 362113 | CLOUD TOP PRESSURE EVENT SEQUENCE | +| SSTEVENT | 362114 | SEA TEMPERATURE EVENT SEQUENCE | +| P__BACKG | 362201 | PRESSURE BACKGROUND SEQUENCE | +| Q__BACKG | 362202 | SPECIFIC HUMIDITY BACKGROUND SEQUENCE | +| T__BACKG | 362203 | TEMPERATURE BACKGROUND SEQUENCE | +| Z__BACKG | 362204 | HEIGHT BACKGROUND SEQUENCE | +| W__BACKG | 362205 | WIND BACKGROUND SEQUENCE | +| PWTBACKG | 362206 | TOTAL PRECIPITABLE WATER BACKGROUND SEQUENCE | +| PW1BACKG | 362207 | 1.0 TO 0.9 SIGMA LAYER PRECIP WATER BACKGROUND SEQUENCE | +| PW2BACKG | 362208 | 0.9 TO 0.7 SIGMA LAYER PRECIP WATER BACKGROUND SEQUENCE | +| PW3BACKG | 362209 | 0.7 TO 0.3 SIGMA LAYER PRECIP WATER BACKGROUND SEQUENCE | +| PW4BACKG | 362210 | 0.3 TO 0.0 SIGMA LAYER PRECIP WATER BACKGROUND SEQUENCE | +| RRTBACKG | 362211 | RAIN RATE BACKGROUND SEQUENCE | +| CTPBACKG | 362212 | CLOUD TOP PRESSURE BACKGROUND SEQUENCE | +| SSTBACKG | 362213 | SEA TEMPERATURE BACKGROUND SEQUENCE | +| TM_BACKG | 362214 | TEMPERATURE BACKGROUND SEQUENCE (MLS) | +| P__POSTP | 362221 | PRESSURE POSTPROCESSING SEQUENCE | +| Q__POSTP | 362222 | SPECIFIC HUMIDITY POSTPROCESSING SEQUENCE | +| T__POSTP | 362223 | TEMPERATURE POSTPROCESSING SEQUENCE | +| Z__POSTP | 362224 | HEIGHT POSTPROCESSING SEQUENCE | +| W__POSTP | 362225 | WIND POSTPROCESSING SEQUENCE | +| PWTPOSTP | 362226 | TOTAL PRECIPITABLE WATER POSTPROCESSING SEQUENCE | +| PW1POSTP | 362227 | 1.0 TO 0.9 SIGMA LAYER PRECIP WATER POSTPROCESSING SEQ. | +| PW2POSTP | 362228 | 0.9 TO 0.7 SIGMA LAYER PRECIP WATER POSTPROCESSING SEQ. | +| PW3POSTP | 362229 | 0.7 TO 0.3 SIGMA LAYER PRECIP WATER POSTPROCESSING SEQ. | +| PW4POSTP | 362230 | 0.3 TO 0.0 SIGMA LAYER PRECIP WATER POSTPROCESSING SEQ. | +| RRTPOSTP | 362231 | RAIN RATE POSTPROCESSING SEQUENCE | +| CTPPOSTP | 362232 | CLOUD TOP PRESSURE POSTPROCESSING SEQUENCE | +| SSTPOSTP | 362233 | SEA TEMPERATURE POSTPROCESSING SEQUENCE | +| PCLIMATO | 362241 | PRESSURE CLIMATOLOGY SEQUENCE | +| QCLIMATO | 362242 | SPECIFIC HUMIDITY CLIMATOLOGY SEQUENCE | +| TCLIMATO | 362243 | TEMPERATURE CLIMATOLOGY SEQUENCE | +| ZCLIMATO | 362244 | HEIGHT CLIMATOLOGY SEQUENCE | +| WCLIMATO | 362245 | WIND CLIMATOLOGY SEQUENCE | +| PFC__MSQ | 363201 | MODEL PRESSURE FORECAST SEQUENCE | +| QFC__MSQ | 363202 | MODEL SPECIFIC HUMIDITY FORECAST SEQUENCE | +| TFC__MSQ | 363203 | MODEL TEMPERATURE FORECAST SEQUENCE | +| ZFC__MSQ | 363204 | MODEL HEIGHT FORECAST SEQUENCE | +| WFC__MSQ | 363205 | MODEL WIND FORECAST SEQUENCE | +| PWF__MSQ | 363206 | MODEL TOTAL PRECIPITABLE WATER FORECAST SEQUENCE | +| PW1F_MSQ | 363207 | MODEL 1.0 TO 0.9 SIGMA LAYER PRECIP WATER FORECAST SEQ. | +| PW2F_MSQ | 363208 | MODEL 0.9 TO 0.7 SIGMA LAYER PRECIP WATER FORECAST SEQ. | +| PW3F_MSQ | 363209 | MODEL 0.7 TO 0.3 SIGMA LAYER PRECIP WATER FORECAST SEQ. | +| PW4F_MSQ | 363210 | MODEL 0.3 TO 0.0 SIGMA LAYER PRECIP WATER FORECAST SEQ. | +| PREPRO | 363001 | INITIAL PREPBUFR PROCESSING STEP | +| SYNDATA | 363002 | SYNTHETIC TROPICAL CYCLONE BOGUS PROCESSING STEP | +| CLIMO | 363003 | CLIMO PROGRAM | +| PREVENT | 363004 | PRE-EVENTS BACKGROUND/OBS. ERROR PROCESSING STEP | +| CQCHT | 363005 | RAWINSONDE HEIGHT/TEMP COMPLEX QUALITY CONTROL STEP | +| RADCOR | 363006 | RAWINSONDE HEIGHT/TEMP RADIATION CORRECTION STEP | +| PREPACQC | 363007 | AIRCRAFT QUALITY CONTROL STEP (NOT INCL. MDCRS ACARS) | +| VIRTMP | 363008 | VIRTUAL TEMPERATURE/SPECIFIC HUMIDITY PROCESSING STEP | +| CQCPROF | 363009 | WIND PROFILER QUALITY CONTROL STEP | +| OIQC | 363010 | OI-QUALITY CONTROL STEP | +| SSI | 363011 | SSI ANALYSIS STEP | +| CQCVAD | 363012 | VAD WIND QUALITY CONTROL STEP | +| R3DVAR | 363013 | 3DVAR ANALYSIS STEP | +| ACARSQC | 363014 | MDCRS ACARS AIRCRAFT QUALITY CONTROL STEP | +| | | | +| ACID | 001006 | AIRCRAFT FLIGHT NUMBER | +| SAID | 001007 | SATELLITE IDENTIFIER (SATELLITE REPORTS ONLY) | +| SID | 001194 | STATION IDENTIFICATION | +| SIRC | 002013 | RAWINSONDE SOLAR & INFRARED RADIATION CORR. INDICATOR | +| MSST | 002038 | METHOD OF SEA SURFACE TEMPERATURE MEASUREMENT | +| ITP | 002195 | INSTRUMENT TYPE | +| RPT | 004214 | REPORTED OBSERVATION TIME | +| DHR | 004215 | OBSERVATION TIME MINUS CYCLE TIME | +| TCOR | 004216 | INDICATOR WHETHER OBS. TIME IN "DHR" WAS CORRECTED | +| RCT | 004217 | RECEIPT TIME | +| YOB | 005002 | LATITUDE | +| ATRN | 005034 | ALONG TRACK ROW NUMBER (QUIKSCAT REPORTS ONLY) | +| CTCN | 006034 | CROSS TRACK CELL NUMBER (QUIKSCAT REPORTS ONLY) | +| XOB | 006240 | LONGITUDE | +| VSSO | 008002 | VERT. SIGNIFICANCE (SFC OBSERVATION) | +| ACAV | 008022 | TOTAL # W.R.T. ACCUMULATION OR AVGE (GOES SNDGS ONLY) | +| ELV | 010199 | STATION ELEVATION | +| SPRR | 021120 | SEAWINDS PROBABILITY OF RAIN (QUIKSCAT REPORTS ONLY) | +| RSRD | 035200 | RESTRICTIONS ON REDISTRIBUTION | +| EXPRSRD | 035201 | EXPIRATION OF RESTRICTIONS ON REDISTRIBUTION | +| SQN | 050001 | REPORT SEQUENCE NUMBER | +| PROCN | 050003 | PROCESS NUMBER FOR THIS MPI RUN (OBTAINED FROM SCRIPT) | +| TYP | 055007 | PREPBUFR REPORT TYPE | +| T29 | 055008 | DATA DUMP REPORT TYPE | +| TSB | 055009 | REPORT SUBTYPE (HAS VARIOUS MEANINGS DEPENDING ON TYPE) | +| PRVSTG | 058009 | MESONET PROVIDER ID STRING | +| SPRVSTG | 058010 | MESONET SUBPROVIDER ID STRING | +| TDMP | 001193 | TRUE DIRECTION OF SHIP DURING PAST 3 HOURS | +| ASMP | 001200 | AVG SPD OF SHIP DURING PAST 3 HOURS | +| PCAT | 002005 | PRECISION OF TEMPERATURE OBSERVATION | +| .DTH.... | 004031 | DURATION OF TIME IN HOURS RELATED TO FOLLOWING VALUE | +| .DTM.... | 004032 | DURATION OF TIME IN MINS RELATED TO FOLLOWING VALUE | +| HRDR | 004218 | RADIOSONDE BALLOON DRIFT TIME MINUS CYCLE TIME | +| CHNM | 005042 | CHANNEL NUMBER | +| YDR | 005241 | RADIOSONDE BALLOON DRIFT LATITUDE | +| XDR | 006241 | RADIOSONDE BALLOON DRIFT LONGITUDE | +| ELEV | 007021 | SATELLITE ELEVATION (ZENITH ANGLE) | +| SOEL | 007022 | SOLAR ELEVATION (ZENITH ANGLE) | +| DBSS | 007062 | DEPTH BELOW SEA SURFACE | +| POB | 007245 | PRESSURE OBSERVATION | +| PQM | 007246 | PRESSURE (QUALITY) MARKER | +| PPC | 007247 | PRESSURE EVENT PROGRAM CODE | +| PRC | 007248 | PRESSURE EVENT REASON CODE | +| PFC | 007249 | FORECAST (BACKGROUND) PRESSURE VALUE | +| POE | 007250 | PRESSURE OBSERVATION ERROR | +| PAN | 007251 | ANALYZED PRESSURE VALUE | +| PCL | 007252 | CLIMATOLOGICAL PRESSURE VALUE | +| PCS | 007253 | STANDARD DEVIATION OF CLIMATOLOGICAL PRESSURE VALUE | +| POAF | 008004 | PHASE OF AIRCRAFT FLIGHT | +| CAT | 008193 | PREPBUFR DATA LEVEL CATEGORY | +| .RE.... | 008201 | RELATIONSHIP TO THE FOLLOWING VALUE | +| ZOB | 010007 | HEIGHT OBSERVATION | +| ALSE | 010052 | ALTIMETER SETTING OBSERVATION | +| 3HPC | 010061 | 3 HOUR PRESSURE CHANGE | +| 24PC | 010062 | 24 HOUR PRESSURE CHANGE | +| CHPT | 010063 | CHARACTERISTIC OF PRESSURE TENDENCY | +| PRSS | 010195 | SURFACE PRESSURE OBSERVATION | +| PMO | 010243 | MEAN SEA-LEVEL PRESSURE OBSERVATION | +| PMQ | 010244 | MEAN SEA-LVL PRESSURE (QUALITY) MARKER | +| ZQM | 010246 | HEIGHT (QUALITY) MARKER | +| ZPC | 010247 | HEIGHT EVENT PROGRAM CODE | +| ZRC | 010248 | HEIGHT EVENT REASON CODE | +| ZFC | 010249 | FORECAST (BACKGROUND) HEIGHT VALUE | +| ZOE | 010250 | HEIGHT OBSERVATION ERROR | +| ZAN | 010251 | ANALYZED HEIGHT VALUE | +| ZCL | 010252 | CLIMATOLOGICAL HEIGHT VALUE | +| ZCS | 010253 | STANDARD DEVIATION OF CLIMATOLOGICAL HEIGHT VALUE | +| DDO | 011001 | WIND DIRECTION OBSERVATION (NOT ASSIMILATED) | +| SOB | 011002 | WIND SPEED OBSERVATION | +| UOB | 011003 | U-COMPONENT WIND OBSERVATION | +| VOB | 011004 | V-COMPONENT WIND OBSERVATION | +| DGOT | 011031 | DEGREE OF TURBULENCE | +| MXGS | 011041 | MAXIMUM WIND SPEED (GUSTS) | +| MXGD | 011043 | MAXIMUM WIND GUST DIRECTION | +| WDIR1 | 011200 | SURFACE WIND DIRECTION | +| WSPD1 | 011201 | SURFACE WIND SPEED | +| PKWDDR | 011202 | PEAK WIND DIRECTION | +| PKWDSP | 011203 | PEAK WIND SPEED | +| SQM | 011217 | WIND SPEED (SOB) (QUALITY) MARKER | +| DFQ | 011218 | WIND DIRECTION/SPEED (DDO/FFO) (QUALITY) MARKER | +| DFP | 011219 | WIND DIRECTION/SPEED (DDO/FFO) EVENT PROGRAM CODE | +| DFR | 011220 | WIND DIRECTION/SPEED (DDO/FFO) EVENT REASON CODE | +| XS10 | 011223 | 10 METER EXTRAPOLATED WIND SPEED | +| XS20 | 011224 | 20 METER EXTRAPOLATED WIND SPEED | +| TRBX10 | 011236 | TURBULENCE INDEX FOR PERIOD (TOB-1 MIN) -> TOB | +| TRBX21 | 011237 | TURBULENCE INDEX FOR PERIOD (TOB-2 MIN) -> (TOB-1 MIN) | +| TRBX32 | 011238 | TURBULENCE INDEX FOR PERIOD (TOB-3 MIN) -> (TOB-2 MIN) | +| TRBX43 | 011239 | TURBULENCE INDEX FOR PERIOD (TOB-4 MIN) -> (TOB-3 MIN) | +| WQM | 011240 | U-, V-COMPONENT WIND (UOB/VOB) (QUALITY) MARKER | +| WPC | 011241 | U-, V-COMPONENT WIND (UOB/VOB) EVENT PROGRAM CODE | +| WRC | 011242 | U-, V-COMPONENT WIND (UOB/VOB) EVENT REASON CODE | +| UFC | 011243 | FORECAST (BACKGROUND) U-COMPONENT WIND VALUE | +| VFC | 011244 | FORECAST (BACKGROUND) V-COMPONENT WIND VALUE | +| WOE | 011245 | WIND OBSERVATION ERROR | +| UAN | 011246 | ANALYZED U-COMPONENT WIND VALUE | +| VAN | 011247 | ANALYZED V-COMPONENT WIND VALUE | +| UCL | 011248 | CLIMATOLOGICAL U-COMPONENT WIND VALUE | +| VCL | 011249 | CLIMATOLOGICAL V-COMPONENT WIND VALUE | +| UCS | 011250 | STANDARD DEVIATION OF CLIMATOLOGICAL U-COMP WIND VALUE | +| VCS | 011251 | STANDARD DEVIATION OF CLIMATOLOGICAL V-COMP WIND VALUE | +| FFO | 011252 | WIND SPEED OBSERVATION (NOT ASSIMILATED) | +| MXTM | 012111 | MAXIMUM TEMPERATURE | +| MITM | 012112 | MINIMUM TEMPERATURE | +| TMSK | 012161 | SKIN TEMPERATURE | +| TMBR | 012163 | BRIGHTNESS TEMPERATURE | +| GCDTT | 012210 | GOES CLOUD TOP TEMPERATURE OBSERVATION | +| TVO | 012243 | NON-Q. CONTROLLED VIRTUAL TEMP OBS (NOT ASSIMILATED) | +| TDO | 012244 | DEWPOINT TEMPERATURE OBSERVATION (NOT ASSIMILATED) | +| TOB | 012245 | TEMPERATURE OBSERVATION | +| TQM | 012246 | TEMPERATURE (QUALITY) MARKER | +| TPC | 012247 | TEMPERATURE EVENT PROGRAM CODE | +| TRC | 012248 | TEMPERATURE EVENT REASON CODE | +| TFC | 012249 | FORECAST (BACKGROUND) TEMPERATURE VALUE | +| TOE | 012250 | TEMPERATURE OBSERVATION ERROR | +| TAN | 012251 | ANALYZED TEMPERATURE VALUE | +| TCL | 012252 | CLIMATOLOGICAL TEMPERATURE VALUE | +| TCS | 012253 | STANDARD DEVIATION OF CLIMATOLOGICAL TEMPERATURE VALUE | +| TOPC | 013011 | TOTAL PRECIPITATION/TOTAL WATER EQUIVALENT | +| DOFS | 013012 | DEPTH OF FRESH SNOW | +| TOSD | 013013 | TOTAL SNOW DEPTH | +| REQV | 013014 | RAINFALL (AVERAGE RATE) OBSERVATION | +| TP01 | 013019 | TOTAL PRECIPITATION PAST 1 HOUR | +| TP03 | 013020 | TOTAL PRECIPITATION PAST 3 HOURS | +| TP06 | 013021 | TOTAL PRECIPITATION PAST 6 HOURS | +| TP12 | 013022 | TOTAL PRECIPITATION PAST 12 HOURS | +| TP24 | 013023 | TOTAL PRECIPITATION PAST 24 HOURS | +| PWO | 013193 | TOTAL PRECIPITABLE WATER OBSERVATION | +| PW1O | 013202 | 1.0 TO 0.9 SIGMA LAYER PRECIPITABLE WATER OBSERVATION | +| PW2O | 013203 | 0.9 TO 0.7 SIGMA LAYER PRECIPITABLE WATER OBSERVATION | +| PW3O | 013204 | 0.7 TO 0.3 SIGMA LAYER PRECIPITABLE WATER OBSERVATION | +| QOB | 013245 | SPECIFIC HUMIDITY OBSERVATION | +| QQM | 013246 | SPECIFIC HUMIDITY (QUALITY) MARKER | +| QPC | 013247 | SPECIFIC HUMIDITY EVENT PROGRAM CODE | +| QRC | 013248 | SPECIFIC HUMIDITY EVENT REASON CODE | +| QFC | 013249 | FORECAST (BACKGROUND) SPECIFIC HUMIDITY VALUE | +| QOE | 013250 | RELATIVE HUMIDITY OBSERVATION ERROR | +| QAN | 013251 | ANALYZED SPECIFIC HUMIDITY VALUE | +| QCL | 013252 | CLIMATOLOGICAL SPECIFIC HUMIDITY VALUE | +| QCS | 013253 | STANDARD DEVIATION OF CLIMATOLOGICAL SPEC. HUMIDITY VAL | +| TOSS | 014031 | TOTAL SUNSHINE | +| OZON | 015001 | OZONE | +| HOVI | 020001 | HORIZONTAL VISIBILITY | +| VTVI | 020002 | VERTICAL VISIBILITY | +| PRWE | 020003 | PRESENT WEATHER | +| PSW1 | 020004 | PAST WEATHER (1) | +| PSW2 | 020005 | PAST WEATHER (2) | +| TOCC | 020010 | CLOUD COVER (TOTAL) | +| CLAM | 020011 | CLOUD AMOUNT | +| CLTP | 020012 | CLOUD TYPE | +| HOCB | 020013 | HEIGHT OF BASE OF CLOUD | +| HOCT | 020014 | HEIGHT OF TOP OF CLOUD | +| CDTP | 020016 | CLOUD TOP PRESSURE OBSERVATION | +| HBLCS | 020201 | HEIGHT ABOVE SURFACE OF BASE OF LOWEST CLOUD SEEN | +| CTPQM | 020246 | CLOUD TOP PRESSURE (QUALITY) MARKER | +| CTPPC | 020247 | CLOUD TOP PRESSURE EVENT PROGRAM CODE | +| CTPRC | 020248 | CLOUD TOP PRESSURE EVENT REASON CODE | +| CTPFC | 020249 | FORECAST (BACKGROUND) CLOUD TOP PRESSURE VALUE | +| CTPOE | 020250 | CLOUD TOP PRESSURE OBSERVATION ERROR | +| CTPAN | 020251 | ANALYZED CLOUD TOP PRESSURE VALUE | +| A1 | 021226 | ERS INCIDENT ANGLE NUMBER 1 | +| A2 | 021227 | ERS INCIDENT ANGLE NUMBER 2 | +| A3 | 021228 | ERS INCIDENT ANGLE NUMBER 3 | +| B1 | 021231 | ERS AZIMUTH ANGLE NUMBER 1 | +| B2 | 021232 | ERS AZIMUTH ANGLE NUMBER 2 | +| B3 | 021233 | ERS AZIMUTH ANGLE NUMBER 3 | +| S1 | 021236 | ERS BACKSCATTER NUMBER 1 | +| S2 | 021237 | ERS BACKSCATTER NUMBER 2 | +| S3 | 021238 | ERS BACKSCATTER NUMBER 3 | +| E1 | 021241 | ERS ERROR ESTIMATE NUMBER 1 | +| E2 | 021242 | ERS ERROR ESTIMATE NUMBER 2 | +| E3 | 021243 | ERS ERROR ESTIMATE NUMBER 3 | +| DOSW | 022003 | DIRECTION OF SWELL WAVES | +| POWV | 022011 | PERIOD OF WAVES | +| POWW | 022012 | PERIOD OF WIND WAVES | +| POSW | 022013 | PERIOD OF SWELL WAVES | +| HOWV | 022021 | HEIGHT OF WAVES | +| HOWW | 022022 | HEIGHT OF WIND WAVES | +| HOSW | 022023 | HEIGHT OF SWELL WAVES | +| SST1 | 022043 | SEA TEMPERATURE | +| SSTQM | 022246 | SEA TEMPERATURE (QUALITY) MARKER | +| SSTPC | 022247 | SEA TEMPERATURE EVENT PROGRAM CODE | +| SSTRC | 022248 | SEA TEMPERATURE EVENT REASON CODE | +| SSTFC | 022249 | FORECAST (BACKGROUND) SEA TEMPERATURE VALUE | +| SSTOE | 022250 | SEA TEMPERATURE OBSERVATION ERROR | +| SSTAN | 022251 | ANALYZED SEA TEMPERATURE VALUE | +| RFFL | 025202 | NESDIS RECURSIVE FILTER FLAG | +| RRTQM | 051001 | RAINFALL (AVERAGE RATE) (QUALITY) MARKER | +| RRTPC | 051002 | RAINFALL (AVERAGE RATE) EVENT PROGRAM CODE | +| RRTRC | 051003 | RAINFALL (AVERAGE RATE) EVENT REASON CODE | +| RRTFC | 051004 | FORECAST (BACKGROUND) RAINFALL (AVERAGE RATE) VALUE | +| RRTOE | 051005 | RAINFALL (AVERAGE RATE) OBSERVATION ERROR | +| RRTAN | 051006 | ANALYZED RAINFALL (AVERAGE RATE) VALUE | +| PWQ | 051021 | TOTAL PRECIPITABLE WATER (QUALITY) MARKER | +| PWP | 051022 | TOTAL PRECIPITABLE WATER EVENT PROGRAM CODE | +| PWR | 051023 | TOTAL PRECIPITABLE WATER EVENT REASON CODE | +| PWF | 051024 | FORECAST (BACKGROUND) TOTAL PRECIPITABLE WATER VALUE | +| PWE | 051025 | TOTAL PRECIPITABLE WATER OBSERVATION ERROR | +| PWA | 051026 | ANALYZED TOTAL PRECIPITABLE WATER VALUE | +| PW1Q | 051032 | 1.0 TO 0.9 SIGMA LAYER PRECIP. WATER (QUALITY) MARKER | +| PW1P | 051033 | 1.0 TO 0.9 SIGMA LAYER PRECIP. WATER EVENT PROGRAM CODE | +| PW1R | 051034 | 1.0 TO 0.9 SIGMA LAYER PRECIP. WATER EVENT REASON CODE | +| PW1F | 051035 | FCST (BACKGRND) 1.0 TO 0.9 SIGMA LYR PRECIP. WATER VALU | +| PW1E | 051036 | 1.0 TO 0.9 SIGMA LAYER PRECIP. WATER OBSERVATION ERROR | +| PW1A | 051037 | ANALYZED 1.0 TO 0.9 SIGMA LAYER PRECIP. WATER VALUE | +| PW2Q | 051042 | 0.9 TO 0.7 SIGMA LAYER PRECIP. WATER (QUALITY) MARKER | +| PW2P | 051043 | 0.9 TO 0.7 SIGMA LAYER PRECIP. WATER EVENT PROGRAM CODE | +| PW2R | 051044 | 0.9 TO 0.7 SIGMA LAYER PRECIP. WATER EVENT REASON CODE | +| PW2F | 051045 | FCST (BACKGRND) 0.9 TO 0.7 SIGMA LYR PRECIP. WATER VALU | +| PW2E | 051046 | 0.9 TO 0.7 SIGMA LAYER PRECIP. WATER OBSERVATION ERROR | +| PW2A | 051047 | ANALYZED 0.9 TO 0.7 SIGMA LAYER PRECIP. WATER VALUE | +| PW3Q | 051052 | 0.7 TO 0.3 SIGMA LAYER PRECIP. WATER (QUALITY) MARKER | +| PW3P | 051053 | 0.7 TO 0.3 SIGMA LAYER PRECIP. WATER EVENT PROGRAM CODE | +| PW3R | 051054 | 0.7 TO 0.3 SIGMA LAYER PRECIP. WATER EVENT REASON CODE | +| PW3F | 051055 | FCST (BACKGRND) 0.7 TO 0.3 SIGMA LYR PRECIP. WATER VALU | +| PW3E | 051056 | 0.7 TO 0.3 SIGMA LAYER PRECIP. WATER OBSERVATION ERROR | +| PW3A | 051057 | ANALYZED 0.7 TO 0.3 SIGMA LAYER PRECIP. WATER VALUE | +| PW4O | 051061 | 0.3 TO 0.0 SIGMA LAYER PRECIPITABLE WATER OBSERVATION | +| PW4Q | 051062 | 0.3 TO 0.0 SIGMA LAYER PRECIP. WATER (QUALITY) MARKER | +| PW4P | 051063 | 0.3 TO 0.0 SIGMA LAYER PRECIP. WATER EVENT PROGRAM CODE | +| PW4R | 051064 | 0.3 TO 0.0 SIGMA LAYER PRECIP. WATER EVENT REASON CODE | +| PW4F | 051065 | FCST (BACKGRND) 0.3 TO 0.0 SIGMA LYR PRECIP. WATER VALU | +| PW4E | 051066 | 0.3 TO 0.0 SIGMA LAYER PRECIP. WATER OBSERVATION ERROR | +| PW4A | 051067 | ANALYZED 0.3 TO 0.0 SIGMA LAYER PRECIP. WATER VALUE | +| PFCMOD | 007254 | MODEL PRESSURE FORECAST VALUE (GLOBAL MODEL SEE PFC) | +| ZFCMOD | 010254 | MODEL HEIGHT FORECAST VALUE (GLOBAL MODEL SEE ZFC) | +| UFCMOD | 011253 | MODEL U-COMPONENT FORECAST VALUE (GLOBAL MODEL SEE UFC) | +| VFCMOD | 011254 | MODEL V-COMPONENT FORECAST VALUE (GLOBAL MODEL SEE VFC) | +| TFCMOD | 012254 | MODEL TEMPERATURE FORECAST VALUE (GLOBAL MODEL SEE TFC) | +| QFCMOD | 013254 | MODEL S. HUMIDITY FORECAST VALUE (GLOBAL MODEL SEE QFC) | +| PWFMOD | 051030 | MODEL TOTAL PWATER FORECAST VALUE (GLOBAL MODEL SEE PWC | +| PW1FMOD | 051040 | MODEL 1.-.9 SIG. LYR PWATER FCST (GLOBAL MODEL SEE PW1F | +| PW2FMOD | 051050 | MODEL .9-.7 SIG. LYR PWATER FCST (GLOBAL MODEL SEE PW2F | +| PW3FMOD | 051060 | MODEL .7-.3 SIG. LYR PWATER FCST (GLOBAL MODEL SEE PW3F | +| PW4FMOD | 051070 | MODEL .3-0. SIG. LYR PWATER FCST (GLOBAL MODEL SEE PW4F | +| SABERT | 025226 | SABER RETRIEVAL STATUS FLAG | +| SABERQ | 025227 | SABER RETRIEVAL QUALITY VALUE | +| SABERC | 025228 | SABER RETRIEVAL CONVERGENCE VALUE | +| SABERRT | 025229 | SABER TEMP RETRIEVAL | +| SABERRQ | 025230 | SABER MIXR RETRIEVAL | +| | | | +|------------------------------------------------------------------------------| +| MNEMONIC | SEQUENCE | +|----------|-------------------------------------------------------------------| +| | | +| ADPUPA | HEADR SIRC {PRSLEVEL} {CLOUDSEQ} | +| ADPUPA | | +| | | +| AIRCAR | HEADR ACID PRSLEVEL | +| | | +| AIRCFT | HEADR RCT PRSLEVEL {PREWXSEQ} | +| AIRCFT | {CLOUDSEQ} | +| | | +| SATWND | HEADR SAID PRSLEVEL | +| | | +| PROFLR | HEADR {PRSLEVEL} | +| | | +| VADWND | HEADR {PRSLEVEL} | +| | | +| SATEMP | HEADR SAID {PRSLEVEL} {BTMPLEVL} | +| | | +| ADPSFC | HEADR PRSLEVEL | +| ADPSFC | {PREWXSEQ} {CLOUDSEQ} {TMXMNSEQ} {SWELLSEQ} | +| ADPSFC | | +| ADPSFC | | +| | | +| SFCSHP | HEADR PRSLEVEL {CLOUDSEQ} | +| SFCSHP | {SWELLSEQ} | +| SFCSHP | | +| | | +| SFCBOG | HEADR PRSLEVEL | +| | | +| SPSSMI | HEADR CAT SAID | +| SPSSMI | {BTMPLEVL} | +| | | +| SYNDAT | HEADR {PRSLEVEL} | +| | | +| ERS1DA | HEADR CAT SAID | +| | | +| GOESND | HEADR SAID ACAV {PRSLEVLG} {BTMPLEVL} | +| | | +| QKSWND | HEADR CAT SAID CTCN ATRN SPRR | +| | | +| MSONET | HEADR PRVSTG SPRVSTG PRSLEVEL {TOPC_SEQ} | +| MSONET | | +| | | +| GPSIPW | HEADR CAT PW__INFO | +| | | +| RASSDA | HEADR {PRSLEVEL} | +| | | +| EOSSABER | HEADR SABERT SABERQ SABERC {PRSLEVLM} | +| | | +| HEADR | SID XOB YOB DHR ELV TYP T29 TSB ITP SQN PROCN RPT | +| HEADR | TCOR | +| | | +| PRSLEVEL | CAT | +| PRSLEVEL | | +| | | +| PMSL_SEQ | PMO PMQ | +| | | +| BTMPLEVL | CHNM TMBR | +| | | +| ALTIMSEQ | ALSE | +| | | +| TURB1SEQ | DGOT | +| | | +| TURB2SEQ | TRBX10 TRBX21 TRBX32 TRBX43 | +| | | +| ACFT_SEQ | PCAT POAF | +| | | +| RFFL_SEQ | RFFL | +| | | +| WSPD_SEQ | SOB SQM | +| | | +| PRSLEVLG | CAT | +| PRSLEVLG | | +| | | +| TOPC_SEQ | .DTHTOPC TOPC | +| | | +| PREWXSEQ | PRWE | +| | | +| CLOUDSEQ | VSSO CLAM CLTP HOCB | +| | | +| HOCT_SEQ | HOCT | +| | | +| TMXMNSEQ | .DTHMXTM MXTM .DTHMITM MITM | +| | | +| SWELLSEQ | DOSW HOSW POSW | +| | | +| DBSS_SEQ | DBSS | +| | | +| VISB1SEQ | .REHOVI HOVI | +| | | +| VISB2SEQ | HOVI | +| | | +| VTVI_SEQ | VTVI | +| | | +| PSTWXSEQ | PSW1 PSW2 | +| | | +| PKWNDSEQ | PKWDSP PKWDDR | +| | | +| GUST1SEQ | .DTMMXGS MXGS | +| | | +| GUST2SEQ | MXGS MXGD | +| | | +| TPRECSEQ | TP01 TP03 TP06 TP24 | +| | | +| TP12_SEQ | TP12 | +| | | +| SUNSHSEQ | TOSS | +| | | +| CLOU2SEQ | TOCC HBLCS | +| | | +| XWSPDSEQ | XS10 XS20 | +| | | +| SWINDSEQ | WDIR1 WSPD1 | +| | | +| SNOW_SEQ | .DTHDOFS DOFS TOSD | +| | | +| WAVE_SEQ | HOWV POWV HOWW POWW | +| | | +| SHIP_SEQ | TDMP ASMP | +| | | +| PTENDSEQ | CHPT 3HPC | +| | | +| PTE24SEQ | 24PC | +| | | +| PREC_SEQ | SABERRT SABERRQ | +| | | +| PRSLEVLM | CAT | +| | | +| RSRD_SEQ | RSRD EXPRSRD | +| | | +| PM__INFO | [PM_EVENT] | +| | | +| P___INFO | [P__EVENT] | +| | | +| Q___INFO | [Q__EVENT] TDO | +| | | +| T___INFO | [T__EVENT] TVO | +| | | +| TM__INFO | [TM_EVENT] TVO | +| | | +| Z___INFO | [Z__EVENT] | +| | | +| W___INFO | [W__EVENT] [DF_EVENT] | +| | | +| PW__INFO | PRSS | +| | | +| PWT_INFO | [PWTEVENT] | +| | | +| PWL_INFO | | +| | | +| PW1_INFO | [PW1EVENT] | +| | | +| PW2_INFO | [PW2EVENT] | +| | | +| PW3_INFO | [PW3EVENT] | +| | | +| PW4_INFO | [PW4EVENT] | +| | | +| BTMPINFO | ELEV SOEL OZON TMSK CLAM | +| | | +| SCATINFO | A1 A2 A3 B1 B2 B3 S1 S2 S3 E1 E2 E3 | +| | | +| DRFTINFO | XDR YDR HRDR | +| | | +| RRT_INFO | [RRTEVENT] | +| | | +| CTP_INFO | [CTPEVENT] TOCC GCDTT | +| | | +| SST_INFO | [SSTEVENT] MSST | +| | | +| PM_EVENT | 207004 POB 207000 PQM PPC PRC | +| | | +| P__EVENT | POB PQM PPC PRC | +| | | +| Q__EVENT | QOB QQM QPC QRC | +| | | +| TM_EVENT | 207001 TOB 207000 TQM TPC TRC | +| | | +| T__EVENT | TOB TQM TPC TRC | +| | | +| Z__EVENT | ZOB ZQM ZPC ZRC | +| | | +| W__EVENT | UOB VOB WQM WPC WRC | +| | | +| DF_EVENT | DDO FFO DFQ DFP DFR | +| | | +| PWTEVENT | PWO PWQ PWP PWR | +| | | +| PW1EVENT | PW1O PW1Q PW1P PW1R | +| | | +| PW2EVENT | PW2O PW2Q PW2P PW2R | +| | | +| PW3EVENT | PW3O PW3Q PW3P PW3R | +| | | +| PW4EVENT | PW4O PW4Q PW4P PW4R | +| | | +| RRTEVENT | 202130 201134 REQV 201000 202000 RRTQM RRTPC RRTRC | +| | | +| CTPEVENT | CDTP CTPQM CTPPC CTPRC | +| | | +| SSTEVENT | SST1 SSTQM SSTPC SSTRC | +| | | +| P__BACKG | POE PFC | +| | | +| Q__BACKG | QOE QFC | +| | | +| T__BACKG | TOE TFC | +| | | +| Z__BACKG | ZFC | +| | | +| W__BACKG | WOE UFC VFC | +| | | +| PWTBACKG | PWE PWF | +| | | +| PW1BACKG | PW1E PW1F | +| | | +| PW2BACKG | PW2E PW2F | +| | | +| PW3BACKG | PW3E PW3F | +| | | +| PW4BACKG | PW4E PW4F | +| | | +| RRTBACKG | RRTOE RRTFC | +| | | +| CTPBACKG | CTPOE CTPFC | +| | | +| SSTBACKG | SSTOE SSTFC | +| | | +| TM_BACKG | 207001 TOE 207000 TFC | +| | | +| P__POSTP | PAN | +| | | +| Q__POSTP | QAN | +| | | +| T__POSTP | TAN | +| | | +| Z__POSTP | ZAN | +| | | +| W__POSTP | UAN VAN | +| | | +| PWTPOSTP | PWA | +| | | +| PW1POSTP | PW1A | +| | | +| PW2POSTP | PW2A | +| | | +| PW3POSTP | PW3A | +| | | +| PW4POSTP | PW4A | +| | | +| RRTPOSTP | RRTAN | +| | | +| CTPPOSTP | CTPAN | +| | | +| SSTPOSTP | SSTAN | +| | | +| PCLIMATO | PCL PCS | +| | | +| QCLIMATO | QCL QCS | +| | | +| TCLIMATO | TCL TCS | +| | | +| ZCLIMATO | ZCL ZCS | +| | | +| WCLIMATO | UCL UCS VCL VCS | +| | | +| PFC__MSQ | PFCMOD | +| | | +| QFC__MSQ | QFCMOD | +| | | +| TFC__MSQ | TFCMOD | +| | | +| ZFC__MSQ | ZFCMOD | +| | | +| WFC__MSQ | UFCMOD VFCMOD | +| | | +| PWF__MSQ | PWFMOD | +| | | +| PW1F_MSQ | PW1FMOD | +| | | +| PW2F_MSQ | PW2FMOD | +| | | +| PW3F_MSQ | PW3FMOD | +| | | +| PW4F_MSQ | PW4FMOD | +| | | +|------------------------------------------------------------------------------| +| MNEMONIC | SCAL | REFERENCE | BIT | UNITS |-------------| +|----------|------|-------------|-----|--------------------------|-------------| +| | | | | |-------------| +| ACID | 0 | 0 | 64 | CCITT IA5 |-------------| +| SAID | 0 | 0 | 10 | CODE TABLE |-------------| +| SID | 0 | 0 | 64 | CCITT IA5 |-------------| +| SIRC | 0 | 0 | 4 | CODE TABLE |-------------| +| MSST | 0 | 0 | 3 | CODE TABLE |-------------| +| ITP | 0 | 0 | 8 | CODE TABLE |-------------| +| RPT | 3 | 0 | 16 | HOURS |-------------| +| DHR | 3 | -24000 | 16 | HOURS |-------------| +| TCOR | 0 | 0 | 3 | CODE TABLE |-------------| +| RCT | 2 | 0 | 12 | HOURS |-------------| +| YOB | 2 | -9000 | 15 | DEG N |-------------| +| ATRN | 0 | 0 | 11 | NUMERIC |-------------| +| CTCN | 0 | 0 | 7 | NUMERIC |-------------| +| XOB | 2 | -18000 | 16 | DEG E |-------------| +| VSSO | 0 | 0 | 6 | CODE TABLE |-------------| +| ACAV | 0 | 0 | 16 | NUMERIC |-------------| +| ELV | 0 | -1000 | 17 | METER |-------------| +| SPRR | 3 | 0 | 10 | NUMERIC |-------------| +| RSRD | 0 | 0 | 9 | FLAG TABLE |-------------| +| EXPRSRD | 0 | 0 | 8 | HOURS |-------------| +| SQN | 0 | 0 | 19 | NUMERIC |-------------| +| PROCN | 0 | 0 | 7 | NUMERIC |-------------| +| TYP | 0 | 0 | 9 | CODE TABLE |-------------| +| T29 | 0 | 0 | 10 | CODE TABLE |-------------| +| TSB | 0 | 0 | 3 | CODE TABLE |-------------| +| PRVSTG | 0 | 0 | 64 | CCITT IA5 |-------------| +| SPRVSTG | 0 | 0 | 64 | CCITT IA5 |-------------| +| TDMP | 0 | 0 | 4 | CODE TABLE |-------------| +| ASMP | 0 | 0 | 4 | CODE TABLE |-------------| +| PCAT | 2 | 0 | 7 | KELVIN |-------------| +| .DTH.... | 0 | 0 | 8 | HOURS |-------------| +| .DTM.... | 0 | 0 | 6 | MINUTES |-------------| +| HRDR | 3 | -24000 | 16 | HOURS |-------------| +| CHNM | 0 | 0 | 6 | NUMERIC |-------------| +| YDR | 2 | -9000 | 15 | DEG N |-------------| +| XDR | 2 | -18000 | 16 | DEG E |-------------| +| ELEV | 2 | -9000 | 15 | DEGREE |-------------| +| SOEL | 2 | -9000 | 15 | DEGREE |-------------| +| DBSS | 1 | 0 | 17 | METERS |-------------| +| POB | 1 | 0 | 14 | MB |-------------| +| PQM | 0 | 0 | 5 | CODE TABLE |-------------| +| PPC | 0 | 0 | 5 | CODE TABLE |-------------| +| PRC | 0 | 0 | 10 | CODE TABLE |-------------| +| PFC | 1 | 0 | 14 | MB |-------------| +| POE | 1 | 0 | 10 | MB |-------------| +| PAN | 1 | 0 | 14 | MB |-------------| +| PCL | 1 | 0 | 14 | MB |-------------| +| PCS | 1 | 0 | 14 | MB |-------------| +| POAF | 0 | 0 | 3 | CODE TABLE |-------------| +| CAT | 0 | 0 | 6 | CODE TABLE |-------------| +| .RE.... | 0 | 0 | 3 | CODE TABLE |-------------| +| ZOB | 0 | -1000 | 17 | METER |-------------| +| ALSE | -1 | 0 | 14 | PASCALS |-------------| +| 3HPC | -1 | -500 | 10 | PASCALS |-------------| +| 24PC | -1 | -1000 | 11 | PASCALS |-------------| +| CHPT | 0 | 0 | 4 | CODE TABLE |-------------| +| PRSS | -1 | 0 | 14 | PASCALS |-------------| +| PMO | 1 | 0 | 14 | MB |-------------| +| PMQ | 0 | 0 | 5 | CODE TABLE |-------------| +| ZQM | 0 | 0 | 5 | CODE TABLE |-------------| +| ZPC | 0 | 0 | 5 | CODE TABLE |-------------| +| ZRC | 0 | 0 | 10 | CODE TABLE |-------------| +| ZFC | 0 | -1000 | 17 | METER |-------------| +| ZOE | 0 | 0 | 10 | METER |-------------| +| ZAN | 0 | -1000 | 17 | METER |-------------| +| ZCL | 0 | -1000 | 17 | METER |-------------| +| ZCS | 0 | 0 | 10 | METER |-------------| +| DDO | 0 | 0 | 9 | DEGREES |-------------| +| SOB | 1 | 0 | 12 | M/S |-------------| +| UOB | 1 | -4096 | 13 | M/S |-------------| +| VOB | 1 | -4096 | 13 | M/S |-------------| +| DGOT | 0 | 0 | 4 | CODE TABLE |-------------| +| MXGS | 1 | 0 | 12 | M/S |-------------| +| MXGD | 0 | 0 | 9 | DEGREES |-------------| +| WDIR1 | 0 | 0 | 9 | DEGREES |-------------| +| WSPD1 | 1 | 0 | 12 | M/S |-------------| +| PKWDDR | 0 | 0 | 9 | DEGREES |-------------| +| PKWDSP | 1 | 0 | 12 | M/S |-------------| +| SQM | 0 | 0 | 5 | CODE TABLE |-------------| +| DFQ | 0 | 0 | 5 | CODE TABLE |-------------| +| DFP | 0 | 0 | 5 | CODE TABLE |-------------| +| DFR | 0 | 0 | 10 | CODE TABLE |-------------| +| XS10 | 1 | 0 | 12 | M/S |-------------| +| XS20 | 1 | 0 | 12 | M/S |-------------| +| TRBX10 | 0 | 0 | 6 | CODE TABLE |-------------| +| TRBX21 | 0 | 0 | 6 | CODE TABLE |-------------| +| TRBX32 | 0 | 0 | 6 | CODE TABLE |-------------| +| TRBX43 | 0 | 0 | 6 | CODE TABLE |-------------| +| WQM | 0 | 0 | 5 | CODE TABLE |-------------| +| WPC | 0 | 0 | 5 | CODE TABLE |-------------| +| WRC | 0 | 0 | 10 | CODE TABLE |-------------| +| UFC | 1 | -4096 | 13 | M/S |-------------| +| VFC | 1 | -4096 | 13 | M/S |-------------| +| WOE | 1 | 0 | 10 | M/S |-------------| +| UAN | 1 | -4096 | 13 | M/S |-------------| +| VAN | 1 | -4096 | 13 | M/S |-------------| +| UCL | 1 | -4096 | 13 | M/S |-------------| +| VCL | 1 | -4096 | 13 | M/S |-------------| +| UCS | 1 | 0 | 10 | M/S |-------------| +| VCS | 1 | 0 | 10 | M/S |-------------| +| FFO | 0 | 0 | 9 | KNOTS |-------------| +| MXTM | 2 | 0 | 16 | KELVIN |-------------| +| MITM | 2 | 0 | 16 | KELVIN |-------------| +| TMSK | 2 | 0 | 16 | KELVIN |-------------| +| TMBR | 2 | 0 | 16 | KELVIN |-------------| +| GCDTT | 2 | 0 | 16 | KELVIN |-------------| +| TVO | 1 | -2732 | 14 | DEG C |-------------| +| TDO | 1 | -2732 | 14 | DEG C |-------------| +| TOB | 1 | -2732 | 14 | DEG C |-------------| +| TQM | 0 | 0 | 5 | CODE TABLE |-------------| +| TPC | 0 | 0 | 5 | CODE TABLE |-------------| +| TRC | 0 | 0 | 10 | CODE TABLE |-------------| +| TFC | 1 | -2732 | 14 | DEG C |-------------| +| TOE | 1 | 0 | 10 | DEG C |-------------| +| TAN | 1 | -2732 | 14 | DEG C |-------------| +| TCL | 1 | -2732 | 14 | DEG C |-------------| +| TCS | 1 | 0 | 10 | DEG C |-------------| +| TOPC | 1 | -1 | 14 | KG/M**2 |-------------| +| DOFS | 2 | -2 | 12 | METERS |-------------| +| TOSD | 2 | -2 | 16 | METERS |-------------| +| REQV | 4 | 0 | 12 | KG/((METER**2)*SECOND) |-------------| +| TP01 | 1 | -1 | 14 | KG/M**2 |-------------| +| TP03 | 1 | -1 | 14 | KG/M**2 |-------------| +| TP06 | 1 | -1 | 14 | KG/M**2 |-------------| +| TP12 | 1 | -1 | 14 | KG/M**2 |-------------| +| TP24 | 1 | -1 | 14 | KG/M**2 |-------------| +| PWO | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PW1O | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PW2O | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PW3O | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| QOB | 0 | 0 | 16 | MG/KG |-------------| +| QQM | 0 | 0 | 5 | CODE TABLE |-------------| +| QPC | 0 | 0 | 5 | CODE TABLE |-------------| +| QRC | 0 | 0 | 10 | CODE TABLE |-------------| +| QFC | 0 | 0 | 16 | MG/KG |-------------| +| QOE | 1 | 0 | 10 | PERCENT DIVIDED BY 10 |-------------| +| QAN | 0 | 0 | 16 | MG/KG |-------------| +| QCL | 0 | 0 | 16 | MG/KG |-------------| +| QCS | 0 | 0 | 16 | MG/KG |-------------| +| TOSS | 0 | 0 | 11 | MINUTE |-------------| +| OZON | 0 | 0 | 10 | DOBSON UNITS |-------------| +| HOVI | -1 | 0 | 13 | METER |-------------| +| VTVI | -1 | 0 | 7 | METER |-------------| +| PRWE | 0 | 0 | 9 | CODE TABLE |-------------| +| PSW1 | 0 | 0 | 5 | CODE TABLE |-------------| +| PSW2 | 0 | 0 | 5 | CODE TABLE |-------------| +| TOCC | 0 | 0 | 7 | PERCENT |-------------| +| CLAM | 0 | 0 | 4 | CODE TABLE |-------------| +| CLTP | 0 | 0 | 6 | CODE TABLE |-------------| +| HOCB | -1 | -40 | 11 | METER |-------------| +| HOCT | -1 | -40 | 11 | METER |-------------| +| CDTP | -1 | 0 | 14 | PASCALS |-------------| +| HBLCS | 0 | 0 | 4 | CODE TABLE |-------------| +| CTPQM | 0 | 0 | 5 | CODE TABLE |-------------| +| CTPPC | 0 | 0 | 5 | CODE TABLE |-------------| +| CTPRC | 0 | 0 | 10 | CODE TABLE |-------------| +| CTPFC | -1 | 0 | 14 | PASCALS |-------------| +| CTPOE | -1 | 0 | 10 | PASCALS |-------------| +| CTPAN | -1 | 0 | 14 | PASCALS |-------------| +| A1 | 1 | 0 | 12 | DEGREE |-------------| +| A2 | 1 | 0 | 12 | DEGREE |-------------| +| A3 | 1 | 0 | 12 | DEGREE |-------------| +| B1 | 1 | 0 | 12 | DEGREE |-------------| +| B2 | 1 | 0 | 12 | DEGREE |-------------| +| B3 | 1 | 0 | 12 | DEGREE |-------------| +| S1 | 2 | -5000 | 13 | DECIBEL |-------------| +| S2 | 2 | -5000 | 13 | DECIBEL |-------------| +| S3 | 2 | -5000 | 13 | DECIBEL |-------------| +| E1 | 0 | 0 | 7 | PERCENT |-------------| +| E2 | 0 | 0 | 7 | PERCENT |-------------| +| E3 | 0 | 0 | 7 | PERCENT |-------------| +| DOSW | 0 | 0 | 9 | DEGREES TRUE |-------------| +| POWV | 0 | 0 | 6 | SECONDS |-------------| +| POWW | 0 | 0 | 6 | SECONDS |-------------| +| POSW | 0 | 0 | 6 | SECONDS |-------------| +| HOWV | 1 | 0 | 10 | METERS |-------------| +| HOWW | 1 | 0 | 10 | METERS |-------------| +| HOSW | 1 | 0 | 10 | METERS |-------------| +| SST1 | 2 | 0 | 15 | KELVIN |-------------| +| SSTQM | 0 | 0 | 5 | CODE TABLE |-------------| +| SSTPC | 0 | 0 | 5 | CODE TABLE |-------------| +| SSTRC | 0 | 0 | 10 | CODE TABLE |-------------| +| SSTFC | 2 | 0 | 15 | KELVIN |-------------| +| SSTOE | 1 | 0 | 10 | KELVIN |-------------| +| SSTAN | 2 | 0 | 15 | KELVIN |-------------| +| RFFL | 0 | 0 | 8 | NUMERIC |-------------| +| RRTQM | 0 | 0 | 5 | CODE TABLE |-------------| +| RRTPC | 0 | 0 | 5 | CODE TABLE |-------------| +| RRTRC | 0 | 0 | 10 | CODE TABLE |-------------| +| RRTFC | 6 | 0 | 18 | KG/((M**2)*S) (OR MM/S) |-------------| +| RRTOE | 6 | 0 | 18 | KG/((M**2)*S) (OR MM/S) |-------------| +| RRTAN | 6 | 0 | 18 | KG/((M**2)*S) (OR MM/S) |-------------| +| PWQ | 0 | 0 | 5 | CODE TABLE |-------------| +| PWP | 0 | 0 | 5 | CODE TABLE |-------------| +| PWR | 0 | 0 | 10 | CODE TABLE |-------------| +| PWF | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PWE | 1 | 0 | 10 | KG/M**2 (OR MM) |-------------| +| PWA | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PW1Q | 0 | 0 | 5 | CODE TABLE |-------------| +| PW1P | 0 | 0 | 5 | CODE TABLE |-------------| +| PW1R | 0 | 0 | 10 | CODE TABLE |-------------| +| PW1F | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PW1E | 1 | 0 | 10 | KG/M**2 (OR MM) |-------------| +| PW1A | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PW2Q | 0 | 0 | 5 | CODE TABLE |-------------| +| PW2P | 0 | 0 | 5 | CODE TABLE |-------------| +| PW2R | 0 | 0 | 10 | CODE TABLE |-------------| +| PW2F | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PW2E | 1 | 0 | 10 | KG/M**2 (OR MM) |-------------| +| PW2A | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PW3Q | 0 | 0 | 5 | CODE TABLE |-------------| +| PW3P | 0 | 0 | 5 | CODE TABLE |-------------| +| PW3R | 0 | 0 | 10 | CODE TABLE |-------------| +| PW3F | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PW3E | 1 | 0 | 10 | KG/M**2 (OR MM) |-------------| +| PW3A | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PW4O | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PW4Q | 0 | 0 | 5 | CODE TABLE |-------------| +| PW4P | 0 | 0 | 5 | CODE TABLE |-------------| +| PW4R | 0 | 0 | 10 | CODE TABLE |-------------| +| PW4F | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PW4E | 1 | 0 | 10 | KG/M**2 (OR MM) |-------------| +| PW4A | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PFCMOD | 1 | 0 | 14 | MB |-------------| +| ZFCMOD | 0 | -1000 | 17 | METER |-------------| +| UFCMOD | 1 | -4096 | 13 | M/S |-------------| +| VFCMOD | 1 | -4096 | 13 | M/S |-------------| +| TFCMOD | 1 | -2732 | 14 | DEG C |-------------| +| QFCMOD | 0 | 0 | 16 | MG/KG |-------------| +| PWFMOD | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PW1FMOD | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PW2FMOD | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PW3FMOD | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| PW4FMOD | 1 | 0 | 11 | KG/M**2 (OR MM) |-------------| +| SABERT | 0 | 0 | 16 | FLAG TABLE |-------------| +| SABERQ | 2 | 0 | 16 | NUMERIC |-------------| +| SABERC | 2 | 0 | 16 | NUMERIC |-------------| +| SABERRT | 2 | 0 | 16 | KELVIN |-------------| +| SABERRQ | 2 | 0 | 16 | NUMERIC |-------------| +| | | | | |-------------| +`------------------------------------------------------------------------------' From bca083694ddeac8480c25339e046d49e2f6a49f0 Mon Sep 17 00:00:00 2001 From: Ricardo Todling Date: Mon, 6 Nov 2023 15:27:51 -0500 Subject: [PATCH 2/5] now time slot in ODS seems correct --- src/Applications/SABER_App/m_saber.f | 821 +++++++++-------------- src/Applications/SABER_App/saber2ods.f90 | 266 ++++---- 2 files changed, 440 insertions(+), 647 deletions(-) diff --git a/src/Applications/SABER_App/m_saber.f b/src/Applications/SABER_App/m_saber.f index c57c919c..f1ea67f3 100644 --- a/src/Applications/SABER_App/m_saber.f +++ b/src/Applications/SABER_App/m_saber.f @@ -12,6 +12,7 @@ module m_saber use m_ods use m_odsmeta, only: H_DESCEND, H_ASCEND + use m_odsmeta, only: ktTT, kto3mx, ktww implicit none @@ -35,19 +36,28 @@ module m_saber ! Overloaded Interfaces ! --------------------- Interface SABER_Get - module procedure SABER_Get1_ + module procedure SABER_Dims_ module procedure SABER_GetM_ + module procedure SABER_range_ end Interface + integer, parameter :: minutes1day = 24 * 60 + integer, parameter :: minutes3hrs = 3 * 60 +! integer, parameter :: mflush = 320 ! not clear what this is about + integer, parameter :: mflush = 400 ! not clear what this is about integer, parameter :: std_levels = 400 integer, parameter :: max_allevents = 2500 +! integer, parameter :: std_levels = 500 +! integer, parameter :: max_allevents = 2200 + integer, dimension(max_allevents) :: tdate real, dimension(std_levels,max_allevents) :: lat, lon integer, dimension(std_levels,max_allevents) :: time, date integer, dimension(max_allevents) :: tpAD real, dimension(std_levels,max_allevents) :: pres, temp, - $ density, h2o + $ density, h2o, o3_96 real, dimension(std_levels,max_allevents) :: pres_e, $ temp_e, density_e, h2o_e + logical :: intime(std_levels,max_allevents) integer start_pt CONTAINS @@ -57,18 +67,19 @@ module m_saber !------------------------------------------------------------------------- !BOP ! -! !IROUTINE: SABER_Get1_ --- Reads data from a single SABER file and returns -! an ODS vector. +! !IROUTINE: SABER_GetM_ --- Reads data from a multiple SABER files and +! returns an ODS vector. ! ! !INTERFACE: - subroutine SABER_Get1_ ( version, fname, nymd, nhms, ods, rc) + subroutine SABER_GetM_ ( version, fname, nymd, nhms, + $ ods, rc) implicit none ! !INPUT PARAMETERS: ! - character(len=*), intent(in) :: version ! SABER version - character(len=*), intent(in) :: fname ! SABER file name + character(len=*), intent(in) :: version ! SABER version + character(len=*), intent(in) :: fname ! SABER file name integer, intent(in) :: nymd ! year-month-day, e.g., 19990701 integer, intent(in) :: nhms ! hour-min-sec, e.g., 120000 @@ -78,7 +89,7 @@ subroutine SABER_Get1_ ( version, fname, nymd, nhms, ods, rc) type(ods_vect), intent(out) :: ods ! ODS vector integer, intent(out) :: rc ! Error return code: - ! = 0 - all is well + ! = 0 - all is well ! !DESCRIPTION: ! \label{SABER:GetM} @@ -95,14 +106,15 @@ subroutine SABER_Get1_ ( version, fname, nymd, nhms, ods, rc) !------------------------------------------------------------------------- integer :: s_julian,s_date ! Selected date and synoptic time - integer :: n,m,i,k,oc + integer :: n,m,i,k,oc,nfiles integer :: min_bnd(2) + integer :: min_tods, max_tods,tgap + integer :: n_levels,n_events integer :: timediff,year,jan01,jul_day,doy,ksnum,iminutes integer, parameter :: dist_tol = 0.001 - real :: minutes,ob_array(3) + real :: minutes,ob_array(4) logical :: levflag,skipflag,skipall integer, external :: ODS_Julian - integer, external :: ODS_Caldat ! Set meta data attributes call SABER_meta_(ods%meta%kt_names,ods%meta%kt_units, @@ -110,25 +122,37 @@ subroutine SABER_Get1_ ( version, fname, nymd, nhms, ods, rc) rc=0 start_pt=1 + intime=.false. + + call read_ ( version, fname, n_events, n_levels ) - call readfile ( version, fname ) + call get_range_ (std_levels,start_pt-1,nhms,intime) +!_RT print *, 'nhms = ', nhms + min_tods = -180 + max_tods = 180 if(nhms.eq.000000)then - min_bnd(1)=-180 - min_bnd(2)=180 + min_bnd(1)= -180 + min_bnd(2)= 0 + tgap = 0 elseif(nhms.eq.060000)then - min_bnd(1)=180 - min_bnd(2)=540 + min_bnd(1)= 180 + min_bnd(2)= 6*60 + tgap = 360 elseif(nhms.eq.120000)then - min_bnd(1)=540 - min_bnd(2)=900 + min_bnd(1)= 540 + min_bnd(2)= 12*60 + tgap = 720 elseif(nhms.eq.180000)then - min_bnd(1)=900 - min_bnd(2)=1260 + min_bnd(1)= 900 + min_bnd(2)= 18*60 + tgap = 1080 else print *,'Synoptic time ',nhms,'Z is not a valid time.' stop endif +! min_bnd(1)= -180 +! min_bnd(2)= 180 s_julian=ODS_Julian(nymd) ! print *, 'Total number of events=',start_pt-1 @@ -138,7 +162,7 @@ subroutine SABER_Get1_ ( version, fname, nymd, nhms, ods, rc) oc=1 ksnum=1 ! Cycle through the events. - do n=1,start_pt-1 + do n=1,n_events !start_pt-1 levflag=.false. ! This flag is activated when processing reaches ! somewhere near the end of the "level" portion of ! this input data array. This allows the program @@ -152,18 +176,21 @@ subroutine SABER_Get1_ ( version, fname, nymd, nhms, ods, rc) ! of obs with impossible locations. ! Cycle through the levels. - do m=1,std_levels + do m=1,n_levels !std_levels + + if(.not.intime(m,n)) cycle ! Find the end of the number of levels for which there are data. - if(abs(lat(m,n)).ge.dist_tol.and.abs(lon(m,n)).ge. - $ dist_tol.and.time(m,n).ne.0)then + if(abs(lat(m,n)).ge.dist_tol.and. + $ abs(lon(m,n)).ge.dist_tol.and. + $ time(m,n).ne.0)then ! Use only data below 0.01 mb if(pres(m,n).ge.0.01)then ! Because netcdf arrays were not flushed, removed junk - ! from then ends. - if(m.gt.320)then + ! from the ends. + if(m.gt.mflush)then levflag=.true. timediff=time(m,n)-time(m-1,n) else @@ -192,32 +219,33 @@ subroutine SABER_Get1_ ( version, fname, nymd, nhms, ods, rc) jul_day=ODS_Julian(jan01)+doy-1 ! Because minutes can be greater than 1440 in the - ! last file of a day, make the subtract 1440 from + ! last file of a day, subtract 1440 from ! these numbers and increment the julian day. ! Get time into minutes - minutes=real(time(m,n))/60000.0 - if(minutes.ge.1260)then - minutes=minutes-1440.0 + minutes=time(m,n)/60000.0 + if(minutes.ge.minutes1day-minutes3hrs)then + minutes=minutes-minutes1day jul_day=jul_day+1 endif - iminutes=anint(minutes) + iminutes=anint(minutes) ! If the times in the file match our temporal search ! criteria write them to the ods arrays. - if(jul_day.eq.s_julian.and.iminutes.ge.min_bnd(1). - $ and.iminutes.lt.min_bnd(2))then + if(jul_day.eq.s_julian)then !.and.iminutes.ge.min_bnd(1) +! $ .and.iminutes.lt.min_bnd(2))then ! Obs types to be written to ods. ! Do some quick quality checks on the data -! if(temp(m,n).lt.0.and.temp(m,n).gt.1000)then - ob_array(1)=temp(m,n) -! else -! ob_array(1)=1.0e+15 -! endif +! if(temp(m,n).lt.0.and.temp(m,n).gt.1000)then + ob_array(1)=temp(m,n) +! else +! ob_array(1)=1.0e+15 +! endif - ob_array(2)=density(m,n) - ob_array(3)=h2o(m,n) + ob_array(2)=h2o(m,n)*0.001 ! pmmv to g/kg + ob_array(3)=O3_96(m,n) ! pmmv +! ob_array(4)=density(m,n) ! Convert lon from 0 to 360 into -180 to 180 if(lon(m,n).gt.180)then @@ -246,19 +274,21 @@ subroutine SABER_Get1_ ( version, fname, nymd, nhms, ods, rc) ods%data%lev(oc)=pres(m,n) ods%data%xm(oc)=0.0 ods%data%obs(oc)=ob_array(k) - ods%data%time(oc)=iminutes + ods%data%time(oc)=iminutes-min_bnd(2) ods%data%ks(oc)=ksnum if(k.eq.1)then - ods%data%kt(oc)=8 - elseif(k.eq.2)then - ods%data%kt(oc)=43 - else - ods%data%kt(oc)=7 + ods%data%kt(oc)=ktTT + elseif (k==2) then + ods%data%kt(oc)=ktww + elseif (k==3) then + ods%data%kt(oc)=kto3mx +! elseif(k.eq.4)then +! ods%data%kt(oc)=43 endif ods%data%kx(oc)=294 ods%data%qcexcl(oc)=0 select case (tpAD(n)) - case (0) + case (0) ods%data%qchist(oc)=H_ASCEND case (1) ods%data%qchist(oc)=H_DESCEND @@ -280,249 +310,8 @@ subroutine SABER_Get1_ ( version, fname, nymd, nhms, ods, rc) endif ! Check current level for valid data. enddo ! Reading level array. if(.not.levflag)then - print*,"Warning: current array has less than 320 levels." - print*,"File may be incomplete." - endif - enddo ! Reading event array. - - if(oc.eq.1)then - rc=1 ! No data were found matching the requested time and date. - else - ods%data%nobs=oc-1 - endif - return - end subroutine SABER_Get1_ - - -!------------------------------------------------------------------------- -! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! -!------------------------------------------------------------------------- -!BOP -! -! !IROUTINE: SABER_GetM_ --- Reads data from a multiple SABER files and -! returns an ODS vector. -! -! !INTERFACE: - - subroutine SABER_GetM_ ( version, nfiles, fnames, nymd, nhms, - $ ods, rc) - implicit none - -! !INPUT PARAMETERS: -! - character(len=*), intent(in) :: version ! SABER version - integer, intent(in) :: nfiles ! number of input files - character(len=*), intent(in) :: fnames(nfiles) ! SABER file name - integer, intent(in) :: nymd ! year-month-day, e.g., 19990701 - integer, intent(in) :: nhms ! hour-min-sec, e.g., 120000 - -! !OUTPUT PARAMETERS: -! - - type(ods_vect), intent(out) :: ods ! ODS vector - - integer, intent(out) :: rc ! Error return code: - ! = 0 - all is well - -! !DESCRIPTION: -! \label{SABER:GetM} -! This routine reads data from 1 SABER HDF files, allocates the necessary -! memory for the ODS vector, and loads the data for the synoptic time -! (nymd,nhms). -! -! !REVISION HISTORY: -! -! 12Mar2003 T. King Initial code is conceptually based on that of the -! m_roms.90 module for reading in ODS files. -! -!EOP -!------------------------------------------------------------------------- - - character*255 fname - integer :: s_julian,s_date ! Selected date and synoptic time - integer :: n,m,i,k,oc - integer :: min_bnd(2) - integer :: timediff,year,jan01,jul_day,doy,ksnum,iminutes - integer, parameter :: dist_tol = 0.001 - real :: minutes,ob_array(3) - logical :: levflag,skipflag,skipall - integer, external :: ODS_Julian - integer, external :: ODS_Caldat - -! Set meta data attributes - call SABER_meta_(ods%meta%kt_names,ods%meta%kt_units, - $ ods%meta%kx_names,ods%meta%kx_meta,ods%meta%qcx_names) - - rc=0 - start_pt=1 - - do i=1,nfiles - fname=fnames(i) - call readfile ( version, fname ) - enddo - - if(nhms.eq.000000)then - min_bnd(1)=-180 - min_bnd(2)=180 - elseif(nhms.eq.060000)then - min_bnd(1)=180 - min_bnd(2)=540 - elseif(nhms.eq.120000)then - min_bnd(1)=540 - min_bnd(2)=900 - elseif(nhms.eq.180000)then - min_bnd(1)=900 - min_bnd(2)=1260 - else - print *,'Synoptic time ',nhms,'Z is not a valid time.' - stop - endif - s_julian=ODS_Julian(nymd) - -! print *, 'Total number of events=',start_pt-1 - -! Begin writing to ODS vector. - - oc=1 - ksnum=1 - ! Cycle through the events. - do n=1,start_pt-1 - levflag=.false. ! This flag is activated when processing reaches - ! somewhere near the end of the "level" portion of - ! this input data array. This allows the program - ! to search for old unflushed data. - - skipflag=.false. ! This allows the processing to skip past all - ! unflushed values in the level portion of the - ! input data array. - - skipall=.false. ! This flag allows for the skipping over sets - ! of obs with impossible locations. - - ! Cycle through the levels. - do m=1,std_levels - - ! Find the end of the number of levels for which there are data. - if(abs(lat(m,n)).ge.dist_tol.and.abs(lon(m,n)).ge. - $ dist_tol.and.time(m,n).ne.0)then - - ! Use only data below 0.01 mb - if(pres(m,n).ge.0.01)then - - ! Because netcdf arrays were not flushed, removed junk - ! from then ends. - if(m.gt.320)then - levflag=.true. - timediff=time(m,n)-time(m-1,n) - else - timediff=0 - endif - - ! If the current observation time is not significantly - ! less than the previous time we continue onward, - ! otherwise we've hit unflushed data and it's time to - ! skip the rest of the array go to the next data event. - if(.not.skipflag.and.timediff.ge.-15000)then - -! Start to get the internal time information out of the file for comparison -! with what was specified in the argument list. - - ! This strips off the "doy" and gives you the year. - year=date(m,n)/1000 - - ! This gives you the doy. - doy=date(m,n)-year*1000 - - ! Get the date of Jan 1st of the current year - jan01=(year*10000)+101 - - ! Then we get the Julian day and add back on the doy - - jul_day=ODS_Julian(jan01)+doy-1 - ! Because minutes can be greater than 1440 in the - ! last file of a day, make the subtract 1440 from - ! these numbers and increment the julian day. - - ! Get time into minutes - minutes=real(time(m,n))/60000.0 - if(minutes.ge.1260)then - minutes=minutes-1440.0 - jul_day=jul_day+1 - endif - iminutes=anint(minutes) - - ! If the times in the file match our temporal search - ! criteria write them to the ods arrays. - if(jul_day.eq.s_julian.and.iminutes.ge.min_bnd(1). - $ and.iminutes.lt.min_bnd(2))then - - ! Obs types to be written to ods. - ! Do some quick quality checks on the data -! if(temp(m,n).lt.0.and.temp(m,n).gt.1000)then - ob_array(1)=temp(m,n) -! else -! ob_array(1)=1.0e+15 -! endif - - ob_array(2)=density(m,n) - ob_array(3)=h2o(m,n) - - ! Convert lon from 0 to 360 into -180 to 180 - if(lon(m,n).gt.180)then - lon(m,n)=lon(m,n)-360 - endif - - ! Do a quick range check of lat and lon - if(abs(lon(m,n)).gt.180)then - print*,'Longitude out of range',lon(m,n) - skipall=.true. - elseif(abs(lat(m,n)).gt.90)then - print*,'Latitude out of range',lat(m,n) - skipall=.true. - endif - - ! If location is possible, continue onward. - if(.not.skipall)then - - do k=1,3 - - ! If data are not out of range, write them - ! to the ods structure. - if(ob_array(k).gt.0)then - ods%data%lat(oc)=lat(m,n) - ods%data%lon(oc)=lon(m,n) - ods%data%lev(oc)=pres(m,n) - ods%data%xm(oc)=0.0 - ods%data%obs(oc)=ob_array(k) - ods%data%time(oc)=iminutes - ods%data%ks(oc)=ksnum - if(k.eq.1)then - ods%data%kt(oc)=8 - elseif(k.eq.2)then - ods%data%kt(oc)=43 - else - ods%data%kt(oc)=7 - endif - ods%data%kx(oc)=294 - ods%data%qcexcl(oc)=0 - ods%data%qchist(oc)=0 - oc=oc+1 - endif ! Good data to write to ods structure. - enddo ! Cycle through obs loop. - ksnum=ksnum+1 - endif ! Location check. - skipall=.false. - endif ! Meet time criteria. - else - skipflag=.true. - endif ! Skip over unflushed data. - endif ! Pressure greater than 0.01. - - endif ! Check current level for valid data. - enddo ! Reading level array. - if(.not.levflag)then - print*,"Warning: current array has less than 320 levels." - print*,"File may be incomplete." +!_RT print*,"Warning: current array has less than ", mflush, " levels." +!_RT print*,"File may be incomplete." endif enddo ! Reading event array. @@ -535,197 +324,83 @@ subroutine SABER_GetM_ ( version, nfiles, fnames, nymd, nhms, end subroutine SABER_GetM_ - subroutine readfile ( version, fname ) - character(len=*), intent(in) :: version - character(len=*), intent(in) :: fname - select case (trim(version)) - case ("1.0") - call read_v1_(fname) - case ("2.0") - call read_v2_(fname) - case default - call read_v1_(fname) - end select - - endsubroutine readfile - - subroutine read_v1_ ( fname ) + subroutine saber_dims_ ( fname, + $ nymd, + $ doy, n_events, n_levels ) implicit none include 'netcdf.inc' -! -! !INPUT PARAMETERS: -! - - character(len=*) fname ! File name - -! Variables for ncopn - - integer fid - integer rc - -! Variables for ncinq - - integer ndims, nvars, ngatts, dimid - -! Variables for ncdid - - integer event_id, n_events, date_id - integer alt_id, n_levels - integer varid - character*100 varname - character*100 dimname - integer dimsize - - integer vartype, nvdims, vdims(MAXVDIMS), nvatts - -! Variables for data - - integer tdate - real buf (400,100) - integer ibuf (400,100) - integer start1D, start2D(2), edge2D(2) - -! Other vars - - integer i,j,end_pt - -! call ncpopt(NCVERBOS) + character(len=*), intent(in) :: fname + integer, intent(out) :: nymd + integer, optional, intent(out) :: doy, n_events, n_levels + + character(len=100) varname + integer ndims, nvars, ngatts, dimid, year, doy_ + integer beg(1), fin(1) + integer prev, now, nthis, jan01, julday + integer fid, id, ii, rc + integer, external :: ODS_Julian + integer, external :: ODS_Caldat +! Open file fid = ncopn (fname, NCNOWRIT, rc) - call ncinq (fid, ndims, nvars, ngatts, dimid, rc) - event_id = ncdid (fid, "event", rc) - alt_id = ncdid (fid, "altitude", rc) - - call ncdinq (fid, event_id, varname, n_events, rc) - end_pt = start_pt + n_events - 1 - if (end_pt .GT. max_allevents) then - print *, end_pt,' events is too many. Increase - $ size of max_allevents.' - stop - endif - - call ncdinq (fid, alt_id, varname, n_levels, rc) - -! Get date - - date_id = ncvid (fid, "date", rc) - call ncvgt (fid,date_id,1,1,tdate,rc) - if ( rc .ne. 0 ) then - print *, 'get date rc=',rc - endif -! print *, TRIM(fname), tdate -! print *, 'Number of events =',n_events -! print *, 'Number of levels=',n_levels - date(:,:)=tdate - - -! Set hyperslab dimensions - - start2D(1)=1 - start2D(2)=1 - edge2D(1)=n_levels - edge2D(2)=n_events - -! Get pressure & error - - varid = ncvid (fid, "pressure", rc) - call ncvgt (fid,varid,start2D,edge2D,buf,rc) - if ( rc .ne. 0 ) then - print *, 'get pres rc=',rc - endif - pres(:,start_pt:end_pt)=buf(:,1:n_events) - - varid = ncvid (fid, "pressure_error", rc) - call ncvgt (fid,varid,start2D,edge2D,buf,rc) - if ( rc .ne. 0 ) then - print *, 'get pres_e rc=',rc - endif - pres_e(:,start_pt:end_pt)=buf(:,1:n_events) - -! Get temperature & error - - varid = ncvid (fid, "ktemp", rc) - call ncvgt (fid,varid,start2D,edge2D,buf,rc) - if ( rc .ne. 0 ) then - print *, 'get temp rc=',rc - endif - temp(:,start_pt:end_pt)=buf(:,1:n_events) +! Inquire dims + call ncinq (fid, ndims, nvars, ngatts, dimid, rc) - varid = ncvid (fid, "ktemp_error", rc) - call ncvgt (fid,varid,start2D,edge2D,buf,rc) - if ( rc .ne. 0 ) then - print *, 'get temp_e rc=',rc + id = ncdid (fid, "event", rc) + call ncdinq (fid, id, varname, nthis, rc) + if(present(n_events)) then + n_events = nthis endif - temp_e(:,start_pt:end_pt)=buf(:,1:n_events) -! Get density and error - - varid = ncvid (fid, "density", rc) - call ncvgt (fid,varid,start2D,edge2D,buf,rc) - if ( rc .ne. 0 ) then - print *, 'get density rc=',rc - endif - density(:,start_pt:end_pt)=buf(:,1:n_events) + beg(1)=1 + fin(1)=nthis + id = ncvid (fid, "date", rc) + call ncvgt (fid,id,beg,fin,tdate,rc) + +! Make sure all data in file is for a single day + prev=-999 + do ii=1,nthis + if(tdate(ii)<197801) cycle + now=tdate(ii) + if (prev==-999) then + prev=now + cycle + endif + if(now/=prev) then + print *, 'Not all data in file at same day' + call exit (1) + endif + enddo - varid = ncvid (fid, "density_error", rc) - call ncvgt (fid,varid,start2D,edge2D,buf,rc) - if ( rc .ne. 0 ) then - print *, 'get density_e rc=',rc + ! This strips off the "doy" and gives you the year. + year=now/1000 + + ! This gives you the doy. + doy_=now-year*1000 + if(present(doy)) then + doy=doy_ endif - density_e(:,start_pt:end_pt)=buf(:,1:n_events) -! Get h2o and error + ! Get the date of Jan 1st of the current year + jan01=(year*10000)+101 - varid = ncvid (fid, "H2O", rc) - call ncvgt (fid,varid,start2D,edge2D,buf,rc) - if ( rc .ne. 0 ) then - print *, 'get h2o rc=',rc - endif - h2o(:,start_pt:end_pt)=buf(:,1:n_events) - - varid = ncvid (fid, "H2O_error", rc) - call ncvgt (fid,varid,start2D,edge2D,buf,rc) - if ( rc .ne. 0 ) then - print *, 'get h2o_e rc=',rc - endif - h2o_e(:,start_pt:end_pt)=buf(:,1:n_events) - -! Get latitude - - varid = ncvid (fid, "tplatitude", rc) - call ncvgt (fid,varid,start2D,edge2D,buf,rc) - if ( rc .ne. 0 ) then - print *, 'get lat rc=',rc - endif - lat(:,start_pt:end_pt)=buf(:,1:n_events) + ! Then we get the Julian day and add back on the doy + JulDay=ODS_Julian(jan01)+doy_-1 + nymd = ODS_CalDat ( JulDay ) -! Get longitude - - varid = ncvid (fid, "tplongitude", rc) - call ncvgt (fid,varid,start2D,edge2D,buf,rc) - if ( rc .ne. 0 ) then - print *, 'get lon rc=',rc + if (present(n_levels)) then + id = ncdid (fid, "altitude", rc) + call ncdinq (fid, id, varname, n_levels, rc) endif - lon(:,start_pt:end_pt)=buf(:,1:n_events) - -! Get time - - varid = ncvid (fid, "time", rc) - call ncvgt (fid,varid,start2D,edge2D,ibuf,rc) - if ( rc .ne. 0 ) then - print *, 'get time rc=',rc - endif - time(:,start_pt:end_pt)=ibuf(:,1:n_events) +! Close file call ncclos (fid, rc) - start_pt = start_pt + n_events - return - end subroutine read_v1_ + end subroutine saber_dims_ - subroutine read_v2_ ( fname ) + subroutine read_ ( version, fname, n_events, n_levels ) implicit none include 'netcdf.inc' @@ -733,7 +408,12 @@ subroutine read_v2_ ( fname ) ! !INPUT PARAMETERS: ! + character(len=*), intent(in) :: version character(len=*) fname ! File name +! +! !OUTPUT PARAMETERS: +! + integer, intent(out) :: n_events, n_levels ! Variables for ncopn @@ -746,8 +426,8 @@ subroutine read_v2_ ( fname ) ! Variables for ncdid - integer event_id, n_events, date_id - integer alt_id, n_levels + integer event_id, date_id + integer alt_id integer varid character*100 varname character*100 dimname @@ -757,24 +437,24 @@ subroutine read_v2_ ( fname ) ! Variables for data - integer tdate - real buf (400,100) - integer ibuf (400,100) + real, allocatable :: buf (:,:) + integer, allocatable :: ibuf (:,:) integer*2 cbuf (1,100) - integer start1D, start2D(2), edge2D(2) + integer start1D(1), edge1D(1), start2D(2), edge2D(2) ! Other vars integer i,j,end_pt + allocate(buf(std_levels,100)) + allocate(ibuf(std_levels,100)) + ! call ncpopt(NCVERBOS) fid = ncopn (fname, NCNOWRIT, rc) call ncinq (fid, ndims, nvars, ngatts, dimid, rc) - event_id = ncdid (fid, "event", rc) - - alt_id = ncdid (fid, "altitude", rc) + event_id = ncdid (fid, "event", rc) call ncdinq (fid, event_id, varname, n_events, rc) end_pt = start_pt + n_events - 1 if (end_pt .GT. max_allevents) then @@ -783,19 +463,24 @@ subroutine read_v2_ ( fname ) stop endif + alt_id = ncdid (fid, "altitude", rc) call ncdinq (fid, alt_id, varname, n_levels, rc) ! Get date + start1D(1)=1 + edge1D (1)=n_events date_id = ncvid (fid, "date", rc) - call ncvgt (fid,date_id,1,1,tdate,rc) + call ncvgt (fid,date_id,start1D,edge1D,tdate,rc) if ( rc .ne. 0 ) then print *, 'get date rc=',rc endif -! print *, TRIM(fname), tdate -! print *, 'Number of events =',n_events -! print *, 'Number of levels=',n_levels - date(:,:)=tdate +! print *, TRIM(fname), tdate(1:n_events) +! print *, 'Number of events =',n_events +! print *, 'Number of levels=',n_levels + do i=1,size(date,1) + date(i,start_pt:end_pt)=tdate + enddo ! Set hyperslab dimensions @@ -823,13 +508,16 @@ subroutine read_v2_ ( fname ) endif pres(:,start_pt:end_pt)=buf(:,1:n_events) -!_RT varid = ncvid (fid, "pressure_error", rc) -!_RT call ncvgt (fid,varid,start2D,edge2D,buf,rc) -!_RT if ( rc .ne. 0 ) then -!_RT print *, 'get pres_e rc=',rc -!_RT endif -!_RT pres_e(:,start_pt:end_pt)=buf(:,1:n_events) - pres_e(:,start_pt:end_pt)=99999. + if (trim(version) == "1.0") then + varid = ncvid (fid, "pressure_error", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get pres_e rc=',rc + endif + pres_e(:,start_pt:end_pt)=buf(:,1:n_events) + else + pres_e(:,start_pt:end_pt)=1.e15 + endif ! Get temperature & error @@ -840,13 +528,16 @@ subroutine read_v2_ ( fname ) endif temp(:,start_pt:end_pt)=buf(:,1:n_events) -!_RT varid = ncvid (fid, "ktemp_error", rc) -!_RT call ncvgt (fid,varid,start2D,edge2D,buf,rc) -!_RT if ( rc .ne. 0 ) then -!_RT print *, 'get temp_e rc=',rc -!_RT endif -!_RT temp_e(:,start_pt:end_pt)=buf(:,1:n_events) - temp_e(:,start_pt:end_pt)=1.0 + if (trim(version) == "1.0") then + varid = ncvid (fid, "ktemp_error", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get temp_e rc=',rc + endif + temp_e(:,start_pt:end_pt)=buf(:,1:n_events) + else + temp_e(:,start_pt:end_pt)=1.e15 + endif ! Get density and error @@ -857,13 +548,25 @@ subroutine read_v2_ ( fname ) endif density(:,start_pt:end_pt)=buf(:,1:n_events) -!_RT varid = ncvid (fid, "density_error", rc) -!_RT call ncvgt (fid,varid,start2D,edge2D,buf,rc) -!_RT if ( rc .ne. 0 ) then -!_RT print *, 'get density_e rc=',rc -!_RT endif -!_RT density_e(:,start_pt:end_pt)=buf(:,1:n_events) - density_e(:,start_pt:end_pt)=1.e15 + if (trim(version) == "1.0") then + varid = ncvid (fid, "density_error", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get density_e rc=',rc + endif + density_e(:,start_pt:end_pt)=buf(:,1:n_events) + else + density_e(:,start_pt:end_pt)=1.e15 + endif + +! Get o3_96 and error + + varid = ncvid (fid, "O3_96", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get o3_96 rc=',rc + endif + o3_96(:,start_pt:end_pt)=buf(:,1:n_events) ! Get h2o and error @@ -874,13 +577,16 @@ subroutine read_v2_ ( fname ) endif h2o(:,start_pt:end_pt)=buf(:,1:n_events) -!_RT varid = ncvid (fid, "H2O_error", rc) -!_RT call ncvgt (fid,varid,start2D,edge2D,buf,rc) -!_RT if ( rc .ne. 0 ) then -!_RT print *, 'get h2o_e rc=',rc -!_RT endif -!_RT h2o_e(:,start_pt:end_pt)=buf(:,1:n_events) - h2o_e(:,start_pt:end_pt)=1.e15 + if (trim(version) == "1.0") then + varid = ncvid (fid, "H2O_error", rc) + call ncvgt (fid,varid,start2D,edge2D,buf,rc) + if ( rc .ne. 0 ) then + print *, 'get h2o_e rc=',rc + endif + h2o_e(:,start_pt:end_pt)=buf(:,1:n_events) + else + h2o_e(:,start_pt:end_pt)=1.e15 + endif ! Get latitude @@ -912,8 +618,11 @@ subroutine read_v2_ ( fname ) call ncclos (fid, rc) start_pt = start_pt + n_events + deallocate(ibuf) + deallocate(buf) + return - end subroutine read_v2_ + end subroutine read_ subroutine SABER_meta_(ktnames,ktunits,kxnames,kxmeta,qcxnames) @@ -934,12 +643,14 @@ subroutine SABER_meta_(ktnames,ktunits,kxnames,kxmeta,qcxnames) kxnames(294)= $'SABER - Sounding of the Atmosphere Broadband Emission Radiometer' - ktnames(7)='Upper-air water vapor mixing ratio' - ktunits(7)='g/kg' - ktnames(8)='Upper-air temperature' - ktunits(8)='Kelvin' - ktnames(43)='Density of atmosphere' - ktunits(43)='1/cm*3' + ktnames(ktww)='Upper-air water vapor mixing ratio' + ktunits(ktww)='g/kg' + ktnames(ktTT)='Upper-air temperature' + ktunits(ktTT)='Kelvin' + ktnames(kto3mx)='Ozone mixing ratio' + ktunits(kto3mx)='ppmv' +! ktnames(43)='Density of atmosphere' +! ktunits(43)='1/cm*3' qcxnames(1)='clear' qcxnames(2)='unspecified preprocessing flag' @@ -979,6 +690,94 @@ subroutine SABER_meta_(ktnames,ktunits,kxnames,kxmeta,qcxnames) return end subroutine SABER_meta_ + subroutine get_range_ (mm,nn,nhms,intime) + integer, intent(in) :: mm,nn,nhms + logical, intent(inout) :: intime(:,:) + integer n,m,iminutes,synmin,synmina,synminb + integer trange(2) + real minutes + + trange(1)= 99999 + trange(2)=-trange(1) + synmin = (nhms/10000)*60 + synmina = synmin-180 + synminb = synmin+180 + intime=.false. + do m=1,mm + do n=1,nn + minutes=time(m,n)/60000.0 + if(minutes.ge.minutes1day-minutes3hrs)then + minutes=minutes-minutes1day + endif + iminutes=anint(minutes) + if (iminutes>=synmina .and. iminutestrange(2)) trange(2)=iminutes + intime(m,n)=.true. + endif + + enddo + enddo + !print*, 'nhms, time range: ', mm, nn, nhms, trange + end subroutine get_range_ + + subroutine SABER_range_ (fname, n_events, n_levels, syn) + + implicit none + include 'netcdf.inc' + + character(len=*), intent(in) :: fname + integer, intent(in) :: n_events, n_levels + logical, intent(inout) :: syn(:) + + integer fid,id,varid,rc + integer m,n,iminutes + integer start2D(2),edge2D(2) + integer, allocatable, dimension(:,:) :: mytime + real minutes + +! Open file + fid = ncopn (fname, NCNOWRIT, rc) + + start2D(1)=1 + start2D(2)=1 + edge2D(1)=n_levels + edge2D(2)=n_events + + allocate(mytime(n_levels,n_events)) + + varid = ncvid (fid, "time", rc) + call ncvgt (fid,varid,start2D,edge2D,mytime,rc) + if ( rc .ne. 0 ) then + print *, 'get_range2_: get time rc=',rc + call exit (1) + endif + + syn=.false. + do m=1,n_levels + do n=1,n_events + minutes=mytime(m,n)/60000.0 +! if(minutes.ge.minutes1day-minutes3hrs)then +! minutes=minutes-minutes1day +! endif + iminutes=anint(minutes) +! if (iminutestrange(2)) trange(2)=iminutes +! if (iminutes>=synmina .and. iminutes 0 .and. iminutes < 180) syn(1)=.true. ! disregard data at midnight + if (iminutes>= 180 .and. iminutes < 540) syn(2)=.true. + if (iminutes>= 540 .and. iminutes < 900) syn(3)=.true. + if (iminutes>= 900 .and. iminutes <1080) syn(4)=.true. + if (iminutes>=1080 ) syn(5)=.true. + enddo + enddo + + deallocate(mytime) + +! Close file + call ncclos (fid, rc) + + end subroutine SABER_range_ end module m_saber diff --git a/src/Applications/SABER_App/saber2ods.f90 b/src/Applications/SABER_App/saber2ods.f90 index 57a157bb..58bd6aaa 100644 --- a/src/Applications/SABER_App/saber2ods.f90 +++ b/src/Applications/SABER_App/saber2ods.f90 @@ -41,27 +41,34 @@ program saber2ods implicit none + integer, parameter :: nfiles_max=200 integer :: i,j,k,l integer :: num_options,nhms(5),nymd,iargc,pos - integer :: rc_saber_get,rc_ods_clean,rc_ods_init, & - rc_ods_put,rc_ods_get,rc_ods_open,rc_ods_close - integer :: ierr_write,ierr_app,rc + integer :: rc_ods_clean,rc_ods_init, & + rc_ods_put,rc_ods_open,rc_ods_close + integer :: iarg,argc,ierr_write,ierr_app,rc integer :: ncid integer :: fyear,fdoy,fjul_day,fcal_day,fjul_day_p1,fcal_day_p1, & jul_day, hh - integer :: ODS_Julian,ODS_Caldat - character(len=180) fnames(200),tempfname,arg,fn,odsname,bfrfname + integer :: n_events, n_levels + integer, external :: ODS_Julian,ODS_Caldat + character(len=180) fnames(nfiles_max),tempfname,arg,fn,odsname,bfrfname character(len=180) odstmpl,bfrtmpl + character(len=255) cmd character(len=8) cnymd character(len=4) cfyear character(len=3) cfdoy character(len=9) ftype character(len=10) s_string character(len=3) version + character(len=255) argv logical :: found,append,hit logical :: verbose,bexist - type(ods_vect) :: ods_struct,ods_old ! ODS vector - integer :: tnobs,fc + logical :: syn(5) + type(ods_vect) :: ods_struct(2), odsm ! ODS vector + integer :: tnobs,nfiles + + logical :: debug=.false. ! Initialize variables version = "2.0" @@ -75,69 +82,92 @@ program saber2ods nhms(4)=180000 nhms(5)=000000 i=1 - fc=1 + nfiles=0 s_string='SABER_L2A_' bfrtmpl='saber.l2a.obs.%y4%m2%d2_%h2z.bfr' bfrtmpl='NULL' -! Process argument list - num_options = iargc() - if (num_options .eq. 0 ) then - print *, "usage: saber2ods.x [-o odstmpl] saber_ncfile(s)" - print *, "odstmpl template for ODS output file(s)" - print *, "saber_ncfile(s) Input netcdf SABER file(s)" - stop - endif - odstmpl='' - do while (i .le. num_options) - call getarg (i,arg) - pos=index(arg,'-o') - if (i.eq.1.and.pos.gt.0)then - call getarg (2,arg) - odstmpl=arg - i=3 + odstmpl='saber.l2a.obs.%y4%m2%d2_%h2z.ods' + + ! Process argument list + argc = iargc() + if ( argc .lt. 1 ) call usage() + nfiles = 0 + iarg = 0 + do i = 1, 32767 + iarg = iarg + 1 + if ( iarg .gt. argc ) go to 111 + call GetArg ( iArg, argv ) + if (index(argv,'-o' ) .gt. 0 ) then + if ( iarg+1 .gt. argc ) call usage() + iarg = iarg + 1 + call GetArg ( iArg, odstmpl ) + else if (index(argv,'-verbose' ) .gt. 0 ) then + verbose= .true. + else if (index(argv,'-version' ) .gt. 0 ) then + if ( iarg+1 .gt. argc ) call usage() + iarg = iarg + 1 + call GetArg ( iArg, version ) else - if(len(trim(odstmpl)).eq.0)then - odstmpl='saber.l2a.obs.%y4%m2%d2_%h2z.ods' - endif - fnames(fc)=trim(arg) - fc=fc+1 - i=i+1 - endif - enddo + nfiles = nfiles + 1 + if ( nfiles .gt. nfiles_max ) then + print *, 'Maximum number of input files = ', nfiles_max + stop + end if + fnames(nfiles) = argv + end if + end do + 111 continue + if ( nfiles .lt. 1 ) call usage() + print * + print *, "Processing the following files:" + do j=1,nfiles + write(*,'(1x,a)') trim(fnames(j)) + enddo ! Begin reading files. - do j=1,fc-1 + do j=1,nfiles ! Search for date string in the filename. - pos=index(fnames(j),s_string) - tempfname=fnames(j) - cfyear=tempfname(pos+10:pos+13) - cfdoy=tempfname(pos+14:pos+16) - read(cfyear,204)fyear - 204 format(i4) - read(cfdoy,204)fdoy - 205 format(i3) - fyear=(10000*fyear)+101 - - fjul_day=ODS_Julian(fyear)+fdoy-1 - fjul_day_p1=ODS_Julian(fyear)+fdoy - - fcal_day=ODS_Caldat(fjul_day) - fcal_day_p1=ODS_Caldat(fjul_day_p1) - hit=.false. +! pos=index(fnames(j),s_string) +! tempfname=fnames(j) +! cfyear=tempfname(pos+10:pos+13) +! cfdoy=tempfname(pos+14:pos+16) +! read(cfyear,204)fyear +!204 format(i4) +! read(cfdoy,204)fdoy +!205 format(i3) +! fyear=(10000*fyear)+101 + +! fjul_day=ODS_Julian(fyear)+fdoy-1 +! fjul_day_p1=ODS_Julian(fyear)+fdoy + +! fcal_day=ODS_Caldat(fjul_day) +! fcal_day_p1=ODS_Caldat(fjul_day_p1) +! hit=.false. + + call SABER_Get(fnames(j), nymd, fdoy, n_events, n_levels) + call SABER_Get(fnames(j), n_events, n_levels, syn) + do k=1,5 ! Cycle through the possible synoptic times in the file + if(.not.syn(k)) cycle + if(k==5 .and. syn(5) ) then + fyear=nymd/10000 + fyear=(10000*fyear)+101 + fjul_day_p1=ODS_Julian(fyear)+fdoy + nymd=ODS_Caldat(fjul_day_p1) + endif + if(debug) cycle found=.false. append=.false. - nymd=fcal_day - if(k.eq.5)then - nymd=fcal_day_p1 - endif ! Create ods file name from template call StrTemplate ( odsname, odstmpl, 'GRADS', xid="saber", & nymd=nymd, nhms=nhms(k), stat=rc ) - ! generate/update ODS file w/ SABER data + ! Initialize ODS vector + call ODS_Init(ods_struct(1),tnobs,rc_ods_init) + + ! Generate/update ODS file w/ SABER data call saberods_(odsname) ! generate bufr file if desired @@ -154,16 +184,17 @@ program saber2ods call init_bufr(bfrfname,tablefile='saber_prepbufr_table',append=.false.) endif -! call write_bfr(stnid, xob, yob, dhr, typ, ib, & -! rstat, quality(jtm), convergence(jtm), & -! pob, tob, tqm, tprec, subset, idate) + call ods2bfr_ (ods_struct(1)) + endif + ! Release the ODS vector + call ODS_Clean(ods_struct(1),rc_ods_clean) enddo - if(.not.hit)then - print*, 'Warning! No data matching the files date and times were found.' - endif +! if(.not.hit)then +! print*, 'Warning! No data matching the files date and times were found.' +! endif enddo contains @@ -171,97 +202,54 @@ subroutine saberods_ (odsname) character(len=*), intent(in) :: odsname ! Initialize ods vector - call ODS_Init(ods_struct,tnobs,rc_ods_init) - call SABER_Get(version,fnames(j),nymd,nhms(k),ods_struct, & - rc_saber_get) + call SABER_Get(version,fnames(j),nymd,nhms(k),ods_struct(1),rc) ! If data matching the selected synoptic time were found, continue. - if(rc_saber_get.eq.0)then ! If something was read from the file, continue - hit=.true. + if(rc.eq.0)then ! If something was read from the file, continue +! hit=.true. ! Check to see if ods file already exists. inquire(file=odsname,exist=found) if(found)then - -! If the file is present read it and get the number of obs -! and then add those nobs to the ks values so ks is unique -! throughout the synoptic time. We also need to know if -! there are already obs written for the current synoptic -! time. If so, we have to set append=.true. - - call ODS_Get(odsname,nymd,nhms(k),ftype,ods_old, & - rc_ods_get) - if(verbose) print*, 'rc_ods_get = ',rc_ods_get - if(verbose) print*,'number of obs found for ',nhms(k),'Z is ', & - ods_old%data%nobs - if(ods_old%data%nobs.eq.0)then - print*,'Writing data at ',nymd,nhms(k),'Z to ',trim(odsname) - call ODS_Put(odsname,ftype,nymd,nhms(k),ods_struct, & - rc_ods_put) - if(verbose) print*,'rc_ods_put = ',rc_ods_put - else - print*,'Appending data at ',nymd,nhms(k),'Z to ',trim(odsname) - do l=1,ods_struct%data%nobs - ods_struct%data%ks(l)=ods_old%data%ks(ods_old%data%nobs) & - +ods_struct%data%ks(l) - enddo -! Append data to the current synoptic time. - call ODS_Open(ncid,odsname,'w',rc_ods_open) - if(verbose) print*,'rc_ods_open=',rc_ods_open - call ODS_Append(ncid,ods_struct%data%nobs,ierr_app) - if(verbose) print*,'ierr_app=',ierr_app - jul_day=ODS_Julian(nymd) - call ODS_PutR(ncid,'lat',jul_day,nhms(k)/10000,ods_struct%data%nobs, & - ods_struct%data%lat,ierr_write) - if(verbose) print*,'ierr_write=',ierr_write - call ODS_PutR(ncid,'lon',jul_day,nhms(k)/10000,ods_struct%data%nobs, & - ods_struct%data%lon,ierr_write) - if(verbose) print*,'ierr_write=',ierr_write - call ODS_PutR(ncid,'lev',jul_day,nhms(k)/10000,ods_struct%data%nobs, & - ods_struct%data%lev,ierr_write) - if(verbose) print*,'ierr_write=',ierr_write - call ODS_PutI(ncid,'time',jul_day,nhms(k)/10000,ods_struct%data%nobs, & - ods_struct%data%time,ierr_write) - if(verbose) print*,'ierr_write=',ierr_write - call ODS_PutI(ncid,'kt',jul_day,nhms(k)/10000,ods_struct%data%nobs, & - ods_struct%data%kt,ierr_write) - if(verbose) print*,'ierr_write=',ierr_write - call ODS_PutI(ncid,'kx',jul_day,nhms(k)/10000,ods_struct%data%nobs, & - ods_struct%data%kx,ierr_write) - if(verbose) print*,'ierr_write=',ierr_write - call ODS_PutI(ncid,'ks',jul_day,nhms(k)/10000,ods_struct%data%nobs, & - ods_struct%data%ks,ierr_write) - if(verbose) print*,'ierr_write=',ierr_write - call ODS_PutR(ncid,'xm',jul_day,nhms(k)/10000,ods_struct%data%nobs, & - ods_struct%data%xm,ierr_write) - if(verbose) print*,'ierr_write=',ierr_write - call ODS_PutI(ncid,'qcexcl',jul_day,nhms(k)/10000,ods_struct%data%nobs, & - ods_struct%data%qcexcl,ierr_write) - if(verbose) print*,'ierr_write=',ierr_write - call ODS_PutI(ncid,'qchist',jul_day,nhms(k)/10000,ods_struct%data%nobs, & - ods_struct%data%qchist,ierr_write) - if(verbose) print*,'ierr_write=',ierr_write - call ODS_PutR(ncid,'obs',jul_day,nhms(k)/10000,ods_struct%data%nobs, & - ods_struct%data%obs,ierr_write) - if(verbose) print*,'ierr_write=',ierr_write - - call ODS_Close(ncid,'SABER',rc_ods_close) - if(verbose) print*,'rc_ods_close=',rc_ods_close + call ODS_Get( odsname, nymd, nhms(k), ftype, ods_struct(2), rc ) + call ODS_Merge ( ods_struct, 2, odsm, rc ) + write(cmd,'(2a)') '/bin/rm -r ', trim(odsname) + call system(cmd) + call ODS_Put( odsname, ftype, nymd, nhms(k), odsm, rc ) + if( maxval(abs(odsm%data%time)) > 180 ) then + write(6,'(a,1x,i6.6,1x,a,2x,2i5)') & + 'At nhms= ', nhms(k), 'min/max time ', minval(odsm%data%time), maxval(odsm%data%time) + call exit(98) endif + write(6,'(a,1x,i6.6,1x,a,3(2x,i6))') & + 'At nhms: ', nhms(k), ' nobs (init,new,merge): ', ods_struct(1)%data%nobs, ods_struct(2)%data%nobs, odsm%data%nobs + call ODS_Clean( ods_struct(2), rc ) + call ODS_Clean( odsm, rc ) else -! Write data to an entirely NEW ods file - call ODS_Put(odsname,ftype,nymd,nhms(k),ods_struct,rc_ods_put) - if(verbose) print*,'rc_ods_put = ',rc_ods_put + if( maxval(abs(ods_struct(1)%data%time)) > 180 ) then + write(6,'(a,1x,i6.6,1x,a,2x,2i5)') & + 'At nhms= ', nhms(k), 'min/max time ', minval(ods_struct(1)%data%time), maxval(ods_struct(1)%data%time) + call exit(99) + endif + write(6,'(a,1x,i6.6,1x,a,2x,i6)') & + 'At nhms: ', nhms(k), ' nobs: ', ods_struct(1)%data%nobs + call ODS_Put(odsname,ftype,nymd,nhms(k),ods_struct(1),rc) endif else - if(verbose) print*,'No data at ',nymd,nhms(k) + if(verbose) print*,'No data from SABER at ',nymd,nhms(k) endif -! Deallocate the ods vector - call ODS_Clean(ods_struct,rc_ods_clean) return end subroutine saberods_ + subroutine ods2bfr_(ods) + + type(ods_vect) :: ods + +! call write_bfr(stnid, xob, yob, dhr, typ, ib, & +! rstat, quality(jtm), convergence(jtm), & +! pob, tob, tqm, tprec, subset, idate) + end subroutine ods2bfr_ subroutine write_bfr(stnid, xob, yob, dhr, typ, ib, & rstat, qual, conv, & pob, tob, tqm, tprec, subset, idate) @@ -325,6 +313,12 @@ subroutine write_bfr(stnid, xob, yob, dhr, typ, ib, & return end subroutine write_bfr + subroutine usage + print *, "usage: saber2ods.x [-o odstmpl] saber_ncfile(s)" + print *, "odstmpl template for ODS output file(s)" + print *, "saber_ncfile(s) Input netcdf SABER file(s)" + stop + end subroutine usage end program saber2ods From f0e6cad0c072fb4232f3cf4445e7fdfd79d2bd54 Mon Sep 17 00:00:00 2001 From: Ricardo Todling Date: Mon, 6 Nov 2023 15:30:04 -0500 Subject: [PATCH 3/5] add comment --- src/Applications/SABER_App/saber2ods.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Applications/SABER_App/saber2ods.f90 b/src/Applications/SABER_App/saber2ods.f90 index 58bd6aaa..6853f86f 100644 --- a/src/Applications/SABER_App/saber2ods.f90 +++ b/src/Applications/SABER_App/saber2ods.f90 @@ -25,6 +25,7 @@ ! - Pulled code into own directory (out of ODS) ! (need to link to bufr lib) ! - Output ODS now 6-hrly instead of daily files +! - Fixed timing getting into ODS time slot ! ! To do: ! 1. generate corresponding prepbufr file From 7690ae8242bf05891e640ead587fd8e457d88ad3 Mon Sep 17 00:00:00 2001 From: Ricardo Todling Date: Thu, 4 Jul 2024 08:56:36 -0400 Subject: [PATCH 4/5] latest upds to SABER v2 --- src/Applications/SABER_App/CMakeLists.txt | 11 +- src/Applications/SABER_App/m_pbutil.f | 4 +- src/Applications/SABER_App/m_saber.f | 27 +- src/Applications/SABER_App/m_saber_err.f90 | 138 +++++ src/Applications/SABER_App/mlsh5bfrT.f | 544 ------------------ src/Applications/SABER_App/saber2ods.f90 | 83 ++- src/Applications/SABER_App/saber_obserr.f | 208 +++++++ .../SABER_App/saber_prepbufr_table | 26 +- 8 files changed, 450 insertions(+), 591 deletions(-) create mode 100644 src/Applications/SABER_App/m_saber_err.f90 delete mode 100644 src/Applications/SABER_App/mlsh5bfrT.f create mode 100644 src/Applications/SABER_App/saber_obserr.f diff --git a/src/Applications/SABER_App/CMakeLists.txt b/src/Applications/SABER_App/CMakeLists.txt index dc370196..c38a641b 100644 --- a/src/Applications/SABER_App/CMakeLists.txt +++ b/src/Applications/SABER_App/CMakeLists.txt @@ -1,12 +1,17 @@ # This is equivalent to FOPT=$(FOPT3) in GNU Make if (CMAKE_Fortran_COMPILER_ID MATCHES Intel) - set (CMAKE_Fortran_FLAGS_RELEASE "${FOPT3} ${EXTENDED_SOURCE} ${BIG_ENDIAN} ${BYTERECLEN} ${FP_MODEL_STRICT} ${ALIGNCOM}") +# set (CMAKE_Fortran_FLAGS_RELEASE "${FOPT3} ${EXTENDED_SOURCE} ${BIG_ENDIAN} ${BYTERECLEN} ${FP_MODEL_STRICT} ${ALIGNCOM}") + set (CMAKE_Fortran_FLAGS_RELEASE "${FOPT3} ${EXTENDED_SOURCE} ${FP_MODEL_STRICT} ${ALIGNCOM}") endif () ecbuild_add_executable ( TARGET saber2ods.x - SOURCES saber2ods.f90 m_saber.f m_pbutil.f - LIBS GMAO_ods GMAO_mpeu NCEP_bufr_r8i4 NCEP_w3_r8i4 NetCDF::NetCDF_Fortran) + SOURCES saber2ods.f90 m_saber.f m_pbutil.f m_saber_err.f90 + LIBS GMAO_ods GMAO_hermes GMAO_mpeu NCEP_bufr_r8i4 NCEP_w3_r8i4 NetCDF::NetCDF_Fortran) # LIBS GMAO_ods GMAO_mpeu NetCDF::NetCDF_Fortran ) +ecbuild_add_executable ( + TARGET saber_obserr.x + SOURCES saber_obserr.f m_saber_err.f90 + LIBS GMAO_hermes NCEP_bufr_r8i4 NCEP_w3_r8i4 NetCDF::NetCDF_Fortran) diff --git a/src/Applications/SABER_App/m_pbutil.f b/src/Applications/SABER_App/m_pbutil.f index 9b62b42f..5d8fca55 100644 --- a/src/Applications/SABER_App/m_pbutil.f +++ b/src/Applications/SABER_App/m_pbutil.f @@ -105,7 +105,7 @@ subroutine init_bufr(outputfile, if (present(append)) then apnfile = append -! if true, inquire about output file. if not exist, set false +! if true, inquire about output file. if not exist, set false ! IF true will use 'apn' when opening bufr file. if (apnfile) then inquire(file=outputfile,exist=ex) @@ -138,7 +138,7 @@ subroutine init_bufr(outputfile, ludx = luavail() if ( usebufr ) then open(unit=ludx,file=bufrtable,action='read', - & form='unformatted') + & form='unformatted') else open(unit=ludx,file=bufrtable,action='read',form='formatted') endif diff --git a/src/Applications/SABER_App/m_saber.f b/src/Applications/SABER_App/m_saber.f index f1ea67f3..79cc5991 100644 --- a/src/Applications/SABER_App/m_saber.f +++ b/src/Applications/SABER_App/m_saber.f @@ -14,6 +14,8 @@ module m_saber use m_odsmeta, only: H_DESCEND, H_ASCEND use m_odsmeta, only: ktTT, kto3mx, ktww + use m_saber_err, only: saber_err_get + implicit none ! @@ -72,21 +74,23 @@ module m_saber ! ! !INTERFACE: - subroutine SABER_GetM_ ( version, fname, nymd, nhms, - $ ods, rc) + subroutine SABER_GetM_ ( version, fname, nymd, nhms, kscnt, + $ kxtyp, ods, rc) implicit none ! !INPUT PARAMETERS: ! character(len=*), intent(in) :: version ! SABER version character(len=*), intent(in) :: fname ! SABER file name - integer, intent(in) :: nymd ! year-month-day, e.g., 19990701 - integer, intent(in) :: nhms ! hour-min-sec, e.g., 120000 + integer, intent(in) :: nymd ! year-month-day, e.g., 19990701 + integer, intent(in) :: nhms ! hour-min-sec, e.g., 120000 + integer, intent(in) :: kscnt ! ks counter + integer, intent(in) :: kxtyp ! kx indicator ! !OUTPUT PARAMETERS: ! - type(ods_vect), intent(out) :: ods ! ODS vector + type(ods_vect), intent(inout) :: ods ! ODS vector integer, intent(out) :: rc ! Error return code: ! = 0 - all is well @@ -160,7 +164,7 @@ subroutine SABER_GetM_ ( version, fname, nymd, nhms, ! Begin writing to ODS vector. oc=1 - ksnum=1 + ksnum=kscnt ! Cycle through the events. do n=1,n_events !start_pt-1 levflag=.false. ! This flag is activated when processing reaches @@ -278,6 +282,7 @@ subroutine SABER_GetM_ ( version, fname, nymd, nhms, ods%data%ks(oc)=ksnum if(k.eq.1)then ods%data%kt(oc)=ktTT + call saber_err_get(ods%data%lev(oc),ods%data%xvec(oc)) elseif (k==2) then ods%data%kt(oc)=ktww elseif (k==3) then @@ -285,7 +290,7 @@ subroutine SABER_GetM_ ( version, fname, nymd, nhms, ! elseif(k.eq.4)then ! ods%data%kt(oc)=43 endif - ods%data%kx(oc)=294 + ods%data%kx(oc)=kxtyp ods%data%qcexcl(oc)=0 select case (tpAD(n)) case (0) @@ -313,6 +318,7 @@ subroutine SABER_GetM_ ( version, fname, nymd, nhms, !_RT print*,"Warning: current array has less than ", mflush, " levels." !_RT print*,"File may be incomplete." endif +! ksnum=ksnum+1 enddo ! Reading event array. if(oc.eq.1)then @@ -323,7 +329,6 @@ subroutine SABER_GetM_ ( version, fname, nymd, nhms, return end subroutine SABER_GetM_ - subroutine saber_dims_ ( fname, $ nymd, $ doy, n_events, n_levels ) @@ -429,8 +434,8 @@ subroutine read_ ( version, fname, n_events, n_levels ) integer event_id, date_id integer alt_id integer varid - character*100 varname - character*100 dimname + character(len=100) varname + character(len=100) dimname integer dimsize integer vartype, nvdims, vdims(MAXVDIMS), nvatts @@ -640,7 +645,7 @@ subroutine SABER_meta_(ktnames,ktunits,kxnames,kxmeta,qcxnames) ktnames = ' ' ktunits = ' ' - kxnames(294)= + kxnames(394)= $'SABER - Sounding of the Atmosphere Broadband Emission Radiometer' ktnames(ktww)='Upper-air water vapor mixing ratio' diff --git a/src/Applications/SABER_App/m_saber_err.f90 b/src/Applications/SABER_App/m_saber_err.f90 new file mode 100644 index 00000000..20ab9491 --- /dev/null +++ b/src/Applications/SABER_App/m_saber_err.f90 @@ -0,0 +1,138 @@ +module m_saber_err +private + public :: saber_err_init + public :: saber_err_set + public :: saber_err_get + public :: saber_err_get_bounds + public :: saber_err_final + + interface saber_err_init + module procedure init_ + end interface + interface saber_err_set + module procedure parameterized_sigo_ + end interface + interface saber_err_get_bounds + module procedure get_bounds_ + end interface + interface saber_err_get + module procedure get_ + end interface + interface saber_err_final + module procedure final_ + end interface + + real,allocatable :: plevs(:) + real,allocatable :: sigo(:) + + integer, parameter :: nlevs=72 ! should be optional + real, parameter :: alpha = -12.0 ! empirical + real, parameter :: errormin = 0.3 ! empirical + real, parameter :: errormax = 1.4 ! empirical + real, parameter :: pabove = 0.1 + real, parameter :: pbelow = 5. + + character(len=*),parameter :: myname = 'm_saber_err' + logical :: initialized_ = .false. + logical :: set_ = .false. +contains + subroutine init_ + character(len=*), parameter :: myname_ = myname//'*init_' + if(initialized_) return + allocate ( plevs(nlevs), sigo(nlevs) ) + initialized_=.true. + print *, trim(myname_), ': done' + end subroutine init_ + subroutine parameterized_sigo_ + + use m_set_eta, only: set_eta + use m_set_eta, only: get_ref_plevs + + implicit none + + real(8) :: ptop8, pint8 + real(8),allocatable :: ak8(:),bk8(:) + real(8),allocatable :: pk(:),err(:) + integer ii,ks + + if(set_) return + allocate(ak8(nlevs+1),bk8(nlevs+1),pk(nlevs),err(nlevs)) + + call set_eta ( nlevs, ks, ptop8, pint8, ak8, bk8 ) + call get_ref_plevs ( ak8, bk8, ptop8, pk ) + + err = 0.0 + do ii=1,nlevs + if (pk(ii)>pbelow) then + err(ii) = errormin + elseif (pk(ii)=pbelow) then + error = errormin + elseif (oblev<=pabove) then + error = errormax + else + ia = -999 + ib = -999 + do ii=1,nlevs + if (oblev <= plevs(ii)) then + ib = ii + endif + enddo + ia=min(ib+1,nlevs-1) + if (ia /= ib) then + deno = log(plevs(ib))-log(plevs(ia)) + error = (log(plevs(ib))-log(oblev))*sigo(ib) + (log(oblev)-log(plevs(ia)))*sigo(ia) + error = error/deno + else + error = sigo(ib) + endif + endif + if ( error > errormax ) then + print *, 'get_: DEBUG, error insanity' + stop(1) + endif + + end subroutine get_ + + subroutine final_ + if (.not. initialized_) return + deallocate ( plevs, sigo ) + initialized_=.false. + end subroutine final_ + +end module m_saber_err diff --git a/src/Applications/SABER_App/mlsh5bfrT.f b/src/Applications/SABER_App/mlsh5bfrT.f deleted file mode 100644 index 7c6d0022..00000000 --- a/src/Applications/SABER_App/mlsh5bfrT.f +++ /dev/null @@ -1,544 +0,0 @@ - program mlsh5bfrT -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -! NASA/GSFC, Global Modeling and Assimilation Office, Code 610.1 ! -!----------------------------------------------------------------------- -!BOP -! -! !ROUTINE: mlsh5bfrT: write MLS HDF5 temperature in prepBUFR format -! -! !INTERFACE: -! -! Usage: mlsh5txtT.x [-f] [-v] [-d yyyymmdd] [-p prefix] h5filename -! -! -f optional: force write regardless of screening -! -v optional: flag for verbose output -! -d yyyymmdd optional: date to process -! -p prefix optional: filename prefix (default: MLSt) -! h5filename name of input HDF5 file -! -! Output file name has format: (prefix).yyyymmdd.tHHz.blk -! -! !USES: -! - use hdf5 - use readmlsh5 - use timefix_mod - use m_pbutil - - implicit none - -! -! !DESCRIPTION: -! -! Read MLS HDF5 temperature data files and write out text format. -! Input files contain one day of retrievals, from -! 00:00:00 to 23:59:59.99 UTC. Output files are separated into 6-hr -! segments centered on 00, 05, 12, 18. For the 00UTC data, the program -! will append to a previously existing text file containing the retrievals -! after 21UTC from the previous day. -! -! If executed with the '-d' flag, the program tries to read data from -! the specified date from the input file. Otherwise the program uses -! date information within the file to determine the date to use. -! -! Screening QC based on info from v2.2 Quality document. -! -! !REVISION HISTORY: -! 19 Oct 2006 Meta Original ozone conversion routine -! 9 Jan 2007 Meta Adapted program for temperature data -! 8 Nov 2007 Meta Modify for v2.2 data files, changes from -! ozone processing (-v, -f and time handling) -! add prologues -! 15 Nov 2007 Meta Text routine modifed to write prepBUFR, -! including modified BUFR table for EOSMLS -! 07 Feb 2008 Meta Added screening out of pressure levels above -! 'plvmin' - obs get QM of 9 (if not already bad) -! 19 Feb 2008 Meta Add command line flag -P to set top level for -! 'plvmin' and set default 'plvmin' to zero -! 19 Apr 2012 JJJ Read MLS v3 temperature, and -! set typ = 315. -! 11 Jun 2012 JJJ Modified date determination ( tcheck ), -! see JJJ x1. -! 12 Jun 2012 JJJ Add screening out of pressure levels below (larger than) -! 'plvmax' - obs get QM of 9 (if not already bad) -! 03 Sep 2012 JJJ reset the type # (315 => 311), because 315 is set for -! AMSU-A brightness temperature. -! 25 Apr 2013 j.jin flag profiles has zero procision (<0.1) in addition to negative -! precisions. These zero errors make GSI crash. -! -!EOP -!----------------------------------------------------------------------- - - - character*250 filename,argv - character*20 wanted - character*50 prefix, plvstr - character*80 outfile - character*8 ymdstr - - integer(HID_T) fid ! file identifier - - integer, parameter :: maxtimes = 10000 - integer, parameter :: maxlevs = 100 - integer, parameter :: lvmin = 8 ! 261 mb level - integer, parameter :: lvmax = 49 ! 49 is 0.001 mb - - integer nlevs ! number of levels - integer ntimes ! number of times - - integer ier, jer ! error return code - - real, parameter :: plvmindef = 0.0 - real, parameter :: plvmaxdef = 5.0 - real plvmin, plvmax - -! variables for hdf5 read - real(8) time(maxtimes), tcheck - real latitude(maxtimes) - real longitude(maxtimes) - real quality(maxtimes) - real convergence(maxtimes) - real pres(maxlevs) - real precision(maxlevs,maxtimes) - real value(maxlevs,maxtimes) - integer istatus(maxtimes) - -! variable for BUFR file writing - real pob(42),tob(42),tqm(42),tprec(42), qmt, qmret - real rstat, xob, yob, dhr, typ - integer ib, idate - character*8 stnid, subset - - integer jtm, llv -! integer mflg - real tk - real std - real sec - - integer iyr,mon,iday, itoday(8), inow(8) - integer isthr, ihr - integer isnd - integer id1, id2 - real rinc(5) - - integer nrec(5),nr - - real(8) tai93_0z, hrmax, hrcnt, dayend, dt - - integer iout ! output unit number - character*89 fmt - - integer argc, iargc, iarg, i - logical ffound - - logical verbose, notforce, ex - - nrec = 0 - wanted = 'Temperature' ! name of the swath to read in - prefix = 'MLSt.' ! default output filename prefix - iout = 10 - fmt='(i5,4i3,f6.2,i7,i5,f10.4,f11.4,f16.7,i7,i5,g16.7,g15.7,f6.3)' - subset = 'EOSMLS' - !typ = 304. ! 304 as set of o3lev. JJJ, 4/19/12. - !typ = 311. ! MLS temperature. JJJ x0 4/19/2012. - typ = 311. ! Changed to 304, 4/24/2013. - call datelen(10) - - itoday = 0 - ffound = .false. - verbose = .false. - notforce = .true. - plvmin = plvmindef - plvmax = plvmaxdef - argc = iargc() - if (argc < 1 .or. argc > 6) then - call usage() - endif - iarg = 0 - do while (iarg < argc) - iarg = iarg + 1 - call getarg( iarg, argv ) - if (index(argv,'-d') > 0) then - if ( iarg+1 > argc ) call usage() - iarg = iarg + 1 - call getarg( iarg,ymdstr ) - read(ymdstr,'(i4,i2,i2)',iostat=ier) iyr, mon, iday - itoday(1) = iyr - itoday(2) = mon - itoday(3) = iday - else if (index( argv, '-p') > 0) then - if ( iarg+1 > argc ) call usage() - iarg = iarg + 1 - call getarg( iarg, prefix ) - else if (index( argv, '-P') > 0) then - if ( iarg+1 > argc ) call usage() - iarg = iarg + 1 - call getarg( iarg, plvstr ) - read(plvstr,*) plvmin - else if (index(argv, '-v') > 0) then - verbose = .true. - else if (index(argv, '-f') > 0) then - notforce = .false. - else - if (ffound) call usage() - filename = argv - ffound = .true. - endif - end do - - if ( .not. ffound ) call usage() - -! initialize HDF interface - call h5open_f(ier) - if (ier .lt. 0) then - print *,'Problem initializing hdf5.' - stop - endif - -! open the HDF5 file - - call h5fopen_f(filename,H5F_ACC_RDONLY_F,fid,ier) - - if (ier .ne. 0) then - print *,'error reading file ',trim(filename) - stop - else - print *,'Successfully opened file ',trim(filename) - endif - - call getfilespecs(fid,iyr,mon,iday,tai93_0z,ier) - - if (ier .eq. 0 .and. tai93_0z .gt. 0.1) then -! fill in year, month, day and check if they match (any) requested date - print *,'Filename: ',trim(filename) - print *,'Year,month,day: ',iyr,mon,iday - print *,'TAI at 0z: ',tai93_0z - if (itoday(1) == 0) then - itoday(1) = iyr - itoday(2) = mon - itoday(3) = iday - else if ( itoday(1) /= iyr .or. itoday(2) /= mon - & .or. itoday(3) /= iday) then - print *,'Requested date: ',itoday(1:3) - print *,'File date: ',iyr,mon,iday - print *,'Date mismatch, stopping program.' - call h5fclose_f(fid,jer) - call h5close_f(jer) - stop - endif - else if (itoday(1) /=0 ) then - call ymd2tai(itoday(1),itoday(2),itoday(3),0,0,0.0, - & tai93_0z,ier) - print *,'Filename: ',trim(filename) - print *,'Requested Year,month,day: ',(itoday(i),i=1,3) - print *,'Requested TAI at 0z: ',tai93_0z - endif - -! if (ier .ne. 0) stop - - call rdmlsh5(fid, wanted, maxtimes, maxlevs, time, - & latitude, longitude, quality, convergence, pres, - & precision, value, istatus, ntimes, nlevs, ier) - - call h5fclose_f(fid,ier) - - call h5close_f(ier) - - if (ier /= 0) then ! problem reading the data - print *,'error reading data from file ',trim(filename) - stop - else - print *,'Successful read of obs data from ',trim(filename) - endif - - if (itoday(1) == 0 ) then ! metadata missing, date from data - ! JJJ x1, 11 JUN 2012 - ! Because a few "time" data are set to be -999.99 (e.g., 2004d228), - ! it produces wrong time to average the fist and the last values. - ! Now use the mean of the huge and the tine values (both are - ! positive values). - ! - ! tcheck = 0.5*(time(1)+time(ntimes)) - tcheck = 0.5*(huge(time)+tiny(time)) - ! JJJ x1 end. - - if (verbose) print *,'Check TAI time ',tcheck - call tai2ymd(tcheck,iyr,mon,iday,id1,id2,sec,ier) - if (verbose) print *,'Year,month,day: ',iyr,mon,iday - call ymd2tai(iyr,mon,iday,0,0,0.0,tai93_0z,ier) - itoday(1) = iyr - itoday(2) = mon - itoday(3) = iday - endif - - dayend = tai93_0z+86400. - isthr = 1 - isnd = 0 - - do ihr = 0,24,6 - - nr = ihr/6+1 - print *,'Start processing ihr = ', ihr - if (ihr .lt. 24) then - write(outfile,'(a,i4.4,i2.2,i2.2,''.t'',i2.2,''z.blk'')') - & trim(prefix),itoday(1:3),ihr - idate = (((itoday(1)*100)+itoday(2))*100+itoday(3))*100+ihr - else - call w3movdat( (/1.,0.,0.,0.,0./),itoday,inow) - write(outfile,'(a,i4.4,i2.2,i2.2,''.t'',i2.2,''z.blk'')') - & trim(prefix),inow(1),inow(2),inow(3),0 - idate = (((inow(1)*100)+inow(2))*100+inow(3))*100 - endif - - -c$$$ if (ihr .eq. 0) then -c$$$ open(iout, file=outfile, form='formatted', -c$$$ & position='append') -c$$$ else -c$$$ open(iout, file=outfile, form='formatted') -c$$$ endif - - if (ihr .eq. 0) then - inquire(file=outfile,exist=ex) - if (ex) then - print *,'Append to output file ',trim(outfile) - call init_bufr(outfile,append=.true.) - else - print *,'Create new output file ',trim(outfile) - call init_bufr(outfile,tablefile='mls_prepbufr_table', - & append=.false.) - endif - else - print *,'Create new output file ',trim(outfile) - call init_bufr(outfile,tablefile='mls_prepbufr_table') - endif - - hrmax = (ihr + 3) * 3600. - hrcnt = ihr * 3600. + tai93_0z - -! Process data for this time window, exit when end time is reached. - - do jtm = isthr, ntimes - - if (time(jtm) .lt. tai93_0z .or. - & time(jtm) .gt. dayend) then - print *,'Skip invalid time for ',jtm, time(jtm) - cycle - endif - - dt = time(jtm) - tai93_0z - if (dt .gt. hrmax) then - isthr = jtm - print *,'Start time ',ihr+6,' at index ',isthr - call end_bufr() - exit - endif - - rinc(4) = dt - call w3movdat(rinc, itoday, inow) - sec = inow(7) + 1.e-3 * inow(8) - qmret = 0.0 - -! skip retrievals where istatus is an odd number - if (mod(istatus(jtm),2) .ne. 0) then - if (notforce) then - cycle - else - qmret = 13. - endif - endif - rstat = istatus(jtm) - -! Quality field: quality < 0.65 do not use -! - if (quality(jtm) .lt. 0.65 ) then - if (notforce) then - cycle - else - qmret = 14 - endif - endif -! mflg = int(quality(jtm) * 100.) - -! Convergence field: Only use if convergence < 1.2 - - if ( convergence(jtm) .ge. 1.2) then - if (notforce) then - cycle - else - qmret = 12. - endif - endif - - isnd = isnd + 1 - - ib = 0 - -! cycle through the levels of this retrieval - do llv = lvmin, lvmax - -! do not use data for pressure > or = 147 hPa if status is 32 (due to cloud) - if ( llv .le. 10 ) then - if (jtm .le. ntimes-1 ) then - if ( istatus(jtm+1) .eq. 32 ) then - if (notforce) then - cycle - else - qmret = 13. - endif - endif - endif - if (jtm .le. ntimes-2 ) then - if ( istatus(jtm+2) .eq. 32 ) then - if (notforce) then - cycle - else - qmret = 13. - endif - endif - endif - endif - -c$$$ add here any profile based screening (low level screening, for instance) -c$$$ - qmt = qmret - -! mark high levels (p plvmax .and. qmret .eq. 0.) then - qmt = 9. - endif - - if (precision(llv,jtm) .lt. 0.1) then - print *,'Neg precision at lev ',llv, - & ' profile ',jtm - qmt = 15. - if (notforce) cycle - endif - - tk = value(llv, jtm) - std = precision(llv,jtm) - -c$$$ write(iout,fmt) inow(1:3),inow(5:6),sec,isnd,llv, -c$$$ & latitude(jtm),longitude(jtm),tk,istatus(jtm), -c$$$ & mflg,std,pres(llv) - - ib = ib + 1 - pob(ib) = pres(llv) - tob(ib) = tk - 273.15 - tprec(ib) = std - if(tprec(ib) < 0.1) write(*,*) llv,ib,pres(llv),tprec(ib) - tqm(ib) = max(qmt, 2.0) - - - end do ! loop over levels of retrieval - - if (ib .gt. 0) then - - dhr = (time(jtm)-hrcnt) / 3600. - yob = latitude(jtm) - xob = longitude(jtm) - if (xob .lt. 0.) xob = xob + 360. - - write(stnid,'(''ML'',i6.6)') isnd - nrec(nr) = nrec(nr) + 1 - - call write_bfr(stnid, xob, yob, dhr, typ, ib, - & rstat, quality(jtm), convergence(jtm), - & pob, tob, tqm, tprec, subset, idate) - - endif - - end do ! loop over times in file - - end do - - call end_bufr() - - print *,'Total obs at synoptic times: ',nrec - - stop - contains - - subroutine usage() - print *, 'Usage: mlsh5bfrT.x [-f] [-d yyyymmdd] [-p prefix] \ ' - print *, ' h5filename ' - print *, ' -f optional: force write w/o quality chk ' - print *, ' -d yyyymmdd optional: date to process ' - print *, ' -p prefix optional: filename prefix ' - print *, ' h5filename name of input HDF5 file ' - stop - - end subroutine usage - - subroutine write_bfr(stnid, xob, yob, dhr, typ, ib, - & rstat, qual, conv, - & pob, tob, tqm, tprec, subset, idate) - - integer idate, ib, l - character(len=8) stnid, subset - real xob, yob, dhr, typ, rstat, qual, conv - real pob(ib), tob(ib), tqm(ib), tprec(ib) - - real(8), dimension(8) :: hdr ! observation header - real(8) :: rid - real(8), dimension(8,255) :: pobs, tobs - - integer, parameter :: MXBLVL = 255 ! max no. of report levels allowed - integer(i_bfr), parameter :: iarr = 8 ! size of bfr arrays - integer(i_bfr), parameter :: i1 = 1 ! single level - integer(i_bfr), parameter :: ilv = MXBLVL ! multiple level - integer(i_bfr) ibdate - integer(i_bfr) ilevs - integer(i_bfr) iret - - character(len=40) hdstr, pobstr, tobstr - data hdstr /'SID XOB YOB DHR TYP MLST MLSQ MLSC'/ - data pobstr /'POB PQM PPC PRC CAT'/ - data tobstr /'TOB TQM TPC TRC MLSPT'/ - - hdr(1) = transfer(stnid, rid) - hdr(2) = xob - hdr(3) = yob - hdr(4) = dhr - hdr(5) = typ - hdr(6) = rstat - hdr(7) = qual - hdr(8) = conv - - pobs = missing - tobs = missing - - do l = 1,ib - pobs(1,l) = pob(l) - pobs(2,l) = tqm(l) ! use same as T - pobs(3,l) = 1. - pobs(4,l) = 1. - pobs(5,l) = 2. - tobs(1,l) = tob(l) - tobs(2,l) = tqm(l) - tobs(3,l) = 1. - tobs(4,l) = 1. - tobs(5,l) = tprec(l) - end do - - ibdate = idate - ilevs = ib - - call openmb(lu_b, subset, ibdate) - call ufbint(lu_b, hdr, iarr, i1 , iret, hdstr) - call ufbint(lu_b, pobs, iarr, ilevs, iret, pobstr) - call ufbint(lu_b, tobs, iarr, ilevs, iret, tobstr) - - call writsb(lu_b) - - return - - - end subroutine write_bfr - - - end program mlsh5bfrT - - diff --git a/src/Applications/SABER_App/saber2ods.f90 b/src/Applications/SABER_App/saber2ods.f90 index 6853f86f..36bcf3bc 100644 --- a/src/Applications/SABER_App/saber2ods.f90 +++ b/src/Applications/SABER_App/saber2ods.f90 @@ -67,7 +67,7 @@ program saber2ods logical :: verbose,bexist logical :: syn(5) type(ods_vect) :: ods_struct(2), odsm ! ODS vector - integer :: tnobs,nfiles + integer :: kxtyp,tnobs,nfiles logical :: debug=.false. @@ -82,11 +82,12 @@ program saber2ods nhms(3)=120000 nhms(4)=180000 nhms(5)=000000 + kxtyp = 394 i=1 nfiles=0 s_string='SABER_L2A_' - bfrtmpl='saber.l2a.obs.%y4%m2%d2_%h2z.bfr' bfrtmpl='NULL' + bfrtmpl='saber.l2a.obs.%y4%m2%d2_%h2z.bfr' odstmpl='saber.l2a.obs.%y4%m2%d2_%h2z.ods' ! Process argument list @@ -175,17 +176,19 @@ program saber2ods call StrTemplate ( bfrfname, bfrtmpl, 'GRADS', xid="saber", & nymd=nymd, nhms=nhms(k), stat=rc ) if ( trim(bfrfname) /= "NULL" ) then - if(verbose) print*,'Writing data at ',nymd,nhms(k),'Z to ',bfrfname + inquire(file=bfrfname,exist=bexist) if (bexist) then - print *,'Append to output bfr file ',trim(bfrfname) + if(verbose) print *,'Append to output bfr file ',trim(bfrfname) call init_bufr(bfrfname,append=.true.) else - print *,'Create output bfr file ',trim(bfrfname) + if(verbose) print *,'Create output bfr file ',trim(bfrfname) call init_bufr(bfrfname,tablefile='saber_prepbufr_table',append=.false.) endif - call ods2bfr_ (ods_struct(1)) + call ods2bfr_ (nymd,nhms(k),ods_struct(1)) + + call end_bufr endif @@ -202,17 +205,26 @@ program saber2ods subroutine saberods_ (odsname) character(len=*), intent(in) :: odsname -! Initialize ods vector - call SABER_Get(version,fnames(j),nymd,nhms(k),ods_struct(1),rc) -! If data matching the selected synoptic time were found, continue. + integer :: ks + +! Check existence of ODS file + ks = 1 + inquire(file=odsname,exist=found) + if (found) then + call ODS_Get( odsname, nymd, nhms(k), ftype, ods_struct(2), rc ) + ks=maxval(ods_struct(2)%data%ks) + 1 + endif + +! Initialize ods vector + call SABER_Get(version,fnames(j),nymd,nhms(k),ks,kxtyp,ods_struct(1),rc) + +! If data matching the selected synoptic time were found, continue. if(rc.eq.0)then ! If something was read from the file, continue ! hit=.true. ! Check to see if ods file already exists. - inquire(file=odsname,exist=found) if(found)then - call ODS_Get( odsname, nymd, nhms(k), ftype, ods_struct(2), rc ) call ODS_Merge ( ods_struct, 2, odsm, rc ) write(cmd,'(2a)') '/bin/rm -r ', trim(odsname) call system(cmd) @@ -243,19 +255,54 @@ subroutine saberods_ (odsname) return end subroutine saberods_ - subroutine ods2bfr_(ods) + subroutine ods2bfr_(nymd,nhms,ods) + use m_odsmeta, only: ktTT, kto3mx, ktww + + implicit none + + integer :: nymd, nhms type(ods_vect) :: ods -! call write_bfr(stnid, xob, yob, dhr, typ, ib, & -! rstat, quality(jtm), convergence(jtm), & -! pob, tob, tqm, tprec, subset, idate) + integer idate + real xob, yob, dhr, typ, rstat, qual, conv + real,allocatable :: pob(:), tob(:), tqm(:), tprec(:) + character(len=8) stnid, subset + + integer ii, ib + + subset = 'SABER' + idate=nymd*100 + nhms/10000 + ib=1 + allocate (pob(ib), tob(ib), tqm(ib), tprec(ib)) + do ii=1,ods%data%nobs,3 + xob = ods%data%lon(ii) + if (xob .lt. 0.) xob = xob + 360. + yob = ods%data%lat(ii) + pob(1) = ods%data%lev(ii) + tprec(1) = 1.03 + if ( ods%data%kt(ii) ==ktTT ) then + tob(1) = ods%data%obs(ii)- 273.15 ! Celsius + tprec(1) = ods%data%xvec(ii) + endif + if ( ods%data%kt(ii+1)==ktww ) tqm(1) = ods%data%obs(ii+1) ! units? + rstat = ods%data%qcexcl(ii) + dhr = ods%data%time(ii)/60. ! seconds + typ = ods%data%kx(ii) + write(stnid,'(''S'',i7.7)') ods%data%ks(ii) + call write_bfr(stnid, xob, yob, dhr, typ, ib, & + rstat, 9., 1.0, & + pob, tob, tqm, tprec, subset, idate) + enddo + deallocate (pob, tob, tqm, tprec) + end subroutine ods2bfr_ subroutine write_bfr(stnid, xob, yob, dhr, typ, ib, & rstat, qual, conv, & pob, tob, tqm, tprec, subset, idate) - integer idate, ib, l + implicit none + integer idate, ib character(len=8) stnid, subset real xob, yob, dhr, typ, rstat, qual, conv real pob(ib), tob(ib), tqm(ib), tprec(ib) @@ -264,6 +311,7 @@ subroutine write_bfr(stnid, xob, yob, dhr, typ, ib, & real(8) :: rid real(8), dimension(8,255) :: pobs, tobs + integer l integer, parameter :: MXBLVL = 255 ! max no. of report levels allowed integer(i_bfr), parameter :: iarr = 8 ! size of bfr arrays integer(i_bfr), parameter :: i1 = 1 ! single level @@ -275,7 +323,7 @@ subroutine write_bfr(stnid, xob, yob, dhr, typ, ib, & character(len=40) hdstr, pobstr, tobstr data hdstr /'SID XOB YOB DHR TYP SABERT SABERQ SABERC'/ data pobstr /'POB PQM PPC PRC CAT'/ - data tobstr /'TOB TQM TPC TRC SABERRT'/ + data tobstr /'TOB TQM TPC TRC SABERPT'/ hdr(1) = transfer(stnid, rid) hdr(2) = xob @@ -304,7 +352,6 @@ subroutine write_bfr(stnid, xob, yob, dhr, typ, ib, & ibdate = idate ilevs = ib - call openmb(lu_b, subset, ibdate) call ufbint(lu_b, hdr, iarr, i1 , iret, hdstr) call ufbint(lu_b, pobs, iarr, ilevs, iret, pobstr) diff --git a/src/Applications/SABER_App/saber_obserr.f b/src/Applications/SABER_App/saber_obserr.f new file mode 100644 index 00000000..2a9f7189 --- /dev/null +++ b/src/Applications/SABER_App/saber_obserr.f @@ -0,0 +1,208 @@ + program saber_obserr +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! NASA/GSFC, Global Modeling and Assimilation Office, Code 610.1 ! +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: saber_obserr: write updated obs errors to PREPBUFR file +! +! !INTERFACE: +! +! Usage: saber_obserr [-b] input_prepbufr output_prepbufr +! +! !USES: +! + use m_saber_err, only: saber_err_init + use m_saber_err, only: saber_err_final + use m_saber_err, only: saber_err_set + use m_saber_err, only: saber_err_get + use m_saber_err, only: saber_err_get_bounds + implicit NONE +! +! link to libbfr_r4i4.a library + +! !DESCRIPTION: simple routine to read prepbufr and update +! observation errors - will also reset QM for +! observations with pressures less than min-pressure +! +! !REVISION HISTORY: +! +! 20Mar2007 Meta Initial version +! 07Feb2008 Meta New version for MLS temperature +! 11Feb2008 Meta add command line flag for options - use +! precision or precision+bias (-b) +! 04Jan2024 Todling Hacked for SABER +! +!EOP +!----------------------------------------------------------------------- + + real*8 OBS(3,255), QMS(2,255),OES(2,255) + CHARACTER*80 QMSTR, OBSTR, OESTR + CHARACTER*8 SUBSET, stnid + integer*4 nymd, nhms + real*8 bmiss, hbmiss + + integer idate, mydate + + integer ilev, jlev, klev, nlev + integer iret, jret, kret, nret , lret + + integer is, i, k + character*255 argv, outfile + + integer ip + real berr(-24:30), bterm, plevm + real pobs, sigo + logical do_bterm + logical first_param + + data berr/ 1.5, 1.45, 1.42, 1.38, 1.33, 1.29, 1.25, 1.21, 1.17, + & 1.13, 1.08, 1.04, 41*1.0, 2.0, 2.5/ + + data plevm/0.04/ + data do_bterm/.false./ + + DATA OBSTR/'POB TOB SABERPT'/ + DATA QMSTR/'PQM TQM '/ + DATA OESTR/'POE TOE '/ + + integer lubfi, lubfo + data lubfi /10/, lubfo /20/ + + integer*4 iargc + + first_param=.false. + + is = iargc() + if (is .lt. 2) then + print *, 'Usage: saber_obserr.x [-b|-p1] inbfrfile outbfrfile' + stop + endif + + i = 0 + + call getarg( 1, argv) + if (index(argv,'-b') > 0) then + do_bterm = .true. + i = i + 1 + else if (index(argv,'-p1') > 0) then + first_param =.true. + print *, 'First attempt at setting sigo ...' + i = i + 1 + endif + + if (i>0) call getarg(1+i,argv) + open( unit=lubfi,file=argv,form='unformatted') + + call getarg(2+i,outfile) + + + bmiss = 10.d10 + hbmiss = 0.5 * bmiss + + call datelen(10) + + CALL OPENBF(LUBFI,'IN',LUBFI) + + subset = '' + idate = -999 + iret = 0 + + CALL READMG(LUBFI,SUBSET,IDATE,IRET) + if (subset .ne. 'SABER ') then + print *,'input file not SABER data, exiting. subset=',subset + stop + endif + + if (iret .eq. 0 ) then + + +! data was found, so open output file +! ----------------------------------- + open(lubfo,file=trim(outfile),form='unformatted') + call openbf(lubfo,'OUT', lubfi) + + else + print *,'Desired data was not found in input file' + stop + endif + + if (first_param) then + call saber_err_init + call saber_err_set + endif + +C LOOP THROUGH THE INPUT MESSAGES - READ THE NEXT SUBSET +C ------------------------------------------------------ + + print *, 'Writing new dataset ',trim(outfile) + lret = 0 + + do while (lret .eq. 0) + CALL READSB(LUBFI,LRET) + IF(LRET .eq. 0) then + call openmb(lubfo, subset, idate) + + call ufbcpy(lubfi, lubfo) + + CALL UFBINT(LUBFI,OBS,3, 255,jlev,OBSTR) + CALL UFBINT(LUBFI,QMS,2, 255,klev,QMSTR) + + if (jlev .ne. klev) print *, 'inconsistent levels' + + oes = bmiss + + if (jlev .gt. 0) then + do k = 1,jlev + +! set obs error based on precision, or combination of precision and 'bias' +! accuracy from table in quality document. + + if (do_bterm) then +! use precision + bias term +! ip = nint(alog10(obs(1,k))*12.) + ip = nint(dlog10(obs(1,k))*12.) + if (ip < -24) then + bterm = 1.5 + else if (ip > 30) then + bterm = 2.5 + else + bterm = berr(ip) + endif + + if(obs(3,k) .lt. bmiss) then + oes(2,k) = sqrt(bterm + obs(3,k)*obs(3,k)) + endif + else if (first_param) then + pobs = obs(1,k) + call saber_err_get(pobs,sigo) + oes(2,k) = sigo + else +! only copy precision value + oes(2,k) = obs(3,k) + endif + enddo + + call ufbint(lubfo,oes,2, jlev,jret, oestr) + if (jlev .ne. jret) print *,'inconsistent 3' + + endif + + call writsb(lubfo) + + else if (lret .eq. -1) then + idate = -999 + iret = 0 + CALL READMG(LUBFI,SUBSET,IDATE,IRET) + lret = iret + else + print *,'lret has a strange value of ',lret + endif + end do + if ( first_param ) then + call saber_err_final + endif + call closbf(lubfi) + call closbf(lubfo) + stop + end program saber_obserr diff --git a/src/Applications/SABER_App/saber_prepbufr_table b/src/Applications/SABER_App/saber_prepbufr_table index e60443eb..49945d81 100644 --- a/src/Applications/SABER_App/saber_prepbufr_table +++ b/src/Applications/SABER_App/saber_prepbufr_table @@ -22,7 +22,7 @@ | MSONET | A60245 | MESONET SURFACE REPORTS (COOPERATIVE NETWORKS) | | GPSIPW | A60246 | GLOBAL POSITIONING SATELLITE-INTEGRATED PRECIP. WATER | | RASSDA | A60247 | RADIO ACOUSTIC SOUNDING SYSTEM (RASS) TEMP PROFILE RPTS | -| EOSSABER | A60254 | EOS-SABER SATELLITE DATA (SOUNDINGS, RETRIEVALS) | +| SABER | A60255 | TIMED-SABER SATELLITE DATA (SOUNDINGS, RETRIEVALS) | | | | | | HEADR | 361001 | REPORT HEADER SEQUENCE | | PRSLEVEL | 361002 | PRESSURE LEVEL SEQUENCE (ALL TYPES EXCEPT GOESND) | @@ -61,13 +61,13 @@ | PTENDSEQ | 361035 | PRESSURE TENDENCY SEQUENCE | | PTE24SEQ | 361036 | 24 HOUR PRESSURE TENDENCY SEQUENCE | | PREC_SEQ | 361098 | SABERRET PRECISION SEQUENCE | -| PRSLEVLM | 361099 | MLSRET PRESSURE LEVEL SEQUENCE | +| PRSLEVLM | 361099 | SABERRET PRESSURE LEVEL SEQUENCE | | RSRD_SEQ | 361101 | RESTRICTIONS ON REDISTRIBUTION SEQUENCE | -| PM__INFO | 362031 | PRESSURE (MLS) INFORMATION | +| PM__INFO | 362031 | PRESSURE (SABER) INFORMATION | | P___INFO | 362001 | PRESSURE INFORMATION | | Q___INFO | 362002 | SPECIFIC HUMIDITY INFORMATION | | T___INFO | 362003 | TEMPERATURE INFORMATION | -| TM__INFO | 362033 | TEMPERATURE INFORMATION (MLS) | +| TM__INFO | 362033 | TEMPERATURE INFORMATION (SABER) | | Z___INFO | 362004 | HEIGHT INFORMATION | | W___INFO | 362005 | WIND INFORMATION | | PW__INFO | 362006 | PRECIPITABLE WATER INFORMATION | @@ -83,10 +83,10 @@ | RRT_INFO | 362017 | RAIN RATE INFORMATION | | CTP_INFO | 362018 | CLOUD TOP INFORMATION | | SST_INFO | 362019 | SEA TEMPERATURE INFORMATION | -| PM_EVENT | 362131 | PRESSURE EVENT SEQUENCE (MLS) | +| PM_EVENT | 362131 | PRESSURE EVENT SEQUENCE (SABER) | | P__EVENT | 362101 | PRESSURE EVENT SEQUENCE | | Q__EVENT | 362102 | SPECIFIC HUMIDITY EVENT SEQUENCE | -| TM_EVENT | 362133 | TEMPERATURE EVENT SEQUENCE (MLS) | +| TM_EVENT | 362133 | TEMPERATURE EVENT SEQUENCE (SABER) | | T__EVENT | 362103 | TEMPERATURE EVENT SEQUENCE | | Z__EVENT | 362104 | HEIGHT EVENT SEQUENCE | | W__EVENT | 362105 | WIND EVENT SEQUENCE | @@ -112,7 +112,7 @@ | RRTBACKG | 362211 | RAIN RATE BACKGROUND SEQUENCE | | CTPBACKG | 362212 | CLOUD TOP PRESSURE BACKGROUND SEQUENCE | | SSTBACKG | 362213 | SEA TEMPERATURE BACKGROUND SEQUENCE | -| TM_BACKG | 362214 | TEMPERATURE BACKGROUND SEQUENCE (MLS) | +| TM_BACKG | 362214 | TEMPERATURE BACKGROUND SEQUENCE (SABER) | | P__POSTP | 362221 | PRESSURE POSTPROCESSING SEQUENCE | | Q__POSTP | 362222 | SPECIFIC HUMIDITY POSTPROCESSING SEQUENCE | | T__POSTP | 362223 | TEMPERATURE POSTPROCESSING SEQUENCE | @@ -393,8 +393,8 @@ | SABERT | 025226 | SABER RETRIEVAL STATUS FLAG | | SABERQ | 025227 | SABER RETRIEVAL QUALITY VALUE | | SABERC | 025228 | SABER RETRIEVAL CONVERGENCE VALUE | -| SABERRT | 025229 | SABER TEMP RETRIEVAL | -| SABERRQ | 025230 | SABER MIXR RETRIEVAL | +| SABERPT | 025229 | SABER TEMP RETRIEVAL PRECISION VALUE | +| SABERPQ | 025230 | SABER MIXR RETRIEVAL PRECISION VALUE | | | | | |------------------------------------------------------------------------------| | MNEMONIC | SEQUENCE | @@ -445,7 +445,7 @@ | | | | RASSDA | HEADR {PRSLEVEL} | | | | -| EOSSABER | HEADR SABERT SABERQ SABERC {PRSLEVLM} | +| SABER | HEADR SABERT SABERQ SABERC {PRSLEVLM} | | | | | HEADR | SID XOB YOB DHR ELV TYP T29 TSB ITP SQN PROCN RPT | | HEADR | TCOR | @@ -522,7 +522,7 @@ | | | | PTE24SEQ | 24PC | | | | -| PREC_SEQ | SABERRT SABERRQ | +| PREC_SEQ | SABERPT SABERPQ | | | | | PRSLEVLM | CAT | | | | @@ -925,7 +925,7 @@ | SABERT | 0 | 0 | 16 | FLAG TABLE |-------------| | SABERQ | 2 | 0 | 16 | NUMERIC |-------------| | SABERC | 2 | 0 | 16 | NUMERIC |-------------| -| SABERRT | 2 | 0 | 16 | KELVIN |-------------| -| SABERRQ | 2 | 0 | 16 | NUMERIC |-------------| +| SABERPT | 2 | 0 | 16 | DEG C |-------------| +| SABERPQ | 2 | 0 | 16 | NUMERIC |-------------| | | | | | |-------------| `------------------------------------------------------------------------------' From d06a9978188fdfe3bfdd77396a8bbab25615cda1 Mon Sep 17 00:00:00 2001 From: Ricardo Todling Date: Thu, 4 Jul 2024 08:57:44 -0400 Subject: [PATCH 5/5] adding saber --- src/Applications/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Applications/CMakeLists.txt b/src/Applications/CMakeLists.txt index b56882ab..89e6bdcb 100644 --- a/src/Applications/CMakeLists.txt +++ b/src/Applications/CMakeLists.txt @@ -8,6 +8,7 @@ esma_add_subdirectories( GAAS_App MKIAU_App GMAO_Etc + SABER_App @CPLFCST_Etc )