[Dart-dev] [3223] DART/trunk: obs_diag.
f90 has been extended to be able to plot the observation locations
thoar at subversion.ucar.edu
thoar at subversion.ucar.edu
Mon Feb 11 23:31:51 MST 2008
An HTML attachment was scrubbed...
URL: http://mailman.ucar.edu/pipermail/dart-dev/attachments/20080211/0bd98bdd/attachment-0001.html
-------------- next part --------------
Modified: DART/trunk/diagnostics/matlab/get_varnames.m
===================================================================
--- DART/trunk/diagnostics/matlab/get_varnames.m 2008-02-12 06:04:47 UTC (rev 3222)
+++ DART/trunk/diagnostics/matlab/get_varnames.m 2008-02-12 06:31:51 UTC (rev 3223)
@@ -52,6 +52,7 @@
if (strcmp( varname , 'time_bounds')), isatmosvar = 0; end
if (strcmp( varname , 'region_names')), isatmosvar = 0; end
if (strcmp( varname , 'CopyMetaData')), isatmosvar = 0; end
+ if (strcmp( varname , 'ObservationTypes')), isatmosvar = 0; end
end
if (isatmosvar > 0)
Modified: DART/trunk/diagnostics/threed_sphere/obs_diag.f90
===================================================================
--- DART/trunk/diagnostics/threed_sphere/obs_diag.f90 2008-02-12 06:04:47 UTC (rev 3222)
+++ DART/trunk/diagnostics/threed_sphere/obs_diag.f90 2008-02-12 06:31:51 UTC (rev 3223)
@@ -60,7 +60,6 @@
revision = "$Revision$", &
revdate = "$Date$"
-
!---------------------------------------------------------------------
!---------------------------------------------------------------------
@@ -108,6 +107,7 @@
integer :: num_obs_kinds
character(len=129) :: obs_seq_read_format
logical :: pre_I_format
+logical :: only_print_locations = .false.
integer, dimension(2) :: key_bounds
real(r8), dimension(1) :: obs
@@ -138,7 +138,7 @@
! 8+ reserved for future use
integer :: qc_index, dart_qc_index
-integer :: qc_integer
+integer :: qc_integer, my_qc_integer
integer, parameter :: QC_MAX = 7
integer, parameter :: QC_MAX_PRIOR = 3
integer, parameter :: QC_MAX_POSTERIOR = 1
@@ -281,9 +281,9 @@
call static_init_obs_sequence() ! Initialize the obs sequence module
!----------------------------------------------------------------------
-! Define/Append the 'wind speed' obs_kinds to supplant the list declared
+! Define/Append the 'wind velocity' obs_kinds to supplant the list declared
! in obs_kind_mod.f90 i.e. if there is a RADIOSONDE_U_WIND_COMPONENT
-! and a RADIOSONDE_V_WIND_COMPONENT, there must be a RADIOSONDE_WIND_SPEED
+! and a RADIOSONDE_V_WIND_COMPONENT, there must be a RADIOSONDE_WIND_VELOCITY
! Replace calls to 'get_obs_kind_name' with variable 'my_obs_kind_names'
!----------------------------------------------------------------------
@@ -309,6 +309,7 @@
! Now that we have input, do some checking and setup
!----------------------------------------------------------------------
+call ObsLocationsExist( print_obs_locations )
call set_calendar_type(GREGORIAN)
call Convert2Time(beg_time, end_time, skip_time, binsep, binwidth, halfbinwidth)
call ActOnNamelist( Nregions )
@@ -334,7 +335,7 @@
write(*,*)'height interfaces = ',hlevel_edges(1:Nhlevels+1)
write(*,*)'model levels = ',mlevel( 1:Nmlevels)
do i = 1,Nregions
- write(*,'(''Region '',i02,1x,a32,'' (EWSN): '',4(f10.4,1x))') i, &
+ write(*,'(''Region '',i02,1x,a32,'' (WESN): '',4(f10.4,1x))') i, &
reg_names(i), lonlim1(i),lonlim2(i),latlim1(i),latlim2(i)
enddo
endif
@@ -472,8 +473,8 @@
!----------------------------------------------------------------------
! Open file for histogram of innovations, as a function of standard deviation.
!----------------------------------------------------------------------
-nsigmaUnit = open_file('nsigma.dat',form='formatted',action='rewind')
-write(nsigmaUnit,*)'Any observations flagged as bad are dumped into the last bin.'
+nsigmaUnit = open_file('LargeInnov.txt',form='formatted',action='rewind')
+write(nsigmaUnit,'(a)')'Any observations flagged as bad are dumped into the last bin.'
write(nsigmaUnit,'(a)') ' day secs lon lat level obs guess zscore key kind'
!-----------------------------------------------------------------------
! We must assume the observation sequence files span an unknown amount
@@ -576,11 +577,17 @@
call print_time(seqT1,'First observation time',logfileunit)
call print_time(seqTN,'Last observation time',logfileunit)
+ call print_date(seqT1,'First observation date',logfileunit)
+ call print_date(seqTN,'Last observation date',logfileunit)
if ( verbose ) then
call print_time(seqT1,'First observation time')
call print_time(seqTN,'Last observation time')
call print_time(TimeMin,'TimeMin ')
call print_time(TimeMax,'TimeMax ')
+ call print_date(seqT1,'First observation date')
+ call print_date(seqTN,'Last observation date')
+ call print_date(TimeMin,'TimeMin ')
+ call print_date(TimeMax,'TimeMax ')
endif
!--------------------------------------------------------------------
@@ -630,11 +637,24 @@
!--------------------------------------------------------------------
! Find the index of obs, ensemble mean, spread ... etc.
!--------------------------------------------------------------------
+ ! Only require obs_index to be present; this allows the program
+ ! to be run on obs_seq.in files which have no means or spreads.
+ ! You can still plot locations, but that's it.
+ !--------------------------------------------------------------------
call SetIndices( obs_index, qc_index, dart_qc_index, &
prior_mean_index, posterior_mean_index, &
prior_spread_index, posterior_spread_index )
+ if ( any( (/ prior_mean_index, prior_spread_index, &
+ posterior_mean_index, posterior_spread_index /) < 0) ) then
+ only_print_locations = .true.
+ msgstring = 'observation sequence has no prior/posterior information'
+ call error_handler(E_MSG,'obs_diag',msgstring,source,revision,revdate)
+ else
+ only_print_locations = .false.
+ endif
+
!====================================================================
EpochLoop : do iepoch = 1, Nepochs
!====================================================================
@@ -660,8 +680,12 @@
if (print_obs_locations) then
! Append epoch number to name
write(locName,'(a,i3.3,a)') 'observation_locations.', iepoch, '.dat'
- lunit = open_file(trim(adjustl(locName)),form='formatted',action='rewind')
- write(lunit, '(a)') ' lon lat lev kind key used'
+ if (file_exist(locName)) then
+ lunit = open_file(trim(adjustl(locName)),form='formatted',action='append')
+ else
+ lunit = open_file(trim(adjustl(locName)),form='formatted',action='rewind')
+ write(lunit, '(a)') ' lon lat lev kind key QCval'
+ endif
endif
allocate(keys(num_obs_in_epoch))
@@ -713,6 +737,10 @@
level_index = ParseLevel(obs_loc, obslevel, flavor, which_vert)
+ if ( 1 == 2 ) then
+ write(8,*)'obsindx ',obsindex, keys(obsindex), obsloc3(3), level_index
+ endif
+
!--------------------------------------------------------------
! Convert the DART QC data to an integer and create histogram
!--------------------------------------------------------------
@@ -723,15 +751,38 @@
qc_integer = min( nint(qc(dart_qc_index)), QC_MAX )
qc_counter(qc_integer) = qc_counter(qc_integer) + 1 ! histogram
else
- ! Provide backwards compatibility. If no dart_qc in obs_seq,
- ! put qc_integer to 0 to replicate logic to be unable to treat
- ! prior and posterior separately.
- qc_integer = 0
- msgstring = 'cannot find DART QC metatdata'
- call error_handler(E_ERR,'obs_diag',msgstring,source,revision,revdate)
+ ! If there is no dart_qc in obs_seq, make sure the observation
+ ! is never used. This must be a case where we are interested
+ ! only in getting the location information.
+ qc_integer = QC_MAX + 9999
endif
!--------------------------------------------------------------
+ ! Write location of observation if namelist item is true
+ !--------------------------------------------------------------
+
+ if (print_obs_locations) then
+
+ if (dart_qc_index > 0) then
+ my_qc_integer = nint(qc(dart_qc_index))
+ elseif (qc_index > 0) then
+ my_qc_integer = -1 * nint(qc( qc_index))
+ else
+ my_qc_integer = -99
+ endif
+
+ write(lunit, FMT='(3(f10.2,1x),3(i7,1x))') &
+ obslon, obslat, obslevel, flavor, keys(obsindex), my_qc_integer
+ endif
+
+ !--------------------------------------------------------------
+ ! Early exit from the observation loop if the observation
+ ! does not have all the required copies (attributes).
+ !--------------------------------------------------------------
+
+ if (only_print_locations) cycle ObservationLoop
+
+ !--------------------------------------------------------------
! retrieve observation prior and posterior means and spreads
!--------------------------------------------------------------
@@ -768,9 +819,9 @@
if ( 1 == 2 ) then
call get_obs_values(observation, copyvals)
! if (any(copyvals < -87.0) .and. ( qc_integer < (QC_MAX_PRIOR+1) ) ) then
- if (any(copyvals < -87.0) .and. ( qc_integer < (QC_MAX_PRIOR-1) ) ) then
+ if ( obsindex == 311 ) then
write(*,*)
- write(*,*)'Observation ',keys(obsindex),' has some suspicious stuff.'
+ write(*,*)'Observation index 311 is ',keys(obsindex),' and has:'
write(*,*)'flavor is',flavor
write(*,*)'obs value is',obs(1)
write(*,*)'prior_mean value is',prior_mean(1)
@@ -778,8 +829,6 @@
write(*,*)'prior_spread value is',prior_spread(1)
write(*,*)'posterior_spread value is',posterior_spread(1)
write(*,*)'DART QC value is',qc_integer
- ! qc_integer = QC_MAX_PRIOR - 1
- ! write(*,*)'DART QC value is now',qc_integer
do i= 1,num_copies
write(*,*)copyvals(i),trim(get_copy_meta_data(seq,i))
enddo
@@ -814,13 +863,12 @@
!--------------------------------------------------------------
! update the histogram of the magnitude of the innovation,
- ! where each bin is a single standard deviation. This is
- ! a one-sided histogram. The innovation can only be calculated
- ! if the prior_mean is valid.
+ ! where each bin is a single standard deviation.
+ ! This is a one-sided histogram.
!--------------------------------------------------------------
- pr_zscore = InnovZscore(obs(1), pr_mean, pr_sprd, obs_err_var, qc_integer)
- po_zscore = InnovZscore(obs(1), po_mean, po_sprd, obs_err_var, qc_integer)
+ pr_zscore = InnovZscore(obs(1), pr_mean, pr_sprd, obs_err_var, qc_integer, QC_MAX_PRIOR)
+ po_zscore = InnovZscore(obs(1), po_mean, po_sprd, obs_err_var, qc_integer, QC_MAX_POSTERIOR)
indx = min(int(pr_zscore), MaxSigmaBins)
nsigma(indx) = nsigma(indx) + 1
@@ -828,7 +876,7 @@
! Individual (valid) observations that are very far away get
! logged to a separate file.
- if( (pr_zscore > 10.0_r8) .and. (qc_integer <= QC_MAX_PRIOR) ) then
+ if( (pr_zscore > 3.0_r8) .and. (qc_integer <= QC_MAX_PRIOR) ) then
call get_time(obs_time,seconds,days)
write(nsigmaUnit,FMT='(i7,1x,i5,1x,2f8.2,i7,1x,2f13.2,f8.1,2i7)') &
@@ -861,13 +909,6 @@
endif
!--------------------------------------------------------------
- ! Print out location of observation if namelist item is true
- !--------------------------------------------------------------
-
- if (print_obs_locations) write(lunit, FMT='(3(f10.2,1x),3(i7,1x))') &
- obslon, obslat, obslevel, flavor, keys(obsindex), qc_integer
-
- !--------------------------------------------------------------
! We have Nregions of interest
!--------------------------------------------------------------
@@ -951,12 +992,12 @@
! since we don't have the necessary covariance between U,V
! we will reject if either univariate z score is bad
- zscoreU = InnovZscore(U_obs, U_pr_mean, U_pr_sprd, U_obs_err_var, U_qc)
+ zscoreU = InnovZscore(U_obs, U_pr_mean, U_pr_sprd, U_obs_err_var, U_qc, QC_MAX_PRIOR)
if( (pr_zscore > rat_cri) .or. (zscoreU > rat_cri) ) then
call IPE(guess%NbadIZ(iepoch,level_index,iregion,wflavor), 1)
endif
- zscoreU = InnovZscore(U_obs, U_po_mean, U_po_sprd, U_obs_err_var, U_qc)
+ zscoreU = InnovZscore(U_obs, U_po_mean, U_po_sprd, U_obs_err_var, U_qc, QC_MAX_POSTERIOR)
if( (po_zscore > rat_cri) .or. (zscoreU > rat_cri) ) then
call IPE(analy%NbadIZ(iepoch,level_index,iregion,wflavor), 1)
endif
@@ -1010,12 +1051,12 @@
ierr = ParseLevel(obs_loc, obslevel, wflavor, which_vert)
- zscoreU = InnovZscore(U_obs, U_pr_mean, U_pr_sprd, U_obs_err_var, U_qc)
+ zscoreU = InnovZscore(U_obs, U_pr_mean, U_pr_sprd, U_obs_err_var, U_qc, QC_MAX_PRIOR)
if( (pr_zscore > rat_cri) .or. (zscoreU > rat_cri) ) then
call IPE(guessAVG%NbadIZ(level_index,iregion,wflavor), 1)
endif
- zscoreU = InnovZscore(U_obs, U_po_mean, U_po_sprd, U_obs_err_var, U_qc)
+ zscoreU = InnovZscore(U_obs, U_po_mean, U_po_sprd, U_obs_err_var, U_qc, QC_MAX_POSTERIOR)
if( (po_zscore > rat_cri) .or. (zscoreU > rat_cri) ) then
call IPE(analyAVG%NbadIZ(level_index,iregion,wflavor), 1)
endif
@@ -1038,6 +1079,8 @@
deallocate(keys)
+ if (print_obs_locations) close(lunit)
+
enddo EpochLoop
if (verbose) then
@@ -1045,8 +1088,6 @@
write( * ,*)'End of EpochLoop for ',trim(adjustl(obs_seq_in_file_name))
endif
- if (print_obs_locations) close(lunit)
-
call destroy_obs(obs1)
call destroy_obs(obsN)
call destroy_obs(observation)
@@ -1131,12 +1172,17 @@
enddo
! Actually print the histogram of innovations as a function of standard deviation.
-close(nsigmaUnit)
-write(*,*)
-write(*,*)'last bin contains all (flagged) bad observations'
+write( * ,*)
+write(nsigmaUnit,*)
+write( * ,'(''last bin contains all (flagged) bad observations'')')
+write(nsigmaUnit,'(''last bin contains all (flagged) bad observations'')')
do i=0,MaxSigmaBins
- if(nsigma(i) /= 0) write(*,*)'innovations in stdev bin ',i+1,' = ',nsigma(i)
+ if(nsigma(i) /= 0) then
+ write( * ,'(''(prior) innovations in stdev bin '',i3,'' = '',i10)'),i+1,nsigma(i)
+ write(nsigmaUnit,'(''(prior) innovations in stdev bin '',i3,'' = '',i10)'),i+1,nsigma(i)
+ endif
enddo
+close(nsigmaUnit)
!-----------------------------------------------------------------------
! temporal average of the vertical statistics
@@ -1577,8 +1623,15 @@
reg_names(4) = 'North America '
else
- ! TJH - confirm - anything that needs to be done ?
+ ! If lonlim2 < lonlim1 ... we add 360.0 to lonlim2 in anticipation
+ ! that you are going 'the long way around'
+ ! e.g. 300E to 25E is a perfectly valid domain ... which
+ ! is also 300E to 385E
+ do i = 1,Nregions
+ if (lonlim2(i) < lonlim1(i)) lonlim2(i) = lonlim2(i) + 360.0_r8
+ enddo
+
endif
! Pressure levels
@@ -1654,10 +1707,6 @@
! Make sure we find an index for each of them.
!--------------------------------------------------------------------
- if ( obs_index < 0 ) then
- write(msgstring,*)'metadata:observation not found'
- call error_handler(E_MSG,'obs_diag',msgstring,source,revision,revdate)
- endif
if ( prior_mean_index < 0 ) then
write(msgstring,*)'metadata:prior ensemble mean not found'
call error_handler(E_MSG,'obs_diag',msgstring,source,revision,revdate)
@@ -1682,14 +1731,13 @@
write(msgstring,*)'metadata:DART quality control not found'
call error_handler(E_MSG,'obs_diag',msgstring,source,revision,revdate)
endif
- !if ( any( (/obs_index, prior_mean_index, posterior_mean_index, qc_index, &
- ! prior_spread_index, posterior_spread_index /) < 0) ) then
+
! Only require obs_index to be present; this allows the program
- ! to be run on obs_seq.in files which have no means or spread. You can get
- ! less info from them, but for plotting locations, etc, there are reasons
- ! you might want to run diags on them.
- if ( any( (/ obs_index /) < 0) ) then
- write(msgstring,*)'observation metadata incomplete'
+ ! to be run on obs_seq.in files which have no means or spread. You get
+ ! less info from them, but you can still plot locations, etc.
+
+ if ( obs_index < 0 ) then
+ write(msgstring,*)'metadata:observation not found'
call error_handler(E_ERR,'obs_diag',msgstring,source,revision,revdate)
endif
@@ -1967,13 +2015,8 @@
+ Function InnovZscore(obsval, prmean, prspred, errvar, qcval, qcmaxval)
-
-
-
-
- Function InnovZscore(obsval, prmean, prspred, errvar, qcval)
-
! This function tries to get a handle on the magnitude of the innovations.
! If the ratio of the observation to the prior mean is 'big', it is an outlier.
! If the prior mean cannot be calculated (i.e. is missing) we put it in the
@@ -1982,11 +2025,11 @@
real(r8) :: InnovZscore
real(r8), intent(in) :: obsval, prmean, prspred, errvar
- integer, intent(in) :: qcval
+ integer, intent(in) :: qcval, qcmaxval
real(r8) :: numer, denom
- if ( qcval <= QC_MAX_PRIOR ) then ! QC indicates a valid obs
+ if ( qcval <= qcmaxval ) then ! QC indicates a valid obs
numer = abs(prmean - obsval)
denom = sqrt( prspred**2 + errvar )
InnovZscore = numer / denom
@@ -1999,14 +2042,27 @@
Function InRegion( lon, lat, lon1, lon2, lat1, lat2 )
+ ! InRegion handles regions that 'wrap' in longitude
+ ! if the easternmost longitude of the region is > 360.0
+ ! For example; lon1 == 320, lon = 10, lon2 == 380 --> .true.
+ !
logical :: InRegion
real(r8), intent(in) :: lon, lat, lon1, lon2, lat1, lat2
+ real(r8) :: mylon
InRegion = .false.
- if( (lon .ge. lon1) .and. (lon .le. lon2) .and. &
- (lat .ge. lat1) .and. (lat .le. lat2) ) InRegion = .true.
+ if( (lon >= lon1) .and. (lon <= lon2) .and. &
+ (lat >= lat1) .and. (lat <= lat2) ) InRegion = .true.
+ if( lon2 > 360.0_r8 ) then ! checking the wraparound case
+ mylon = lon + 360.0_r8
+ if( (mylon >= lon1) .and. (mylon <= lon2) .and. &
+ ( lat >= lat1) .and. ( lat <= lat2) ) then
+ InRegion = .true.
+ endif
+ endif
+
end Function InRegion
@@ -2069,9 +2125,9 @@
endif
if (indx1 > 0) then ! must be _?_WIND_COMPONENT
- str3 = str1(1:indx1)//'_WIND_SPEED'
+ str3 = str1(1:indx1)//'_WIND_VELOCITY'
else ! must be _?_10_METER_WIND_SPEED
- str3 = str1(1:indx2)//'_WIND_SPEED'
+ str3 = str1(1:indx2)//'_WIND_VELOCITY'
indx1 = indx2
endif
@@ -2129,21 +2185,16 @@
real(r8) :: postspred ! POSTERIOR (spread,variance)
real(r8) :: postspredplus ! POSTERIOR (spread,variance**)
logical, dimension(6) :: optionals
- real(r8) :: obsspeed, pospeed, prspeed
optionals = (/ present(uobs), present(uobserrvar), present(uprmean), &
present(uprsprd), present(upomean), present(uposprd) /)
if ( all(optionals) ) then
- obsspeed = sqrt( uobs**2 + obsval**2 )
- prspeed = sqrt( uprmean**2 + prmean**2 )
- pospeed = sqrt( upomean**2 + pomean**2 )
-
- priorsqerr = (prspeed - obsspeed)**2
- postsqerr = (pospeed - obsspeed)**2
- priorbias = prspeed - obsspeed
- postbias = pospeed - obsspeed
+ priorsqerr = (prmean - obsval)**2 + (uprmean - uobs)**2
+ postsqerr = (pomean - obsval)**2 + (upomean - uobs)**2
+ priorbias = (prmean - obsval) + (uprmean - uobs)
+ postbias = (pomean - obsval) + (upomean - uobs)
priorspred = prsprd**2 + uprsprd**2
postspred = posprd**2 + uposprd**2
priorspredplus = prsprd**2 + obserrvar + uprsprd**2 + uobserrvar
@@ -2226,6 +2277,7 @@
real(r8), intent(in) :: obsval, obserrvar, prmean, prsprd, pomean, posprd
real(r8), intent(in), optional :: uobs, uobserrvar, uprmean, uprsprd, upomean, uposprd
+ real(r8) :: obsspeed ! PRIOR Squared Error
real(r8) :: priorsqerr ! PRIOR Squared Error
real(r8) :: priorbias ! PRIOR simple bias
real(r8) :: priorspred ! PRIOR (spread,variance)
@@ -2236,26 +2288,27 @@
real(r8) :: postspredplus ! POSTERIOR (spread,variance**)
logical, dimension(6) :: optionals
- real(r8) :: obsspeed, pospeed, prspeed
-
optionals = (/ present(uobs), present(uobserrvar), present(uprmean), &
present(uprsprd), present(upomean), present(uposprd) /)
if ( all(optionals) ) then
+ priorsqerr = (prmean - obsval)**2 + (uprmean - uobs)**2
+ postsqerr = (pomean - obsval)**2 + (upomean - uobs)**2
- obsspeed = sqrt( uobs**2 + obsval**2 )
- prspeed = sqrt( uprmean**2 + prmean**2 )
- pospeed = sqrt( upomean**2 + pomean**2 )
+ ! This calculation is the bias in the wind vector
+ priorbias = (prmean - obsval) + (uprmean - uobs)
+ postbias = (pomean - obsval) + (upomean - uobs)
- priorsqerr = (prspeed - obsspeed)**2
- postsqerr = (pospeed - obsspeed)**2
- priorbias = prspeed - obsspeed
- postbias = pospeed - obsspeed
+ ! This calculation is the bias in the wind speed
+ obsspeed = sqrt(uobs**2 + obsval**2)
+ priorbias = obsspeed - sqrt(prmean**2 + uprmean**2)
+ postbias = obsspeed - sqrt(pomean**2 + upomean**2)
+
priorspred = prsprd**2 + uprsprd**2
postspred = posprd**2 + uposprd**2
priorspredplus = prsprd**2 + obserrvar + uprsprd**2 + uobserrvar
postspredplus = posprd**2 + obserrvar + uposprd**2 + uobserrvar
-
+
else if ( any(optionals) ) then
call error_handler(E_ERR,'Bin3D','wrong number of optional arguments', &
source,revision,revdate)
@@ -2339,7 +2392,8 @@
integer :: HlevelDimID, HlevelVarID
integer :: SlevelDimID
integer :: TimeDimID, TimeVarID
- integer :: CopyDimID, CopyVarID, CopyMetaVarID
+ integer :: CopyDimID, CopyVarID, CopyMetaVarID
+ integer :: TypesDimID, TypesVarID, TypesMetaVarID
integer :: PlevIntDimID, PlevIntVarID
integer :: HlevIntDimID, HlevIntVarID
integer :: BoundsDimID, BoundsVarID
@@ -2430,7 +2484,8 @@
! write all 'known' observation types
call nc_check(nf90_put_att(ncid, NF90_GLOBAL, "comment", &
- 'all known observation types follow' ), &
+ 'All known observation types follow. &
+ &Also see ObservationTypes variable.' ), &
'WriteNetCDF', 'put_att latlim2 '//trim(fname))
do ivar = 1,max_obs_kinds
call nc_check(nf90_put_att(ncid, NF90_GLOBAL, &
@@ -2447,6 +2502,10 @@
'WriteNetCDF', 'copy:def_dim '//trim(fname))
call nc_check(nf90_def_dim(ncid=ncid, &
+ name="obstypes", len = max_obs_kinds, dimid = TypesDimID), &
+ 'WriteNetCDF', 'types:def_dim '//trim(fname))
+
+ call nc_check(nf90_def_dim(ncid=ncid, &
name="region", len = Nregions, dimid = RegionDimID), &
'WriteNetCDF', 'region:def_dim '//trim(fname))
@@ -2491,6 +2550,14 @@
call nc_check(nf90_put_att(ncid, CopyVarID, "explanation", 'see CopyMetaData'), &
'WriteNetCDF', 'copy:explanation')
+ ! Define the observation types - needed to be a coordinate variable
+
+ call nc_check(nf90_def_var(ncid=ncid, name="obstypes", xtype=nf90_int, &
+ dimids=TypesDimID, varid=TypesVarID), &
+ 'WriteNetCDF', 'types:def_var')
+ call nc_check(nf90_put_att(ncid, TypesVarID, "explanation", 'see ObservationTypes'), &
+ 'WriteNetCDF', 'types:explanation')
+
! Define the regions coordinate variable and attributes
call nc_check(nf90_def_var(ncid=ncid, name="region", xtype=nf90_int, &
@@ -2617,6 +2684,15 @@
call nc_check(nf90_put_att(ncid, CopyMetaVarID, "long_name", "quantity names"), &
'WriteNetCDF', 'copymeta:long_name')
+ call nc_check(nf90_def_var(ncid=ncid, name="ObservationTypes", xtype=nf90_char, &
+ dimids=(/ StringDimID, TypesDimID /), varid=TypesMetaVarID), &
+ 'WriteNetCDF', 'typesmeta:def_var')
+ call nc_check(nf90_put_att(ncid, TypesMetaVarID, "long_name", "DART observation types"), &
+ 'WriteNetCDF', 'typesmeta:long_name')
+ call nc_check(nf90_put_att(ncid, TypesMetaVarID, "comment", &
+ "table relating integer to observation type string"), &
+ 'WriteNetCDF', 'typesmeta:comment')
+
! Set nofill mode - supposed to be performance gain
call nc_check(nf90_set_fill(ncid, NF90_NOFILL, i), &
@@ -2638,6 +2714,12 @@
call nc_check(nf90_put_var(ncid, CopyMetaVarID, copy_names), &
'WriteNetCDF', 'copymeta:put_var')
+ call nc_check(nf90_put_var(ncid, TypesVarId, (/ (i,i=1,max_obs_kinds) /) ), &
+ 'WriteNetCDF', 'types:put_var')
+
+ call nc_check(nf90_put_var(ncid, TypesMetaVarID, my_obs_kind_names(1:max_obs_kinds)), &
+ 'WriteNetCDF', 'typesmeta:put_var')
+
call nc_check(nf90_put_var(ncid, RegionVarID, (/ (i,i=1,Nregions) /) ), &
'WriteNetCDF', 'region:put_var')
@@ -2845,7 +2927,7 @@
- Function FindVertical(ncid, flav,dimid)
+ Function FindVertical(ncid, flav, dimid)
integer, intent(in) :: ncid, flav
integer, intent(out) :: dimid
integer :: FindVertical
@@ -2875,6 +2957,8 @@
'FindVertical', 'vertisheight')
else if ( which_vert(flav) == VERTISUNDEF ) then
+ write(msgstring,*)flav,trim(my_obs_kind_names(flav)),' has undefined vertical.'
+ call error_handler(E_MSG,'FindVertical',msgstring,source,revision,revdate)
call error_handler(E_ERR,'FindVertical','vertical undefined not implemented', &
source,revision,revdate)
else
@@ -2888,9 +2972,9 @@
Function grok_observation_names(my_names)
!----------------------------------------------------------------------
- ! Define/Append the 'wind speed' obs_kinds to supplant the list declared
+ ! Define/Append the 'wind velocity' obs_kinds to supplant the list declared
! in obs_kind_mod.f90 i.e. if there is a RADIOSONDE_U_WIND_COMPONENT
- ! and a RADIOSONDE_V_WIND_COMPONENT, there must be a RADIOSONDE_WIND_SPEED
+ ! and a RADIOSONDE_V_WIND_COMPONENT, there must be a RADIOSONDE_WIND_VELOCITY
! Replace calls to 'get_obs_kind_name' with variable 'my_obs_kind_names'
!----------------------------------------------------------------------
@@ -2902,7 +2986,7 @@
character(len=stringlength), dimension(2*max_obs_kinds) :: names
! Initially, the array of obs_kind_names is exactly 'max_num_obs' in length.
- ! This block finds the U,V wind pairs and searches for pre-existing wind_speed
+ ! This block finds the U,V wind pairs and searches for pre-existing wind_velocity
! equivalents. Depending on the number of unique wind pairs - we can allocate
! space, copy the existing names into that array, and append the new unique ones.
! easy ...
@@ -2944,7 +3028,7 @@
if (indxN > 0) then ! we know they are matching kinds
nwinds = nwinds + 1
- str3 = str1(1:indx2)//'_WIND_SPEED'
+ str3 = str1(1:indx2)//'_WIND_VELOCITY'
names(max_obs_kinds + nwinds) = str3
! write(*,*)'Seems like ',str1(1:indx1N),' matches ',str2(1:indx2N)
@@ -2971,7 +3055,7 @@
indxN = index(str1(1:indx1),str2(1:indx2))
if (indxN > 0) then ! we know they are matching kinds
nwinds = nwinds + 1
- str3 = str1(1:indx2)//'_10_METER_WIND_SPEED'
+ str3 = str1(1:indx2)//'_10_METER_WIND_VELOCITY'
names(max_obs_kinds + nwinds) = str3
endif
endif
@@ -3081,4 +3165,39 @@
end Function NextFile
+
+
+ Subroutine ObsLocationsExist( printswitch )
+
+ ! This routine checks for the existence of observation location files.
+ ! Each epoch writes out its own observation location file - and since
+ ! it is possible that multiple observation sequence files contribute
+ ! to the same epoch ... opening and appending is not a well-posed
+ ! strategy. Furthermore, some people do not start close enough to the
+ ! beginning of their epoch definition to ensure that epoch 1 exists.
+ ! So ... we check for any of observation_locations.00[1-4].dat
+ ! Completely arbitrary.
+
+ logical :: printswitch
+ integer :: i
+
+ ! locname, msgstring, source, revision, and revdate are globally-scoped
+
+ if (printswitch) then
+
+ do i = 1,4
+ write(locName,'(a,i3.3,a)') 'observation_locations.', i, '.dat'
+
+ if (file_exist(locName)) then
+ write(msgstring,*)'please remove file(s) like ', trim(locName)
+ call error_handler(E_MSG,'ObsLocationsExist',msgstring,source,revision,revdate)
+ write(msgstring,*)'Cannot have pre-existing obs location output files. Stopping.'
+ call error_handler(E_ERR,'ObsLocationsExist',msgstring,source,revision,revdate)
+ endif
+ enddo
+
+ endif
+
+ end Subroutine ObsLocationsExist
+
end program obs_diag
Modified: DART/trunk/diagnostics/threed_sphere/obs_diag.nml
===================================================================
--- DART/trunk/diagnostics/threed_sphere/obs_diag.nml 2008-02-12 06:04:47 UTC (rev 3222)
+++ DART/trunk/diagnostics/threed_sphere/obs_diag.nml 2008-02-12 06:31:51 UTC (rev 3223)
@@ -6,7 +6,7 @@
# in which case last_bin_center should be safely in the future.
#
# Acceptable latitudes range from [-90, 90]
-# Acceptable longitudes range from [ 0, 360]
+# Acceptable longitudes range from [ 0, Inf]
&obs_diag_nml
obs_sequence_name = 'obs_seq.final',
@@ -15,10 +15,7 @@
bin_separation = 0, 0, 0, 6, 0, 0 ,
bin_width = 0, 0, 0, 6, 0, 0 ,
time_to_skip = 0, 0, 0, 6, 0, 0 ,
- max_num_bins = 1000,
- plevel = 500,
- hlevel = 5000,
- mlevel = 5,
+ max_num_bins = 1000,
rat_cri = 3.0,
input_qc_threshold = 4.0,
Nregions = 4,
Modified: DART/trunk/matlab/PlotObsLocs.m
===================================================================
--- DART/trunk/matlab/PlotObsLocs.m 2008-02-12 06:04:47 UTC (rev 3222)
+++ DART/trunk/matlab/PlotObsLocs.m 2008-02-12 06:31:51 UTC (rev 3223)
@@ -1,4 +1,6 @@
-function PlotObsLocs(in_used, in_box, in_typelist, in_epochlist, in_subset, in_plotd, in_world, in_invertz, in_writeplot, in_legend2dloc, in_legend3dloc, in_viewlist)
+function phandle = PlotObsLocs(in_dartqc, in_box, in_typelist, in_epochlist, ...
+ in_subset, in_plotd, in_world, in_invertz, in_writeplot, ...
+ in_legend2dloc, in_legend3dloc, in_viewlist)
% PLOTOBSLOCS - Plot an observation_locations.NNN.dat file as output from the latest obs_diag program in DART.
% (You must enable an obs_diag_nml namelist entry to get the output files;
% they are not created by default.)
@@ -8,15 +10,22 @@
% replaced by the character string 'default' to use the internal defaults.
%
% usage:
-% PlotObsLocs(in_used, in_box, in_typelist, in_epochlist, in_subset,
+% PlotObsLocs(in_dartqc, in_box, in_typelist, in_epochlist, in_subset,
% in_plotd, in_world, in_invertz, in_writeplot,
% in_legend2dloc, in_legend3dloc, in_viewlist)
%
% where:
%
-% in_used = 0 to plot both used and unused observations
-% = -1 for unused obs only
-% = 1 for used obs only (default)
+% in_dartqc = 0 all OK (default)
+% 1 Evaluated only
+% 2 OK but posterior forward operator failed
+% 3 Evaluated only, BUT posterior forward operator failed.
+% 4 prior forward operator failed
+% 5 not used because of namelist control
+% 6 prior qc rejected
+% 7 outlier rejected
+% a negative value means everything "up to" that value, i.e.
+% -3 == 0, 1, 2, and 3
%
% in_box = optional bounding box [xmin xmax ymin ymax] for 2d or
% [xmin xmax ymin ymax zmin zmax] for 3d. default is max extent of
@@ -107,7 +116,7 @@
% user_specified (prompt user for 4 or 6 corners)
%
-arg_used = 1; % -1 = unused, 0 = both, 1 = used
+arg_used = 0; % dart QC values to use ... see in_dartqc table above
arg_box = []; % [[lon_min, lon_max, lat_min, lat_max], v_min, v_max]
arg_typelist = []; % numeric observation type list; if ~[], integer list
arg_epochlist = []; % list of epochs to process; if ~[], integer list
@@ -123,11 +132,11 @@
% default viewpoints for 3D plots.
% [90 0], [0 90] and [0 0] are also good.
+ ncfname = 'obs_diag_output.nc';
-
% get the values from the arguments and fill them in:
-if (~isa(in_used,'char'))
- arg_used = in_used;
+if (~isa(in_dartqc,'char'))
+ arg_used = in_dartqc;
end
if (~isa(in_box,'char'))
arg_box = in_box;
@@ -153,10 +162,10 @@
if (~isa(in_writeplot,'char'))
arg_writeplot = in_writeplot;
end
-if (in_legend2dloc ~= 'default')
+if (~strcmp(in_legend2dloc,'default'))
arg_legend2dloc = in_legend2dloc;
end
-if (in_legend3dloc ~= 'default')
+if (~strcmp(in_legend3dloc,'default'))
arg_legend3dloc = in_legend3dloc;
end
if (~isa(in_viewlist,'char'))
@@ -168,15 +177,15 @@
% if user specified an epoch list, use only those.
-% else, set it to a huge number and bail when we
-% run out of files to open.
+% else, get the number from the netcdf file
if (~isequal(arg_epochlist,[]))
epochlist = arg_epochlist;
else
- epochlist = 1 : 100000;
+ epochtime = getnc(ncfname,'time');
+ epochbnds = getnc(ncfname,'time_bounds');
+ epochlist = 1:length(epochtime);
end
-
% for each epoch file given or that we find:
for epoch = epochlist
@@ -212,20 +221,19 @@
% in the 'Observation_Kind()' array. (this file is produced by
% running obs_diag -- full name is ObsDiagAtts.m)
- ObsDiagAtts;
-
- % up to 36 different observation types, using a different marker
- % and color for each.
- markers = {
- 'r.', 'b.', 'g.', 'c.', 'm.', 'y.',
- 'r+', 'b+', 'g+', 'c+', 'm+', 'y+',
- 'r*', 'b*', 'g*', 'c*', 'm*', 'y*',
- 'ro', 'bo', 'go', 'co', 'mo', 'yo',
- 'rx', 'bx', 'gx', 'cx', 'mx', 'yx',
- 'rd', 'bd', 'gd', 'cd', 'md', 'yd',
- };
-
-
+ Observation_Kind = getnc(ncfname,'ObservationTypes');
+
+ % Use a different marker and color for each observation type
+ % (12*6) = 72 combinations at the moment. Could extend these
+ % by cycling through the 'fillable' symbols and filling ...
+ symbols = [double('o'),double('s'),double('d'),double('v'), ...
+ double('^'),double('<'),double('>'),double('p'), ...
+ double('h'),double('x'),double('+'),double('*')];
+ colors = [double('b'),double('r'),double('c'), ...
+ double('m'),double('g'),double('k')];
+ [smat,cmat] = meshgrid(symbols,colors);
+ markers = strcat([cmat(:) smat(:)]);
+
% setup before looping over observations:
mobs = max(s(:,4)); % max obs type number found in file
nobstypes = 0; % running count of obs types found
@@ -240,6 +248,12 @@
else
obslist = 1 : mobs;
end
+
+ if (length(obslist) > length(markers))
+ disp(sprintf('There are %d observation types',length(obslist)))
+ disp(sprintf('There are %d marker symbols',length(markers)))
+ error('Too many observation types to uniquely identify ... stopping.')
+ end
% loop over observation types, plotting each in 2d or 3d with
% a different marker.
@@ -260,10 +274,10 @@
if (size(l, 1) ~= 0)
if (arg_plotd == 2)
% 2d plot of (lon,lat):
- phandle = plot(l(:,1),l(:,2),markers{obs});
+ phandle = plot(l(:,1),l(:,2),markers(obs,:));
else
% 3D plot of (lon,lat,level):
- phandle = plot3(l(:,1),l(:,2),l(:,3),markers{obs});
+ phandle = plot3(l(:,1),l(:,2),l(:,3),markers(obs,:));
thismax = max(l(:,3));
lmax = max(lmax, thismax); % save overall max height for axis
end
@@ -272,7 +286,8 @@
% add this observation type to the legend string array
nobstypes = nobstypes + 1;
- obs_labels(nobstypes) = Observation_Kind(obs) ;
+
+ obs_labels{nobstypes} = deblank(Observation_Kind(obs,:));
end % if data of this observation type exists
@@ -321,15 +336,11 @@
end
end
- % get a handle to the axes graphics object
- % ahandle = axes
-
% if we actually set something, use it to constrain the axis limits.
if (~isequal(use_box, []))
axis(use_box);
- else
- axis tight;
end
+ axis image; % set aspect ratio dx ~= dy ... cylindrical equidistant
% set legend, and try to shrink the original size of the legend bounding box
% because it is pretty large by default. a 'good' location depends on the
@@ -342,10 +353,14 @@
end
% If you have Matlab v6.5 or before, this must be split into 2 lines
- %h = legend( obs_labels );
- %legend( h, 'Location', legendloc, 'Interpreter', 'none', 'FontSize', 8);
% Matlab v7.0+ requires it all in one go. Anyone know a way which works for both?
- legend( obs_labels , 'Location', legendloc, 'Interpreter', 'none', 'FontSize', 8);
+ myversion = ver('matlab');
+ if (str2num(myversion.Version) <= 6.5)
+ h = legend( obs_labels );
+ legend( h, 'Location', legendloc, 'Interpreter', 'none', 'FontSize', 8);
+ else
+ legend( obs_labels , 'Location', legendloc, 'Interpreter', 'none', 'FontSize', 8);
+ end
% example of how to escape only underscores if we still want to use tex
% in the strings. (instead of turning the interpreter off completely).
@@ -358,7 +373,7 @@
worldmap(lmax);
% these plots are generally longer than high, and add 3d-box.
- orient landscape;
+ % orient landscape;
set(gca, 'Box', 'on');
% various attempts to make the x/y axis have the same spacing per degree
@@ -382,20 +397,20 @@
zlabel('Third coordinate', 'FontSize', 14);
end
end
-
+
% add input filename somewhere?
% text()
% make it look roughly like it will when printed.
wysiwyg;
-
-
+
+
if (arg_used < 0)
- tstring = sprintf('Unused Observation Locations at Epoch %d', epoch);
- elseif (arg_used > 0)
- tstring = sprintf('Used Observation Locations at Epoch %d', epoch);
- else
- tstring = sprintf('Used + Unused Observation Locations at Epoch %d', epoch);
+ tstring = sprintf('Obs Locs for Epoch %d with DART QC values <= %d', ...
+ epoch, abs(arg_used));
+ elseif (arg_used >= 0)
+ tstring = sprintf('Obs Locs for Epoch %d with DART QC value == %d', ...
+ epoch, arg_used);
end
if (arg_subset > 0)
@@ -404,8 +419,8 @@
end
title(tstring, 'FontSize', 16);
-
-
+
+
% if 3d plot, turn on grid and view for interactive look
if (arg_plotd == 3)
grid on;
@@ -417,7 +432,8 @@
pause;
end
else
- disp('Pausing. Hit any key to continue');
+ disp(sprintf('Pausing on epoch %d of %d. Hit any key to continue ...', ...
+ epoch,length(epochlist)));
pause;
end
@@ -462,14 +478,12 @@
return
end
-
-% select used, unused, or all observations (column 6)
+% select based on dart QC flag
+% -99 implies everything, -3 implies 0,1,2,3
if (used < 0)
- data = raw(raw(:,6)<1, :);
-elseif (used > 0)
- data = raw(raw(:,6)>0, :);
-else
- data = raw;
+ data = raw(raw(:,6) <= abs(used),:);
+elseif (used >= 0)
+ data = raw(raw(:,6) == used ,:);
end
if (isequal(data, []))
Modified: DART/trunk/matlab/plot_observation_locations.m
===================================================================
--- DART/trunk/matlab/plot_observation_locations.m 2008-02-12 06:04:47 UTC (rev 3222)
+++ DART/trunk/matlab/plot_observation_locations.m 2008-02-12 06:31:51 UTC (rev 3223)
@@ -26,6 +26,7 @@
% the PlotObsLocs routine to use the default values.
plotd = 'default';
+ncfname = 'default';
used = 'default';
typelist = 'default';
box = 'default';
@@ -44,13 +45,19 @@
done = 0;
disp('Plot observations at their proper locations. Many subsetting options exist.');
disp('Hitting <cr> to answer the questions will use the default value,');
-disp('or once you have made a selection, reuse the previous value.');
+disp('or - once you have made a selection - reuse the previous value.');
disp(' ');
disp('The default plotting options are:');
disp(' 2D plot, full world map, all obs types, all times, ');
disp(' no file output, Z axis increases up.');
disp(' ');
+ % What file has the metadata
+ reply = input('Enter the netCDF file name with the metadata: ');
+ if (~isempty(reply))
+ ncfname = reply;
+ end
+
% loop and keep the previous default until the user says to quit
while done == 0
@@ -59,14 +66,27 @@
if (~isempty(reply))
plotd = reply;
end
+
% plot used, unused, or both
- reply = input('Input -1=unused obs, 0=both, 1=used: ');
+ disp('')
+ disp('DART QC Values ... 0 == all OK')
+ disp('DART QC Values ... 1 == Evaluated only')
+ disp('DART QC Values ... 2 == OK but posterior forward operator failed')
+ disp('DART QC Values ... 3 == Evaluated only, BUT posterior forward operator failed')
+ disp('DART QC Values ... 4 == prior forward operator failed')
+ disp('DART QC Values ... 5 == not used because of namelist control')
+ disp('DART QC Values ... 6 == prior qc rejected')
+ disp('DART QC Values ... 7 == outlier rejected')
+ disp(' a negative value means everything ''up to'' that value, i.e.')
+ disp(' -3 == 0, 1, 2, and 3 -99 == everything');
+ reply = input('Input DART QC val: ');
if (~isempty(reply))
used = reply;
end
% restrict observations to a particular observation type?
+ disp('')
reply = input('Input [obs type list] to plot only some obs types, ''default'' to reset: ');
if (~isempty(reply))
typelist = reply;
Modified: DART/trunk/models/MITgcm_annulus/work/input.nml
===================================================================
--- DART/trunk/models/MITgcm_annulus/work/input.nml 2008-02-12 06:04:47 UTC (rev 3222)
+++ DART/trunk/models/MITgcm_annulus/work/input.nml 2008-02-12 06:31:51 UTC (rev 3223)
@@ -153,7 +153,7 @@
# in which case last_bin_center should be safely in the future.
#
# Acceptable latitudes range from [-90, 90]
-# Acceptable longitudes range from [ 0, 360]
+# Acceptable longitudes range from [ 0, Inf]
&obs_diag_nml
obs_sequence_name = 'obs_seq.final',
@@ -162,19 +162,16 @@
bin_separation = 0, 0, 0, 6, 0, 0 ,
bin_width = 0, 0, 0, 6, 0, 0 ,
time_to_skip = 0, 0, 0, 0, 0, 0 ,
- max_num_bins = 1000,
- mlevel = 5,
- plevel = 500,
- hlevel = 5000,
- obs_select = 1,
- Nregions = 4,
- rat_cri = 3.0,
+ max_num_bins = 1000,
+ rat_cri = 3.0,
input_qc_threshold = 4.0,
+ Nregions = 4,
lonlim1 = 0.0, 0.0, 0.0, 235.0,
lonlim2 = 360.0, 360.0, 360.0, 295.0,
latlim1 = 20.0, -80.0, -20.0, 25.0,
latlim2 = 80.0, -20.0, 20.0, 55.0,
reg_names = 'Northern Hemisphere', 'Southern Hemisphere', 'Tropics', 'North America',
print_mismatched_locs = .false.,
+ print_obs_locations = .false.,
verbose = .false. /
Modified: DART/trunk/models/PBL_1d/work/input.nml
===================================================================
--- DART/trunk/models/PBL_1d/work/input.nml 2008-02-12 06:04:47 UTC (rev 3222)
+++ DART/trunk/models/PBL_1d/work/input.nml 2008-02-12 06:31:51 UTC (rev 3223)
@@ -167,7 +167,7 @@
# in which case last_bin_center should be safely in the future.
#
# Acceptable latitudes range from [-90, 90]
-# Acceptable longitudes range from [ 0, 360]
+# Acceptable longitudes range from [ 0, Inf]
&obs_diag_nml
obs_sequence_name = 'obs_seq.final',
@@ -176,10 +176,7 @@
bin_separation = 0, 0, 0, 1, 0, 0,
bin_width = 0, 0, 0, 1, 0, 0,
time_to_skip = 0, 0, 0, 0, 0, 0,
- max_num_bins = 1000,
- plevel = 500,
- hlevel = 5000,
- mlevel = 5,
+ max_num_bins = 1000,
rat_cri = 3.0,
input_qc_threshold = 4.0,
Nregions = 1,
Modified: DART/trunk/models/bgrid_solo/work/input.nml
===================================================================
--- DART/trunk/models/bgrid_solo/work/input.nml 2008-02-12 06:04:47 UTC (rev 3222)
+++ DART/trunk/models/bgrid_solo/work/input.nml 2008-02-12 06:31:51 UTC (rev 3223)
@@ -226,7 +226,7 @@
# in which case last_bin_center should be safely in the future.
#
# Acceptable latitudes range from [-90, 90]
-# Acceptable longitudes range from [ 0, 360]
+# Acceptable longitudes range from [ 0, Inf]
&obs_diag_nml
obs_sequence_name = 'obs_seq.final',
@@ -235,10 +235,7 @@
bin_separation = 0, 0, 0, 0, 3, 0 ,
bin_width = 0, 0, 0, 0, 3, 0 ,
time_to_skip = 0, 0, 0, 0, 0, 0 ,
- max_num_bins = 1000,
- plevel = 500,
- hlevel = 5000,
- mlevel = 5,
+ max_num_bins = 1000,
rat_cri = 3.0,
input_qc_threshold = 4.0,
Nregions = 4,
Modified: DART/trunk/models/cam/work/input.nml
===================================================================
--- DART/trunk/models/cam/work/input.nml 2008-02-12 06:04:47 UTC (rev 3222)
+++ DART/trunk/models/cam/work/input.nml 2008-02-12 06:31:51 UTC (rev 3223)
@@ -176,7 +176,7 @@
# in which case last_bin_center should be safely in the future.
#
# Acceptable latitudes range from [-90, 90]
-# Acceptable longitudes range from [ 0, 360]
+# Acceptable longitudes range from [ 0, Inf]
&obs_diag_nml
obs_sequence_name = 'obs_seq.final',
@@ -185,18 +185,17 @@
bin_separation = 0, 0, 0, 6, 0, 0 ,
bin_width = 0, 0, 0, 6, 0, 0 ,
time_to_skip = 0, 0, 1, 0, 0, 0 ,
- max_num_bins = 1000,
- plevel = 500,
- hlevel = 5000,
- Nregions = 4,
- rat_cri = 3.0,
+ max_num_bins = 1000,
+ rat_cri = 3.0,
input_qc_threshold = 4.0,
+ Nregions = 4,
lonlim1 = 0.0, 0.0, 0.0, 235.0,
lonlim2 = 360.0, 360.0, 360.0, 295.0,
latlim1 = 20.0, -80.0, -20.0, 25.0,
latlim2 = 80.0, -20.0, 20.0, 55.0,
reg_names = 'Northern Hemisphere', 'Southern Hemisphere', 'Tropics', 'North America',
print_mismatched_locs = .false.,
+ print_obs_locations = .false.,
verbose = .false. /
&restart_file_utility_nml
Modified: DART/trunk/models/pe2lyr/work/input.nml
===================================================================
--- DART/trunk/models/pe2lyr/work/input.nml 2008-02-12 06:04:47 UTC (rev 3222)
+++ DART/trunk/models/pe2lyr/work/input.nml 2008-02-12 06:31:51 UTC (rev 3223)
@@ -148,7 +148,7 @@
# in which case last_bin_center should be safely in the future.
#
# Acceptable latitudes range from [-90, 90]
-# Acceptable longitudes range from [ 0, 360]
+# Acceptable longitudes range from [ 0, Inf]
&obs_diag_nml
obs_sequence_name = 'obs_seq.final',
@@ -157,10 +157,7 @@
bin_separation = 0, 0, 0, 6, 0, 0 ,
bin_width = 0, 0, 0, 6, 0, 0 ,
time_to_skip = 0, 0, 1, 0, 0, 0 ,
- max_num_bins = 1000,
- plevel = 1013,
- hlevel = 5000,
- mlevel = 2,
+ max_num_bins = 1000,
rat_cri = 3.0,
input_qc_threshold = 4.0,
Nregions = 4,
Modified: DART/trunk/models/rose/work/input.nml
===================================================================
--- DART/trunk/models/rose/work/input.nml 2008-02-12 06:04:47 UTC (rev 3222)
+++ DART/trunk/models/rose/work/input.nml 2008-02-12 06:31:51 UTC (rev 3223)
@@ -156,7 +156,7 @@
# in which case last_bin_center should be safely in the future.
#
# Acceptable latitudes range from [-90, 90]
-# Acceptable longitudes range from [ 0, 360]
+# Acceptable longitudes range from [ 0, Inf]
&obs_diag_nml
obs_sequence_name = 'obs_seq.final',
@@ -165,10 +165,7 @@
bin_separation = 0, 0, 0, 6, 0, 0 ,
bin_width = 0, 0, 0, 6, 0, 0 ,
time_to_skip = 0, 0, 0, 6, 0, 0 ,
- max_num_bins = 1000,
- plevel = 500,
- hlevel = 5000,
- mlevel = 5,
+ max_num_bins = 1000,
rat_cri = 3.0,
input_qc_threshold = 4.0,
Nregions = 4,
Modified: DART/trunk/models/wrf/work/input.nml
===================================================================
--- DART/trunk/models/wrf/work/input.nml 2008-02-12 06:04:47 UTC (rev 3222)
+++ DART/trunk/models/wrf/work/input.nml 2008-02-12 06:31:51 UTC (rev 3223)
@@ -184,7 +184,7 @@
# in which case last_bin_center should be safely in the future.
#
# Acceptable latitudes range from [-90, 90]
-# Acceptable longitudes range from [ 0, 360]
+# Acceptable longitudes range from [ 0, Inf]
&obs_diag_nml
obs_sequence_name = 'obs_seq.final',
@@ -193,10 +193,7 @@
bin_separation = 0, 0, 0,12, 0, 0 ,
bin_width = 0, 0, 0, 6, 0, 0 ,
time_to_skip = 0, 0, 0, 0, 0, 0 ,
- max_num_bins = 1000,
- plevel = 500,
- hlevel = 5000,
- mlevel = 5,
+ max_num_bins = 1000,
rat_cri = 5000.0,
input_qc_threshold = 4.0,
Nregions = 1,
More information about the Dart-dev
mailing list