From nancy at ucar.edu Mon Apr 2 09:37:44 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 02 Apr 2012 09:37:44 -0600
Subject: [Dart-dev] [5636] DART/branches/development/models/model_mod.html:
this is the generic model_mod.html file in the DART/models directory
Message-ID:
Revision: 5636
Author: nancy
Date: 2012-04-02 09:37:44 -0600 (Mon, 02 Apr 2012)
Log Message:
-----------
this is the generic model_mod.html file in the DART/models directory
(not for any one specific model). a feeble start at unraveling the
types/kinds confusion; get_state_meta_data, model_interpolate, etc
all deal with generic kinds. the specific types apply only to
observations, and are always associated with a generic kind before
they reach the model_mod code. the original docs here only talked
about types, which is incorrect.
Modified Paths:
--------------
DART/branches/development/models/model_mod.html
-------------- next part --------------
Modified: DART/branches/development/models/model_mod.html
===================================================================
--- DART/branches/development/models/model_mod.html 2012-03-30 19:18:58 UTC (rev 5635)
+++ DART/branches/development/models/model_mod.html 2012-04-02 15:37:44 UTC (rev 5636)
@@ -250,14 +250,10 @@
Given an integer index into the state vector structure, returns the
-associated location. A second intent(out) optional argument kind
-can be returned if the model has more than one type of field (for
-instance temperature and zonal wind component). This routine could
-also be called get_state_location_plus() since it returns not the
-data value, but the location of that value, plus an optional
-variable type (e.g. U_WIND or V_WIND).
-This interface is required for all applications as it is used
-to compute the distance between observations and state variables.
+associated location. A second intent(out) optional argument
+returns the generic kind of this item, e.g. KIND_TEMPERATURE,
+KIND_DENSITY, KIND_SALINITY, KIND_U_WIND_COMPONENT.
+This interface is required to be functional for all applications.
@@ -269,7 +265,7 @@
The location of state variable element. |
var_type |
- The type of the state variable element. |
+ The generic kind of the state variable element. |
@@ -295,14 +291,16 @@
-Given a state vector, a location, and a model state variable type,
+Given a state vector, a location, and a model state variable kind
interpolates the state variable field to that location and returns
the value in obs_val. The istatus variable should be returned as
0 unless there is some problem in computing the interpolation in
-which case an alternate value should be returned. The itype variable
-is a model specific integer that specifies the type of field (for
-instance temperature, zonal wind component, etc.). In low order
-models that have no notion of types of variables, this argument can
+which case a positive value should be returned. The itype variable
+is one of the KIND parameters defined in the
+obs_kind_mod.f90 file
+and defines which generic kind of item is being interpolated.
+In low order
+models that have no notion of kinds of variables this argument may
be ignored. For applications in which only perfect model experiments
with identity observations (i.e. only the value of a particular
state variable is observed), this can be a NULL INTERFACE.
@@ -318,7 +316,7 @@
Location to which to interpolate. |
itype |
- Type of state field to be interpolated. |
+ Kind of state field to be interpolated. |
obs_val |
The interpolated value from the model. |
@@ -503,7 +501,7 @@
can be used for any model as-is. The generic code prepares a
file which will have the state vector written as a single 1-D array
of data. This routine can be modified to save the data in form
-more closely related to the actual grid shape and variable type,
+more closely related to the actual grid shape and variable kind,
and could also be extended to write additional attributes if desired.
This routine is required for all models.
@@ -514,7 +512,7 @@
NF90_OPEN ! open existing netCDF dataset
NF90_redef ! put into define mode
NF90_def_dim ! define additional dimensions (if any)
- NF90_def_var ! define variables: from name, type, and dims
+ NF90_def_var ! define variables: from name, kind, and dims
NF90_put_att ! assign attribute values
NF90_ENDDEF ! end definitions: leave define mode
NF90_put_var ! provide values for variable
@@ -558,7 +556,7 @@
models/template/model_mod.f90 contains code that
can be used for any model as-is. It writes the state vector as a single
1-D array of data. The code can be modified to write out the data in a
-form more closely resembling the computational grid and variable types if
+form more closely resembling the computational grid and variable kind if
if desired.
This routine is required for all models.
@@ -569,7 +567,7 @@
NF90_OPEN ! open existing netCDF dataset
NF90_redef ! put into define mode
NF90_def_dim ! define additional dimensions (if any)
- NF90_def_var ! define variables: from name, type, and dims
+ NF90_def_var ! define variables: from name, kind, and dims
NF90_put_att ! assign attribute values
NF90_ENDDEF ! end definitions: leave define mode
NF90_put_var ! provide values for variable
From nancy at ucar.edu Mon Apr 2 10:17:00 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 02 Apr 2012 10:17:00 -0600
Subject: [Dart-dev] [5637]
DART/branches/development/obs_sequence/obs_seq_verify.f90: Actually check
that the ensemble members are in the same order in all files .
Message-ID:
Revision: 5637
Author: thoar
Date: 2012-04-02 10:17:00 -0600 (Mon, 02 Apr 2012)
Log Message:
-----------
Actually check that the ensemble members are in the same order in all files.
The previous check was not correct.
Modified Paths:
--------------
DART/branches/development/obs_sequence/obs_seq_verify.f90
-------------- next part --------------
Modified: DART/branches/development/obs_sequence/obs_seq_verify.f90
===================================================================
--- DART/branches/development/obs_sequence/obs_seq_verify.f90 2012-04-02 15:37:44 UTC (rev 5636)
+++ DART/branches/development/obs_sequence/obs_seq_verify.f90 2012-04-02 16:17:00 UTC (rev 5637)
@@ -383,17 +383,16 @@
! The first trip through sets the module_obs_copy_names so we can
! be sure we are stuffing compatible objects into the same slots
if ( ifile == 1 ) then
- module_obs_copy_names = obs_copy_names
+ module_obs_copy_names = obs_copy_names(copy_indices(1:ensemble_size))
else
- ! FIXME more robust checks
+ ! Check to make sure the ensemble members are in the expected copies
do i = 1,ensemble_size
if ( obs_copy_names(copy_indices(i)) /= module_obs_copy_names(i) ) then
-
- write(string1,*)'mismatch in observation copies ',&
- trim(obs_copy_names(copy_indices(i)))
- string2 = trim(module_obs_copy_names(i))
+ write(string1,'(''module has '',A)') trim(module_obs_copy_names(i))
+ write(string2,'(A,'' has '',A)') trim(obs_seq_in_file_name), &
+ trim(obs_copy_names(copy_indices(i)))
call error_handler(E_ERR,'obs_seq_verify', &
- string1,source,revision,revdate,text2=string2)
+ 'mismatch in observation copies',source,revision,revdate,text2=string1,text3=string2)
endif
enddo
endif
From nancy at ucar.edu Mon Apr 2 10:50:46 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 02 Apr 2012 10:50:46 -0600
Subject: [Dart-dev] [5638]
DART/branches/development/random_seq/random_seq_mod.f90: Makes the XLF
compiler happy.
Message-ID:
Revision: 5638
Author: thoar
Date: 2012-04-02 10:50:46 -0600 (Mon, 02 Apr 2012)
Log Message:
-----------
Makes the XLF compiler happy.
Modified Paths:
--------------
DART/branches/development/random_seq/random_seq_mod.f90
-------------- next part --------------
Modified: DART/branches/development/random_seq/random_seq_mod.f90
===================================================================
--- DART/branches/development/random_seq/random_seq_mod.f90 2012-04-02 16:17:00 UTC (rev 5637)
+++ DART/branches/development/random_seq/random_seq_mod.f90 2012-04-02 16:50:46 UTC (rev 5638)
@@ -195,7 +195,7 @@
sd = seed
if (sd == 0) sd = 4357 ! do not allow seed to be 0, use default
-s%mt(0) = iand(sd, FULL32_MASK)
+s%mt(0) = iand(int(sd,i8), FULL32_MASK)
! See Knuth's "Art of Computer Programming" Vol. 2, 3rd Ed. p.106
! for multiplier.
From nancy at ucar.edu Mon Apr 2 11:00:19 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 02 Apr 2012 11:00:19 -0600
Subject: [Dart-dev] [5639] DART/trunk/obs_sequence/obs_seq_verify.f90: The
error check or the metadata (ensemble copy) information
Message-ID:
Revision: 5639
Author: thoar
Date: 2012-04-02 11:00:19 -0600 (Mon, 02 Apr 2012)
Log Message:
-----------
The error check or the metadata (ensemble copy) information
for each file is now correct.
Modified Paths:
--------------
DART/trunk/obs_sequence/obs_seq_verify.f90
Property Changed:
----------------
DART/trunk/obs_sequence/obs_seq_verify.f90
-------------- next part --------------
Modified: DART/trunk/obs_sequence/obs_seq_verify.f90
===================================================================
--- DART/trunk/obs_sequence/obs_seq_verify.f90 2012-04-02 16:50:46 UTC (rev 5638)
+++ DART/trunk/obs_sequence/obs_seq_verify.f90 2012-04-02 17:00:19 UTC (rev 5639)
@@ -383,17 +383,16 @@
! The first trip through sets the module_obs_copy_names so we can
! be sure we are stuffing compatible objects into the same slots
if ( ifile == 1 ) then
- module_obs_copy_names = obs_copy_names
+ module_obs_copy_names = obs_copy_names(copy_indices(1:ensemble_size))
else
- ! FIXME more robust checks
+ ! Check to make sure the ensemble members are in the expected copies
do i = 1,ensemble_size
if ( obs_copy_names(copy_indices(i)) /= module_obs_copy_names(i) ) then
-
- write(string1,*)'mismatch in observation copies ',&
- trim(obs_copy_names(copy_indices(i)))
- string2 = trim(module_obs_copy_names(i))
+ write(string1,'(''module has '',A)') trim(module_obs_copy_names(i))
+ write(string2,'(A,'' has '',A)') trim(obs_seq_in_file_name), &
+ trim(obs_copy_names(copy_indices(i)))
call error_handler(E_ERR,'obs_seq_verify', &
- string1,source,revision,revdate,text2=string2)
+ 'mismatch in observation copies',source,revision,revdate,text2=string1,text3=string2)
endif
enddo
endif
Property changes on: DART/trunk/obs_sequence/obs_seq_verify.f90
___________________________________________________________________
Added: svn:mergeinfo
+ /DART/branches/development/obs_sequence/obs_seq_verify.f90:5074-5638
From nancy at ucar.edu Mon Apr 2 11:34:14 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 02 Apr 2012 11:34:14 -0600
Subject: [Dart-dev] [5642] DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90:
keep in sync with kodiak; added altimeter tendency kind.
Message-ID:
Revision: 5642
Author: nancy
Date: 2012-04-02 11:34:13 -0600 (Mon, 02 Apr 2012)
Log Message:
-----------
keep in sync with kodiak; added altimeter tendency kind.
Modified Paths:
--------------
DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90
Property Changed:
----------------
DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90
-------------- next part --------------
Modified: DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90
===================================================================
--- DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90 2012-04-02 17:29:46 UTC (rev 5641)
+++ DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90 2012-04-02 17:34:13 UTC (rev 5642)
@@ -140,6 +140,10 @@
KIND_ATOMIC_OXYGEN_MIXING_RATIO = 46, &
KIND_MOLEC_OXYGEN_MIXING_RATIO = 47
+! kinds for tendencies
+integer, parameter, public :: &
+ KIND_ALTIMETER_TENDENCY = 48
+
! kinds for the MITgcm, POP ocean model
integer, parameter, public :: &
KIND_SALINITY = 50, &
Property changes on: DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90
___________________________________________________________________
Added: svn:mergeinfo
+ /DART/releases/Kodiak/obs_kind/DEFAULT_obs_kind_mod.F90:5020-5641
From nancy at ucar.edu Mon Apr 2 11:46:05 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 02 Apr 2012 11:46:05 -0600
Subject: [Dart-dev] [5643]
DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90: Keep in sync
with kodiak; added altimeter tendency kind.
Message-ID:
Revision: 5643
Author: nancy
Date: 2012-04-02 11:46:05 -0600 (Mon, 02 Apr 2012)
Log Message:
-----------
Keep in sync with kodiak; added altimeter tendency kind.
Modified Paths:
--------------
DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
Property Changed:
----------------
DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
-------------- next part --------------
Modified: DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
===================================================================
--- DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90 2012-04-02 17:34:13 UTC (rev 5642)
+++ DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90 2012-04-02 17:46:05 UTC (rev 5643)
@@ -140,6 +140,10 @@
KIND_ATOMIC_OXYGEN_MIXING_RATIO = 46, &
KIND_MOLEC_OXYGEN_MIXING_RATIO = 47
+! kinds for tendencies
+integer, parameter, public :: &
+ KIND_ALTIMETER_TENDENCY = 48
+
! kinds for the MITgcm, POP ocean model
integer, parameter, public :: &
KIND_SALINITY = 50, &
Property changes on: DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
___________________________________________________________________
Added: svn:mergeinfo
+ /DART/releases/Kodiak/obs_kind/DEFAULT_obs_kind_mod.F90:5020-5642
/DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90:4680-5293
From nancy at ucar.edu Mon Apr 2 14:16:57 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 02 Apr 2012 14:16:57 -0600
Subject: [Dart-dev] [5645] DART/branches/development/filter/filter.f90: add
a single line to the dart_log file saying what the
Message-ID:
Revision: 5645
Author: nancy
Date: 2012-04-02 14:16:56 -0600 (Mon, 02 Apr 2012)
Log Message:
-----------
add a single line to the dart_log file saying what the
ensemble size is. yes, it is in the namelist but we don't
ever print out the value in the log.
Modified Paths:
--------------
DART/branches/development/filter/filter.f90
-------------- next part --------------
Modified: DART/branches/development/filter/filter.f90
===================================================================
--- DART/branches/development/filter/filter.f90 2012-04-02 17:58:55 UTC (rev 5644)
+++ DART/branches/development/filter/filter.f90 2012-04-02 20:16:56 UTC (rev 5645)
@@ -211,6 +211,10 @@
call error_handler(E_ERR,'filter_main', msgstring, source, revision, revdate)
endif
+! informational message to log
+write(msgstring, *) 'running with an ensemble size of ', ens_size
+call error_handler(E_MSG,'filter:', msgstring)
+
! See if smoothing is turned on
ds = do_smoothing()
From nancy at ucar.edu Thu Apr 5 16:24:57 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Thu, 05 Apr 2012 16:24:57 -0600
Subject: [Dart-dev] [5654] DART/trunk/models/pe2lyr/model_mod.f90: major bug
in an infrequently used model.
Message-ID:
Revision: 5654
Author: nancy
Date: 2012-04-05 16:24:57 -0600 (Thu, 05 Apr 2012)
Log Message:
-----------
major bug in an infrequently used model. the interpolate routine was
using the wrong indices and so all forward operator values were wrong.
after the fix i'm able to assimilate without strange results.
(merged from kodiak.)
Modified Paths:
--------------
DART/trunk/models/pe2lyr/model_mod.f90
-------------- next part --------------
Modified: DART/trunk/models/pe2lyr/model_mod.f90
===================================================================
--- DART/trunk/models/pe2lyr/model_mod.f90 2012-04-05 22:22:57 UTC (rev 5653)
+++ DART/trunk/models/pe2lyr/model_mod.f90 2012-04-05 22:24:57 UTC (rev 5654)
@@ -433,7 +433,7 @@
! order is u,v,z
if(mytype == KIND_U_WIND_COMPONENT) then
- indx = (level-1)*nlats*nlons+(lat_index-1)*nlons + lat_index
+ indx = (level-1)*nlats*nlons+(lat_index-1)*nlons + lon_index
else if(mytype == KIND_V_WIND_COMPONENT) then
indx = 2*nlats*nlons+(level-1)*nlats*nlons+(lat_index-1)*nlons + lon_index
else if(mytype == KIND_GEOPOTENTIAL_HEIGHT) then
From nancy at ucar.edu Fri Apr 6 11:08:51 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Fri, 06 Apr 2012 11:08:51 -0600
Subject: [Dart-dev] [5656]
DART/branches/development/adaptive_inflate/adaptive_inflate_mod.f90: minor
changes after code review with tim.
Message-ID:
Revision: 5656
Author: nancy
Date: 2012-04-06 11:08:50 -0600 (Fri, 06 Apr 2012)
Log Message:
-----------
minor changes after code review with tim.
Modified Paths:
--------------
DART/branches/development/adaptive_inflate/adaptive_inflate_mod.f90
Property Changed:
----------------
DART/branches/development/adaptive_inflate/adaptive_inflate_mod.f90
-------------- next part --------------
Modified: DART/branches/development/adaptive_inflate/adaptive_inflate_mod.f90
===================================================================
--- DART/branches/development/adaptive_inflate/adaptive_inflate_mod.f90 2012-04-05 23:17:16 UTC (rev 5655)
+++ DART/branches/development/adaptive_inflate/adaptive_inflate_mod.f90 2012-04-06 17:08:50 UTC (rev 5656)
@@ -161,8 +161,8 @@
! give this an initial value which defaults to time-constant inflation
! change it below if the value(s) are > 0
-minmax_mean = 0.0_r8
-minmax_sd = 0.0_r8
+minmax_mean(:) = 0.0_r8
+minmax_sd(:) = 0.0_r8
!------ Block for state space inflation initialization ------
@@ -183,9 +183,12 @@
! and send the value to PE0 if not already there.
minmax_sd = sd_initial
- ! Read in initial values from file OR get from subroutine arguments
+ ! Read in initial values from file OR get from namelist arguments
+
! If either mean, sd, or both are to be read from the restart file, read them in.
- ! Then test to see if either are to be overwritten, and do it.
+ ! There is no option to read only one; to get either you have to read both.
+ ! If one is to be set from the namelist, it gets overwritten in the block below
+ ! this one.
if(mean_from_restart .or. sd_from_restart) then
! the .true. below is 'start_from_restart', which tells the read routine to
! read in the full number of ensemble members requested (as opposed to reading
@@ -193,15 +196,10 @@
call read_ensemble_restart(ens_handle, ss_inflate_index, ss_inflate_sd_index, &
.true., in_file_name, force_single_file = .true.)
endif
- ! If one or both are false, we need to set the array values from the namelist item
+ ! Now, if one or both values come from the namelist (i.e. is a single static
+ ! value), write or overwrite the arrays here.
if (.not. mean_from_restart .or. .not. sd_from_restart) then
-! original code requires an expensive transpose which is not necessary.
-! ! Get initial values from higher level; requires pe's to have all copies of some vars
-! call all_vars_to_all_copies(ens_handle)
-! if (.not. mean_from_restart) ens_handle%copies(ss_inflate_index, :) = inf_initial
-! if (.not. sd_from_restart) ens_handle%copies(ss_inflate_sd_index, :) = sd_initial
-! call all_copies_to_all_vars(ens_handle)
-! proposed alternate:
+ ! original code required an expensive transpose which is not necessary.
! if setting initial values from the namelist, find out which task has the
! inflation and inf sd values and set them only on that task. this saves us
! a transpose.
@@ -263,15 +261,12 @@
endif
! Inflation type 3 is spatially-constant. Make sure the entire array is set to that
- ! value; the computation only uses index 1, but the diagnostics write out the entire
+ ! value. the computation only uses index 1, but the diagnostics write out the entire
! array and it will be misleading if not constant. the inf values were set above.
! if they were set by namelist, this code changes nothing. but if they were read in
! from a file, then it is possible the values vary across the array. these lines
! ensure the entire array contains a single constant value to match what the code uses.
if(inf_flavor == 3) then
-! this was wrong - we are var complete at this point...
-! ens_handle%copies(ss_inflate_index, :) = ens_handle%copies(ss_inflate_index, 1)
-! ens_handle%copies(ss_inflate_sd_index, :) = ens_handle%copies(ss_inflate_sd_index, 1)
call get_copy_owner_index(ss_inflate_index, owner, owners_index)
if (owner == my_task_id()) ens_handle%vars(:, owners_index) = ens_handle%vars(1, owners_index)
call get_copy_owner_index(ss_inflate_sd_index, owner, owners_index)
Property changes on: DART/branches/development/adaptive_inflate/adaptive_inflate_mod.f90
___________________________________________________________________
Added: svn:mergeinfo
+ /DART/branches/inf_restart/adaptive_inflate_mod.f90:4784-4812
/DART/trunk/adaptive_inflate/adaptive_inflate_mod.f90:4680-5630
From nancy at ucar.edu Fri Apr 6 11:25:29 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Fri, 06 Apr 2012 11:25:29 -0600
Subject: [Dart-dev] [5658]
DART/trunk/adaptive_inflate/adaptive_inflate_mod.f90: removed unnecessary
pair of transposes when setting the initial
Message-ID:
Revision: 5658
Author: nancy
Date: 2012-04-06 11:25:29 -0600 (Fri, 06 Apr 2012)
Log Message:
-----------
removed unnecessary pair of transposes when setting the initial
inflation values from the namelist. moved the diagnostic prints
to the end of the routine so it prints out the correct values
even when read in from restart files. added new message to
print out min/max values if read in from file.
Modified Paths:
--------------
DART/trunk/adaptive_inflate/adaptive_inflate_mod.f90
Property Changed:
----------------
DART/trunk/adaptive_inflate/adaptive_inflate_mod.f90
-------------- next part --------------
Modified: DART/trunk/adaptive_inflate/adaptive_inflate_mod.f90
===================================================================
--- DART/trunk/adaptive_inflate/adaptive_inflate_mod.f90 2012-04-06 17:18:08 UTC (rev 5657)
+++ DART/trunk/adaptive_inflate/adaptive_inflate_mod.f90 2012-04-06 17:25:29 UTC (rev 5658)
@@ -16,10 +16,10 @@
use time_manager_mod, only : time_type, get_time, set_time
use utilities_mod, only : file_exist, get_unit, register_module, &
error_handler, E_ERR, E_MSG
-use random_seq_mod, only : random_seq_type, random_gaussian, init_random_seq, &
- random_uniform
+use random_seq_mod, only : random_seq_type, random_gaussian, init_random_seq
use ensemble_manager_mod, only : ensemble_type, all_vars_to_all_copies, all_copies_to_all_vars, &
- read_ensemble_restart, write_ensemble_restart
+ read_ensemble_restart, write_ensemble_restart, get_copy_owner_index
+use mpi_utilities_mod, only : my_task_id, send_to, receive_from
implicit none
private
@@ -92,50 +92,20 @@
character(len = *), intent(in) :: label
character(len = 128) :: det, tadapt, sadapt, akind, rsread, nmread
-integer :: restart_unit, io
+integer :: restart_unit, io, owner, owners_index
+real(r8) :: minmax_mean(2), minmax_sd(2)
-! Write to log file what kind of inflation is being used.
-if(deterministic) then
- det = 'deterministic,'
-else
- det = 'random-noise,'
+! Record the module version if this is first initialize call
+if(.not. initialized) then
+ initialized = .true.
+ call register_module(source, revision, revdate)
+
+ ! If non-deterministic inflation is being done, need to initialize random sequence.
+ ! use the task id number (plus 1 since they start at 0) to set the initial seed.
+ ! NOTE: non-deterministic inflation does NOT reproduce as process count is varied!
+ if(.not. deterministic) call init_random_seq(inflate_handle%ran_seq, my_task_id()+1)
endif
-if (sd_initial > inf_lower_bound) then
- det = trim(det) // ' covariance adaptive,'
-endif
-if (inf_lower_bound < 1.0_r8) then
- det = trim(det) // ' deflation permitted,'
-endif
-if (sd_initial > 0.0_r8) then
- tadapt = ' time-adaptive,'
-else
- tadapt = ' time-constant,'
-endif
-select case(inf_flavor)
- case (0)
- det = ''
- tadapt = ''
- sadapt = ''
- akind = 'None '
- case (1)
- sadapt = ''
- akind = ' observation-space'
- case (2)
- sadapt = ' spatially-varying,'
- akind = ' state-space '
- case (3)
- sadapt = ' spatially-constant,'
- akind = ' state-space'
- case default
- write(errstring, *) 'Illegal inflation value for ', label
- call error_handler(E_ERR, 'adaptive_inflate_init', errstring, source, revision, revdate)
-end select
-! say in plain english what kind of inflation was selected.
-write(errstring, '(4A)') &
- trim(det), trim(tadapt), trim(sadapt), trim(akind)
-call error_handler(E_MSG, trim(label) // ' inflation:', errstring, source, revision, revdate)
-
! more information for users to document what they selected in the nml:
! if flavor > 0, look at read_from_restart for both mean and sd.
! print the actual value used if from namelist, or say
@@ -183,22 +153,17 @@
! Set obs_diag unit to -1 indicating it has not been opened yet
inflate_handle%obs_diag_unit = -1
-! Record the module version if this is first initialize call
-if(.not. initialized) then
- initialized = .true.
- call register_module(source, revision, revdate)
-endif
-
-! If non-deterministic inflation is being done, need to initialize random sequence
-! NOTE: non-deterministic inflation does NOT reproduce as process count is varied!
-if(.not. deterministic) call init_random_seq(inflate_handle%ran_seq)
-
! Cannot support non-determistic inflation and an inf_lower_bound < 1
if(.not. deterministic .and. inf_lower_bound < 1.0_r8) then
write(errstring, *) 'Cannot have non-deterministic inflation and inf_lower_bound < 1'
call error_handler(E_ERR, 'adaptive_inflate_init', errstring, source, revision, revdate)
endif
+! give this an initial value which defaults to time-constant inflation
+! change it below if the value(s) are > 0
+minmax_mean(:) = 0.0_r8
+minmax_sd(:) = 0.0_r8
+
!------ Block for state space inflation initialization ------
! Types 2 and 3 are state space inflation types
@@ -214,9 +179,16 @@
errstring, source, revision, revdate)
endif
- ! Read in initial values from file OR get from subroutine arguments
+ ! set this, and then below if sd values are from a file, compute them
+ ! and send the value to PE0 if not already there.
+ minmax_sd = sd_initial
+
+ ! Read in initial values from file OR get from namelist arguments
+
! If either mean, sd, or both are to be read from the restart file, read them in.
- ! Then test to see if either are to be overwritten, and do it.
+ ! There is no option to read only one; to get either you have to read both.
+ ! If one is to be set from the namelist, it gets overwritten in the block below
+ ! this one.
if(mean_from_restart .or. sd_from_restart) then
! the .true. below is 'start_from_restart', which tells the read routine to
! read in the full number of ensemble members requested (as opposed to reading
@@ -224,21 +196,81 @@
call read_ensemble_restart(ens_handle, ss_inflate_index, ss_inflate_sd_index, &
.true., in_file_name, force_single_file = .true.)
endif
- ! If one or both are false, we need to transpose and then set the values
+ ! Now, if one or both values come from the namelist (i.e. is a single static
+ ! value), write or overwrite the arrays here.
if (.not. mean_from_restart .or. .not. sd_from_restart) then
- ! Get initial values from higher level; requires pe's to have all copies of some vars
- call all_vars_to_all_copies(ens_handle)
- if (.not. mean_from_restart) ens_handle%copies(ss_inflate_index, :) = inf_initial
- if (.not. sd_from_restart) ens_handle%copies(ss_inflate_sd_index, :) = sd_initial
- call all_copies_to_all_vars(ens_handle)
+ ! original code required an expensive transpose which is not necessary.
+ ! if setting initial values from the namelist, find out which task has the
+ ! inflation and inf sd values and set them only on that task. this saves us
+ ! a transpose.
+ if (.not. mean_from_restart) then
+ call get_copy_owner_index(ss_inflate_index, owner, owners_index)
+ if (owner == my_task_id()) ens_handle%vars(:, owners_index) = inf_initial
+ endif
+ if (.not. sd_from_restart) then
+ call get_copy_owner_index(ss_inflate_sd_index, owner, owners_index)
+ if (owner == my_task_id()) ens_handle%vars(:, owners_index) = sd_initial
+ endif
endif
+
+ ! this block figures out what the min/max value of the mean/sd is
+ ! if we are reading in the values from a restart file. it is used
+ ! in diagnostic output so it needs to get to PE0. we also could check it
+ ! against the limits in the namelist to be sure the file values aren't
+ ! already outside the requested limits. (not sure that's necessary -
+ ! depends on when the code that changes the values imposes the limits.)
+ if (mean_from_restart) then
+ call get_copy_owner_index(ss_inflate_index, owner, owners_index)
+ ! if inflation array is already on PE0, just figure out the
+ ! largest value in the array and we're done.
+ if (owner == 0) then
+ minmax_mean(1) = minval(ens_handle%vars(:, owners_index))
+ minmax_mean(2) = maxval(ens_handle%vars(:, owners_index))
+ else
+ ! someone else has the inf array. have the owner send the min/max
+ ! values to PE0. after this point only PE0 has the right value
+ ! in minmax_mean, but it is the only one who is going to print below.
+ if (my_task_id() == 0) then
+ call receive_from(owner, minmax_mean)
+ else if (my_task_id() == owner) then
+ minmax_mean(1) = minval(ens_handle%vars(:, owners_index))
+ minmax_mean(2) = maxval(ens_handle%vars(:, owners_index))
+ call send_to(0, minmax_mean)
+ endif
+ endif
+ endif
+ if (sd_from_restart) then
+ call get_copy_owner_index(ss_inflate_sd_index, owner, owners_index)
+ ! if inflation sd array is already on PE0, just figure out the
+ ! largest value in the array and we're done.
+ if (owner == 0) then
+ minmax_sd(1) = minval(ens_handle%vars(:, owners_index))
+ minmax_sd(2) = maxval(ens_handle%vars(:, owners_index))
+ else
+ ! someone else has the sd array. have the owner send the min/max
+ ! values to PE0. after this point only PE0 has the right value
+ ! in minmax_sd, but it is the only one who is going to print below.
+ if (my_task_id() == 0) then
+ call receive_from(owner, minmax_sd)
+ else if (my_task_id() == owner) then
+ minmax_sd(1) = minval(ens_handle%vars(:, owners_index))
+ minmax_sd(2) = maxval(ens_handle%vars(:, owners_index))
+ call send_to(0, minmax_sd)
+ endif
+ endif
+ endif
! Inflation type 3 is spatially-constant. Make sure the entire array is set to that
- ! value; the computation only uses index 1, but the diagnostics write out the entire
- ! array and it will be misleading if not constant.
+ ! value. the computation only uses index 1, but the diagnostics write out the entire
+ ! array and it will be misleading if not constant. the inf values were set above.
+ ! if they were set by namelist, this code changes nothing. but if they were read in
+ ! from a file, then it is possible the values vary across the array. these lines
+ ! ensure the entire array contains a single constant value to match what the code uses.
if(inf_flavor == 3) then
- ens_handle%copies(ss_inflate_index, :) = ens_handle%copies(ss_inflate_index, 1)
- ens_handle%copies(ss_inflate_sd_index, :) = ens_handle%copies(ss_inflate_sd_index, 1)
+ call get_copy_owner_index(ss_inflate_index, owner, owners_index)
+ if (owner == my_task_id()) ens_handle%vars(:, owners_index) = ens_handle%vars(1, owners_index)
+ call get_copy_owner_index(ss_inflate_sd_index, owner, owners_index)
+ if (owner == my_task_id()) ens_handle%vars(:, owners_index) = ens_handle%vars(1, owners_index)
endif
!------ Block for obs. space inflation initialization ------
@@ -247,7 +279,7 @@
else if(inf_flavor == 1) then
! Initialize observation space inflation values from restart files
- ! Only values are inflation, inflation_sd
+ ! Only single values for inflation, inflation_sd (not arrays)
if(mean_from_restart .or. sd_from_restart) then
! Open the file
restart_unit = get_unit()
@@ -274,6 +306,64 @@
endif
+! Write to log file what kind of inflation is being used.
+! This used to be at the start, but if you are starting from a restart
+! file then you can't tell what sd values are being read in until here.
+if(deterministic) then
+ det = 'deterministic,'
+else
+ det = 'random-noise,'
+endif
+if (inflate_handle%sd_lower_bound > inf_lower_bound) then
+ det = trim(det) // ' covariance adaptive,'
+endif
+if (inflate_handle%inf_lower_bound < 1.0_r8) then
+ det = trim(det) // ' deflation permitted,'
+endif
+if (minmax_sd(2) > 0.0_r8) then
+ tadapt = ' time-adaptive,'
+else
+ tadapt = ' time-constant,'
+endif
+
+select case(inf_flavor)
+ case (0)
+ det = ''
+ tadapt = ''
+ sadapt = ''
+ akind = 'None '
+ case (1)
+ sadapt = ''
+ akind = ' observation-space'
+ case (2)
+ sadapt = ' spatially-varying,'
+ akind = ' state-space '
+ case (3)
+ sadapt = ' spatially-constant,'
+ akind = ' state-space'
+ case default
+ write(errstring, *) 'Illegal inflation value for ', label
+ call error_handler(E_ERR, 'adaptive_inflate_init', errstring, source, revision, revdate)
+end select
+
+! say in plain english what kind of inflation was selected.
+write(errstring, '(4A)') &
+ trim(det), trim(tadapt), trim(sadapt), trim(akind)
+call error_handler(E_MSG, trim(label) // ' inflation:', errstring, source, revision, revdate)
+
+if (inf_flavor > 0) then
+ if (mean_from_restart) then
+ write(errstring, '(A, F8.3, A, F8.3)') &
+ 'inf mean from restart file: min value: ', minmax_mean(1), ' max value: ', minmax_mean(2)
+ call error_handler(E_MSG, trim(label) // ' inflation:', errstring, source, revision, revdate)
+ endif
+ if (sd_from_restart) then
+ write(errstring, '(A, F8.3, A, F8.3)') &
+ 'inf stddev from restart file: min value: ', minmax_sd(1), ' max value: ', minmax_sd(2)
+ call error_handler(E_MSG, trim(label) // ' inflation:', errstring, source, revision, revdate)
+ endif
+endif
+
end subroutine adaptive_inflate_init
!------------------------------------------------------------------
Property changes on: DART/trunk/adaptive_inflate/adaptive_inflate_mod.f90
___________________________________________________________________
Added: svn:mergeinfo
+ /DART/branches/development/adaptive_inflate/adaptive_inflate_mod.f90:4680-5657
/DART/branches/inf_restart/adaptive_inflate_mod.f90:4784-4812
From nancy at ucar.edu Fri Apr 6 15:04:53 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Fri, 06 Apr 2012 15:04:53 -0600
Subject: [Dart-dev] [5661] DART/branches/development: Synchronizing the
development branch with the trunk.
Message-ID:
Revision: 5661
Author: thoar
Date: 2012-04-06 15:04:52 -0600 (Fri, 06 Apr 2012)
Log Message:
-----------
Synchronizing the development branch with the trunk.
All the good bits on the trunk are now also on the development branch.
Modified Paths:
--------------
DART/branches/development/location/threed_sphere/location_mod.f90
DART/branches/development/models/PBL_1d/work/path_names_create_real_network_seq
DART/branches/development/models/pe2lyr/model_mod.f90
DART/branches/development/models/wrf/WRF_BC/module_netcdf_interface.f90
Added Paths:
-----------
DART/branches/development/models/PBL_1d/create_real_network.f90
DART/branches/development/models/PBL_1d/create_real_network.nml
Removed Paths:
-------------
DART/branches/development/models/PBL_1d/create_real_network/
DART/branches/development/models/PBL_1d/create_real_network.f90
Property Changed:
----------------
DART/branches/development/
DART/branches/development/adaptive_inflate/
DART/branches/development/adaptive_inflate/adaptive_inflate_mod.f90
DART/branches/development/assim_tools/assim_tools_mod.f90
DART/branches/development/models/cam/
DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
DART/branches/development/utilities/
-------------- next part --------------
Property changes on: DART/branches/development
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/trunk:4680-5293
+ /DART/trunk:4680-5660
Property changes on: DART/branches/development/adaptive_inflate
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/branches/inf_restart:4784-4812
/DART/trunk/adaptive_inflate:4680-5372
+ /DART/branches/inf_restart:4784-4812
/DART/trunk/adaptive_inflate:4680-5660
Property changes on: DART/branches/development/adaptive_inflate/adaptive_inflate_mod.f90
___________________________________________________________________
Deleted: svn:mergeinfo
- /DART/branches/inf_restart/adaptive_inflate_mod.f90:4784-4812
/DART/trunk/adaptive_inflate/adaptive_inflate_mod.f90:4680-5630
Property changes on: DART/branches/development/assim_tools/assim_tools_mod.f90
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/releases/Kodiak/assim_tools/assim_tools_mod.f90:5020-5583
/DART/trunk/assim_tools/assim_tools_mod.f90:4680-5293
+ /DART/releases/Kodiak/assim_tools/assim_tools_mod.f90:5020-5583
/DART/trunk/assim_tools/assim_tools_mod.f90:4680-5660
Modified: DART/branches/development/location/threed_sphere/location_mod.f90
===================================================================
--- DART/branches/development/location/threed_sphere/location_mod.f90 2012-04-06 20:06:46 UTC (rev 5660)
+++ DART/branches/development/location/threed_sphere/location_mod.f90 2012-04-06 21:04:52 UTC (rev 5661)
@@ -753,7 +753,7 @@
read(*, *) location%vloc
location%vloc = 100.0 * location%vloc
else if(location%which_vert == VERTISHEIGHT ) then
- write(*, *) 'Vertical coordinate height (in gpm)'
+ write(*, *) 'Vertical coordinate height (in meters)'
read(*, *) location%vloc
else if(location%which_vert == VERTISSURFACE ) then
! most 3d sphere users want height in meters, not pressure.
Deleted: DART/branches/development/models/PBL_1d/create_real_network.f90
===================================================================
--- DART/branches/development/models/PBL_1d/create_real_network.f90 2012-04-06 20:06:46 UTC (rev 5660)
+++ DART/branches/development/models/PBL_1d/create_real_network.f90 2012-04-06 21:04:52 UTC (rev 5661)
@@ -1,380 +0,0 @@
-! DART software - Copyright 2004 - 2011 UCAR. This open source software is
-! provided by UCAR, "as is", without charge, subject to all terms of use at
-! http://www.image.ucar.edu/DAReS/DART/DART_download
-
-program create_real_network_seq
-
-!
-! $URL$
-! $Id$
-! $Revision$
-! $Date$
-
-! JPH
-! This code originated from create_fixed_network. It uses module_wrf to get
-! obs from smos file, with file, date, and interval controlled via the wrf1d
-! namelist. Note that an obs_def is still required to control which
-! obs are actually written out. Normally, this would be created with
-! create_obs_sequence. This would be run in place of both create_fixed_network
-! and perfect_model_obs.
-
-use types_mod, only : r8, missing_r8, missing_i, metadatalength
-use utilities_mod, only : timestamp, register_module, open_file, &
- close_file, find_namelist_in_file, &
- error_handler, check_namelist_read, &
- initialize_utilities, E_ERR
-use obs_kind_mod, only : assimilate_this_obs_kind, evaluate_this_obs_kind
-use obs_def_mod, only : obs_def_type, get_obs_def_time, set_obs_def_time,&
- get_obs_kind, get_obs_name
-use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
- get_num_obs, init_obs_sequence, get_first_obs, &
- write_obs_seq, set_copy_meta_data, &
- get_obs_def, set_obs_def, append_obs_to_seq, &
- get_next_obs, insert_obs_in_seq, init_obs, &
- assignment(=), static_init_obs_sequence, &
- get_num_copies, get_num_qc, &
- get_copy_meta_data, get_qc_meta_data, &
- set_qc_meta_data, read_obs_seq_header, &
- set_obs_values, set_qc, get_qc
-use time_manager_mod, only : time_type, operator(*), operator(+), set_time, &
- set_date, increment_time, get_time, print_time, &
- operator(==), operator(/), operator(<), operator(-)
-use model_mod, only : static_init_model, real_obs_period, start_real_obs
-use module_wrf, only : static_init_wrf, init_wrf, nt_f_smos, &
- start_year_f, start_month_f,start_day_f, &
- start_hour_f, start_minute_f, &
- start_forecast, interval_smos, &
- init_f_type, u10_init_f, v10_init_f, &
- q2_init_f, t2_init_f, forecast_length
-
-
-implicit none
-
-! version controlled file description for error handling, do not edit
-character(len=128), parameter :: &
- source = "$URL$", &
- revision = "$Revision$", &
- revdate = "$Date$"
-
-
-type(obs_sequence_type) :: seq, seq_in, seq_out
-type(obs_type) :: obs, next_obs, new_obs
-type(obs_def_type) :: obs_def
-character(len = 129) :: file_name, obs_seq_in_file_name
-logical :: is_there_one, is_this_last
-type(time_type) :: ob_time, init_time, this_time
-type(time_type) :: obs_seq_period, obs_list_period
-type(time_type),dimension(:), allocatable :: obs_list_time
-type(time_type),dimension(:), allocatable :: obs_seq_time
-type(time_type) :: start_seq_time, flen_time, end_time
-integer :: seconds, days, i, j, network_size, num_times, num_copies, num_qc
-integer :: obs_seq_file_id, iunit, io
-integer :: cnum_copies, cnum_qc, cnum_obs, cnum_max
-integer :: additional_qc, additional_copies
-integer :: last_key_used, time_step_number
-integer :: num_obs, obs_kind_ind
-real(r8) :: this_obs_val, this_qc_val
-real(r8), dimension(:), allocatable :: obs_vals, qc_vals, qc_sequence
-logical :: assimilate_this_ob, evaluate_this_ob, pre_I_format
-character(len=metadatalength) :: copy_meta_data(2), qc_meta_data, obs_seq_read_format
-integer :: wrf_rnd_seed = -1
-
-! Record the current time, date, etc. to the logfile
-call initialize_utilities('Create_real_network_seq')
-call register_module(source,revision,revdate)
-
-! The only necessary namelist variables come from the model
-
-! Call the underlying model's static initialization for calendar info
-call static_init_model()
-
-! Initialize the obs_sequence module
-call static_init_obs_sequence
-
-! fail if we are not initializing from OBS (this could be easily modified
-! to get values from WRF, and may come in handy later!
-if ( init_f_type /= 'OBS' ) then
- call error_handler(E_ERR, 'create_real_network', &
- 'CANNOT PRODUCE OBS SEQUENCE FROM WRF OUTPUT YET', source, revision, revdate)
-endif
-
-! Write the sequence to a file
-write(*, *) 'Input filename for network definition sequence (usually set_def.out )'
-read(*, *) file_name
-call read_obs_seq(file_name, 0, 0, 0, seq_in)
-
-! Find out how many obs there are
-network_size = get_num_obs(seq_in)
-
-! Initialize the obs_type variables
-num_copies = get_num_copies(seq_in)
-num_qc = get_num_qc(seq_in)
-call init_obs(obs, num_copies, num_qc)
-call init_obs(next_obs, num_copies, num_qc)
-call init_obs(new_obs, num_copies, num_qc)
-
-! set init time and period, including increment for forecast start and
-! increment to the proper time of day. One might want to start the assimilation
-! later then when constrained to start the obs list.
- init_time = set_date(start_year_f, start_month_f, start_day_f, &
- start_hour_f, start_minute_f, 0)
- init_time = increment_time(init_time,start_forecast,0)
- flen_time = set_time(forecast_length,0)
- end_time = init_time + flen_time
- real_obs_period = max(real_obs_period,interval_smos)
-
- call get_time(init_time,seconds,days)
-
- start_seq_time = increment_time(init_time,start_real_obs,0)
- obs_seq_period = set_time(real_obs_period, 0)
- obs_list_period = set_time(interval_smos, 0)
-
- if ( interval_smos >= real_obs_period ) then
- num_times = (end_time - start_seq_time) / set_time(interval_smos,0) + 1
- else
- num_times = (end_time - start_seq_time) / set_time(real_obs_period,0) + 1
- endif
-
- ! time information comes from the wrf1d_namelist.input
- ! only supports regularly-repeating obs right now
- allocate(obs_seq_time(num_times))
- allocate(obs_list_time(nt_f_smos))
-
- ! associate a time with each obs in the input list
- do j = 1, nt_f_smos
- obs_list_time(j) = init_time + (j - 1) * obs_list_period
- enddo
-
- ! Initialize the output sequence
- call init_obs_sequence(seq, num_copies, &
- num_qc, network_size * num_times)
-
- ! Get the metadata (might want a call in obs_sequence to do this)
- do i = 1, num_copies
- call set_copy_meta_data(seq, i, get_copy_meta_data(seq_in, i))
- end do
- do i = 1, num_qc
- call set_qc_meta_data(seq, i, get_qc_meta_data(seq_in, i))
- end do
-
- ! while looping through the times, generate a list of obs times
- ! and qc values
- do j = 1, num_times
- write(*, *) j
- ob_time = start_seq_time + (j - 1) * obs_seq_period
- obs_seq_time(j) = ob_time
- call print_time(obs_seq_time(j))
-
- is_there_one = get_first_obs(seq_in, obs)
-
- do i = 1, network_size
- new_obs = obs
- ! Set the time
- call get_obs_def(new_obs, obs_def)
- call set_obs_def_time(obs_def, ob_time)
- call set_obs_def(new_obs, obs_def)
-
- ! Append it to the sequence
- call append_obs_to_seq(seq, new_obs)
-
- ! Find the next observation in the input set
- call get_next_obs(seq_in, obs, next_obs, is_this_last)
- if(.not. is_this_last) obs = next_obs
- end do
-
- enddo
-
-!-------------------------------------------------------------------------
-! write to a temporary file for ingestion into the next block
-file_name = 'real_obs_seq.in'
-
-call write_obs_seq(seq, file_name)
-
-! Clean up
-call timestamp(string1=source,string2=revision,string3=revdate,pos='end')
-
-!-------------------------------------------------------------------------
-! Now the part that replaces perfect_model_obs. There are some
-! assumptions in here about what type of obs we are ingesting:
-! 1. pressure and vapor pressure are used to get mixing ratio
-! 2. T and winds are in correct units (K and m/s)
-
-call init_wrf(wrf_rnd_seed)
-
-!do i = 1,num_times
-! print*,t2_init_f(i),u10_init_f(i),v10_init_f(i),q2_init_f(i)
-!enddo
-
-obs_seq_in_file_name = file_name
-
-call read_obs_seq_header(obs_seq_in_file_name, cnum_copies, cnum_qc, &
- cnum_obs, cnum_max, obs_seq_file_id, &
- obs_seq_read_format, pre_I_format, &
- close_the_file = .true.)
-
-! First two copies of output will be truth and observation;
-! Will overwrite first two existing copies in file if there are any
-! Note that truth=obs for this case of real obs
-additional_copies = 2 - cnum_copies
-if(additional_copies < 0) additional_copies = 0
-
-! currently no need for additional qc field
-additional_qc = 0
-
-! Just read in the definition part of the obs sequence; expand to include
-! observation and truth field
-call read_obs_seq(obs_seq_in_file_name, additional_copies, additional_qc, &
- 0, seq)
-
-! Initialize an obs type variable
-call init_obs(obs, cnum_copies + additional_copies, cnum_qc + additional_qc)
-
-! Need metadata for added qc field (here in case needed later)
-if(additional_qc == 1) then
- qc_meta_data = 'Quality Control'
- call set_qc_meta_data(seq, 1, qc_meta_data)
-endif
-
-time_step_number = 0
-num_qc = get_num_qc(seq)
-num_copies = get_num_copies(seq)
-num_obs = get_num_obs(seq)
-
-! init output obs sequence
-call init_obs_sequence(seq_out, num_copies, num_qc, num_obs)
-call init_obs(obs, num_copies, num_qc)
-call init_obs(next_obs, num_copies, num_qc)
-call init_obs(new_obs, num_copies, num_qc)
-
-! Need space to put in the obs_values in the sequence;
-copy_meta_data(1) = 'observations'
-copy_meta_data(2) = 'truth'
-call set_copy_meta_data(seq_out, 1, copy_meta_data(1))
-call set_copy_meta_data(seq_out, 2, copy_meta_data(2))
-do i = 1, num_qc
- call set_qc_meta_data(seq_out, i, get_qc_meta_data(seq, i))
-end do
-
-! simply look through obs one-by-one and pull from the proper vector
-allocate(obs_vals(num_copies), qc_vals(num_qc))
-allocate(qc_sequence(num_obs))
-
-is_there_one = get_first_obs(seq, obs)
-if ( is_there_one ) then
- do i = 1, num_obs
- new_obs = obs
-
- ! Set the time
- call get_obs_def(new_obs, obs_def)
- ob_time = get_obs_def_time(obs_def)
- obs_kind_ind = get_obs_kind(obs_def)
- assimilate_this_ob = assimilate_this_obs_kind(obs_kind_ind)
- evaluate_this_ob = evaluate_this_obs_kind(obs_kind_ind)
-
- this_obs_val = get_obs_from_input(ob_time,obs_kind_ind,num_times)
- this_qc_val = get_qc_from_obs(obs_kind_ind,this_obs_val)
- if ( num_qc > 0 ) then
- call get_qc(new_obs,qc_sequence(i:i),1)
- this_qc_val = max(this_qc_val,qc_sequence(i))
- endif
-
- ! for input, all copies are the same
- obs_vals = this_obs_val
- call set_obs_values(new_obs,obs_vals)
- qc_vals = this_qc_val
-
- if ( num_qc > 0 ) then
- call set_qc(new_obs,qc_vals)
- endif
-
- call set_obs_def(new_obs, obs_def)
-
- ! Append it to the sequence
- call append_obs_to_seq(seq_out, new_obs)
-
- ! Find the next observation in the input set
- call get_next_obs(seq, obs, next_obs, is_this_last)
- if(.not. is_this_last) obs = next_obs
-
- end do ! obs
-
-file_name = 'real_obs_seq.out'
-
-call write_obs_seq(seq_out, file_name)
-stop
-
-
-else
-
- print*, "could not find any obs in the input sequence"
-
-endif
-
-
-!--------------------------------------------------------------
-CONTAINS
-!--------------------------------------------------------------
-
-
-real(r8) function get_obs_from_input(ob_time,obs_kind_in,num_times)
-
-implicit none
-
-type(time_type), intent(in) :: ob_time
-integer, intent(in) :: obs_kind_in, num_times
-
-integer :: seconds, days, i
-integer :: this_time_ind
-real(r8) :: obs_val
-
-get_obs_from_input = missing_r8
-
-this_time_ind = missing_i
-do i = 1, nt_f_smos
- if ( obs_list_time(i) == ob_time ) this_time_ind = i
-enddo
-
-if ( this_time_ind == missing_i ) return
-
-select case ( trim(get_obs_name(obs_kind_in)) )
- case ('METAR_U_10_METER_WIND')
- obs_val = u10_init_f(this_time_ind)
- case ('METAR_V_10_METER_WIND')
- obs_val = v10_init_f(this_time_ind)
- case ('METAR_TEMPERATURE_2_METER')
- obs_val = t2_init_f(this_time_ind)
- case ('METAR_SPECIFIC_HUMIDITY_2_METER')
- obs_val = q2_init_f(this_time_ind)
- case default
- return
-end select
-
-get_obs_from_input = obs_val
-
-end function get_obs_from_input
-
-!--------------------------------------------------------------
-
-real(r8) function get_qc_from_obs(obs_kind_in,obs_val)
-! simple gross error check on qc
-
-implicit none
-
-integer, intent(in) :: obs_kind_in
-real(r8), intent(in) :: obs_val
-
-get_qc_from_obs = 0.0_r8
-if ( obs_val == missing_r8 ) then
- get_qc_from_obs = 9.0_r8
- return
-end if
-
-! no real qc yet
-select case ( trim(get_obs_name(obs_kind_in)) )
- case default
- return
-end select
-
-end function get_qc_from_obs
-
-end program create_real_network_seq
Copied: DART/branches/development/models/PBL_1d/create_real_network.f90 (from rev 5660, DART/trunk/models/PBL_1d/create_real_network.f90)
===================================================================
--- DART/branches/development/models/PBL_1d/create_real_network.f90 (rev 0)
+++ DART/branches/development/models/PBL_1d/create_real_network.f90 2012-04-06 21:04:52 UTC (rev 5661)
@@ -0,0 +1,375 @@
+! DART software - Copyright 2004 - 2011 UCAR. This open source software is
+! provided by UCAR, "as is", without charge, subject to all terms of use at
+! http://www.image.ucar.edu/DAReS/DART/DART_download
+
+program create_real_network_seq
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
+! JPH
+! This code originated from create_fixed_network. It uses module_wrf to get
+! obs from smos file, with file, date, and interval controlled via the wrf1d
+! namelist. Note that an obs_def is still required to control which
+! obs are actually written out. Normally, this would be created with
+! create_obs_sequence. This would be run in place of both create_fixed_network
+! and perfect_model_obs.
+
+use types_mod, only : r8, missing_r8, missing_i, metadatalength
+use utilities_mod, only : timestamp, register_module, open_file, &
+ close_file, find_namelist_in_file, &
+ error_handler, check_namelist_read, &
+ initialize_utilities, E_ERR
+use obs_kind_mod, only : assimilate_this_obs_kind, evaluate_this_obs_kind
+use obs_def_mod, only : obs_def_type, get_obs_def_time, set_obs_def_time,&
+ get_obs_kind, get_obs_name
+use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
+ get_num_obs, init_obs_sequence, get_first_obs, &
+ write_obs_seq, set_copy_meta_data, &
+ get_obs_def, set_obs_def, append_obs_to_seq, &
+ get_next_obs, insert_obs_in_seq, init_obs, &
+ assignment(=), static_init_obs_sequence, &
+ get_num_copies, get_num_qc, &
+ get_copy_meta_data, get_qc_meta_data, &
+ set_qc_meta_data, read_obs_seq_header, &
+ set_obs_values, set_qc, get_qc
+use time_manager_mod, only : time_type, operator(*), operator(+), set_time, &
+ set_date, increment_time, get_time, print_time, &
+ operator(==), operator(/), operator(<), operator(-)
+use model_mod, only : static_init_model, real_obs_period, start_real_obs
+use module_wrf, only : static_init_wrf, init_wrf, nt_f_smos, &
+ start_year_f, start_month_f,start_day_f, &
+ start_hour_f, start_minute_f, &
+ start_forecast, interval_smos, &
+ init_f_type, u10_init_f, v10_init_f, &
+ q2_init_f, t2_init_f, forecast_length
+
+
+implicit none
+
+! version controlled file description for error handling, do not edit
+character(len=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
+
+
+type(obs_sequence_type) :: seq, seq_in, seq_out
+type(obs_type) :: obs, next_obs, new_obs
+type(obs_def_type) :: obs_def
+character(len = 129) :: file_name, obs_seq_in_file_name
+logical :: is_there_one, is_this_last
+type(time_type) :: ob_time, init_time, this_time
+type(time_type) :: obs_seq_period, obs_list_period
+type(time_type),dimension(:), allocatable :: obs_list_time
+type(time_type),dimension(:), allocatable :: obs_seq_time
+type(time_type) :: start_seq_time, flen_time, end_time
+integer :: seconds, days, i, j, network_size, num_times, num_copies, num_qc
+integer :: obs_seq_file_id, iunit, io
+integer :: cnum_copies, cnum_qc, cnum_obs, cnum_max
+integer :: additional_qc, additional_copies
+integer :: last_key_used, time_step_number
+integer :: num_obs, obs_kind_ind
+real(r8) :: this_obs_val, this_qc_val
+real(r8), dimension(:), allocatable :: obs_vals, qc_vals, qc_sequence
+logical :: assimilate_this_ob, evaluate_this_ob, pre_I_format
+character(len=metadatalength) :: copy_meta_data(2), qc_meta_data, obs_seq_read_format
+integer :: wrf_rnd_seed = -1
+
+! Record the current time, date, etc. to the logfile
+call initialize_utilities('Create_real_network_seq')
+call register_module(source,revision,revdate)
+
+! The only necessary namelist variables come from the model
+
+! Call the underlying model's static initialization for calendar info
+call static_init_model()
+
+! Initialize the obs_sequence module
+call static_init_obs_sequence
+
+! fail if we are not initializing from OBS (this could be easily modified
+! to get values from WRF, and may come in handy later!
+if ( init_f_type == 'WRF' ) then
+ call error_handler(E_ERR, 'create_real_network', &
+ 'CANNOT PRODUCE OBS SEQUENCE FROM WRF OUTPUT YET', source, revision, revdate)
+endif
+
+! Write the sequence to a file
+write(*, *) 'Input filename for network definition sequence (usually set_def.out )'
+read(*, *) file_name
+call read_obs_seq(file_name, 0, 0, 0, seq_in)
+
+! Find out how many obs there are
+network_size = get_num_obs(seq_in)
+
+! Initialize the obs_type variables
+num_copies = get_num_copies(seq_in)
+num_qc = get_num_qc(seq_in)
+call init_obs(obs, num_copies, num_qc)
+call init_obs(next_obs, num_copies, num_qc)
+call init_obs(new_obs, num_copies, num_qc)
+
+! set init time and period, including increment for forecast start and
+! increment to the proper time of day. One might want to start the assimilation
+! later then when constrained to start the obs list.
+ init_time = set_date(start_year_f, start_month_f, start_day_f, &
+ start_hour_f, start_minute_f, 0)
+ init_time = increment_time(init_time,start_forecast,0)
+ flen_time = set_time(forecast_length,0)
+ end_time = init_time + flen_time
+
+ call get_time(init_time,seconds,days)
+
+ start_seq_time = increment_time(init_time,start_real_obs,0)
+ obs_seq_period = set_time(real_obs_period, 0)
+ obs_list_period = set_time(interval_smos, 0)
+
+ num_times = (end_time - start_seq_time) / set_time(real_obs_period,0) + 1
+
+ ! time information comes from the wrf1d_namelist.input
+ ! only supports regularly-repeating obs right now
+ allocate(obs_seq_time(num_times))
+ allocate(obs_list_time(nt_f_smos))
+
+ ! associate a time with each obs in the input list
+ do j = 1, nt_f_smos
+ obs_list_time(j) = init_time + (j - 1) * obs_list_period
+ enddo
+
+ ! Initialize the output sequence
+ call init_obs_sequence(seq, num_copies, &
+ num_qc, network_size * num_times)
+
+ ! Get the metadata (might want a call in obs_sequence to do this)
+ do i = 1, num_copies
+ call set_copy_meta_data(seq, i, get_copy_meta_data(seq_in, i))
+ end do
+ do i = 1, num_qc
+ call set_qc_meta_data(seq, i, get_qc_meta_data(seq_in, i))
+ end do
+
+ ! while looping through the times, generate a list of obs times
+ ! and qc values
+ do j = 1, num_times
+ write(*, *) j
+ ob_time = start_seq_time + (j - 1) * obs_seq_period
+ obs_seq_time(j) = ob_time
+ call print_time(obs_seq_time(j))
+
+ is_there_one = get_first_obs(seq_in, obs)
+
+ do i = 1, network_size
+ new_obs = obs
+ ! Set the time
+ call get_obs_def(new_obs, obs_def)
+ call set_obs_def_time(obs_def, ob_time)
+ call set_obs_def(new_obs, obs_def)
+
+ ! Append it to the sequence
+ call append_obs_to_seq(seq, new_obs)
+
+ ! Find the next observation in the input set
+ call get_next_obs(seq_in, obs, next_obs, is_this_last)
+ if(.not. is_this_last) obs = next_obs
+ end do
+
+ enddo
+
+!-------------------------------------------------------------------------
+! write to a temporary file for ingestion into the next block
+file_name = 'real_obs_seq.in'
+
+call write_obs_seq(seq, file_name)
+
+! Clean up
+call timestamp(string1=source,string2=revision,string3=revdate,pos='end')
+
+!-------------------------------------------------------------------------
+! Now the part that replaces perfect_model_obs. There are some
+! assumptions in here about what type of obs we are ingesting:
+! 1. pressure and vapor pressure are used to get mixing ratio
+! 2. T and winds are in correct units (K and m/s)
+
+call init_wrf(wrf_rnd_seed)
+
+!do i = 1,num_times
+! print*,t2_init_f(i),u10_init_f(i),v10_init_f(i),q2_init_f(i)
+!enddo
+
+obs_seq_in_file_name = file_name
+
+call read_obs_seq_header(obs_seq_in_file_name, cnum_copies, cnum_qc, &
+ cnum_obs, cnum_max, obs_seq_file_id, &
+ obs_seq_read_format, pre_I_format, &
+ close_the_file = .true.)
+
+! First two copies of output will be truth and observation;
+! Will overwrite first two existing copies in file if there are any
+! Note that truth=obs for this case of real obs
+additional_copies = 2 - cnum_copies
+if(additional_copies < 0) additional_copies = 0
+
+! currently no need for additional qc field
+additional_qc = 0
+
+! Just read in the definition part of the obs sequence; expand to include
+! observation and truth field
+call read_obs_seq(obs_seq_in_file_name, additional_copies, additional_qc, &
+ 0, seq)
+
+! Initialize an obs type variable
+call init_obs(obs, cnum_copies + additional_copies, cnum_qc + additional_qc)
+
+! Need metadata for added qc field (here in case needed later)
+if(additional_qc == 1) then
+ qc_meta_data = 'Quality Control'
+ call set_qc_meta_data(seq, 1, qc_meta_data)
+endif
+
+time_step_number = 0
+num_qc = get_num_qc(seq)
+num_copies = get_num_copies(seq)
+num_obs = get_num_obs(seq)
+
+! init output obs sequence
+call init_obs_sequence(seq_out, num_copies, num_qc, num_obs)
+call init_obs(obs, num_copies, num_qc)
+call init_obs(next_obs, num_copies, num_qc)
+call init_obs(new_obs, num_copies, num_qc)
+
+! Need space to put in the obs_values in the sequence;
+copy_meta_data(1) = 'observations'
+copy_meta_data(2) = 'truth'
+call set_copy_meta_data(seq_out, 1, copy_meta_data(1))
+call set_copy_meta_data(seq_out, 2, copy_meta_data(2))
+do i = 1, num_qc
+ call set_qc_meta_data(seq_out, i, get_qc_meta_data(seq, i))
+end do
+
+! simply look through obs one-by-one and pull from the proper vector
+allocate(obs_vals(num_copies), qc_vals(num_qc))
+allocate(qc_sequence(num_obs))
+
+is_there_one = get_first_obs(seq, obs)
+if ( is_there_one ) then
+ do i = 1, num_obs
+ new_obs = obs
+
+ ! Set the time
+ call get_obs_def(new_obs, obs_def)
+ ob_time = get_obs_def_time(obs_def)
+ obs_kind_ind = get_obs_kind(obs_def)
+ assimilate_this_ob = assimilate_this_obs_kind(obs_kind_ind)
+ evaluate_this_ob = evaluate_this_obs_kind(obs_kind_ind)
+
+ this_obs_val = get_obs_from_input(ob_time,obs_kind_ind,num_times)
+ this_qc_val = get_qc_from_obs(obs_kind_ind,this_obs_val)
+ if ( num_qc > 0 ) then
+ call get_qc(new_obs,qc_sequence(i:i),1)
+ this_qc_val = max(this_qc_val,qc_sequence(i))
+ endif
+
+ ! for input, all copies are the same
+ obs_vals = this_obs_val
+ call set_obs_values(new_obs,obs_vals)
+ qc_vals = this_qc_val
+
+ if ( num_qc > 0 ) then
+ call set_qc(new_obs,qc_vals)
+ endif
+
+ call set_obs_def(new_obs, obs_def)
+
+ ! Append it to the sequence
+ call append_obs_to_seq(seq_out, new_obs)
+
+ ! Find the next observation in the input set
+ call get_next_obs(seq, obs, next_obs, is_this_last)
+ if(.not. is_this_last) obs = next_obs
+
+ end do ! obs
+
+file_name = 'real_obs_seq.out'
+
+call write_obs_seq(seq_out, file_name)
+stop
+
+
+else
+
+ print*, "could not find any obs in the input sequence"
+
+endif
+
+
+!--------------------------------------------------------------
+CONTAINS
+!--------------------------------------------------------------
+
+
+real(r8) function get_obs_from_input(ob_time,obs_kind_in,num_times)
+
+implicit none
+
+type(time_type), intent(in) :: ob_time
+integer, intent(in) :: obs_kind_in, num_times
+
+integer :: seconds, days, i
+integer :: this_time_ind
+real(r8) :: obs_val
+
+get_obs_from_input = missing_r8
+
+this_time_ind = missing_i
+do i = 1, nt_f_smos
+ if ( obs_list_time(i) == ob_time ) this_time_ind = i
+enddo
+
+if ( this_time_ind == missing_i ) return
+
+select case ( trim(get_obs_name(obs_kind_in)) )
+ case ('METAR_U_10_METER_WIND')
+ obs_val = u10_init_f(this_time_ind)
+ case ('METAR_V_10_METER_WIND')
+ obs_val = v10_init_f(this_time_ind)
+ case ('METAR_TEMPERATURE_2_METER')
+ obs_val = t2_init_f(this_time_ind)
+ case ('METAR_SPECIFIC_HUMIDITY_2_METER')
+ obs_val = q2_init_f(this_time_ind)
+ case default
+ return
+end select
+
+get_obs_from_input = obs_val
+
+end function get_obs_from_input
+
+!--------------------------------------------------------------
+
+real(r8) function get_qc_from_obs(obs_kind_in,obs_val)
+! simple gross error check on qc
+
+implicit none
+
+integer, intent(in) :: obs_kind_in
+real(r8), intent(in) :: obs_val
+
+get_qc_from_obs = 0.0_r8
+if ( obs_val == missing_r8 ) then
+ get_qc_from_obs = 9.0_r8
+ return
+end if
+
+! no real qc yet
+select case ( trim(get_obs_name(obs_kind_in)) )
+ case default
+ return
+end select
+
+end function get_qc_from_obs
+
+end program create_real_network_seq
Copied: DART/branches/development/models/PBL_1d/create_real_network.nml (from rev 5660, DART/trunk/models/PBL_1d/create_real_network.nml)
===================================================================
--- DART/branches/development/models/PBL_1d/create_real_network.nml (rev 0)
+++ DART/branches/development/models/PBL_1d/create_real_network.nml 2012-04-06 21:04:52 UTC (rev 5661)
@@ -0,0 +1,4 @@
+&create_real_network
+ seconds_start = 43200
+ obs_period = 3600 /
+
Modified: DART/branches/development/models/PBL_1d/work/path_names_create_real_network_seq
===================================================================
--- DART/branches/development/models/PBL_1d/work/path_names_create_real_network_seq 2012-04-06 20:06:46 UTC (rev 5660)
+++ DART/branches/development/models/PBL_1d/work/path_names_create_real_network_seq 2012-04-06 21:04:52 UTC (rev 5661)
@@ -3,7 +3,7 @@
obs_def/obs_def_mod.f90
assim_model/assim_model_mod.f90
models/PBL_1d/model_mod.f90
-models/PBL_1d/create_real_network/create_real_network.f90
+models/PBL_1d/create_real_network.f90
common/types_mod.f90
location/threed_sphere/location_mod.f90
random_seq/random_seq_mod.f90
Property changes on: DART/branches/development/models/cam
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/branches/cam-update:4903-4923
/DART/trunk/models/cam:4680-5372
+ /DART/branches/cam-update:4903-4923
/DART/trunk/models/cam:4680-5660
Modified: DART/branches/development/models/pe2lyr/model_mod.f90
===================================================================
--- DART/branches/development/models/pe2lyr/model_mod.f90 2012-04-06 20:06:46 UTC (rev 5660)
+++ DART/branches/development/models/pe2lyr/model_mod.f90 2012-04-06 21:04:52 UTC (rev 5661)
@@ -433,7 +433,7 @@
! order is u,v,z
if(mytype == KIND_U_WIND_COMPONENT) then
- indx = (level-1)*nlats*nlons+(lat_index-1)*nlons + lat_index
+ indx = (level-1)*nlats*nlons+(lat_index-1)*nlons + lon_index
else if(mytype == KIND_V_WIND_COMPONENT) then
indx = 2*nlats*nlons+(level-1)*nlats*nlons+(lat_index-1)*nlons + lon_index
else if(mytype == KIND_GEOPOTENTIAL_HEIGHT) then
Modified: DART/branches/development/models/wrf/WRF_BC/module_netcdf_interface.f90
===================================================================
--- DART/branches/development/models/wrf/WRF_BC/module_netcdf_interface.f90 2012-04-06 20:06:46 UTC (rev 5660)
+++ DART/branches/development/models/wrf/WRF_BC/module_netcdf_interface.f90 2012-04-06 21:04:52 UTC (rev 5661)
@@ -35,6 +35,7 @@
revision = "$Revision$", &
revdate = "$Date$"
+character(len=128) :: errstring
CONTAINS
@@ -477,6 +478,13 @@
! get the times
n_times = idims(2)
+ if (n_times > max_times) then
+ write(errstring, '(2(A,I6))') 'number of times in file ', n_times, &
+ ' is larger than allocated space ', max_times
+ call error_handler(E_ERR, 'get_times_cdf', errstring, source, revision, revdate, &
+ text2='increase max_times in [pert,update]_wrf_bc.f90 and recompile')
+ endif
+
do i=1,idims(2)
istart(1) = 1
iend(1) = idims(1)
Property changes on: DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/releases/Kodiak/obs_kind/DEFAULT_obs_kind_mod.F90:5020-5642
/DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90:4680-5293
+ /DART/releases/Kodiak/obs_kind/DEFAULT_obs_kind_mod.F90:5020-5642
/DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90:4680-5660
Property changes on: DART/branches/development/utilities
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/branches/close:4780-4810
/DART/trunk/utilities:4680-5372
+ /DART/branches/close:4780-4810
/DART/trunk/utilities:4680-5660
From nancy at ucar.edu Fri Apr 6 16:35:02 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Fri, 06 Apr 2012 16:35:02 -0600
Subject: [Dart-dev] [5662] DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90:
have to add kind not just to parameter table, but also
Message-ID:
Revision: 5662
Author: nancy
Date: 2012-04-06 16:35:02 -0600 (Fri, 06 Apr 2012)
Log Message:
-----------
have to add kind not just to parameter table, but also
to init routine that populates the table.
Modified Paths:
--------------
DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90
-------------- next part --------------
Modified: DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90
===================================================================
--- DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90 2012-04-06 21:04:52 UTC (rev 5661)
+++ DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90 2012-04-06 22:35:02 UTC (rev 5662)
@@ -375,6 +375,7 @@
obs_kind_names(45) = obs_kind_type(KIND_3D_PARAMETER, 'KIND_3D_PARAMETER')
obs_kind_names(46) = obs_kind_type(KIND_ATOMIC_OXYGEN_MIXING_RATIO, 'KIND_ATOMIC_OXYGEN_MIXING_RATIO')
obs_kind_names(47) = obs_kind_type(KIND_MOLEC_OXYGEN_MIXING_RATIO, 'KIND_MOLEC_OXYGEN_MIXING_RATIO')
+obs_kind_names(48) = obs_kind_type(KIND_ALTIMETER_TENDENCY, 'KIND_ALTIMETER_TENDENCY')
obs_kind_names(50) = obs_kind_type(KIND_SALINITY, 'KIND_SALINITY')
obs_kind_names(51) = obs_kind_type(KIND_U_CURRENT_COMPONENT, 'KIND_U_CURRENT_COMPONENT')
From nancy at ucar.edu Fri Apr 6 16:39:35 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Fri, 06 Apr 2012 16:39:35 -0600
Subject: [Dart-dev] [5664]
DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90: add line to
init routine to match new kind in the parameter list.
Message-ID:
Revision: 5664
Author: nancy
Date: 2012-04-06 16:39:34 -0600 (Fri, 06 Apr 2012)
Log Message:
-----------
add line to init routine to match new kind in the parameter list.
Modified Paths:
--------------
DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
Property Changed:
----------------
DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
-------------- next part --------------
Modified: DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
===================================================================
--- DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90 2012-04-06 22:38:18 UTC (rev 5663)
+++ DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90 2012-04-06 22:39:34 UTC (rev 5664)
@@ -400,6 +400,7 @@
obs_kind_names(45) = obs_kind_type(KIND_3D_PARAMETER, 'KIND_3D_PARAMETER')
obs_kind_names(46) = obs_kind_type(KIND_ATOMIC_OXYGEN_MIXING_RATIO, 'KIND_ATOMIC_OXYGEN_MIXING_RATIO')
obs_kind_names(47) = obs_kind_type(KIND_MOLEC_OXYGEN_MIXING_RATIO, 'KIND_MOLEC_OXYGEN_MIXING_RATIO')
+obs_kind_names(48) = obs_kind_type(KIND_ALTIMETER_TENDENCY, 'KIND_ALTIMETER_TENDENCY')
obs_kind_names(50) = obs_kind_type(KIND_SALINITY, 'KIND_SALINITY')
obs_kind_names(51) = obs_kind_type(KIND_U_CURRENT_COMPONENT, 'KIND_U_CURRENT_COMPONENT')
Property changes on: DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/releases/Kodiak/obs_kind/DEFAULT_obs_kind_mod.F90:5020-5642
/DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90:4680-5660
+ /DART/releases/Kodiak/obs_kind/DEFAULT_obs_kind_mod.F90:5020-5663
/DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90:4680-5662
From nancy at ucar.edu Mon Apr 9 09:17:03 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 09 Apr 2012 09:17:03 -0600
Subject: [Dart-dev] [5669] DART/branches: The mpas_atm model has matured
enough to move onto the development branch.
Message-ID:
Revision: 5669
Author: thoar
Date: 2012-04-09 09:17:03 -0600 (Mon, 09 Apr 2012)
Log Message:
-----------
The mpas_atm model has matured enough to move onto the development branch.
Preparing to delete the mpas branch (I still have Matlab script changes that
need to be preserved.)
Added Paths:
-----------
DART/branches/development/models/mpas_atm/
Removed Paths:
-------------
DART/branches/mpas/models/mpas_atm/
-------------- next part --------------
Property changes on: DART/branches/development/models/mpas_atm
___________________________________________________________________
Added: svn:mergeinfo
+ /DART/trunk/models/mpas_atm:5020-5658
From nancy at ucar.edu Mon Apr 9 10:08:21 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 09 Apr 2012 10:08:21 -0600
Subject: [Dart-dev] [5670]
DART/branches/development/mpi_utilities/null_mpi_utilities_mod.f90: no code
change; correct a couple comments in the null version
Message-ID:
Revision: 5670
Author: nancy
Date: 2012-04-09 10:08:21 -0600 (Mon, 09 Apr 2012)
Log Message:
-----------
no code change; correct a couple comments in the null version
to be more helpful. the null version of this code does no
communication because you only have 1 task.
Modified Paths:
--------------
DART/branches/development/mpi_utilities/null_mpi_utilities_mod.f90
-------------- next part --------------
Modified: DART/branches/development/mpi_utilities/null_mpi_utilities_mod.f90
===================================================================
--- DART/branches/development/mpi_utilities/null_mpi_utilities_mod.f90 2012-04-09 15:17:03 UTC (rev 5669)
+++ DART/branches/development/mpi_utilities/null_mpi_utilities_mod.f90 2012-04-09 16:08:21 UTC (rev 5670)
@@ -516,9 +516,8 @@
call error_handler(E_ERR,'broadcast_send', errstring, source, revision, revdate)
endif
-! this must be paired with broadcast_recv() on all other tasks.
-! it will not return until all tasks in the communications group have
-! made the call.
+! this does nothing, because the array already has the data.
+! the subroutine does validate 'from' to be sure it's a valid task id.
call array_broadcast(array1, from)
end subroutine broadcast_send
@@ -546,9 +545,8 @@
call error_handler(E_ERR,'broadcast_recv', errstring, source, revision, revdate)
endif
-! this must be paired with a single broadcast_send() on the 'from' task.
-! it will not return until all tasks in the communications group have
-! made the call.
+! this does nothing, because the array already has the data.
+! the subroutine does validate 'from' to be sure it's a valid task id.
call array_broadcast(array1, from)
end subroutine broadcast_recv
From nancy at ucar.edu Mon Apr 9 10:43:32 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 09 Apr 2012 10:43:32 -0600
Subject: [Dart-dev] [5671] DART/branches/development/location: alternate
location type donated by alex reinecke from the NRL.
Message-ID:
Revision: 5671
Author: nancy
Date: 2012-04-09 10:43:31 -0600 (Mon, 09 Apr 2012)
Log Message:
-----------
alternate location type donated by alex reinecke from the NRL.
has not been extensively tested.
Added Paths:
-----------
DART/branches/development/location/channel/
DART/branches/development/location/channel/location_mod.f90
DART/branches/development/location/channel/location_mod.html
DART/branches/development/location/channel/location_mod.nml
DART/branches/development/location/channel/test/
DART/branches/development/location/channel/test/input.nml
DART/branches/development/location/channel/test/location_test_file
DART/branches/development/location/channel/test/mkmf_location_test
DART/branches/development/location/channel/test/mkmf_location_test3
DART/branches/development/location/channel/test/path_names_location_test
DART/branches/development/location/channel/test/path_names_location_test3
DART/branches/development/location/channel/test/test.in
-------------- next part --------------
Added: DART/branches/development/location/channel/location_mod.f90
===================================================================
--- DART/branches/development/location/channel/location_mod.f90 (rev 0)
+++ DART/branches/development/location/channel/location_mod.f90 2012-04-09 16:43:31 UTC (rev 5671)
@@ -0,0 +1,2218 @@
+! DART software - Copyright 2004 - 2011 UCAR. This open source software is
+! provided by UCAR, "as is", without charge, subject to all terms of use at
+! http://www.image.ucar.edu/DAReS/DART/DART_download
+
+module location_mod
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
+! Implements location interfaces for a 3d channel in X,Y,Z where X is periodic,
+! Y has walls (limited domain), and Z is infinite
+
+use types_mod, only : r8, MISSING_R8, MISSING_I, PI, RAD2DEG, DEG2RAD
+use utilities_mod, only : register_module, error_handler, E_ERR, ascii_file_format, &
+ nc_check, E_MSG, open_file, close_file, set_output, &
+ logfileunit, nmlfileunit, find_namelist_in_file, &
+ check_namelist_read, do_output, do_nml_file, &
+ do_nml_term, is_longitude_between
+use random_seq_mod, only : random_seq_type, init_random_seq, random_uniform
+use obs_kind_mod, only : get_num_obs_kinds, get_obs_kind_name
+use mpi_utilities_mod, only : my_task_id, task_count
+
+implicit none
+private
+
+public :: location_type, get_location, set_location, &
+ set_location_missing, is_location_in_region, &
+ write_location, read_location, interactive_location, query_location, &
+ LocationDims, LocationName, LocationLName, get_close_obs, &
+ get_close_maxdist_init, get_close_obs_init, get_close_type, &
+ operator(==), operator(/=), get_dist, get_close_obs_destroy, &
+ nc_write_location_atts, nc_get_location_varids, nc_write_location, &
+ vert_is_height, vert_is_pressure, vert_is_undef, vert_is_level, &
+ vert_is_surface, vert_is_scale_height, has_vertical_localization, &
+ print_get_close_type, find_nearest
+
+! version controlled file description for error handling, do not edit
+character(len=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
+
+type location_type
+ private
+ real(r8) :: x, y, z
+end type location_type
+
+! This version supports both regularly spaced boxes, and octree division
+! of the space. for octrees, divide each dim in half until N numbers of filled
+! boxes, or octree reaches some depth? give some threshold where you don't
+! divide a box with less than N points in it?
+
+! contrast with kD-trees (divide along dimensions, not points), and there are
+! two types of octrees - PR (point region) where the regions split at an
+! explicit point, vs MX tree where the split is defined to be at the center
+! of the region.
+
+! if the underlying geometry is spherical, there will be many many empty boxes
+! if we uniformly divide up space, and worse, existing locations will be
+! clustered in a few boxes.
+
+
+! fortran doesn't let you make arrays of pointers, but you can make a
+! derived type containing a pointer, and then make arrays of that derived type.
+! i'm sure if i think about this hard enough i'll figure out why this is so,
+! but for now i'll just believe the great google which tells me it's this way.
+type octree_ptr
+ private
+ type(octree_type), pointer :: p
+end type octree_ptr
+
+type octree_type
+ private
+ integer :: count ! count in this cube, -1 for non-terminal cube
+ integer, pointer :: index(:) ! list of indices in this cube, count long
+ type(octree_ptr), allocatable :: children(:,:,:) ! subcubes
+ type(octree_type), pointer :: parent ! who made you
+ type(location_type) :: llb ! xyz of lower left bottom
+ type(location_type) :: split ! xyz of split point
+ type(location_type) :: urt ! xyz of upper right top
+end type octree_type
+
+type box_type
+ private
+ integer, pointer :: obs_box(:) ! (nobs); List of obs indices in boxes
+ integer, pointer :: count(:, :, :) ! (nx, ny, nz); # of obs in each box
+ integer, pointer :: start(:, :, :) ! (nx, ny, nz); Start of list of obs in this box
+ real(r8) :: bot_x, top_x ! extents in x, y, z
+ real(r8) :: bot_y, top_y
+ real(r8) :: bot_z, top_z
+ real(r8) :: x_width, y_width, z_width ! widths of boxes in x,y,z
+ real(r8) :: nboxes_x, nboxes_y, nboxes_z ! based on maxdist how far to search
+end type box_type
+
+! Type to facilitate efficient computation of observations close to a given location
+type get_close_type
+ private
+ integer :: num
+ real(r8) :: maxdist
+ type(box_type) :: box
+ type(octree_type) :: root
+end type get_close_type
+
+type(random_seq_type) :: ran_seq
+logical :: ran_seq_init = .false.
+logical, save :: module_initialized = .false.
+
+integer, parameter :: LocationDims = 3
+character(len = 129), parameter :: LocationName = "loc3Dchan"
+character(len = 129), parameter :: LocationLName = &
+ "threed channel locations: x, y, z"
+
+character(len = 512) :: errstring
+
+real(r8) :: radius ! used only for converting points on a sphere into x,y,z and back
+
+! If maxdist stays the same, don't need to do box distance calculations
+integer :: last_maxdist = -1.0
+
+!-----------------------------------------------------------------
+! Namelist with default values
+
+! FIXME: give these better defaults? or put in namelist
+! right now they are recomputed based on the setting of nboxes;
+! each is about the cube root of nboxes, but if the bounds are
+! very different distances in each dim, we may want better control
+! over the ratios of each.
+integer :: nx = 10
+integer :: ny = 10
+integer :: nz = 10
+
+logical :: output_box_info = .false.
+integer :: print_box_level = 0
+! tuning options
+integer :: nboxes = 1000 ! suggestion for max number of nodes
+integer :: maxdepth = 4 ! suggestion for max tree depth
+integer :: filled = 10 ! threshold at which you quit splitting
+logical :: use_octree = .false. ! if false, use regular boxes, true = octree
+
+! Option for verification using exhaustive search
+logical :: compare_to_correct = .true. ! normally false
+
+namelist /location_nml/ &
+ filled, nboxes, maxdepth, use_octree, &
+ compare_to_correct, output_box_info, print_box_level
+
+!-----------------------------------------------------------------
+
+interface operator(==); module procedure loc_eq; end interface
+interface operator(/=); module procedure loc_ne; end interface
+
+interface set_location
+ module procedure set_location_single
+ module procedure set_location_array
+end interface set_location
+
+contains
+
+!----------------------------------------------------------------------------
+
+subroutine initialize_module
+
+! things which need doing exactly once.
+
+integer :: iunit, io, i
+character(len=129) :: str1
+
+if (module_initialized) return
+
+call register_module(source, revision, revdate)
+module_initialized = .true.
+
+! Read the namelist entry
+call find_namelist_in_file("input.nml", "location_nml", iunit)
+read(iunit, nml = location_nml, iostat = io)
+call check_namelist_read(iunit, io, "location_nml")
+
+! Write the namelist values to the log file
+
+if(do_nml_file()) write(nmlfileunit, nml=location_nml)
+if(do_nml_term()) write( * , nml=location_nml)
+
+if (filled < 1) then
+ write(errstring,*)'filled sets limit for number of points per box. must be >= 1'
+ call error_handler(E_ERR, 'set_location', errstring, source, revision, revdate)
+endif
+
+end subroutine initialize_module
+
+!----------------------------------------------------------------------------
+
+function get_dist(loc1, loc2, kind1, kind2)
+
+! returns the distance between 2 locations
+
+! In spite of the names, the 3rd and 4th argument are actually specific types
+! (e.g. RADIOSONDE_TEMPERATURE, AIRCRAFT_TEMPERATURE). The types are part of
+! the interface in case user-code wants to do a more sophisticated distance
+! calculation based on the base or target types. In the usual case this
+! code still doesn't use the types, but there's an undocumented feature that
+! allows you to maintain the original vertical normalization even when
+! changing the cutoff distance in the horizontal. For that to work we
+! do need to know the type, and we use the type of loc1 to control it.
+!
+
+type(location_type), intent(in) :: loc1, loc2
+integer, optional, intent(in) :: kind1, kind2
+real(r8) :: get_dist
+
+real(r8) :: x_dif, y_dif, z_dif
+
+if ( .not. module_initialized ) call initialize_module
+
+x_dif = loc1%x - loc2%x
+y_dif = loc1%y - loc2%y
+z_dif = loc1%z - loc2%z
+
+get_dist = sqrt(x_dif * x_dif + y_dif * y_dif + z_dif * z_dif)
+
+end function get_dist
+
+!---------------------------------------------------------------------------
+
+function loc_eq(loc1,loc2)
+
+! Interface operator used to compare two locations.
+! Returns true only if all components are 'the same' to within machine
+! precision.
+
+type(location_type), intent(in) :: loc1, loc2
+logical :: loc_eq
+
+if ( .not. module_initialized ) call initialize_module
+
+loc_eq = .false.
+
+if ( abs(loc1%x - loc2%x ) > epsilon(loc1%x ) ) return
+if ( abs(loc1%y - loc2%y ) > epsilon(loc1%y ) ) return
+if ( abs(loc1%z - loc2%z ) > epsilon(loc1%z ) ) return
+
+loc_eq = .true.
+
+end function loc_eq
+
+!---------------------------------------------------------------------------
+
+function loc_ne(loc1,loc2)
+
+! Interface operator used to compare two locations.
+! Returns true if locations are not identical to machine precision.
+
+type(location_type), intent(in) :: loc1, loc2
+logical :: loc_ne
+
+if ( .not. module_initialized ) call initialize_module
+
+loc_ne = (.not. loc_eq(loc1,loc2))
+
+end function loc_ne
+
+!---------------------------------------------------------------------------
+
+function get_location(loc)
+
+! Given a location type return the x,y,z coordinates
+
+type(location_type), intent(in) :: loc
+real(r8), dimension(3) :: get_location
+
+if ( .not. module_initialized ) call initialize_module
+
+get_location(1) = loc%x
+get_location(2) = loc%y
+get_location(3) = loc%z
+
+end function get_location
+
+!---------------------------------------------------------------------------
+
+function set_location_single(x, y, z)
+
+! Puts the x, y, z into a location datatype.
+
+real(r8), intent(in) :: x, y, z
+type (location_type) :: set_location_single
+
+if ( .not. module_initialized ) call initialize_module
+
+set_location_single%x = x
+set_location_single%y = y
+set_location_single%z = z
+
+end function set_location_single
+
+!----------------------------------------------------------------------------
+
+function set_location_array(list)
+
+! location semi-independent interface routine
+! given 3 float numbers, call the underlying set_location routine
+
+real(r8), intent(in) :: list(:)
+type (location_type) :: set_location_array
+
+if ( .not. module_initialized ) call initialize_module
+
+if (size(list) < 3) then
+ write(errstring,*)'requires 3 input values'
+ call error_handler(E_ERR, 'set_location', errstring, source, revision, revdate)
+endif
+
+set_location_array = set_location_single(list(1), list(2), list(3))
+
+end function set_location_array
+
+!----------------------------------------------------------------------------
+
+function set_location_missing()
+
+! Initialize a location type to indicate the contents are unset.
+
+type (location_type) :: set_location_missing
+
+if ( .not. module_initialized ) call initialize_module
+
+set_location_missing%x = MISSING_R8
+set_location_missing%y = MISSING_R8
+set_location_missing%z = MISSING_R8
+
+end function set_location_missing
+
+!---------------------------------------------------------------------------
+
+function query_location(loc, attr)
+
+! Returns the value of the attribute
+
+type(location_type), intent(in) :: loc
+character(len=*), optional, intent(in) :: attr
+real(r8) :: query_location
+
+if ( .not. module_initialized ) call initialize_module
+
+! before you change any of the code in this subroutine,
+! check out the extensive comments in the threed_sphere
+! version of this routine. then proceed with caution.
+
+if (.not. present(attr)) then
+ query_location = loc%x
+ return
+endif
+
+select case(attr)
+ case ('x','X')
+ query_location = loc%x
+ case ('y','Y')
+ query_location = loc%y
+ case ('z','Z')
+ query_location = loc%z
+ case default
+ call error_handler(E_ERR, 'query_location:', &
+ 'Only "X","Y","Z" are legal attributes to request from location', &
+ source, revision, revdate)
+end select
+
+end function query_location
+
+!----------------------------------------------------------------------------
+
+subroutine write_location(locfile, loc, fform, charstring)
+
+! Writes a location to a file.
+! most recent change: adding the optional charstring option. if present,
+! locfile is ignored, and a pretty-print formatting is done into charstring.
+
+integer, intent(in) :: locfile
+type(location_type), intent(in) :: loc
+character(len = *), intent(in), optional :: fform
+character(len = *), intent(out), optional :: charstring
+
+integer :: charlength
+logical :: writebuf
+character(len=129) :: string1
+
+10 format(1X,3(G25.16,1X))
+
+if ( .not. module_initialized ) call initialize_module
+
+! writing to a file (normal use) or to a character buffer?
+writebuf = present(charstring)
+
+! output file; test for ascii or binary, write what's asked, and return
+if (.not. writebuf) then
+ if (ascii_file_format(fform)) then
+ write(locfile, '(''loc3Dchan'')' )
+ write(locfile, 10) loc%x, loc%y, loc%z
+ else
+ write(locfile) loc%x, loc%y, loc%z
+ endif
+ return
+endif
+
+! you only get here if you're writing to a buffer and not
+! to a file, and you can't have binary format set.
+if (.not. ascii_file_format(fform)) then
+ call error_handler(E_ERR, 'write_location', &
+ 'Cannot use string buffer with binary format', &
+ source, revision, revdate)
+endif
+
+! format the location to be human-friendly
+
+! the output can be no longer than this
+charlength = 70
+
+if (len(charstring) < charlength) then
+ write(errstring, *) 'charstring buffer must be at least ', charlength, ' chars long'
+ call error_handler(E_ERR, 'write_location', errstring, source, revision, revdate)
+endif
+
+! format into the outout string
+write(charstring, '(A,3(G20.8,1X))') 'X/Y/Z: ', loc%x, loc%y, loc%z
+
+end subroutine write_location
+
+!----------------------------------------------------------------------------
+
+function read_location(locfile, fform)
+
+! Reads a location from a file that was written by write_location.
+! See write_location for additional discussion.
+
+integer, intent(in) :: locfile
+character(len = *), intent(in), optional :: fform
+type(location_type) :: read_location
+
+character(len=8) :: header
+
+if ( .not. module_initialized ) call initialize_module
+
+if (ascii_file_format(fform)) then
+ read(locfile, '(A8)' ) header
+ if(header /= 'loc3Dchan') then
+ write(errstring,*)'Expected location header "loc3Dchan" in input file, got ', header
+ call error_handler(E_ERR, 'read_location', errstring, source, revision, revdate)
+ endif
+ ! Now read the location data value
+ read(locfile, *)read_location%x, read_location%y, read_location%z
+else
+ read(locfile)read_location%x, read_location%y, read_location%z
+endif
+
+end function read_location
+
+!--------------------------------------------------------------------------
+
+subroutine interactive_location(location, set_to_default)
+
+! Allows for interactive input of a location. Also gives option of selecting
+! a uniformly distributed random location.
+
+type(location_type), intent(out) :: location
+logical, intent(in), optional :: set_to_default
+
+real(r8) :: v(3), minv, maxv
+character(len=1) :: l(3)
+integer :: i, r
+
+if ( .not. module_initialized ) call initialize_module
+
+! If set_to_default is true, then just zero out and return
+if(present(set_to_default)) then
+ if(set_to_default) then
+ location%x = 0.0
+ location%y = 0.0
+ location%z = 0.0
+ return
+ endif
+endif
+
+l(1) = 'X'
+l(2) = 'Y'
+l(3) = 'Z'
+
+! prompt for an explicit location or a random one.
+! if random, generate all 3 x/y/z values randomly.
+! if you want to make some combination of x/y/z random
+! and specify others, you would have to move this read
+! into the loop.
+
+r = 1
+do while (r > 0)
+
+ write(*, *) 'Input 0 to specify a value for the location, or'
+ write(*, *) '-1 for a uniformly distributed random location'
+ read(*, *) r
+
+ if (r > 0) write(*, *) 'Please input 0 or -1 for selection'
+enddo
+
+do i = 1, 3
+ if (r == 0) then
+ write(*, *) 'Input value for ', l(i)
+ read (*,*) v(i)
+
+ else
+ ! Need to make sure random sequence is initialized
+
+ if(.not. ran_seq_init) then
+ call init_random_seq(ran_seq)
+ ran_seq_init = .TRUE.
+ endif
+
+ write(*, *) 'Input minimum ', l(i), ' value '
+ read(*, *) minv
+
+ write(*, *) 'Input maximum ', l(i), ' value '
+ read(*, *) maxv
+
+ v(i) = random_uniform(ran_seq) * (maxv-minv) + minv
+
+ write(*, *) 'random location is ', v(i)
+
+ endif
+
+enddo
+
+location%x = v(1)
+location%y = v(2)
+location%z = v(3)
+
+end subroutine interactive_location
+
+!----------------------------------------------------------------------------
+
+function nc_write_location_atts( ncFileID, fname, ObsNumDimID ) result (ierr)
+
+! Writes the "location module" -specific attributes to a netCDF file.
+
+use typeSizes
+use netcdf
+
+integer, intent(in) :: ncFileID ! handle to the netcdf file
+character(len=*), intent(in) :: fname ! file name (for printing purposes)
+integer, intent(in) :: ObsNumDimID ! handle to the dimension that grows
+integer :: ierr
+
+integer :: LocDimID
+integer :: VarID
+
+if ( .not. module_initialized ) call initialize_module
+
+ierr = -1 ! assume things will fail ...
+
+! define the rank/dimension of the location information
+call nc_check(nf90_def_dim(ncid=ncFileID, name='location', len=LocationDims, &
+ dimid = LocDimID), 'nc_write_location_atts', 'def_dim:location '//trim(fname))
+
+! Define the observation location variable and attributes
+
+call nc_check(nf90_def_var(ncid=ncFileID, name='location', xtype=nf90_double, &
+ dimids=(/ LocDimID, ObsNumDimID /), varid=VarID), &
+ 'nc_write_location_atts', 'location:def_var')
+
+call nc_check(nf90_put_att(ncFileID, VarID, 'description', &
+ 'location coordinates'), 'nc_write_location_atts', 'location:description')
+call nc_check(nf90_put_att(ncFileID, VarID, 'location_type', &
+ trim(LocationName)), 'nc_write_location_atts', 'location:location_type')
+call nc_check(nf90_put_att(ncFileID, VarID, 'long_name', &
+ trim(LocationLName)), 'nc_write_location_atts', 'location:long_name')
+call nc_check(nf90_put_att(ncFileID, VarID, 'storage_order', &
+ 'X Y Z'), 'nc_write_location_atts', 'location:storage_order')
+call nc_check(nf90_put_att(ncFileID, VarID, 'units', &
+ 'X Y Z'), 'nc_write_location_atts', 'location:units')
+
+ierr = 0
+
+end function nc_write_location_atts
+
+!----------------------------------------------------------------------------
+
+subroutine nc_get_location_varids( ncFileID, fname, LocationVarID, WhichVertVarID )
+
+! Return the LocationVarID and WhichVertVarID variables from a given netCDF file.
+!
+! ncFileId the netcdf file descriptor
+! fname the name of the netcdf file (for error messages only)
+! LocationVarID the integer ID of the 'location' variable in the netCDF file
+! WhichVertVarID the integer ID of the 'which_vert' variable in the netCDF file
+
+use typeSizes
+use netcdf
+
+integer, intent(in) :: ncFileID ! handle to the netcdf file
+character(len=*), intent(in) :: fname ! file name (for printing purposes)
+integer, intent(out) :: LocationVarID, WhichVertVarID
+
+if ( .not. module_initialized ) call initialize_module
+
+call nc_check(nf90_inq_varid(ncFileID, 'location', varid=LocationVarID), &
+ 'nc_get_location_varids', 'inq_varid:location '//trim(fname))
+
+WhichVertVarID = -1
+
+end subroutine nc_get_location_varids
+
+!----------------------------------------------------------------------------
+
+subroutine nc_write_location(ncFileID, LocationVarID, loc, obsindex, WhichVertVarID)
+
+! Writes a SINGLE location to the specified netCDF variable and file.
+! The LocationVarID and WhichVertVarID must be the values returned from
+! the nc_get_location_varids call.
+
+use typeSizes
+use netcdf
+
+integer, intent(in) :: ncFileID, LocationVarID
+type(location_type), intent(in) :: loc
+integer, intent(in) :: obsindex
+integer, intent(in) :: WhichVertVarID
+
+real(r8), dimension(LocationDims) :: locations
+integer, dimension(1) :: intval
+
+if ( .not. module_initialized ) call initialize_module
+
+locations = get_location( loc )
+
+call nc_check(nf90_put_var(ncFileID, LocationVarId, locations, &
+ start=(/ 1, obsindex /), count=(/ LocationDims, 1 /) ), &
+ 'nc_write_location', 'put_var:location')
+
+end subroutine nc_write_location
+
+!----------------------------------------------------------------------------
+
+subroutine get_close_obs_init(gc, num, obs)
+
+! Initializes part of get_close accelerator that depends on the particular obs
+
+type(get_close_type), intent(inout) :: gc
+integer, intent(in) :: num
+type(location_type), intent(in) :: obs(num)
+
+if (use_octree) then
+ call get_close_init_otree(gc, num, obs)
+else
+ call get_close_init_boxes(gc, num, obs)
+endif
+
+end subroutine get_close_obs_init
+
+!----------------------------------------------------------------------------
+
+subroutine get_close_init_boxes(gc, num, obs)
+
+! Initializes part of get_close accelerator that depends on the particular obs
+
+type(get_close_type), intent(inout) :: gc
+integer, intent(in) :: num
+type(location_type), intent(in) :: obs(num)
+
+integer :: i, j, k, cum_start, l
+integer :: x_box(num), y_box(num), z_box(num)
+integer :: tstart(nx, ny, nz)
+
+if ( .not. module_initialized ) call initialize_module
+
+! Allocate storage for obs number dependent part
+allocate(gc%box%obs_box(num))
+gc%box%obs_box(:) = -1
+
+! Set the value of num_obs in the structure
+gc%num = num
+
+! If num == 0, no point in going any further.
+if (num == 0) return
+
+! FIXME: compute nx, ny, nz from nboxes? or put in namelist
+nx = nint(real(nboxes, r8)**0.33333) ! roughly cube root
+ny = nint(real(nboxes, r8)**0.33333) ! roughly cube root
+nz = nint(real(nboxes, r8) / real(nx * ny, r8)) ! whatever is left
+
+! Determine where the boxes should be for this set of obs and maxdist
+call find_box_ranges(gc, obs, num)
+
+! Begin by computing the number of observations in each box in x,y,z
+gc%box%count = 0
+do i = 1, num
+
+!print *, i, obs(i)%x, obs(i)%y, obs(i)%z
+ x_box(i) = floor((obs(i)%x - gc%box%bot_x) / gc%box%x_width) + 1
+ if(x_box(i) > nx) x_box(i) = nx
+ if(x_box(i) < 1) x_box(i) = 1
+
+ y_box(i) = floor((obs(i)%y - gc%box%bot_y) / gc%box%y_width) + 1
+ if(y_box(i) > ny) y_box(i) = ny
+ if(y_box(i) < 1) y_box(i) = 1
+
+ z_box(i) = floor((obs(i)%z - gc%box%bot_z) / gc%box%z_width) + 1
+ if(z_box(i) > nz) z_box(i) = nz
+ if(z_box(i) < 1) z_box(i) = 1
+
+ gc%box%count(x_box(i), y_box(i), z_box(i)) = gc%box%count(x_box(i), y_box(i), z_box(i)) + 1
+!print *, 'adding count to box ', x_box(i), y_box(i), z_box(i), &
+! gc%box%count(x_box(i), y_box(i), z_box(i))
+end do
+
+! Figure out where storage for each boxes members should begin
+cum_start = 1
+do i = 1, nx
+ do j = 1, ny
+ do k = 1, nz
+ gc%box%start(i, j, k) = cum_start
+ cum_start = cum_start + gc%box%count(i, j, k)
+ end do
+ end do
+end do
+
+! Now we know how many are in each box, get a list of which are in each box
+tstart = gc%box%start
+do i = 1, num
+ gc%box%obs_box(tstart(x_box(i), y_box(i), z_box(i))) = i
+ tstart(x_box(i), y_box(i), z_box(i)) = tstart(x_box(i), y_box(i), z_box(i)) + 1
+end do
+
+do i = 1, nx
+ do j = 1, ny
+ do k = 1, nz
+if (gc%box%count(i,j,k) > 0) print *, i,j,k, gc%box%count(i,j,k), gc%box%start(i,j,k)
+ do l=1, gc%box%count(i,j,k)
+!print *, l, gc%box%obs_box(l)
+ enddo
+ end do
+ end do
+end do
+
+
+! info on how well the boxes are working. by default print nothing.
+! set print_box_level to higher values to get more and more detail.
+! user info should be level 1; 2 and 3 should be for debug only.
+! special for grid-decomposition debugging; set print level to -8.
+if (output_box_info) then
+ ! if this task normally prints, call the print routine.
+ ! if print level > 2, set all tasks to print and call print.
+ ! then reset the status to off again.
+ if (do_output()) then
+ call print_get_close_type(gc, print_box_level)
+ else if (print_box_level >= 2 .or. print_box_level < 0) then
+ ! print status was false, but turn on temporarily
+ ! to output box info from all tasks.
+ call set_output(.true.)
+ call print_get_close_type(gc, print_box_level)
+ call set_output(.false.)
+ endif
+endif
+
+end subroutine get_close_init_boxes
+
+!----------------------------------------------------------------------------
+
+subroutine get_close_init_otree(gc, num, locs)
+
+! Octree version
+
+! Initializes part of get_close accelerator that depends on the particular obs
+
+type(get_close_type), intent(inout), target :: gc
+integer, intent(in) :: num
+type(location_type), intent(in) :: locs(num)
+
+integer :: i, j, k, n
+
+type(octree_type), pointer :: r, c
+real(r8) :: xl, xu, yl, yu, zl, zu
+
+if ( .not. module_initialized ) call initialize_module
+
+r => gc%root
+
+! Set the value of num_obs in the structure
+gc%num = num
+
+! If num == 0, no point in going any further.
+if (num == 0) return
+
+r%count = num
+
+! need to include space outside the limits of the initialization set,
+! so points outside boundary but closer than maxdist will still match.
+r%llb = set_location(minval(locs(:)%x)-gc%maxdist, &
+ minval(locs(:)%y)-gc%maxdist, &
+ minval(locs(:)%z)-gc%maxdist)
+r%urt = set_location(maxval(locs(:)%x)+gc%maxdist, &
+ maxval(locs(:)%y)+gc%maxdist, &
+ maxval(locs(:)%z)+gc%maxdist)
+! for now, split is midpoint in each dim. this does NOT have to be the case.
+r%split = set_location((r%urt%x + r%llb%x) / 2.0_r8, &
+ (r%urt%y + r%llb%y) / 2.0_r8, &
+ (r%urt%z + r%llb%z) / 2.0_r8)
+
+! initially everyone is in the original list
+allocate(r%index(num))
+do i=1,num
+ r%index(i) = i
+enddo
+
+! recursion starts here
+if (r%count > filled) then
+ call split_tree(r)
+ call move_to_children(r, locs)
+endif
+
+! info on how well the boxes are working. by default print nothing.
+! set print_box_level to higher values to get more and more detail.
+! user info should be level 1; 2 and 3 should be for debug only.
+! special for grid-decomposition debugging; set print level to -8.
+if (output_box_info) then
+ ! if this task normally prints, call the print routine.
+ ! if print level > 2, set all tasks to print and call print.
+ ! then reset the status to off again.
+ if (do_output()) then
+ call print_get_close_type(gc, print_box_level)
+ else if (print_box_level >= 2 .or. print_box_level < 0) then
+ ! print status was false, but turn on temporarily
+ ! to output box info from all tasks.
+ call set_output(.true.)
+ call print_get_close_type(gc, print_box_level)
+ call set_output(.false.)
+ endif
+endif
+
+end subroutine get_close_init_otree
+
+!----------------------------------------------------------------------------
+
+subroutine get_close_obs_destroy(gc)
+
+type(get_close_type), intent(inout) :: gc
+
+if (use_octree) then
+ call get_close_destroy_otree(gc)
+else
+ call get_close_destroy_boxes(gc)
+endif
+
+end subroutine get_close_obs_destroy
+
+!----------------------------------------------------------------------------
+
+subroutine get_close_destroy_boxes(gc)
+
+type(get_close_type), intent(inout) :: gc
+
+deallocate(gc%box%obs_box, gc%box%count, gc%box%start)
+
+end subroutine get_close_destroy_boxes
+
+!----------------------------------------------------------------------------
+
+subroutine get_close_destroy_otree(gc)
+
+type(get_close_type), intent(inout) :: gc
+
+! FIXME: do a depth-first search and deallocate
+! the index() arrays, then deallocate the octree structs
+! one by one.
+
+! gc%root -> children until unallocated
+
+end subroutine get_close_destroy_otree
+
+!----------------------------------------------------------------------------
+
+subroutine get_close_maxdist_init(gc, maxdist)
+
+type(get_close_type), intent(inout) :: gc
+real(r8), intent(in) :: maxdist
+
+character(len=129) :: str1
+integer :: i
+
+! set the default value.
+gc%maxdist = maxdist
+!print *, 'setting maxdist to ', maxdist
+
+if (.not. use_octree) then
+ ! Allocate the storage for the grid dependent boxes
+ allocate(gc%box%count(nx,ny,nz), gc%box%start(nx,ny,nz))
+ gc%box%count = -1
+ gc%box%start = -1
+endif
+
+end subroutine get_close_maxdist_init
+
+!----------------------------------------------------------------------------
+
+subroutine get_close_obs(gc, base_obs_loc, base_obs_kind, obs, obs_kind, &
+ num_close, close_ind, dist)
+
+! FIXME: these work on any locations. the names of these args should be:
+! gc, base_loc, base_kind, locs, locs_kinds, ...
+
+type(get_close_type), intent(in) :: gc
+type(location_type), intent(in) :: base_obs_loc, obs(:)
+integer, intent(in) :: base_obs_kind, obs_kind(:)
+integer, intent(out) :: num_close, close_ind(:)
+real(r8), optional, intent(out) :: dist(:)
+
+if (use_octree) then
+ call get_close_otree(gc, base_obs_loc, base_obs_kind, obs, obs_kind, &
+ num_close, close_ind, dist)
+else
+ call get_close_boxes(gc, base_obs_loc, base_obs_kind, obs, obs_kind, &
+ num_close, close_ind, dist)
+endif
+
+end subroutine get_close_obs
+
+!----------------------------------------------------------------------------
+
+subroutine get_close_boxes(gc, base_obs_loc, base_obs_kind, obs, obs_kind, &
+ num_close, close_ind, dist)
+
+! FIXME: these work on any locations. the names of these args should be:
+! gc, base_loc, base_kind, locs, locs_kinds, ...
+
+type(get_close_type), intent(in) :: gc
+type(location_type), intent(in) :: base_obs_loc, obs(:)
+integer, intent(in) :: base_obs_kind, obs_kind(:)
+integer, intent(out) :: num_close, close_ind(:)
+real(r8), optional, intent(out) :: dist(:)
+
+! If dist is NOT present, just find everybody in a box, put them in the list,
+! but don't compute any distances
+
+integer :: x_box, y_box, z_box, i, j, k, l
+integer :: start_x, end_x, start_y, end_y, start_z, end_z
+integer :: n_in_box, st, t_ind
+real(r8) :: this_dist, this_maxdist
+
+! Variables needed for comparing against correct case.
+! these could be large - make them allocatable
+! and only allocate them if needed.
+integer :: cnum_close
+integer, allocatable :: cclose_ind(:)
+real(r8), allocatable :: cdist(:)
+
+! First, set the intent out arguments to a missing value
+num_close = 0
+close_ind = -99
+if(present(dist)) dist = -1e38_r8 ! big but negative
+this_dist = 1e38_r8 ! something big and positive.
+
+! the list of locations in the obs() argument must be the same
+! as the list of locations passed into get_close_obs_init(), so
+! gc%num and size(obs) better be the same. if the list changes,
+! you have to destroy the old gc and init a new one.
+if (size(obs) /= gc%num) then
+ write(errstring,*)'obs() array must match one passed to get_close_obs_init()'
+ call error_handler(E_ERR, 'get_close_obs', errstring, source, revision, revdate)
+endif
+
+! If num == 0, no point in going any further.
+if (gc%num == 0) return
+
+this_maxdist = gc%maxdist
+
+
+! For validation, it is useful to be able to compare against exact
+! exhaustive search
+if(compare_to_correct) then
+ call exhaustive_collect(gc, base_obs_loc, obs, &
+ cnum_close, cclose_ind, cdist)
+endif
+
+
+! Begin by figuring out which box the base loc is in
+x_box = floor((base_obs_loc%x - gc%box%bot_x) / gc%box%x_width) + 1
+y_box = floor((base_obs_loc%y - gc%box%bot_y) / gc%box%y_width) + 1
+z_box = floor((base_obs_loc%z - gc%box%bot_z) / gc%box%z_width) + 1
+
+! If it is not in any box, then it is more than the maxdist away from everybody
+if(x_box > nx .or. x_box < 1 .or. x_box < 0) return
+if(y_box > ny .or. y_box < 1 .or. y_box < 0) return
+if(z_box > nz .or. z_box < 1 .or. z_box < 0) return
+
+! figure out how many boxes need searching
+! FIXME: if we support a variable maxdist, nboxes_X will need to
+! be computed on the fly here instead of precomputed at init time.
+!print *, 'nboxes x, y, z = ', gc%box%nboxes_x, gc%box%nboxes_y, gc%box%nboxes_z
+!print *, 'base_loc in box ', x_box, y_box, z_box
+
+start_x = x_box - gc%box%nboxes_x
+if (start_x < 1) start_x = 1
+end_x = x_box + gc%box%nboxes_x
+if (end_x > nx) end_x = nx
+
+start_y = y_box - gc%box%nboxes_y
+if (start_y < 1) start_y = 1
+end_y = y_box + gc%box%nboxes_y
+if (end_y > ny) end_y = ny
+
+start_z = z_box - gc%box%nboxes_z
+if (start_z < 1) start_z = 1
+end_z = z_box + gc%box%nboxes_z
+if (end_z > nz) end_z = nz
+
+!print *, 'looping from '
+!print *, 'x: ', start_x, end_x
+!print *, 'y: ', start_y, end_y
+!print *, 'z: ', start_z, end_z
+
+! Next, loop through each box that is close to this box
+do i = start_x, end_x
+ do j = start_y, end_y
+ do k = start_z, end_z
+
+ ! Box to search is i,j,k
+ n_in_box = gc%box%count(i, j, k)
+ st = gc%box%start(i,j,k)
+
+
+ ! Loop to check how close all obs in the box are; add those that are close
+ do l = 1, n_in_box
+
+ t_ind = gc%box%obs_box(st - 1 + l)
+!print *, 'l, t_ind = ', l, t_ind
+
+ ! Only compute distance if dist is present
+ if(present(dist)) then
+ this_dist = get_dist(base_obs_loc, obs(t_ind))
+!print *, 'this_dist = ', this_dist
+ ! If this obs' distance is less than cutoff, add it in list
+ if(this_dist <= this_maxdist) then
+ num_close = num_close + 1
+ close_ind(num_close) = t_ind
+ dist(num_close) = this_dist
+ endif
+ else
+ ! Dist isn't present; add this ob to list without computing distance
+ num_close = num_close + 1
+ close_ind(num_close) = t_ind
+ endif
+
+ end do
+ end do
+ end do
+end do
+
+
+! Verify by comparing to exhaustive search
+if(compare_to_correct) then
+ call exhaustive_report(cnum_close, num_close, cclose_ind, close_ind, cdist, dist)
+endif
+
+
+end subroutine get_close_boxes
+
+!----------------------------------------------------------------------------
+
+subroutine get_close_otree(gc, base_obs_loc, base_obs_kind, obs, obs_kind, &
+ num_close, close_ind, dist)
+
+! FIXME: these work on any locations. the names of these args should be:
+! gc, base_loc, base_kind, locs, locs_kinds, ...
+
+type(get_close_type), intent(in), target :: gc
+type(location_type), intent(in) :: base_obs_loc, obs(:)
+integer, intent(in) :: base_obs_kind, obs_kind(:)
+integer, intent(out) :: num_close, close_ind(:)
+real(r8), optional, intent(out) :: dist(:)
+
+! If dist is NOT present, just find everybody in a box, put them in the list,
+! but don't compute any distances
+
+type(octree_type), pointer :: r, c
+
+integer :: x_box, y_box, z_box, i, j, k, l, n
+integer :: start_x, end_x, start_y, end_y, start_z, end_z
+integer :: n_in_box, st, t_ind
+real(r8) :: this_dist
+
+! Variables needed for comparing against correct case.
+! these could be large - make them allocatable
+! and only allocate them if needed.
+integer :: cnum_close
+integer, allocatable :: cclose_ind(:)
+real(r8), allocatable :: cdist(:)
+
+! First, set the intent out arguments to a missing value
+num_close = 0
+close_ind = -99
+if(present(dist)) dist = -1e38_r8 ! big but negative
+this_dist = 1e38_r8 ! something big and positive.
+
+! the list of locations in the obs() argument must be the same
+! as the list of locations passed into get_close_obs_init(), so
+! gc%num and size(obs) better be the same. if the list changes,
+! you have to destroy the old gc and init a new one.
+if (size(obs) /= gc%num) then
+ write(errstring,*)'obs() array must match one passed to get_close_obs_init()'
+ call error_handler(E_ERR, 'get_close_obs', errstring, source, revision, revdate)
+endif
+
+! If num == 0, no point in going any further.
+if (gc%num == 0) return
+
+
+! For validation, it is useful to be able to compare against exact
+! exhaustive search
+if(compare_to_correct) then
+ call exhaustive_collect(gc, base_obs_loc, obs, &
+ cnum_close, cclose_ind, cdist)
+endif
+
+
+! revised plan:
+! find min/max extents in each dim, +/- maxdist from base
+! and only descend lower in a branch if the region intersects
+! the range that this branch covers. maxdist doesn't have to
+! be a constant in this case - it can be specified per search.
+
+call collect_nearby(gc%root, base_obs_loc, gc%maxdist, obs, base_obs_kind, obs_kind, &
+ num_close, close_ind, dist)
+
+
+! Verify by comparing to exhaustive search
+if(compare_to_correct) then
+ call exhaustive_report(cnum_close, num_close, cclose_ind, close_ind, cdist, dist)
+endif
+
+
+end subroutine get_close_otree
+
+!--------------------------------------------------------------------------
+
+subroutine find_box_ranges(gc, locs, num)
+
+! Finds boundaries for x,y,z boxes.
+! FIXME: ways boxes could be divided:
+! - evenly along each axis
+! - octree-like, divide each axis so roughly half the points are
+! on each side of the dividing plane.
+! - about 100 other schemes
+
+type(get_close_type), intent(inout) :: gc
+integer, intent(in) :: num
+type(location_type), intent(in) :: locs(num)
+
+logical :: old_out
+
+
+! FIXME: this space could be very sparse
+
+gc%box%bot_x = minval(locs(:)%x)
+gc%box%bot_y = minval(locs(:)%y)
+gc%box%bot_z = minval(locs(:)%z)
+
+gc%box%top_x = maxval(locs(:)%x)
+gc%box%top_y = maxval(locs(:)%y)
+gc%box%top_z = maxval(locs(:)%z)
+
+gc%box%x_width = (gc%box%top_x - gc%box%bot_x) / nx
+gc%box%y_width = (gc%box%top_y - gc%box%bot_y) / ny
+gc%box%z_width = (gc%box%top_z - gc%box%bot_z) / nz
+
+! FIXME: compute a sphere of radius maxdist and see how
+! many boxes in x, y, z that would include.
+gc%box%nboxes_x = aint((gc%maxdist + (gc%box%x_width-1)) / gc%box%x_width)
+gc%box%nboxes_y = aint((gc%maxdist + (gc%box%y_width-1)) / gc%box%y_width)
+gc%box%nboxes_z = aint((gc%maxdist + (gc%box%z_width-1)) / gc%box%z_width)
+
+
+!if(compare_to_correct) then
+! old_out = do_output()
+! call set_output(.true.)
+! write(errstring, *) 'x bot, top, width, nboxes ', gc%box%bot_x, gc%box%top_x, gc%box%x_width, gc%box%nboxes_x
+! call error_handler(E_MSG, 'find_box_ranges', errstring)
+! write(errstring, *) 'y bot, top, width, nboxes ', gc%box%bot_y, gc%box%top_y, gc%box%y_width, gc%box%nboxes_y
+! call error_handler(E_MSG, 'find_box_ranges', errstring)
+! write(errstring, *) 'z bot, top, width, nboxes ', gc%box%bot_z, gc%box%top_z, gc%box%z_width, gc%box%nboxes_z
+! call error_handler(E_MSG, 'find_box_ranges', errstring)
+! call set_output(old_out)
+!endif
+
+end subroutine find_box_ranges
+
+!----------------------------------------------------------------------------
+
+recursive subroutine split_tree(r)
+ type(octree_type), pointer :: r
+
+integer :: i, j, k
+real(r8) :: xl, xu, yl, yu, zl, zu
+type(octree_type), pointer :: c
+
+
+allocate(r%children(2,2,2))
+
+do i=1,2
@@ Diff output truncated at 40000 characters. @@
From nancy at ucar.edu Mon Apr 9 10:48:53 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 09 Apr 2012 10:48:53 -0600
Subject: [Dart-dev] [5672] DART/branches/development/location/README: add
ref to new channel location type.
Message-ID:
Revision: 5672
Author: nancy
Date: 2012-04-09 10:48:53 -0600 (Mon, 09 Apr 2012)
Log Message:
-----------
add ref to new channel location type.
Modified Paths:
--------------
DART/branches/development/location/README
-------------- next part --------------
Modified: DART/branches/development/location/README
===================================================================
--- DART/branches/development/location/README 2012-04-09 16:43:31 UTC (rev 5671)
+++ DART/branches/development/location/README 2012-04-09 16:48:53 UTC (rev 5672)
@@ -41,6 +41,7 @@
'twod', a periodic 2d domain with x,y coordinates between 0 and 1.
'twod_sphere', a 2d shell with latitude, longitude pairs.
'threed', a periodic 3d domain with x,y,z coordinates between 0 and 1.
+ 'channel', a 3d domain periodic in x, limited in y, and unlimited z.
Other schemes can be added, as needed by the models.
Possible ideas are a non-periodic version of the 1d, 2d
From nancy at ucar.edu Mon Apr 9 11:11:37 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 09 Apr 2012 11:11:37 -0600
Subject: [Dart-dev] [5673] DART/branches/development/location: added a [0,
1] periodic 3d locations mod, and an X, Y, Z 3d Cartesian one.
Message-ID:
Revision: 5673
Author: nancy
Date: 2012-04-09 11:11:37 -0600 (Mon, 09 Apr 2012)
Log Message:
-----------
added a [0,1] periodic 3d locations mod, and an X,Y,Z 3d Cartesian one.
Added Paths:
-----------
DART/branches/development/location/location_test3.f90
DART/branches/development/location/threed/
DART/branches/development/location/threed/location_mod.f90
DART/branches/development/location/threed/test/
DART/branches/development/location/threed/test/input.nml
DART/branches/development/location/threed/test/mkmf_location_test
DART/branches/development/location/threed/test/path_names_location_test
DART/branches/development/location/threed/test/test.in
DART/branches/development/location/threed_cartesian/
DART/branches/development/location/threed_cartesian/location_mod.f90
DART/branches/development/location/threed_cartesian/location_mod.html
DART/branches/development/location/threed_cartesian/location_mod.nml
DART/branches/development/location/threed_cartesian/test/
DART/branches/development/location/threed_cartesian/test/input.nml
DART/branches/development/location/threed_cartesian/test/mkmf_location_test
DART/branches/development/location/threed_cartesian/test/mkmf_location_test3
DART/branches/development/location/threed_cartesian/test/path_names_location_test
DART/branches/development/location/threed_cartesian/test/path_names_location_test3
DART/branches/development/location/threed_cartesian/test/test.in
Removed Paths:
-------------
DART/branches/development/location/threed/location_mod.f90
DART/branches/development/location/threed/test/
DART/branches/development/location/threed/test/input.nml
DART/branches/development/location/threed/test/mkmf_location_test
DART/branches/development/location/threed/test/path_names_location_test
DART/branches/development/location/threed/test/test.in
DART/branches/development/location/threed_cartesian/location_mod.f90
DART/branches/development/location/threed_cartesian/location_mod.html
DART/branches/development/location/threed_cartesian/location_mod.nml
DART/branches/development/location/threed_cartesian/test/
DART/branches/development/location/threed_cartesian/test/input.nml
DART/branches/development/location/threed_cartesian/test/mkmf_location_test
DART/branches/development/location/threed_cartesian/test/mkmf_location_test3
DART/branches/development/location/threed_cartesian/test/path_names_location_test
DART/branches/development/location/threed_cartesian/test/path_names_location_test3
DART/branches/development/location/threed_cartesian/test/test.in
-------------- next part --------------
Copied: DART/branches/development/location/location_test3.f90 (from rev 5672, DART/branches/mpas/location/location_test3.f90)
===================================================================
--- DART/branches/development/location/location_test3.f90 (rev 0)
+++ DART/branches/development/location/location_test3.f90 2012-04-09 17:11:37 UTC (rev 5673)
@@ -0,0 +1,161 @@
+! DART software - Copyright 2004 - 2011 UCAR. This open source software is
+! provided by UCAR, "as is", without charge, subject to all terms of use at
+! http://www.image.ucar.edu/DAReS/DART/DART_download
+
+program location_test3
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
+! Simple test program to exercise oned location module.
+
+use location_mod
+use types_mod, only : r8
+use utilities_mod, only : get_unit, error_handler, E_ERR
+use random_seq_mod, only : random_seq_type, init_random_seq, random_uniform
+
+
+implicit none
+
+! version controlled file description for error handling, do not edit
+character(len=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
+
+integer, parameter :: nl = 20
+type(location_type) :: loc1(nl), loc2, near1
+integer :: iunit, i, j, dummy(nl), num_close, close_ind(nl), rc, near1index
+real(r8) :: loc2_val(3), dist(nl)
+real(r8) :: minv(3), maxv(3), v(3), minr(3), maxr(3), maxdist
+type(random_seq_type) :: ran_seq
+logical :: ran_seq_init = .false.
+type(get_close_type) :: cc_gc
+character(len=100) :: buf
+
+
+
+! Open an output file
+iunit = get_unit()
+open(iunit, file = 'location_test_file')
+
+if(.not. ran_seq_init) then
+ call init_random_seq(ran_seq)
+ ran_seq_init = .TRUE.
+endif
+
+minv(1) = -100.0_r8
+minv(2) = -200.0_r8
+minv(3) = -500.0_r8
+
+maxv(1) = 10000.0_r8
+maxv(2) = 20000.0_r8
+maxv(3) = 50000.0_r8
+
+minr(:) = 1e38_r8
+maxr(:) = -1e38_r8
+
+maxdist = 10000.0_r8
+
+! set a known min/max at the box edges so we know any
+! random points generated will be inside for now.
+loc1(1) = set_location(minv(1), minv(2), minv(3))
+call write_location(0, loc1(1), charstring=buf)
+write(*,*) 'location ', 1, trim(buf)
+
+loc1(2) = set_location(maxv(1), maxv(2), maxv(3))
+call write_location(0, loc1(2), charstring=buf)
+write(*,*) 'location ', 2, trim(buf)
+
+! Set the location list
+do i = 3, nl
+ do j=1, 3
+ v(j) = random_uniform(ran_seq) * (maxv(j)-minv(j)) + minv(j)
+ if (v(j) < minr(j)) minr(j) = v(j)
+ if (v(j) > maxr(j)) maxr(j) = v(j)
+ enddo
+
+ loc1(i) = set_location(v(1), v(2), v(3))
+
+ call write_location(0, loc1(i), charstring=buf)
+ write(*,*) 'location ', i, trim(buf)
+enddo
+
+! Write this location to the file
+do i = 1, nl
+ call write_location(iunit, loc1(i))
+enddo
+
+call get_close_maxdist_init(cc_gc, maxdist)
+call get_close_obs_init(cc_gc, nl, loc1)
+
+call print_get_close_type(cc_gc)
+
+dummy = 0
+
+! generate another random and find nearest from list
+do i = 1, nl
+ do j=1, 3
+ v(j) = random_uniform(ran_seq) * (maxr(j)-minr(j)) + minr(j)
+ enddo
+
+ loc2 = set_location(v(1), v(2), v(3))
+ call write_location(iunit, loc2)
+ call write_location(0, loc2, charstring=buf)
+ print *, 'generated a random point at ', trim(buf)
+
+ do j=1, nl
+ dist(j) = get_dist(loc1(j), loc2)
+ if (dist(j) <= maxdist) then
+ print *, 'dist to point ', j, 'is less than maxdist', dist(j)
+ endif
+ enddo
+
+
+ call get_close_obs(cc_gc, loc2, 0, loc1, dummy, num_close, close_ind, dist)
+ if (num_close > 0) then
+ print *, 'num close = ', num_close
+ do j=1, min(num_close, nl)
+ print *, j, close_ind(j)
+ if (close_ind(j) >= 1 .and. close_ind(j) <= nl) then
+ call write_location(0, loc1(close_ind(j)), charstring=buf)
+ write(*,*) 'close box loc ', trim(buf), dist(j)
+ endif
+ enddo
+ endif
+
+ call find_nearest(cc_gc, loc2, loc1, near1index, rc)
+ if (rc /= 0) then
+ print *, 'bad return from find nearest, ', rc
+ cycle
+ endif
+ if (near1index < 1) then
+ print *, 'near1index < 1, ', near1index
+ cycle
+ endif
+ print *, 'nearest location index = ', near1index
+ call write_location(0, loc1(near1index), charstring=buf)
+ write(*,*) 'near loc ', trim(buf)
+
+enddo
+
+close(iunit)
+
+! Now read them back in and compute the distances from loc1
+open(iunit, file = 'location_test_file')
+
+do i = 1, nl
+ loc1(i) = read_location(iunit)
+enddo
+do i = 1, nl
+ loc2 = read_location(iunit)
+ write(*, *) 'distance ', i, ' is ', get_dist(loc1(i), loc2)
+enddo
+
+close(iunit)
+
+end program location_test3
+
Deleted: DART/branches/development/location/threed/location_mod.f90
===================================================================
--- DART/branches/mpas/location/threed/location_mod.f90 2012-04-09 16:48:53 UTC (rev 5672)
+++ DART/branches/development/location/threed/location_mod.f90 2012-04-09 17:11:37 UTC (rev 5673)
@@ -1,729 +0,0 @@
-! DART software - Copyright 2004 - 2011 UCAR. This open source software is
-! provided by UCAR, "as is", without charge, subject to all terms of use at
-! http://www.image.ucar.edu/DAReS/DART/DART_download
-
-module location_mod
-
-!
-! $URL$
-! $Id$
-! $Revision$
-! $Date$
-
-! Implements location interfaces for a three dimensional cyclic region.
-! The internal representation of the location is currently implemented
-! as (x, y) from 0.0 to 1.0 in both dimensions.
-!
-! If you are looking for a geophysical locations module, look at either
-! the threed_sphere or threed_cartesian versions of this file.
-
-use types_mod, only : r8, MISSING_R8
-use utilities_mod, only : register_module, error_handler, E_ERR, ascii_file_format, &
- nc_check
-use random_seq_mod, only : random_seq_type, init_random_seq, random_uniform
-
-implicit none
-private
-
-public :: location_type, get_location, set_location, &
- set_location_missing, is_location_in_region, &
- write_location, read_location, interactive_location, query_location, &
- LocationDims, LocationName, LocationLName, get_close_obs, &
- get_close_maxdist_init, get_close_obs_init, get_close_type, &
- operator(==), operator(/=), get_dist, get_close_obs_destroy, &
- nc_write_location_atts, nc_get_location_varids, nc_write_location, &
- vert_is_height, vert_is_pressure, vert_is_undef, vert_is_level, &
- vert_is_surface, has_vertical_localization
-
-! version controlled file description for error handling, do not edit
-character(len=128), parameter :: &
- source = "$URL$", &
- revision = "$Revision$", &
- revdate = "$Date$"
-
-type location_type
- private
- real(r8) :: x, y, z
-end type location_type
-
-! Needed as stub but not used in this low-order model
-type get_close_type
- private
- integer :: num
- real(r8) :: maxdist
-end type get_close_type
-
-type(random_seq_type) :: ran_seq
-logical :: ran_seq_init = .false.
-logical, save :: module_initialized = .false.
-
-integer, parameter :: LocationDims = 3
-character(len = 129), parameter :: LocationName = "loc3D"
-character(len = 129), parameter :: LocationLName = "threed cyclic locations: x, y, z"
-
-character(len = 129) :: errstring
-
-interface operator(==); module procedure loc_eq; end interface
-interface operator(/=); module procedure loc_ne; end interface
-
-interface set_location
- module procedure set_location_single
- module procedure set_location_array
-end interface set_location
-
-contains
-
-!----------------------------------------------------------------------------
-
-subroutine initialize_module
-
-if (module_initialized) return
-
-call register_module(source, revision, revdate)
-module_initialized = .true.
-
-end subroutine initialize_module
-
-!----------------------------------------------------------------------------
-
-function get_dist(loc1, loc2, kind1, kind2)
-
-! Return the distance between 2 locations. Since this is a periodic
-! domain, the shortest distance may wrap around.
-
-type(location_type), intent(in) :: loc1, loc2
-integer, optional, intent(in) :: kind1, kind2
-real(r8) :: get_dist
-
-real(r8) :: x_dif, y_dif, z_dif
-
-if ( .not. module_initialized ) call initialize_module
-
-! Periodic domain, if distance is greater than half wraparound the other way.
-x_dif = abs(loc1%x - loc2%x)
-if (x_dif > 0.5_r8) x_dif = 1.0_r8 - x_dif
-y_dif = abs(loc1%y - loc2%y)
-if (y_dif > 0.5_r8) y_dif = 1.0_r8 - y_dif
-z_dif = abs(loc1%z - loc2%z)
-if (z_dif > 0.5_r8) z_dif = 1.0_r8 - z_dif
-
-get_dist = sqrt ( x_dif * x_dif + y_dif * y_dif + z_dif * z_dif)
-
-end function get_dist
-
-!---------------------------------------------------------------------------
-
-function loc_eq(loc1,loc2)
-
-! interface operator used to compare two locations.
-! Returns true only if all components are 'the same' to within machine
-! precision.
-
-type(location_type), intent(in) :: loc1, loc2
-logical :: loc_eq
-
-if ( .not. module_initialized ) call initialize_module
-
-loc_eq = .false.
-
-if ( abs(loc1%x - loc2%x ) > epsilon(loc1%x ) ) return
-if ( abs(loc1%y - loc2%y ) > epsilon(loc1%y ) ) return
-if ( abs(loc1%z - loc2%z ) > epsilon(loc1%z ) ) return
-
-loc_eq = .true.
-
-end function loc_eq
-
-!---------------------------------------------------------------------------
-
-function loc_ne(loc1,loc2)
-
-! interface operator used to compare two locations.
-! Returns true if locations are not identical to machine precision.
-
-type(location_type), intent(in) :: loc1, loc2
-logical :: loc_ne
-
-if ( .not. module_initialized ) call initialize_module
-
-loc_ne = (.not. loc_eq(loc1,loc2))
-
-end function loc_ne
-
-!---------------------------------------------------------------------------
-
-function get_location(loc)
-
-! Given a location type, return the x, y, z
-
-type(location_type), intent(in) :: loc
-real(r8), dimension(3) :: get_location
-
-if ( .not. module_initialized ) call initialize_module
-
-get_location(1) = loc%x
-get_location(2) = loc%y
-get_location(3) = loc%z
-
-end function get_location
-
-!----------------------------------------------------------------------------
-
-function set_location_single(x, y, z)
-
-! Given an x, y, z triplet, put the values into the location.
-
-real(r8), intent(in) :: x, y, z
-type (location_type) :: set_location_single
-
-if ( .not. module_initialized ) call initialize_module
-
-if(x < 0.0_r8 .or. x > 1.0_r8) then
- write(errstring,*)'x (',x,') is not within range [0,1]'
- call error_handler(E_ERR, 'set_location', errstring, source, revision, revdate)
-endif
-
-if(y < 0.0_r8 .or. y > 1.0_r8) then
- write(errstring,*)'y (',y,') is not within range [0,1]'
- call error_handler(E_ERR, 'set_location', errstring, source, revision, revdate)
-endif
-
-if(z < 0.0_r8 .or. z > 1.0_r8) then
- write(errstring,*)'z (',z,') is not within range [0,1]'
- call error_handler(E_ERR, 'set_location', errstring, source, revision, revdate)
-endif
-
-set_location_single%x = x
-set_location_single%y = y
-set_location_single%z = z
-
-end function set_location_single
-
-!----------------------------------------------------------------------------
-
-function set_location_array(list)
-
-! location semi-independent interface routine
-! given 3 float numbers, call the underlying set_location routine
-
-real(r8), intent(in) :: list(:)
-type (location_type) :: set_location_array
-
-if ( .not. module_initialized ) call initialize_module
-
-if (size(list) < 3) then
- write(errstring,*)'requires 3 input values'
- call error_handler(E_ERR, 'set_location', errstring, source, revision, revdate)
-endif
-
-set_location_array = set_location_single(list(1), list(2), list(3))
-
-end function set_location_array
-
-!----------------------------------------------------------------------------
-
-function set_location_missing()
-
-! fill in the contents to a known value.
-
-type (location_type) :: set_location_missing
-
-if ( .not. module_initialized ) call initialize_module
-
-set_location_missing%x = MISSING_R8
-set_location_missing%y = MISSING_R8
-set_location_missing%z = MISSING_R8
-
-end function set_location_missing
-
-!---------------------------------------------------------------------------
-
-function query_location(loc,attr)
-
-! Returns the value of the attribute
-!
-
-type(location_type), intent(in) :: loc
-character(len=*), optional, intent(in) :: attr
-real(r8) :: query_location
-
-if ( .not. module_initialized ) call initialize_module
-
-! see the long comment in this routine in the threed_sphere
-! module for warnings about compiler bugs before you change
-! this code.
-
-query_location = loc%x
-
-if (.not. present(attr)) return
-
-select case(attr)
- case ('x','X')
- query_location = loc%x
- case ('y','Y')
- query_location = loc%y
- case ('z','Z')
- query_location = loc%z
- case default
- call error_handler(E_ERR, 'query_location; threed', &
- 'Only x, y, or z are legal attributes to request from location', source, revision, revdate)
-end select
-
-end function query_location
-
-!----------------------------------------------------------------------------
-
-subroutine write_location(locfile, loc, fform, charstring)
-
-! Writes a 3D location to the file.
-! additional functionality: if optional argument charstring is specified,
-! it must be long enough to hold the string, and the location information is
-! written into it instead of to a file. fform must be ascii (which is the
-! default if not specified) to use this option.
-
-integer, intent(in) :: locfile
-type(location_type), intent(in) :: loc
-character(len = *), intent(in), optional :: fform
-character(len = *), intent(out), optional :: charstring
-
-integer :: charlength
-logical :: writebuf
-
-! 10 format(1x,2(f22.14,1x)) ! old
-10 format(1X,3(F20.16,1X))
-
-if ( .not. module_initialized ) call initialize_module
-
-! writing to a file (normal use) or to a character buffer?
-writebuf = present(charstring)
-
-! output file; test for ascii or binary, write what's asked, and return
-if (.not. writebuf) then
- if (ascii_file_format(fform)) then
- write(locfile, '(''loc3D'')' )
- write(locfile, 10) loc%x, loc%y, loc%z
- else
- write(locfile) loc%x, loc%y, loc%z
- endif
- return
-endif
-
-! you only get here if you're writing to a buffer and not
-! to a file, and you can't have binary format set.
-if (.not. ascii_file_format(fform)) then
- call error_handler(E_ERR, 'write_location', &
- 'Cannot use string buffer with binary format', &
- source, revision, revdate)
-endif
-
-! format the location to be more human-friendly; which in
-! this case doesn't change the value.
-
-! this must be the sum of the formats below.
-charlength = 38
-
-if (len(charstring) < charlength) then
- write(errstring, *) 'charstring buffer must be at least ', charlength, ' chars long'
- call error_handler(E_ERR, 'write_location', errstring, source, revision, revdate)
-endif
-
-write(charstring, '(A,F9.7,2(2X,F9.7))') 'X/Y/Z: ', loc%x, loc%y, loc%z
-
-
-end subroutine write_location
-
-!----------------------------------------------------------------------------
-
-function read_location(locfile, fform)
-
-! Reads a 3D location from locfile that was written by write_location.
-! See write_location for additional discussion.
-
-integer, intent(in) :: locfile
-type(location_type) :: read_location
-character(len = *), intent(in), optional :: fform
-
-character(len=5) :: header
-
-if ( .not. module_initialized ) call initialize_module
-
-if (ascii_file_format(fform)) then
- read(locfile, '(a5)' ) header
- if(header /= 'loc3D') then
- write(errstring,*)'Expected location header "loc3D" in input file, got ', header
- call error_handler(E_ERR, 'read_location', errstring, source, revision, revdate)
- endif
- ! Now read the location data value
- read(locfile, *) read_location%x, read_location%y, read_location%z
-else
- read(locfile) read_location%x, read_location%y, read_location%z
-endif
-
-end function read_location
-
-!--------------------------------------------------------------------------
-
-subroutine interactive_location(location, set_to_default)
-
-! Allows for interactive input of a location. Also gives option of selecting
-! a uniformly distributed random location.
-
-type(location_type), intent(out) :: location
-logical, intent(in), optional :: set_to_default
-
-real(r8) :: v(3)
-character(len=1) :: l(3)
-integer :: i
-
-if ( .not. module_initialized ) call initialize_module
-
-! If set_to_default is true, then just zero out and return
-if(present(set_to_default)) then
- if(set_to_default) then
- location%x = 0.0
- location%y = 0.0
- location%z = 0.0
- return
- endif
-endif
-
-l(1) = 'X'
-l(2) = 'Y'
-l(3) = 'Z'
-
-do i=1, 3
- write(*, *) 'Input ', l(i), ' location for this obs: value 0 to 1 or a negative number for '
- write(*, *) 'Uniformly distributed random location'
- read(*, *) v(i)
-
- do while(v(i) > 1.0_r8)
- write(*, *) 'Input value greater than 1.0 is illegal, please try again'
- read(*, *) v(i)
- end do
-
- if(v(i) < 0.0_r8) then
-
- ! Need to make sure random sequence is initialized
-
- if(.not. ran_seq_init) then
- call init_random_seq(ran_seq)
- ran_seq_init = .TRUE.
- endif
-
- ! Uniform location from 0 to 1 for this location type
-
- v(i) = random_uniform(ran_seq)
- write(*, *) 'random ',l(i),' location is ', v(i)
-
- endif
-enddo
-
-location%x = v(1)
-location%y = v(2)
-location%z = v(3)
-
-end subroutine interactive_location
-
-!----------------------------------------------------------------------------
-
-function nc_write_location_atts( ncFileID, fname, ObsNumDimID ) result (ierr)
-
-! Writes the "location module" -specific attributes to a netCDF file.
-
-use typeSizes
-use netcdf
-
-integer, intent(in) :: ncFileID ! handle to the netcdf file
-character(len=*), intent(in) :: fname ! file name (for printing purposes)
-integer, intent(in) :: ObsNumDimID ! handle to the dimension that grows
-integer :: ierr
-
-integer :: LocDimID
-integer :: VarID
-
-if ( .not. module_initialized ) call initialize_module
-
-ierr = -1 ! assume things will fail ...
-
-! define the rank/dimension of the location information
-call nc_check(nf90_def_dim(ncid=ncFileID, name='location', len=LocationDims, &
- dimid = LocDimID), 'nc_write_location_atts', 'def_dim:location '//trim(fname))
-
-! Define the observation location variable and attributes
-
-call nc_check(nf90_def_var(ncid=ncFileID, name='location', xtype=nf90_double, &
- dimids=(/ LocDimID, ObsNumDimID /), varid=VarID), &
- 'nc_write_location_atts', 'location:def_var')
-
-call nc_check(nf90_put_att(ncFileID, VarID, 'description', &
- 'location coordinates'), 'nc_write_location_atts', 'location:description')
-call nc_check(nf90_put_att(ncFileID, VarID, 'location_type', &
- trim(LocationName)), 'nc_write_location_atts', 'location:location_type')
-call nc_check(nf90_put_att(ncFileID, VarID, 'long_name', &
- trim(LocationLName)), 'nc_write_location_atts', 'location:long_name')
-call nc_check(nf90_put_att(ncFileID, VarID, 'storage_order', &
- 'X Y'), 'nc_write_location_atts', 'location:storage_order')
-call nc_check(nf90_put_att(ncFileID, VarID, 'units', &
- 'none none'), 'nc_write_location_atts', 'location:units')
-
-! no vertical array here.
-
-! If we made it to here without error-ing out ... we're good.
-
-ierr = 0
-
-end function nc_write_location_atts
-
-!----------------------------------------------------------------------------
-
-subroutine nc_get_location_varids( ncFileID, fname, LocationVarID, WhichVertVarID )
-
-! Return the LocationVarID and WhichVertVarID variables from a given netCDF file.
-!
-! ncFileId the netcdf file descriptor
-! fname the name of the netcdf file (for error messages only)
-! LocationVarID the integer ID of the 'location' variable in the netCDF file
-! WhichVertVarID the integer ID of the 'which_vert' variable in the netCDF file
-!
-! In this instance, WhichVertVarID will never be defined, ... set to a bogus value
-
-use typeSizes
-use netcdf
-
-integer, intent(in) :: ncFileID ! handle to the netcdf file
-character(len=*), intent(in) :: fname ! file name (for printing purposes)
-integer, intent(out) :: LocationVarID, WhichVertVarID
-
-if ( .not. module_initialized ) call initialize_module
-
-call nc_check(nf90_inq_varid(ncFileID, 'location', varid=LocationVarID), &
- 'nc_get_location_varids', 'inq_varid:location '//trim(fname))
-
-WhichVertVarID = -99
-
-end subroutine nc_get_location_varids
-
-!----------------------------------------------------------------------------
-
-subroutine nc_write_location(ncFileID, LocationVarID, loc, obsindex, WhichVertVarID)
-
-! Writes a SINGLE location to the specified netCDF variable and file.
-! The LocationVarID and WhichVertVarID must be the values returned from
-! the nc_get_location_varids call.
-
-use typeSizes
-use netcdf
-
-integer, intent(in) :: ncFileID, LocationVarID
-type(location_type), intent(in) :: loc
-integer, intent(in) :: obsindex
-integer, intent(in) :: WhichVertVarID
-
-real(r8), dimension(LocationDims) :: locations
-
-if ( .not. module_initialized ) call initialize_module
-
-locations = get_location( loc )
-
-call nc_check(nf90_put_var(ncFileID, LocationVarId, locations, &
- start=(/ 1, obsindex /), count=(/ LocationDims, 1 /) ), &
- 'nc_write_location', 'put_var:location')
-
-if ( WhichVertVarID >= 0 ) then
- write(errstring,*)'WhichVertVarID supposed to be negative ... is ',WhichVertVarID
- call error_handler(E_ERR, 'nc_write_location', errstring, source, revision, revdate)
-endif ! if less than zero (as it should be) ... just ignore
-
-end subroutine nc_write_location
-
-!----------------------------------------------------------------------------
-
-subroutine get_close_obs_init(gc, num, obs)
-
-! Initializes part of get_close accelerator that depends on the particular obs
-
-type(get_close_type), intent(inout) :: gc
-integer, intent(in) :: num
-type(location_type), intent(in) :: obs(num)
-
-! Set the value of num_obs in the structure
-gc%num = num
-
-end subroutine get_close_obs_init
-
-!----------------------------------------------------------------------------
-
-subroutine get_close_obs_destroy(gc)
-
-type(get_close_type), intent(inout) :: gc
-
-end subroutine get_close_obs_destroy
-
-!----------------------------------------------------------------------------
-
-subroutine get_close_maxdist_init(gc, maxdist, maxdist_list)
-
-type(get_close_type), intent(inout) :: gc
-real(r8), intent(in) :: maxdist
-real(r8), intent(in), optional :: maxdist_list(:)
-
-! Set the maximum distance in the structure
-gc%maxdist = maxdist
-
-end subroutine get_close_maxdist_init
-
-!----------------------------------------------------------------------------
-
-subroutine get_close_obs(gc, base_obs_loc, base_obs_kind, obs, obs_kind, &
- num_close, close_ind, dist)
-
-! Default version with no smarts; no need to be smart in 1D
-! Kinds are available here if one wanted to do more refined distances.
-
-type(get_close_type), intent(in) :: gc
-type(location_type), intent(in) :: base_obs_loc, obs(:)
-integer, intent(in) :: base_obs_kind, obs_kind(:)
-integer, intent(out) :: num_close, close_ind(:)
-real(r8), optional, intent(out) :: dist(:)
-
-integer :: i
-real(r8) :: this_dist
-
-! the list of locations in the obs() argument must be the same
-! as the list of locations passed into get_close_obs_init(), so
-! gc%num and size(obs) better be the same. if the list changes,
-! you have to destroy the old gc and init a new one.
-if (size(obs) /= gc%num) then
- write(errstring,*)'obs() array must match one passed to get_close_obs_init()'
- call error_handler(E_ERR, 'get_close_obs', errstring, source, revision, revdate)
-endif
-
-! Return list of obs that are within maxdist and their distances
-num_close = 0
-do i = 1, gc%num
- this_dist = get_dist(base_obs_loc, obs(i), base_obs_kind, obs_kind(i))
- if(this_dist <= gc%maxdist) then
- ! Add this ob to the list
- num_close = num_close + 1
- close_ind(num_close) = i
- if (present(dist)) dist(num_close) = this_dist
- endif
-end do
-
-end subroutine get_close_obs
-
-!----------------------------------------------------------------------------
-
-function is_location_in_region(loc, minl, maxl)
-
-! Returns true if the given location is between the other two.
-
-logical :: is_location_in_region
-type(location_type), intent(in) :: loc, minl, maxl
-
-if ( .not. module_initialized ) call initialize_module
-
-! assume failure and return as soon as we are confirmed right.
-! set to success only at the bottom after all tests have passed.
-is_location_in_region = .false.
-
-! FIXME: this is a triply cyclic domain. check if min
-! limit > max; if so, then wrap around.
-!if (minl%x <= maxl%x) .and. ...
-if ((loc%x < minl%x) .or. (loc%x > maxl%x)) return
-if ((loc%y < minl%y) .or. (loc%y > maxl%y)) return
-if ((loc%z < minl%z) .or. (loc%z > maxl%z)) return
-
-is_location_in_region = .true.
-
-end function is_location_in_region
-
-!----------------------------------------------------------------------------
-! stubs - always say no, but allow this code to be compiled with
-! common code that sometimes needs vertical info.
-!----------------------------------------------------------------------------
-
-function vert_is_undef(loc)
-
-! Stub, always returns false.
-
-logical :: vert_is_undef
-type(location_type), intent(in) :: loc
-
-vert_is_undef = .false.
-
-end function vert_is_undef
-
-!----------------------------------------------------------------------------
-
-function vert_is_surface(loc)
-
-! Stub, always returns false.
-
-logical :: vert_is_surface
-type(location_type), intent(in) :: loc
-
-vert_is_surface = .false.
-
-end function vert_is_surface
-
-!----------------------------------------------------------------------------
-
-function vert_is_pressure(loc)
-
-! Stub, always returns false.
-
-logical :: vert_is_pressure
-type(location_type), intent(in) :: loc
-
-vert_is_pressure = .false.
-
-end function vert_is_pressure
-
-!----------------------------------------------------------------------------
-
-function vert_is_height(loc)
-
-! Stub, always returns false.
-
-logical :: vert_is_height
-type(location_type), intent(in) :: loc
-
-vert_is_height = .false.
-
-end function vert_is_height
-
-!----------------------------------------------------------------------------
-
-function vert_is_level(loc)
-
-! Stub, always returns false.
-
-logical :: vert_is_level
-type(location_type), intent(in) :: loc
-
-vert_is_level = .false.
-
-end function vert_is_level
-
-!---------------------------------------------------------------------------
-
-function has_vertical_localization()
-
-! Always returns false since this type of location doesn't support
-! vertical localization.
-
-logical :: has_vertical_localization
-
-if ( .not. module_initialized ) call initialize_module
-
-has_vertical_localization = .false.
-
-end function has_vertical_localization
-
-
-!----------------------------------------------------------------------------
-! end of location/threed/location_mod.f90
-!----------------------------------------------------------------------------
-
-end module location_mod
Copied: DART/branches/development/location/threed/location_mod.f90 (from rev 5672, DART/branches/mpas/location/threed/location_mod.f90)
===================================================================
--- DART/branches/development/location/threed/location_mod.f90 (rev 0)
+++ DART/branches/development/location/threed/location_mod.f90 2012-04-09 17:11:37 UTC (rev 5673)
@@ -0,0 +1,729 @@
+! DART software - Copyright 2004 - 2011 UCAR. This open source software is
+! provided by UCAR, "as is", without charge, subject to all terms of use at
+! http://www.image.ucar.edu/DAReS/DART/DART_download
+
+module location_mod
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
+! Implements location interfaces for a three dimensional cyclic region.
+! The internal representation of the location is currently implemented
+! as (x, y) from 0.0 to 1.0 in both dimensions.
+!
+! If you are looking for a geophysical locations module, look at either
+! the threed_sphere or threed_cartesian versions of this file.
+
+use types_mod, only : r8, MISSING_R8
+use utilities_mod, only : register_module, error_handler, E_ERR, ascii_file_format, &
+ nc_check
+use random_seq_mod, only : random_seq_type, init_random_seq, random_uniform
+
+implicit none
+private
+
+public :: location_type, get_location, set_location, &
+ set_location_missing, is_location_in_region, &
+ write_location, read_location, interactive_location, query_location, &
+ LocationDims, LocationName, LocationLName, get_close_obs, &
+ get_close_maxdist_init, get_close_obs_init, get_close_type, &
+ operator(==), operator(/=), get_dist, get_close_obs_destroy, &
+ nc_write_location_atts, nc_get_location_varids, nc_write_location, &
+ vert_is_height, vert_is_pressure, vert_is_undef, vert_is_level, &
+ vert_is_surface, has_vertical_localization
+
+! version controlled file description for error handling, do not edit
+character(len=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
+
+type location_type
+ private
+ real(r8) :: x, y, z
+end type location_type
+
+! Needed as stub but not used in this low-order model
+type get_close_type
+ private
+ integer :: num
+ real(r8) :: maxdist
+end type get_close_type
+
+type(random_seq_type) :: ran_seq
+logical :: ran_seq_init = .false.
+logical, save :: module_initialized = .false.
+
+integer, parameter :: LocationDims = 3
+character(len = 129), parameter :: LocationName = "loc3D"
+character(len = 129), parameter :: LocationLName = "threed cyclic locations: x, y, z"
+
+character(len = 129) :: errstring
+
+interface operator(==); module procedure loc_eq; end interface
+interface operator(/=); module procedure loc_ne; end interface
+
+interface set_location
+ module procedure set_location_single
+ module procedure set_location_array
+end interface set_location
+
+contains
+
+!----------------------------------------------------------------------------
+
+subroutine initialize_module
+
+if (module_initialized) return
+
+call register_module(source, revision, revdate)
+module_initialized = .true.
+
+end subroutine initialize_module
+
+!----------------------------------------------------------------------------
+
+function get_dist(loc1, loc2, kind1, kind2)
+
+! Return the distance between 2 locations. Since this is a periodic
+! domain, the shortest distance may wrap around.
+
+type(location_type), intent(in) :: loc1, loc2
+integer, optional, intent(in) :: kind1, kind2
+real(r8) :: get_dist
+
+real(r8) :: x_dif, y_dif, z_dif
+
+if ( .not. module_initialized ) call initialize_module
+
+! Periodic domain, if distance is greater than half wraparound the other way.
+x_dif = abs(loc1%x - loc2%x)
+if (x_dif > 0.5_r8) x_dif = 1.0_r8 - x_dif
+y_dif = abs(loc1%y - loc2%y)
+if (y_dif > 0.5_r8) y_dif = 1.0_r8 - y_dif
+z_dif = abs(loc1%z - loc2%z)
+if (z_dif > 0.5_r8) z_dif = 1.0_r8 - z_dif
+
+get_dist = sqrt ( x_dif * x_dif + y_dif * y_dif + z_dif * z_dif)
+
+end function get_dist
+
+!---------------------------------------------------------------------------
+
+function loc_eq(loc1,loc2)
+
+! interface operator used to compare two locations.
+! Returns true only if all components are 'the same' to within machine
+! precision.
+
+type(location_type), intent(in) :: loc1, loc2
+logical :: loc_eq
+
+if ( .not. module_initialized ) call initialize_module
+
+loc_eq = .false.
+
+if ( abs(loc1%x - loc2%x ) > epsilon(loc1%x ) ) return
+if ( abs(loc1%y - loc2%y ) > epsilon(loc1%y ) ) return
+if ( abs(loc1%z - loc2%z ) > epsilon(loc1%z ) ) return
+
+loc_eq = .true.
+
+end function loc_eq
+
+!---------------------------------------------------------------------------
+
+function loc_ne(loc1,loc2)
+
+! interface operator used to compare two locations.
+! Returns true if locations are not identical to machine precision.
+
+type(location_type), intent(in) :: loc1, loc2
+logical :: loc_ne
+
+if ( .not. module_initialized ) call initialize_module
+
+loc_ne = (.not. loc_eq(loc1,loc2))
+
+end function loc_ne
+
+!---------------------------------------------------------------------------
+
+function get_location(loc)
+
+! Given a location type, return the x, y, z
+
+type(location_type), intent(in) :: loc
+real(r8), dimension(3) :: get_location
+
+if ( .not. module_initialized ) call initialize_module
+
+get_location(1) = loc%x
+get_location(2) = loc%y
+get_location(3) = loc%z
+
+end function get_location
+
+!----------------------------------------------------------------------------
+
+function set_location_single(x, y, z)
+
+! Given an x, y, z triplet, put the values into the location.
+
+real(r8), intent(in) :: x, y, z
+type (location_type) :: set_location_single
+
+if ( .not. module_initialized ) call initialize_module
+
+if(x < 0.0_r8 .or. x > 1.0_r8) then
+ write(errstring,*)'x (',x,') is not within range [0,1]'
+ call error_handler(E_ERR, 'set_location', errstring, source, revision, revdate)
+endif
+
+if(y < 0.0_r8 .or. y > 1.0_r8) then
+ write(errstring,*)'y (',y,') is not within range [0,1]'
+ call error_handler(E_ERR, 'set_location', errstring, source, revision, revdate)
+endif
+
+if(z < 0.0_r8 .or. z > 1.0_r8) then
+ write(errstring,*)'z (',z,') is not within range [0,1]'
+ call error_handler(E_ERR, 'set_location', errstring, source, revision, revdate)
+endif
+
+set_location_single%x = x
+set_location_single%y = y
+set_location_single%z = z
+
+end function set_location_single
+
+!----------------------------------------------------------------------------
+
+function set_location_array(list)
+
+! location semi-independent interface routine
+! given 3 float numbers, call the underlying set_location routine
+
+real(r8), intent(in) :: list(:)
+type (location_type) :: set_location_array
+
+if ( .not. module_initialized ) call initialize_module
+
+if (size(list) < 3) then
+ write(errstring,*)'requires 3 input values'
+ call error_handler(E_ERR, 'set_location', errstring, source, revision, revdate)
+endif
+
+set_location_array = set_location_single(list(1), list(2), list(3))
+
+end function set_location_array
+
+!----------------------------------------------------------------------------
+
+function set_location_missing()
+
+! fill in the contents to a known value.
+
+type (location_type) :: set_location_missing
+
+if ( .not. module_initialized ) call initialize_module
+
+set_location_missing%x = MISSING_R8
+set_location_missing%y = MISSING_R8
+set_location_missing%z = MISSING_R8
+
+end function set_location_missing
+
+!---------------------------------------------------------------------------
+
+function query_location(loc,attr)
+
+! Returns the value of the attribute
+!
+
+type(location_type), intent(in) :: loc
+character(len=*), optional, intent(in) :: attr
+real(r8) :: query_location
+
+if ( .not. module_initialized ) call initialize_module
+
+! see the long comment in this routine in the threed_sphere
+! module for warnings about compiler bugs before you change
+! this code.
+
+query_location = loc%x
+
+if (.not. present(attr)) return
+
+select case(attr)
+ case ('x','X')
+ query_location = loc%x
+ case ('y','Y')
+ query_location = loc%y
+ case ('z','Z')
+ query_location = loc%z
+ case default
+ call error_handler(E_ERR, 'query_location; threed', &
+ 'Only x, y, or z are legal attributes to request from location', source, revision, revdate)
+end select
+
+end function query_location
+
+!----------------------------------------------------------------------------
+
+subroutine write_location(locfile, loc, fform, charstring)
+
+! Writes a 3D location to the file.
+! additional functionality: if optional argument charstring is specified,
+! it must be long enough to hold the string, and the location information is
+! written into it instead of to a file. fform must be ascii (which is the
+! default if not specified) to use this option.
+
+integer, intent(in) :: locfile
+type(location_type), intent(in) :: loc
+character(len = *), intent(in), optional :: fform
+character(len = *), intent(out), optional :: charstring
+
+integer :: charlength
+logical :: writebuf
+
+! 10 format(1x,2(f22.14,1x)) ! old
+10 format(1X,3(F20.16,1X))
+
+if ( .not. module_initialized ) call initialize_module
+
+! writing to a file (normal use) or to a character buffer?
+writebuf = present(charstring)
+
+! output file; test for ascii or binary, write what's asked, and return
+if (.not. writebuf) then
+ if (ascii_file_format(fform)) then
+ write(locfile, '(''loc3D'')' )
+ write(locfile, 10) loc%x, loc%y, loc%z
+ else
+ write(locfile) loc%x, loc%y, loc%z
+ endif
+ return
+endif
+
+! you only get here if you're writing to a buffer and not
+! to a file, and you can't have binary format set.
+if (.not. ascii_file_format(fform)) then
+ call error_handler(E_ERR, 'write_location', &
+ 'Cannot use string buffer with binary format', &
+ source, revision, revdate)
+endif
+
+! format the location to be more human-friendly; which in
+! this case doesn't change the value.
+
+! this must be the sum of the formats below.
+charlength = 38
+
+if (len(charstring) < charlength) then
+ write(errstring, *) 'charstring buffer must be at least ', charlength, ' chars long'
+ call error_handler(E_ERR, 'write_location', errstring, source, revision, revdate)
+endif
+
+write(charstring, '(A,F9.7,2(2X,F9.7))') 'X/Y/Z: ', loc%x, loc%y, loc%z
+
+
+end subroutine write_location
+
+!----------------------------------------------------------------------------
+
+function read_location(locfile, fform)
+
+! Reads a 3D location from locfile that was written by write_location.
+! See write_location for additional discussion.
+
+integer, intent(in) :: locfile
+type(location_type) :: read_location
+character(len = *), intent(in), optional :: fform
+
+character(len=5) :: header
+
+if ( .not. module_initialized ) call initialize_module
+
+if (ascii_file_format(fform)) then
+ read(locfile, '(a5)' ) header
+ if(header /= 'loc3D') then
+ write(errstring,*)'Expected location header "loc3D" in input file, got ', header
+ call error_handler(E_ERR, 'read_location', errstring, source, revision, revdate)
+ endif
+ ! Now read the location data value
+ read(locfile, *) read_location%x, read_location%y, read_location%z
+else
+ read(locfile) read_location%x, read_location%y, read_location%z
+endif
+
+end function read_location
+
+!--------------------------------------------------------------------------
+
+subroutine interactive_location(location, set_to_default)
+
+! Allows for interactive input of a location. Also gives option of selecting
+! a uniformly distributed random location.
+
+type(location_type), intent(out) :: location
+logical, intent(in), optional :: set_to_default
+
+real(r8) :: v(3)
+character(len=1) :: l(3)
+integer :: i
+
+if ( .not. module_initialized ) call initialize_module
+
+! If set_to_default is true, then just zero out and return
+if(present(set_to_default)) then
+ if(set_to_default) then
+ location%x = 0.0
+ location%y = 0.0
+ location%z = 0.0
+ return
+ endif
+endif
+
+l(1) = 'X'
+l(2) = 'Y'
+l(3) = 'Z'
+
+do i=1, 3
+ write(*, *) 'Input ', l(i), ' location for this obs: value 0 to 1 or a negative number for '
+ write(*, *) 'Uniformly distributed random location'
+ read(*, *) v(i)
+
+ do while(v(i) > 1.0_r8)
+ write(*, *) 'Input value greater than 1.0 is illegal, please try again'
+ read(*, *) v(i)
+ end do
+
+ if(v(i) < 0.0_r8) then
+
+ ! Need to make sure random sequence is initialized
+
+ if(.not. ran_seq_init) then
+ call init_random_seq(ran_seq)
+ ran_seq_init = .TRUE.
+ endif
+
@@ Diff output truncated at 40000 characters. @@
From nancy at ucar.edu Mon Apr 9 11:12:45 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 09 Apr 2012 11:12:45 -0600
Subject: [Dart-dev] [5674]
DART/branches/development/models/forced_lorenz_96/work/ workshop_setup.csh:
tim's changes to the workshop setup script to match
Message-ID:
Revision: 5674
Author: nancy
Date: 2012-04-09 11:12:45 -0600 (Mon, 09 Apr 2012)
Log Message:
-----------
tim's changes to the workshop setup script to match
documentation for the forced lorenz model.
Modified Paths:
--------------
DART/branches/development/models/forced_lorenz_96/work/workshop_setup.csh
-------------- next part --------------
Modified: DART/branches/development/models/forced_lorenz_96/work/workshop_setup.csh
===================================================================
--- DART/branches/development/models/forced_lorenz_96/work/workshop_setup.csh 2012-04-09 17:11:37 UTC (rev 5673)
+++ DART/branches/development/models/forced_lorenz_96/work/workshop_setup.csh 2012-04-09 17:12:45 UTC (rev 5674)
@@ -87,23 +87,37 @@
endsw
end
+#----------------------------------------------------------------------
+# Tutorial section 20 states that perfect_model_obs has forcing
+# fixed at 8.0, and can vary after that.
+#----------------------------------------------------------------------
+
+echo '/model_nml/' >! ex_script
+echo '/ forcing ' >> ex_script
+echo 's;=.*;= 8.0,;' >> ex_script
+echo '/reset_forcing/' >> ex_script
+echo 's;=.*;= .true.,;' >> ex_script
+echo 'wq' >> ex_script
+
+cat ex_script | ex input.nml || exit 30
+
@ n = $n + 1
./perfect_model_obs || exit $n
#----------------------------------------------------------------------
# For forced L96, we want to allow filter to assimilate forcing.
-# Use vi to change value of reset_forcing in namelist.
+# Use ex to change value of reset_forcing in namelist.
#----------------------------------------------------------------------
-echo ':0' >! vi_script
-echo '/reset_forcing' >> vi_script
-echo ':s/true/false/' >> vi_script
-echo ':wq' >> vi_script
-(vi -s vi_script -e input.nml > /dev/null) || exit 98
+echo '/model_nml/' >! ex_script
+echo '/reset_forcing/' >> ex_script
+echo 's;=.*;= .false.,;' >> ex_script
+echo 'wq' >> ex_script
+cat ex_script | ex input.nml || exit 31
@ n = $n + 1
./filter || exit $n
-\rm -f vi_script
+\rm -f ex_script
exit 0
From nancy at ucar.edu Mon Apr 9 11:18:54 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 09 Apr 2012 11:18:54 -0600
Subject: [Dart-dev] [5675]
DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90: Move ' edge
normal speed' for maps into an unused slot
Message-ID:
Revision: 5675
Author: nancy
Date: 2012-04-09 11:18:54 -0600 (Mon, 09 Apr 2012)
Log Message:
-----------
Move 'edge normal speed' for maps into an unused slot
for kinds in the development version.
Modified Paths:
--------------
DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
Property Changed:
----------------
DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
-------------- next part --------------
Modified: DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
===================================================================
--- DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90 2012-04-09 17:12:45 UTC (rev 5674)
+++ DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90 2012-04-09 17:18:54 UTC (rev 5675)
@@ -166,6 +166,10 @@
KIND_INFRARED_BRIGHT_TEMP = 61, &
KIND_LANDMASK = 62
+! kind for unstructured grids
+integer, parameter, public :: &
+ KIND_EDGE_NORMAL_SPEED = 63
+
! kinds for planetary remote sensing (wglawson, c.lee)
integer, parameter, public :: &
KIND_SKIN_TEMPERATURE = 70, &
@@ -215,7 +219,7 @@
KIND_DUST = 97, &
KIND_SMOKE = 98, &
KIND_SEASALT = 99
-
+
! kinds for ZVD (advanced microphysics)
integer, parameter, public ::&
KIND_HAIL_MIXING_RATIO = 100, &
@@ -414,6 +418,7 @@
obs_kind_names(60) = obs_kind_type(KIND_INFRARED_RADIANCE, 'KIND_INFRARED_RADIANCE')
obs_kind_names(61) = obs_kind_type(KIND_INFRARED_BRIGHT_TEMP, 'KIND_INFRARED_BRIGHT_TEMP')
obs_kind_names(62) = obs_kind_type(KIND_LANDMASK, 'KIND_LANDMASK')
+obs_kind_names(63) = obs_kind_type(KIND_EDGE_NORMAL_SPEED, 'KIND_EDGE_NORMAL_SPEED')
obs_kind_names(70) = obs_kind_type(KIND_SKIN_TEMPERATURE, 'KIND_SKIN_TEMPERATURE')
obs_kind_names(71) = obs_kind_type(KIND_NADIR_RADIANCE, 'KIND_NADIR_RADIANCE')
Property changes on: DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/releases/Kodiak/obs_kind/DEFAULT_obs_kind_mod.F90:5020-5663
/DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90:4680-5662
+ /DART/branches/mpas/obs_kind/DEFAULT_obs_kind_mod.F90:5183-5672
/DART/releases/Kodiak/obs_kind/DEFAULT_obs_kind_mod.F90:5020-5663
/DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90:4680-5662
From nancy at ucar.edu Mon Apr 9 11:50:48 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 09 Apr 2012 11:50:48 -0600
Subject: [Dart-dev] [5676] DART/branches/development/models/template: start
to flesh out a full example/template directory.
Message-ID:
Revision: 5676
Author: nancy
Date: 2012-04-09 11:50:48 -0600 (Mon, 09 Apr 2012)
Log Message:
-----------
start to flesh out a full example/template directory. the original
1d-based, simplistic model_mod needs to remain because it is compiled
into generic tools which require a model_mod to satisfy the subroutine
names but is never actually called. the 'full_model_mod.f90' file
is the start of an example full 3d geophysical model interface file,
along with the normal utilities we support.
Added Paths:
-----------
DART/branches/development/models/template/README
DART/branches/development/models/template/dart_to_model.f90
DART/branches/development/models/template/full_model_mod.f90
DART/branches/development/models/template/model_mod_check.f90
DART/branches/development/models/template/model_to_dart.f90
DART/branches/development/models/template/trans_time.f90
DART/branches/development/models/template/work/mkmf_dart_to_model
DART/branches/development/models/template/work/mkmf_model_mod_check
DART/branches/development/models/template/work/mkmf_model_to_dart
DART/branches/development/models/template/work/mkmf_trans_time
DART/branches/development/models/template/work/path_names_dart_to_model
DART/branches/development/models/template/work/path_names_model_mod_check
DART/branches/development/models/template/work/path_names_model_to_dart
DART/branches/development/models/template/work/path_names_trans_time
Removed Paths:
-------------
DART/branches/development/models/template/utils/
-------------- next part --------------
Copied: DART/branches/development/models/template/README (from rev 5672, DART/branches/mpas/models/template/README)
===================================================================
--- DART/branches/development/models/template/README (rev 0)
+++ DART/branches/development/models/template/README 2012-04-09 17:50:48 UTC (rev 5676)
@@ -0,0 +1,135 @@
+
+Hints for porting a new model to DART:
+
+copy this template directory into a DART/models/xxx
+directory for your new model.
+
+if the coordinate system for the model is 1d, you're ok as-is.
+if model coordinates are 3d, edit the work/path_names_* files
+and change location/oned/* to location/threed_sphere/*
+
+if your model is closer to the simpler examples (e.g. lorenz),
+the existing model_mod.f90 is a good place to start.
+if your model is a full 3d geophysical one (e.g. like cam, pop, etc)
+then rename full_model_mod.f90 to model_mod.f90 and start there.
+
+edit all the work/path_names_* files and change models/template/xxx
+to use the name of the directory for your model.
+
+try ./quickbuild.csh and everything should compile at this point.
+
+the required subroutines are these:
+public :: get_model_size, &
+ adv_1step, &
+ get_state_meta_data, &
+ model_interpolate, &
+ get_model_time_step, &
+ end_model, &
+ static_init_model, &
+ init_time, &
+ init_conditions, &
+ nc_write_model_atts, &
+ nc_write_model_vars, &
+ pert_model_state, &
+ get_close_maxdist_init, &
+ get_close_obs_init, &
+ get_close_obs, &
+ ens_mean_for_model
+
+in addition, model_mod can contain subroutines that are used
+for other utility programs and we recommend at least the following
+routines be added to model_mod.f90:
+
+public :: model_file_to_dart_vector, & ! converter
+ dart_vector_to_model_file, & ! converter
+ get_gridsize, & ! called by everyone
+ get_model_filename, & ! called by both (set_model_filename?)
+ get_state_time, & ! model_to_sv, static_init_model
+ set_state_time !(?) ! sv_to_model, trans_time
+
+
+edit the model mod and fill in the routines in this order:
+
+1. static_init_model() - make it read in the grid information
+ and the number of variables that will be in the state vector
+ (fill in the progvar derived type). fill in the model_size
+ variable. as part of this work, fill in the get_gridsize()
+ code.
+
+ after number 1 is done, get_model_size() and
+ get_model_time_step() from the template should be ok as-is.
+
+2. model_file_to_dart_vector() - given a model data file, read in
+ the fields and put them into the 1D DART state vector. make
+ sure the order and values match the progvar array.
+
+3. dart_vector_to_model_file() - do the reverse of the previous step.
+
+4. get_state_meta_data() - given an index number into the state vector
+ return the location and type. the code which loops over the
+ progvar should already do the type, but code to compute what
+ lon, lat, and vertical (for a 3d model) or x location (1d)
+ corresponds to this item must be written.
+
+5. model_interpolate() - given a location (lon/lat/vert in 3d, x in 1d)
+ and a state KIND_xxx kind, return the interpolated value the field
+ has at that location. this is probably one of the routines that
+ will take the most code to write.
+
+6. nc_write_model_atts(), nc_write_model_vars() - when filter runs
+ it calls these routines to output model data into a netcdf diagnostic
+ file which is unrelated to the model data files. it is possible to
+ have the ensemble data just be dumped as a single 1D vector but
+ that makes the files less useful. generally it's most useful to
+ put the grid info and dump each variable from the state vector
+ into a separate netcdf variable. the diagnostic files contain the
+ ensemble mean, the ensemble stddev, the inflation information, and
+ then optionally some or all of the individual ensemble members.
+
+for now, ignore these routines:
+ get_close_maxdist_init()
+ get_close_obs_init()
+ get_close_obs()
+ ens_mean_for_model()
+ end_model()
+
+if you have data in a dart initial condition/restart file, then you
+can ignore these routines:
+ init_time()
+ init_conditions()
+otherwise, have them return an initial time and an initial default
+ensemble state.
+
+if your model is NOT subroutine callable, you can ignore this routine:
+ adv_1step()
+otherwise have it call the interface to your model and add the files
+necessary to build your model to all the work/path_names_* files.
+add the model source to a src/ directory.
+
+if you want to let filter add gaussian noise to a single state vector
+to generate an ensemble, you can ignore this routine
+ pert_model_state()
+otherwise fill in code that does whatever perturbation makes sense
+to have an initial ensemble of states. in some cases that means
+adding a different range of values to each different field in the
+state vector.
+
+at this point you should have enough code to test and run simple
+experiments. the 'model_mod_check' utility program can be used
+during this process to check your implementation.
+
+the general flow is:
+
+ ./model_to_dart - read model data and convert it into a dart state vector file
+ ./create_obs_sequence - make a file with a single observation in it
+ ./perfect_model_obs - should interpolate a value for the obs
+ ./dart_to_model - convert the dart vector back into a model data file
+
+ generate an ensemble of states, or set 'start_from_restart' to .false.
+ run ./filter with the single observation
+ look at the Prior_Diag.nc and Posterior_Diag.nc files
+ diff them with ncdiff: ncdiff Posterior_Diag.nc Prior_Diag.nc Innov.nc
+ plot it, with ncview if possible: ncview Innov.nc
+ the difference between the two is the impact of that single observation
+ see if it's at the right location and if the differences seem reasonable
+
Copied: DART/branches/development/models/template/dart_to_model.f90 (from rev 5672, DART/branches/mpas/models/template/dart_to_model.f90)
===================================================================
--- DART/branches/development/models/template/dart_to_model.f90 (rev 0)
+++ DART/branches/development/models/template/dart_to_model.f90 2012-04-09 17:50:48 UTC (rev 5676)
@@ -0,0 +1,191 @@
+! DART software - Copyright 2004 - 2011 UCAR. This open source software is
+! provided by UCAR, "as is", without charge, subject to all terms of use at
+! http://www.image.ucar.edu/DAReS/DART/DART_download
+
+program dart_to_model
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
+!----------------------------------------------------------------------
+! purpose: interface between DART and the model model
+!
+! method: Read DART state vector and overwrite values in a model restart file.
+! If the DART state vector has an 'advance_to_time' present, a
+! file called model_in.DART is created with a time_manager_nml namelist
+! appropriate to advance model to the requested time.
+!
+! The dart_to_model_nml namelist setting for advance_time_present
+! determines whether or not the input file has an 'advance_to_time'.
+! Typically, only temporary files like 'assim_model_state_ic' have
+! an 'advance_to_time'.
+!
+! author: Tim Hoar 25 Jun 09, revised 12 July 2010
+!----------------------------------------------------------------------
+
+use types_mod, only : r8
+use utilities_mod, only : initialize_utilities, timestamp, &
+ find_namelist_in_file, check_namelist_read, &
+ logfileunit, open_file, close_file
+use assim_model_mod, only : open_restart_read, aread_state_restart, close_restart
+use time_manager_mod, only : time_type, print_time, print_date, operator(-), &
+ get_time, get_date
+use model_mod, only : static_init_model, sv_to_restart_file, &
+ get_model_size, get_base_time, get_model_restart_dirname
+
+implicit none
+
+! version controlled file description for error handling, do not edit
+character(len=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
+
+!------------------------------------------------------------------
+! The namelist variables
+!------------------------------------------------------------------
+
+character (len = 128) :: dart_to_model_input_file = 'dart.ic'
+logical :: advance_time_present = .false.
+character(len=256) :: model_restart_dirname = 'model_restartdir'
+
+namelist /dart_to_model_nml/ dart_to_model_input_file, &
+ advance_time_present, &
+ model_restart_dirname
+
+!----------------------------------------------------------------------
+
+integer :: iunit, io, x_size, diff1, diff2
+type(time_type) :: model_time, adv_to_time, base_time
+real(r8), allocatable :: statevector(:)
+logical :: verbose = .FALSE.
+
+!----------------------------------------------------------------------
+
+call initialize_utilities(progname='dart_to_model', output_flag=verbose)
+
+!----------------------------------------------------------------------
+! Call model_mod:static_init_model() which reads the model namelists
+! to set grid sizes, etc.
+!----------------------------------------------------------------------
+
+call static_init_model()
+
+x_size = get_model_size()
+allocate(statevector(x_size))
+
+! Read the namelist to get the input dirname.
+
+call find_namelist_in_file("input.nml", "dart_to_model_nml", iunit)
+read(iunit, nml = dart_to_model_nml, iostat = io)
+call check_namelist_read(iunit, io, "dart_to_model_nml")
+
+write(*,*)
+write(*,*) 'dart_to_model: converting DART file ', "'"//trim(dart_to_model_input_file)//"'"
+write(*,*) 'to model restart files in directory ', "'"//trim(model_restart_dirname)//"'"
+
+!----------------------------------------------------------------------
+! Reads the valid time, the state, and the target time.
+!----------------------------------------------------------------------
+
+iunit = open_restart_read(dart_to_model_input_file)
+
+if ( advance_time_present ) then
+ call aread_state_restart(model_time, statevector, iunit, adv_to_time)
+else
+ call aread_state_restart(model_time, statevector, iunit)
+endif
+call close_restart(iunit)
+
+print *, 'read state vector'
+!----------------------------------------------------------------------
+! update the current model state vector
+! Convey the amount of time to integrate the model ...
+! time_manager_nml: stop_option, stop_count increments
+!----------------------------------------------------------------------
+
+print *, 'calling sv to restart file'
+call sv_to_restart_file(statevector, model_restart_dirname, model_time)
+
+if ( advance_time_present ) then
+ call write_model_time_control(model_time, adv_to_time)
+endif
+
+!----------------------------------------------------------------------
+! Log what we think we're doing, and exit.
+!----------------------------------------------------------------------
+
+call print_date( model_time,'dart_to_model:model model date')
+call print_time( model_time,'dart_to_model:DART model time')
+call print_date( model_time,'dart_to_model:model model date',logfileunit)
+call print_time( model_time,'dart_to_model:DART model time',logfileunit)
+
+if ( advance_time_present ) then
+call print_time(adv_to_time,'dart_to_model:advance_to time')
+call print_date(adv_to_time,'dart_to_model:advance_to date')
+call print_time(adv_to_time,'dart_to_model:advance_to time',logfileunit)
+call print_date(adv_to_time,'dart_to_model:advance_to date',logfileunit)
+endif
+
+! When called with 'end', timestamp will call finalize_utilities()
+call timestamp(string1=source, pos='end')
+
+!======================================================================
+contains
+!======================================================================
+
+subroutine write_model_time_control(model_time, adv_to_time)
+! The idea is to write a text file with the following structure:
+!
+!#TIMESTART
+!2003 year
+!06 month
+!21 day
+!00 hour
+!00 minute
+!00 second
+!
+!#TIMEEND
+!2003 year
+!07 month
+!21 day
+!00 hour
+!00 minute
+!00 second
+!
+
+type(time_type), intent(in) :: model_time, adv_to_time
+integer :: iyear,imonth,iday,ihour,imin,isec
+
+iunit = open_file('DART_model_time_control.txt', action='write')
+write(iunit,*)
+
+call get_date(model_time,iyear,imonth,iday,ihour,imin,isec)
+write(iunit,'(''#TIMESTART'')')
+write(iunit,'(i4.4,10x,''year'' )')iyear
+write(iunit,'(i2.2,12x,''month'' )')imonth
+write(iunit,'(i2.2,12x,''day'' )')iday
+write(iunit,'(i2.2,12x,''hour'' )')ihour
+write(iunit,'(i2.2,12x,''minute'')')imin
+write(iunit,'(i2.2,12x,''second'')')isec
+write(iunit,*)
+
+call get_date(adv_to_time,iyear,imonth,iday,ihour,imin,isec)
+write(iunit,'(''#TIMEEND'')')
+write(iunit,'(i4.4,10x,''year'' )')iyear
+write(iunit,'(i2.2,12x,''month'' )')imonth
+write(iunit,'(i2.2,12x,''day'' )')iday
+write(iunit,'(i2.2,12x,''hour'' )')ihour
+write(iunit,'(i2.2,12x,''minute'')')imin
+write(iunit,'(i2.2,12x,''second'')')isec
+write(iunit,*)
+
+call close_file(iunit)
+end subroutine write_model_time_control
+
+
+
+end program dart_to_model
Copied: DART/branches/development/models/template/full_model_mod.f90 (from rev 5672, DART/branches/mpas/models/template/full_model_mod.f90)
===================================================================
--- DART/branches/development/models/template/full_model_mod.f90 (rev 0)
+++ DART/branches/development/models/template/full_model_mod.f90 2012-04-09 17:50:48 UTC (rev 5676)
@@ -0,0 +1,3202 @@
+! DART software - Copyright 2004 - 2011 UCAR. This open source software is
+! provided by UCAR, "as is", without charge, subject to all terms of use at
+! http://www.image.ucar.edu/DAReS/DART/DART_download
+
+module model_mod
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
+! This is the interface between the model model and DART.
+
+! Modules that are absolutely required for use are listed
+use types_mod, only : r4, r8, digits12, SECPERDAY, MISSING_R8, &
+ rad2deg, deg2rad, PI
+use time_manager_mod, only : time_type, set_time, set_date, get_date, get_time,&
+ print_time, print_date, set_calendar_type, &
+ operator(*), operator(+), operator(-), &
+ operator(>), operator(<), operator(/), &
+ operator(/=), operator(<=)
+
+use location_mod, only : location_type, get_dist, query_location, &
+ get_close_maxdist_init, get_close_type, &
+ set_location, get_location, horiz_dist_only, &
+ vert_is_undef, VERTISUNDEF, &
+ vert_is_surface, VERTISSURFACE, &
+ vert_is_level, VERTISLEVEL, &
+ vert_is_pressure, VERTISPRESSURE, &
+ vert_is_height, VERTISHEIGHT, &
+ get_close_obs_init, loc_get_close_obs => get_close_obs
+
+use utilities_mod, only : register_module, error_handler, &
+ E_ERR, E_WARN, E_MSG, logfileunit, get_unit, &
+ nc_check, do_output, to_upper, &
+ find_namelist_in_file, check_namelist_read, &
+ open_file, file_exist, find_textfile_dims, &
+ file_to_text, close_file
+
+use obs_kind_mod, only : paramname_length, &
+ get_raw_obs_kind_index, &
+ get_raw_obs_kind_name
+
+use mpi_utilities_mod, only: my_task_id
+
+use random_seq_mod, only: random_seq_type, init_random_seq, random_gaussian
+
+use dart_model_mod, only: get_model_nLons, get_model_nLats, get_model_nAlts, &
+ get_nSpecies, get_nSpeciesTotal, get_nIons, &
+ get_nSpeciesAll, decode_model_indices
+
+use typesizes
+use netcdf
+
+implicit none
+private
+
+! these routines must be public and you cannot change
+! the arguments - they will be called *from* the DART code.
+public :: get_model_size, &
+ adv_1step, &
+ get_state_meta_data, &
+ model_interpolate, &
+ get_model_time_step, &
+ static_init_model, &
+ end_model, &
+ init_time, &
+ init_conditions, &
+ nc_write_model_atts, &
+ nc_write_model_vars, &
+ pert_model_state, &
+ get_close_maxdist_init, &
+ get_close_obs_init, &
+ get_close_obs, &
+ ens_mean_for_model
+
+! generally useful routines for various support purposes.
+! the interfaces here can be changed as appropriate.
+
+public :: get_gridsize, &
+ restart_file_to_statevector, &
+ statevector_to_restart_file, &
+ get_model_restart_dirname, &
+ get_base_time, &
+ get_state_time
+
+! version controlled file description for error handling, do not edit
+
+character(len=128), parameter :: &
+ source = '$URL$', &
+ revision = '$Revision$', &
+ revdate = '$Date$'
+
+character(len=256) :: string1, string2
+logical, save :: module_initialized = .false.
+
+! Storage for a random sequence for perturbing a single initial state
+
+type(random_seq_type) :: random_seq
+
+! things which can/should be in the model_nml
+
+integer :: assimilation_period_days = 0
+integer :: assimilation_period_seconds = 60
+real(r8) :: model_perturbation_amplitude = 0.2
+logical :: output_state_vector = .true.
+integer :: debug = 0 ! turn up for more and more debug messages
+character(len=32) :: calendar = 'Gregorian'
+character(len=256) :: model_restart_dirname = 'model_restartdir'
+
+namelist /model_nml/ &
+ model_restart_dirname, &
+ output_state_vector, &
+ assimilation_period_days, & ! for now, this is the timestep
+ assimilation_period_seconds, &
+ model_perturbation_amplitude,&
+ calendar, &
+ debug
+
+!------------------------------------------------------------------
+!
+! The DART state vector may consist of things like:
+!
+! U long_name = "X-WIND COMPONENT" float U(TIME, ALT, LAT, XE)
+! V long_name = "Y-WIND COMPONENT" float V(TIME, ALT, YE, LON)
+! W long_name = "Z-WIND COMPONENT" float W(TIME, ZE, LAT, LON)
+! TH long_name = "POTENTIAL TEMPERATURE" float TH(TIME, ALT, LAT, LON)
+! DBZ long_name = "RADAR REFLECTIVITY" float DBZ(TIME, ALT, LAT, LON)
+! WZ long_name = "VERTICAL VORTICITY" float WZ(TIME, ALT, LAT, LON)
+! PI long_name = "PERT. EXNER" float PI(TIME, ALT, LAT, LON)
+! QV long_name = "VAPOR MIXING RATIO" float QV(TIME, ALT, LAT, LON)
+! QC long_name = "CLOUD MIXING RATIO" float QC(TIME, ALT, LAT, LON)
+! QR long_name = "RAIN MIXING RATIO" float QR(TIME, ALT, LAT, LON)
+! QI long_name = "ICE MIXING RATIO" float QI(TIME, ALT, LAT, LON)
+! QS long_name = "SNOW MIXING RATIO" float QS(TIME, ALT, LAT, LON)
+! QH long_name = "GRAUPEL MIXING RATIO" float QH(TIME, ALT, LAT, LON)
+!
+! The variables in the model restart file that are used to create the
+! DART state vector are specified in the input.nml:model_vars_nml namelist.
+!
+!------------------------------------------------------------------
+
+integer, parameter :: max_state_variables = 80
+integer, parameter :: num_state_table_columns = 2
+character(len=NF90_MAX_NAME) :: model_state_variables(max_state_variables * num_state_table_columns ) = ' '
+character(len=NF90_MAX_NAME) :: variable_table(max_state_variables, num_state_table_columns )
+
+namelist /model_vars_nml/ model_state_variables
+
+integer :: nfields
+
+! Everything needed to describe a variable
+
+type progvartype
+ private
+ character(len=NF90_MAX_NAME) :: varname ! crazy species name
+ character(len=NF90_MAX_NAME) :: long_name
+ character(len=NF90_MAX_NAME) :: units
+ character(len=NF90_MAX_NAME) :: storder
+ character(len=NF90_MAX_NAME) :: model_varname ! NDensityS, IDensityS, ...
+ integer :: model_dim ! dimension defining species
+ integer :: model_index ! 'iSpecies' or u,v,w ...
+ integer, dimension(NF90_MAX_VAR_DIMS) :: dimlens ! nlons, nlats, nalts [, nspecies]
+ integer :: posdef
+ integer :: numdims
+ integer :: varsize ! prod(dimlens(1:numdims))
+ integer :: index1 ! location in dart state vector of first occurrence
+ integer :: indexN ! location in dart state vector of last occurrence
+ integer :: dart_kind
+ character(len=paramname_length) :: kind_string
+end type progvartype
+
+type(progvartype), dimension(max_state_variables) :: progvar
+
+! These are statically defined in ModSize.f90 ...
+! nAlts is the one and only number of altitudes ... no block-dependence
+! nLons, nLats are the number of lons/lats PER block
+! the number of blocks comes from UAM.in
+
+integer :: nLons, nLats, nAlts
+
+! "... keep in mind that if the model resolution is 5 deg latitude,
+! the model will actually go from -87.5 to 87.5 latitude
+! (even though you specify -90 to 90 in the UAM.in file),
+! since the latitudes/longitudes are at cell centers,
+! while the edges are at the boundaries." -- Aaron Ridley
+
+integer :: NgridLon=-1, NgridLat=-1, NgridAlt=-1 ! scalar grid counts
+integer :: nBlocksLon=-1, nBlocksLat=-1 ! number of blocks along each dim
+real(r8) :: LatStart=MISSING_R8, LatEnd=MISSING_R8, LonStart=MISSING_R8
+integer :: nSpeciesTotal=-1, nSpecies=-1, nIons=-1, nSpeciesAll=-1
+
+! scalar grid positions
+
+real(r8), allocatable :: LON(:) ! longitude centers
+real(r8), allocatable :: LAT(:) ! latitude centers
+real(r8), allocatable :: ALT(:) ! vertical level centers
+
+integer :: model_size ! the state vector length
+type(time_type) :: model_time ! valid time of the model state
+type(time_type) :: model_timestep ! smallest time to adv model
+real(r8), allocatable :: ens_mean(:) ! may be needed for forward ops
+
+! set this to true if you want to print out the current time
+! after each N observations are processed, for benchmarking.
+
+logical :: print_timestamps = .false.
+integer :: print_every_Nth = 10000
+
+integer, parameter :: nGhost = 2 ! number of ghost cells on all edges
+
+!------------------------------------------------------------------
+! The model restart manager namelist variables
+!------------------------------------------------------------------
+
+character(len= 64) :: ew_boundary_type, ns_boundary_type
+
+INTERFACE vector_to_prog_var
+ MODULE PROCEDURE vector_to_1d_prog_var
+ MODULE PROCEDURE vector_to_2d_prog_var
+ MODULE PROCEDURE vector_to_3d_prog_var
+ MODULE PROCEDURE vector_to_4d_prog_var
+END INTERFACE
+
+INTERFACE get_base_time
+ MODULE PROCEDURE get_base_time_ncid
+ MODULE PROCEDURE get_base_time_fname
+END INTERFACE
+
+INTERFACE get_index_range
+ MODULE PROCEDURE get_index_range_string
+ MODULE PROCEDURE get_index_range_int
+END INTERFACE
+
+contains
+
+!==================================================================
+! All the REQUIRED interfaces come first - just by convention.
+!==================================================================
+
+
+function get_model_size()
+!------------------------------------------------------------------
+! Done - TJH.
+! Returns the size of the model as an integer.
+! Required for all applications.
+
+integer :: get_model_size
+
+if ( .not. module_initialized ) call static_init_model
+
+get_model_size = model_size
+
+end function get_model_size
+
+
+
+subroutine adv_1step(x, time)
+!------------------------------------------------------------------
+! Done - TJH.
+! Does a single timestep advance of the model. The input value of
+! the vector x is the starting condition and x is updated to reflect
+! the changed state after a timestep. The time argument is intent
+! in and is used for models that need to know the date/time to
+! compute a timestep, for instance for radiation computations.
+! This interface is only called IF the namelist parameter
+! async is set to 0 in perfect_model_obs or filter -OR- if the
+! program integrate_model is to be used to advance the model
+! state as a separate executable. If none of these options
+! are used (the model will only be advanced as a separate
+! model-specific executable), this can be a NULL INTERFACE.
+
+real(r8), intent(inout) :: x(:)
+type(time_type), intent(in) :: time
+
+if ( .not. module_initialized ) call static_init_model
+
+if (do_output()) then
+ call print_time(time,'NULL interface adv_1step (no advance) DART time is')
+ call print_time(time,'NULL interface adv_1step (no advance) DART time is',logfileunit)
+endif
+
+! FIXME: put an error handler call here - we cannot advance the model
+! this way and it would be an error if filter called it.
+
+end subroutine adv_1step
+
+
+
+subroutine get_state_meta_data(index_in, location, var_type)
+!------------------------------------------------------------------
+! Done - JLA.
+! given an index into the state vector, return its location and
+! if given, the var kind. despite the name, var_type is a generic
+! kind, like those in obs_kind/obs_kind_mod.f90, starting with KIND_
+
+integer, intent(in) :: index_in
+type(location_type) :: location
+integer, optional, intent(out) :: var_type
+
+! Local variables
+
+integer :: lat_index, lon_index, alt_index
+integer :: n, nf, myindx, remainder, remainder2
+
+if ( .not. module_initialized ) call static_init_model
+
+! Find out which of the 3D fields index_in is part of
+nf = -1
+
+FindIndex : do n = 1,nfields
+ if( (progvar(n)%index1 <= index_in) .and. (index_in <= progvar(n)%indexN) ) then
+ nf = n
+ myindx = index_in - progvar(n)%index1 + 1
+ exit FindIndex
+ endif
+enddo FindIndex
+
+if( myindx == -1 ) then
+ write(string1,*) 'Problem, cannot find base_offset, index_in is: ', index_in
+ call error_handler(E_ERR,'get_state_meta_data',string1,source,revision,revdate)
+endif
+
+alt_index = 1 + (myindx - 1) / (NgridLon * NgridLat)
+remainder = myindx - (alt_index-1) * NgridLon * NgridLat
+lat_index = 1 + (remainder - 1) / NgridLon
+remainder2 = remainder - (lat_index - 1) * NgridLon
+lon_index = remainder2
+
+location = set_location(LON(lon_index), LAT(lat_index), ALT(alt_index), VERTISHEIGHT)
+
+if (present(var_type)) then
+ var_type = progvar(nf)%dart_kind
+endif
+
+end subroutine get_state_meta_data
+
+
+
+function get_model_time_step()
+!------------------------------------------------------------------
+!
+! Returns the the time step of the model; the smallest increment
+! in time that the model is capable of advancing the state in a given
+! implementation. This interface is required for all applications.
+
+type(time_type) :: get_model_time_step
+
+if ( .not. module_initialized ) call static_init_model
+
+get_model_time_step = model_timestep
+
+end function get_model_time_step
+
+
+
+subroutine static_init_model()
+!------------------------------------------------------------------
+!
+! Called to do one time initialization of the model.
+!
+! All the grid information comes from the initialization of
+! the dart_model_mod module.
+
+! Local variables - all the important ones have module scope
+
+integer, dimension(NF90_MAX_VAR_DIMS) :: dimIDs
+character(len=NF90_MAX_NAME) :: varname
+character(len=paramname_length) :: kind_string
+integer :: ncid, VarID, numdims, dimlen, varsize
+integer :: iunit, io, ivar, i, index1, indexN
+integer :: ss, dd
+integer :: nDimensions, nVariables, nAttributes, unlimitedDimID, TimeDimID
+logical :: shapeok
+
+if ( module_initialized ) return ! only need to do this once.
+
+! Print module information to log file and stdout.
+call register_module(source, revision, revdate)
+
+! Since this routine calls other routines that could call this routine
+! we'll say we've been initialized pretty dang early.
+module_initialized = .true.
+
+! Read the DART namelist for this model
+call find_namelist_in_file('input.nml', 'model_nml', iunit)
+read(iunit, nml = model_nml, iostat = io)
+call check_namelist_read(iunit, io, 'model_nml')
+
+! Record the namelist values used for the run
+call error_handler(E_MSG,'static_init_model','model_nml values are',' ',' ',' ')
+if (do_output()) write(logfileunit, nml=model_nml)
+if (do_output()) write( * , nml=model_nml)
+
+! Get the model variables in a restricted scope setting.
+
+nLons = get_model_nLons()
+nLats = get_model_nLats()
+nAlts = get_model_nAlts()
+nSpecies = get_nSpecies()
+nSpeciesTotal = get_nSpeciesTotal()
+nIons = get_nIons()
+nSpeciesAll = get_nSpeciesAll()
+
+if ((debug > 0) .and. do_output() ) then
+ write(*,*)
+ write(*,*)'nLons is ',nLons
+ write(*,*)'nLats is ',nLats
+ write(*,*)'nAlts is ',nAlts
+ write(*,*)'nSpecies is ',nSpecies
+ write(*,*)'nSpeciesTotal is ',nSpeciesTotal
+ write(*,*)'nIons is ',nIons
+ write(*,*)'nSpeciesAll is ',nSpeciesAll
+endif
+
+! Read the model variable list to populate DART state vector
+! Once parsed, the values will be recorded for posterity
+call find_namelist_in_file('input.nml', 'model_vars_nml', iunit)
+read(iunit, nml = model_vars_nml, iostat = io)
+call check_namelist_read(iunit, io, 'model_vars_nml')
+
+!---------------------------------------------------------------
+! Set the time step ... causes model namelists to be read.
+! Ensures model_timestep is multiple of 'dynamics_timestep'
+
+call set_calendar_type( calendar ) ! comes from model_mod_nml
+
+model_timestep = set_model_time_step()
+
+call get_time(model_timestep,ss,dd) ! set_time() assures the seconds [0,86400)
+
+write(string1,*)'assimilation period is ',dd,' days ',ss,' seconds'
+call error_handler(E_MSG,'static_init_model',string1,source,revision,revdate)
+
+!---------------------------------------------------------------
+! 1) get grid dimensions
+! 2) allocate space for the grids
+! 3) read them from the block restart files, could be stretched ...
+
+call get_grid_info(NgridLon, NgridLat, NgridAlt, nBlocksLon, nBlocksLat, &
+ LatStart, LatEnd, LonStart)
+
+if( debug > 0 ) then
+ write(*,*)'grid dims are ',NgridLon,NgridLat,NgridAlt
+endif
+
+allocate( LON( NgridLon ))
+allocate( LAT( NgridLat ))
+allocate( ALT( NgridAlt ))
+
+call get_grid(model_restart_dirname, nBlocksLon, nBlocksLat, &
+ nLons, nLats, nAlts, LON, LAT, ALT )
+
+!---------------------------------------------------------------
+! Compile the list of model variables to use in the creation
+! of the DART state vector. Required to determine model_size.
+!
+! Verify all variables are in the model restart file
+!
+! Compute the offsets into the state vector for the start of each
+! different variable type. Requires reading shapes from the model
+! restart file. As long as TIME is the LAST dimension, we're OK.
+!
+! Record the extent of the data type in the state vector.
+
+call verify_state_variables( model_state_variables, ncid, model_restart_dirname, &
+ nfields, variable_table )
+
+index1 = 1;
+indexN = 0;
+
+do ivar = 1, nfields
+
+ varname = trim(variable_table(ivar,1))
+ kind_string = trim(variable_table(ivar,2))
+ progvar(ivar)%varname = varname
+ progvar(ivar)%kind_string = kind_string
+ progvar(ivar)%dart_kind = get_raw_obs_kind_index( progvar(ivar)%kind_string )
+ progvar(ivar)%dimlens = 0
+
+ ! I would really like decode_model_indices to set the following (on a per-variable basis)
+ ! progvar(ivar)%storder
+ ! progvar(ivar)%numdims
+ ! progvar(ivar)%dimlens
+
+ call decode_model_indices( varname, progvar(ivar)%model_varname, progvar(ivar)%model_dim, &
+ progvar(ivar)%model_index, progvar(ivar)%long_name, &
+ progvar(ivar)%units)
+
+ varsize = NgridLon * NgridLat * NgridAlt
+
+ progvar(ivar)%storder = 'xyz3d'
+ progvar(ivar)%numdims = 3
+ progvar(ivar)%dimlens(1:progvar(ivar)%numdims) = (/ NgridLon, NgridLat, NgridAlt /)
+ progvar(ivar)%varsize = varsize
+ progvar(ivar)%index1 = index1
+ progvar(ivar)%indexN = index1 + varsize - 1
+ index1 = index1 + varsize ! sets up for next variable
+
+ if ( debug > 0 ) then
+ write(logfileunit,*)
+ write(logfileunit,*) trim(progvar(ivar)%varname),' variable number ',ivar
+ write(logfileunit,*) ' storage ',trim(progvar(ivar)%storder)
+ write(logfileunit,*) ' long_name ',trim(progvar(ivar)%long_name)
+ write(logfileunit,*) ' units ',trim(progvar(ivar)%units)
+ write(logfileunit,*) ' numdims ',progvar(ivar)%numdims
+ write(logfileunit,*) ' dimlens ',progvar(ivar)%dimlens(1:progvar(ivar)%numdims)
+ write(logfileunit,*) ' varsize ',progvar(ivar)%varsize
+ write(logfileunit,*) ' index1 ',progvar(ivar)%index1
+ write(logfileunit,*) ' indexN ',progvar(ivar)%indexN
+ write(logfileunit,*) ' dart_kind ',progvar(ivar)%dart_kind
+ write(logfileunit,*) ' kind_string ',trim(progvar(ivar)%kind_string)
+ write(logfileunit,*) ' model_varname ',trim(progvar(ivar)%model_varname)
+ write(logfileunit,*) ' model_dim ',progvar(ivar)%model_dim
+ write(logfileunit,*) ' model_index ',progvar(ivar)%model_index
+
+ write( * ,*)
+ write( * ,*) trim(progvar(ivar)%varname),' variable number ',ivar
+ write( * ,*) ' storage ',trim(progvar(ivar)%storder)
+ write( * ,*) ' long_name ',trim(progvar(ivar)%long_name)
+ write( * ,*) ' units ',trim(progvar(ivar)%units)
+ write( * ,*) ' numdims ',progvar(ivar)%numdims
+ write( * ,*) ' dimlens ',progvar(ivar)%dimlens(1:progvar(ivar)%numdims)
+ write( * ,*) ' varsize ',progvar(ivar)%varsize
+ write( * ,*) ' index1 ',progvar(ivar)%index1
+ write( * ,*) ' indexN ',progvar(ivar)%indexN
+ write( * ,*) ' dart_kind ',progvar(ivar)%dart_kind
+ write( * ,*) ' kind_string ',trim(progvar(ivar)%kind_string)
+ write( * ,*) ' model_varname ',trim(progvar(ivar)%model_varname)
+ write( * ,*) ' model_dim ',progvar(ivar)%model_dim
+ write( * ,*) ' model_index ',progvar(ivar)%model_index
+ endif
+
+enddo
+
+model_size = progvar(nfields)%indexN
+
+if ( debug > 0 ) then
+ write(logfileunit,'("grid: NgridLon, NgridLat, NgridAlt =",3(1x,i5))') NgridLon, NgridLat, NgridAlt
+ write( * ,'("grid: NgridLon, NgridLat, NgridAlt =",3(1x,i5))') NgridLon, NgridLat, NgridAlt
+ write(logfileunit, *)'model_size = ', model_size
+ write( * , *)'model_size = ', model_size
+endif
+
+allocate( ens_mean(model_size) )
+
+end subroutine static_init_model
+
+
+
+subroutine end_model()
+!------------------------------------------------------------------
+!
+! Does any shutdown and clean-up needed for model. Can be a NULL
+! INTERFACE if the model has no need to clean up storage, etc.
+
+if (allocated(LON)) deallocate(LON, LAT, ALT)
+
+end subroutine end_model
+
+
+
+subroutine init_time(time)
+!------------------------------------------------------------------
+!
+! Companion interface to init_conditions. Returns a time that is somehow
+! appropriate for starting up a long integration of the model.
+! At present, this is only used if the namelist parameter
+! start_from_restart is set to .false. in the program perfect_model_obs.
+! If this option is not to be used in perfect_model_obs, or if no
+! synthetic data experiments using perfect_model_obs are planned,
+! this can be a NULL INTERFACE.
+
+type(time_type), intent(out) :: time
+
+if ( .not. module_initialized ) call static_init_model
+
+! for now, just set to 0
+time = set_time(0,0)
+
+! FIXME: put an error handler call here - we cannot initialize the model
+! this way and it would be an error if filter called it.
+
+end subroutine init_time
+
+
+
+subroutine init_conditions(x)
+!------------------------------------------------------------------
+!
+! Returns a model state vector, x, that is some sort of appropriate
+! initial condition for starting up a long integration of the model.
+! At present, this is only used if the namelist parameter
+! start_from_restart is set to .false. in the program perfect_model_obs.
+! If this option is not to be used in perfect_model_obs, or if no
+! synthetic data experiments using perfect_model_obs are planned,
+! this can be a NULL INTERFACE.
+
+real(r8), intent(out) :: x(:)
+
+if ( .not. module_initialized ) call static_init_model
+
+x = 0.0_r8
+
+! FIXME: put an error handler call here - we cannot initialize the model
+! this way and it would be an error if filter called it.
+
+end subroutine init_conditions
+
+
+
+function nc_write_model_atts( ncFileID ) result (ierr)
+!------------------------------------------------------------------
+! TJH -- Writes the model-specific attributes to a netCDF file.
+! This includes coordinate variables and some metadata, but NOT
+! the model state vector.
+!
+! assim_model_mod:init_diag_output uses information from the location_mod
+! to define the location dimension and variable ID. All we need to do
+! is query, verify, and fill ...
+!
+! Typical sequence for adding new dimensions,variables,attributes:
+! NF90_OPEN ! open existing netCDF dataset
+! NF90_redef ! put into define mode
+! NF90_def_dim ! define additional dimensions (if any)
+! NF90_def_var ! define variables: from name, type, and dims
+! NF90_put_att ! assign attribute values
+! NF90_ENDDEF ! end definitions: leave define mode
+! NF90_put_var ! provide values for variable
+! NF90_CLOSE ! close: save updated netCDF dataset
+
+integer, intent(in) :: ncFileID ! netCDF file identifier
+integer :: ierr ! return value of function
+
+integer :: nDimensions, nVariables, nAttributes, unlimitedDimID
+
+!----------------------------------------------------------------------
+! variables if we just blast out one long state vector
+!----------------------------------------------------------------------
+
+integer :: StateVarDimID ! netCDF pointer to state variable dimension (model size)
+integer :: MemberDimID ! netCDF pointer to dimension of ensemble (ens_size)
+integer :: TimeDimID ! netCDF pointer to time dimension (unlimited)
+
+integer :: StateVarVarID ! netCDF pointer to state variable coordinate array
+integer :: StateVarID ! netCDF pointer to 3D [state,copy,time] array
+
+!----------------------------------------------------------------------
+! variables if we parse the state vector into prognostic variables.
+!----------------------------------------------------------------------
+
+! for the dimensions and coordinate variables
+integer :: NLONDimID
+integer :: NLATDimID
+integer :: NALTDimID
+
+! for the prognostic variables
+integer :: ivar, VarID
+
+!----------------------------------------------------------------------
+! variables for the namelist output
+!----------------------------------------------------------------------
+
+character(len=129), allocatable, dimension(:) :: textblock
+integer :: LineLenDimID, nlinesDimID, nmlVarID
+integer :: nlines, linelen
@@ Diff output truncated at 40000 characters. @@
From nancy at ucar.edu Mon Apr 9 14:39:58 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 09 Apr 2012 14:39:58 -0600
Subject: [Dart-dev] [5677] DART/branches/development/mkmf: fix the
'debugging' line in the gfortran mkmf to include the
Message-ID:
Revision: 5677
Author: nancy
Date: 2012-04-09 14:39:57 -0600 (Mon, 09 Apr 2012)
Log Message:
-----------
fix the 'debugging' line in the gfortran mkmf to include the
flag that allows > 132 length lines. also set it in the default
template and include comments about how to set NETCDF.
Modified Paths:
--------------
DART/branches/development/mkmf/mkmf.template
DART/branches/development/mkmf/mkmf.template.gfortran
-------------- next part --------------
Modified: DART/branches/development/mkmf/mkmf.template
===================================================================
--- DART/branches/development/mkmf/mkmf.template 2012-04-09 17:50:48 UTC (rev 5676)
+++ DART/branches/development/mkmf/mkmf.template 2012-04-09 20:39:57 UTC (rev 5677)
@@ -71,9 +71,15 @@
MPILD = mpif90
FC = gfortran
LD = gfortran
-NETCDF = /contrib
+
+# if $NETCDF in your environment is set to the location of the
+# include and lib directories, you are ok. otherwise set the
+# next line to the location and uncomment it.
+# NETCDF = /usr/local
+
INCS = ${NETCDF}/include
-FFLAGS = -O2 -I$(INCS)
-LIBS = -L${NETCDF}/lib -lnetcdf
+FFLAGS = -O2 -I$(INCS) -ffree-line-length-none
+
+LIBS = -L${NETCDF}/lib -lnetcdf -lnetcdff
LDFLAGS = -I$(INCS) $(LIBS)
Modified: DART/branches/development/mkmf/mkmf.template.gfortran
===================================================================
--- DART/branches/development/mkmf/mkmf.template.gfortran 2012-04-09 17:50:48 UTC (rev 5676)
+++ DART/branches/development/mkmf/mkmf.template.gfortran 2012-04-09 20:39:57 UTC (rev 5677)
@@ -95,7 +95,7 @@
FFLAGS = -O2 $(INCS) -ffree-line-length-none
LDFLAGS = $(FFLAGS) $(LIBS)
-#FFLAGS = -O0 -fbounds-check -frecord-marker=4 -ffpe-trap=invalid $(INCS)
+#FFLAGS = -O0 -fbounds-check -frecord-marker=4 -ffpe-trap=invalid -ffree-line-length-none $(INCS)
# The following libraries are commonly needed if netCDF4 was built with HDF5 support.
#LIBS = -L${NETCDF}/lib -lnetcdf -lcurl -lhdf5_hl -lhdf5 -lz -lm
From nancy at ucar.edu Mon Apr 9 15:02:26 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 09 Apr 2012 15:02:26 -0600
Subject: [Dart-dev] [5678]
DART/branches/development/models/simple_advection/model_mod.f90: move where
the random number generator is initialized up to the
Message-ID:
Revision: 5678
Author: nancy
Date: 2012-04-09 15:02:26 -0600 (Mon, 09 Apr 2012)
Log Message:
-----------
move where the random number generator is initialized up to the
static init routine so it's guaranteed to be before the first use.
turns out the model advance routine (adv_1step) also uses some
random number calls and that is called before the pert routine (where
it used be initialized) if you are running perfect model.
Modified Paths:
--------------
DART/branches/development/models/simple_advection/model_mod.f90
-------------- next part --------------
Modified: DART/branches/development/models/simple_advection/model_mod.f90
===================================================================
--- DART/branches/development/models/simple_advection/model_mod.f90 2012-04-09 20:39:57 UTC (rev 5677)
+++ DART/branches/development/models/simple_advection/model_mod.f90 2012-04-09 21:02:26 UTC (rev 5678)
@@ -185,6 +185,13 @@
! Compute the width of the domain in meters
domain_width_meters = num_grid_points * grid_spacing_meters
+! For any routines that want to use the random number
+! generator later on, initialize it.
+if(.not. random_seq_init) then
+ call init_random_seq(random_seq, 1)
+ random_seq_init = .true.
+endif
+
end subroutine static_init_model
@@ -989,11 +996,6 @@
interf_provided = .true.
write(*, *) 'in pert_model_state'
-! Initialize my random number sequence
-if(.not. random_seq_init) then
- call init_random_seq(random_seq, 1)
- random_seq_init = .true.
-endif
! Need to make sure perturbed states are not centered on true value
! This model is too forgiving in such circumstances
From nancy at ucar.edu Mon Apr 9 15:06:24 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 09 Apr 2012 15:06:24 -0600
Subject: [Dart-dev] [5679]
DART/branches/development/random_seq/random_seq_mod.f90: add some
bookkeeping in the random gauss routine.
Message-ID:
Revision: 5679
Author: nancy
Date: 2012-04-09 15:06:24 -0600 (Mon, 09 Apr 2012)
Log Message:
-----------
add some bookkeeping in the random gauss routine. if you loop inside that routine
for more than 100 times without successfully generating a good gaussian value, then
most likely you've called the random number generator without initializing it.
call the error handler instead of sitting in an infinite loop.
Modified Paths:
--------------
DART/branches/development/random_seq/random_seq_mod.f90
-------------- next part --------------
Modified: DART/branches/development/random_seq/random_seq_mod.f90
===================================================================
--- DART/branches/development/random_seq/random_seq_mod.f90 2012-04-09 21:02:26 UTC (rev 5678)
+++ DART/branches/development/random_seq/random_seq_mod.f90 2012-04-09 21:06:24 UTC (rev 5679)
@@ -59,6 +59,7 @@
end type random_seq_type
logical, save :: module_initialized = .false.
+character(len=128) :: errstring
contains
@@ -314,6 +315,7 @@
real(r8) :: ran_gauss
real(digits12) :: x, y, r2, t
+integer :: lc
if ( .not. module_initialized ) call initialize_module
@@ -326,7 +328,9 @@
s%gset = .false.
else
- 10 continue
+ lc = 0
+10 continue
+ lc = lc + 1
! choose x,y in uniform square (-1,-1) to (+1,+1)
x = -1.0_digits12 + 2.0_digits12 * ran_unif(s)
@@ -334,7 +338,16 @@
! repeat if it is outside the unit circle or at origin
r2 = x*x + y*y
- if (r2 >= 1.0_digits12 .or. r2 == 0.0_digits12) goto 10
+ if (r2 >= 1.0_digits12 .or. r2 == 0.0_digits12) then
+ if (lc > 100) then
+ write(errstring, *) 'x, y = ', x, y
+ call error_handler(E_ERR, 'ran_gauss', &
+ 'if both x and y are -1, random number generator probably not initialized', &
+ source, revision, revdate, &
+ text2 = errstring);
+ endif
+ goto 10
+ endif
t = sqrt(-2.0_digits12 * log(r2) / r2)
s%lastg = real(x * t, r8)
From nancy at ucar.edu Tue Apr 10 14:35:43 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Tue, 10 Apr 2012 14:35:43 -0600
Subject: [Dart-dev] [5681] DART/branches/development/models/lorenz_63/work:
give the input. nml used for the workshop a different name, and make
Message-ID:
Revision: 5681
Author: nancy
Date: 2012-04-10 14:35:42 -0600 (Tue, 10 Apr 2012)
Log Message:
-----------
give the input.nml used for the workshop a different name, and make
sure the default input.nml has good settings for a successful assimilation.
simplify the workshop_setup script so it only does what the workshop needs,
including building perfect_model_obs and filter.
Modified Paths:
--------------
DART/branches/development/models/lorenz_63/work/workshop_setup.csh
Added Paths:
-----------
DART/branches/development/models/lorenz_63/work/input.nml
DART/branches/development/models/lorenz_63/work/input.workshop.nml
Removed Paths:
-------------
DART/branches/development/models/lorenz_63/work/input.nml
-------------- next part --------------
Deleted: DART/branches/development/models/lorenz_63/work/input.nml
===================================================================
--- DART/branches/development/models/lorenz_63/work/input.nml 2012-04-10 15:35:27 UTC (rev 5680)
+++ DART/branches/development/models/lorenz_63/work/input.nml 2012-04-10 20:35:42 UTC (rev 5681)
@@ -1,200 +0,0 @@
-&perfect_model_obs_nml
- start_from_restart = .true.,
- output_restart = .true.,
- async = 0,
- init_time_days = 0,
- init_time_seconds = 0,
- first_obs_days = -1,
- first_obs_seconds = -1,
- last_obs_days = -1,
- last_obs_seconds = -1,
- output_interval = 1,
- restart_in_file_name = "perfect_ics",
- restart_out_file_name = "perfect_restart",
- obs_seq_in_file_name = "obs_seq.in",
- obs_seq_out_file_name = "obs_seq.out",
- adv_ens_command = "./advance_model.csh",
- output_timestamps = .false.,
- trace_execution = .false.,
- output_forward_op_errors = .false.,
- print_every_nth_obs = -1,
- silence = .false.,
- /
-
-&filter_nml
- async = 0,
- adv_ens_command = "./advance_model.csh",
- ens_size = 20,
- start_from_restart = .true.,
- output_restart = .true.,
- obs_sequence_in_name = "obs_seq.out",
- obs_sequence_out_name = "obs_seq.final",
- restart_in_file_name = "filter_ics",
- restart_out_file_name = "filter_restart",
- init_time_days = 0,
- init_time_seconds = 0,
- first_obs_days = -1,
- first_obs_seconds = -1,
- last_obs_days = -1,
- last_obs_seconds = -1,
- num_output_state_members = 20,
- num_output_obs_members = 0,
- output_interval = 1,
- num_groups = 1,
- input_qc_threshold = 3.0,
- outlier_threshold = -1.0,
- output_forward_op_errors = .false.,
- output_timestamps = .false.,
- output_inflation = .true.,
- trace_execution = .false.,
- silence = .false.,
-
- inf_flavor = 0, 0,
- inf_initial_from_restart = .false., .false.,
- inf_sd_initial_from_restart = .false., .false.,
- inf_output_restart = .true., .true.,
- inf_deterministic = .true., .true.,
- inf_in_file_name = 'prior_inflate_ics', 'post_inflate_ics',
- inf_out_file_name = 'prior_inflate_restart', 'post_inflate_restart',
- inf_diag_file_name = 'prior_inflate_diag', 'post_inflate_diag',
- inf_initial = 1.0, 1.0,
- inf_sd_initial = 0.0, 0.0,
- inf_damping = 1.0, 1.0,
- inf_lower_bound = 1.0, 1.0,
- inf_upper_bound = 1000000.0, 1000000.0,
- inf_sd_lower_bound = 0.0, 0.0
-/
-
-&smoother_nml
- num_lags = 0,
- start_from_restart = .false.,
- output_restart = .false.,
- restart_in_file_name = 'smoother_ics',
- restart_out_file_name = 'smoother_restart' /
-
-&ensemble_manager_nml
- single_restart_file_in = .true.,
- single_restart_file_out = .true.,
- perturbation_amplitude = 0.2 /
-
-&assim_tools_nml
- filter_kind = 1,
- cutoff = 0.00001,
- sort_obs_inc = .true.,
- spread_restoration = .false.,
- sampling_error_correction = .false.,
- adaptive_localization_threshold = -1,
- output_localization_diagnostics = .false.,
- localization_diagnostics_file = 'localization_diagnostics',
- print_every_nth_obs = 0 /
-
-&cov_cutoff_nml
- select_localization = 1 /
-
-®_factor_nml
- select_regression = 1,
- input_reg_file = "time_mean_reg",
- save_reg_diagnostics = .false.,
- reg_diagnostics_file = "reg_diagnostics" /
-
-&obs_sequence_nml
- write_binary_obs_sequence = .false. /
-
-&obs_kind_nml
- assimilate_these_obs_types = 'RAW_STATE_VARIABLE' /
-
-&assim_model_nml
- write_binary_restart_files = .false.,
- netCDF_large_file_support = .false.
- /
-
-&model_nml
- sigma = 10.0,
- r = 28.0,
- b = 2.6666666666667,
- deltat = 0.01,
- time_step_days = 0,
- time_step_seconds = 3600 /
-
-&utilities_nml
- TERMLEVEL = 1,
- module_details = .false.,
- logfilename = 'dart_log.out',
- nmlfilename = 'dart_log.nml',
- write_nml = 'terminal' /
-
-&preprocess_nml
- input_obs_def_mod_file = '../../../obs_def/DEFAULT_obs_def_mod.F90',
- output_obs_def_mod_file = '../../../obs_def/obs_def_mod.f90',
- input_obs_kind_mod_file = '../../../obs_kind/DEFAULT_obs_kind_mod.F90',
- output_obs_kind_mod_file = '../../../obs_kind/obs_kind_mod.f90',
- input_files = '../../../obs_def/obs_def_1d_state_mod.f90' /
-
-
-&obs_sequence_tool_nml
- num_input_files = 2,
- filename_seq = 'obs_seq.one', 'obs_seq.two',
- filename_out = 'obs_seq.processed',
- first_obs_days = -1,
- first_obs_seconds = -1,
- last_obs_days = -1,
- last_obs_seconds = -1,
- print_only = .false.,
- gregorian_cal = .false.
- /
-
-# other possible obs tool namelist items:
-#
-# keep only the U and V radiosonde winds:
-# obs_types = 'RADIOSONDE_U_WIND_COMPONENT',
-# 'RADIOSONDE_V_WIND_COMPONENT',
-# keep_types = .true.,
-#
-# remove the U and V radiosonde winds:
-# obs_types = 'RADIOSONDE_U_WIND_COMPONENT',
-# 'RADIOSONDE_V_WIND_COMPONENT',
-# keep_types = .false.,
-#
-# keep only observations with a DART QC of 0:
-# qc_metadata = 'Dart quality control',
-# min_qc = 0,
-# max_qc = 0,
-#
-# keep only radiosonde temp obs between 250 and 300 K:
-# copy_metadata = 'NCEP BUFR observation',
-# copy_type = 'RADIOSONDE_TEMPERATURE',
-# min_copy = 250.0,
-# max_copy = 300.0,
-#
-
-
-&restart_file_tool_nml
- input_file_name = "filter_restart",
- output_file_name = "filter_updated_restart",
- ens_size = 1,
- single_restart_file_in = .true.,
- single_restart_file_out = .true.,
- write_binary_restart_files = .true.,
- overwrite_data_time = .false.,
- new_data_days = -1,
- new_data_secs = -1,
- input_is_model_advance_file = .false.,
- output_is_model_advance_file = .false.,
- overwrite_advance_time = .false.,
- new_advance_days = -1,
- new_advance_secs = -1,
- gregorian_cal = .false.
-/
-
-&obs_diag_nml
- obs_sequence_name = 'obs_seq.final',
- iskip_days = 0,
- obs_select = 1,
- rat_cri = 4.0,
- input_qc_threshold = 3.0,
- bin_width_seconds = 0,
- lonlim1 = 0.0, 0.0, 0.5, -1.0,
- lonlim2 = 1.0, 0.5, 1.5, -1.0,
- reg_names = 'whole', 'yin', 'yang', 'bogus',
- verbose = .false. /
-
Added: DART/branches/development/models/lorenz_63/work/input.nml
===================================================================
--- DART/branches/development/models/lorenz_63/work/input.nml (rev 0)
+++ DART/branches/development/models/lorenz_63/work/input.nml 2012-04-10 20:35:42 UTC (rev 5681)
@@ -0,0 +1,200 @@
+&perfect_model_obs_nml
+ start_from_restart = .true.,
+ output_restart = .true.,
+ async = 0,
+ init_time_days = 0,
+ init_time_seconds = 0,
+ first_obs_days = -1,
+ first_obs_seconds = -1,
+ last_obs_days = -1,
+ last_obs_seconds = -1,
+ output_interval = 1,
+ restart_in_file_name = "perfect_ics",
+ restart_out_file_name = "perfect_restart",
+ obs_seq_in_file_name = "obs_seq.in",
+ obs_seq_out_file_name = "obs_seq.out",
+ adv_ens_command = "./advance_model.csh",
+ output_timestamps = .false.,
+ trace_execution = .false.,
+ output_forward_op_errors = .false.,
+ print_every_nth_obs = -1,
+ silence = .false.,
+ /
+
+&filter_nml
+ async = 0,
+ adv_ens_command = "./advance_model.csh",
+ ens_size = 20,
+ start_from_restart = .true.,
+ output_restart = .true.,
+ obs_sequence_in_name = "obs_seq.out",
+ obs_sequence_out_name = "obs_seq.final",
+ restart_in_file_name = "filter_ics",
+ restart_out_file_name = "filter_restart",
+ init_time_days = 0,
+ init_time_seconds = 0,
+ first_obs_days = -1,
+ first_obs_seconds = -1,
+ last_obs_days = -1,
+ last_obs_seconds = -1,
+ num_output_state_members = 20,
+ num_output_obs_members = 0,
+ output_interval = 1,
+ num_groups = 1,
+ input_qc_threshold = 3.0,
+ outlier_threshold = -1.0,
+ output_forward_op_errors = .false.,
+ output_timestamps = .false.,
+ output_inflation = .true.,
+ trace_execution = .false.,
+ silence = .false.,
+
+ inf_flavor = 2, 0,
+ inf_initial_from_restart = .false., .false.,
+ inf_sd_initial_from_restart = .false., .false.,
+ inf_output_restart = .true., .true.,
+ inf_deterministic = .true., .true.,
+ inf_in_file_name = 'prior_inflate_ics', 'post_inflate_ics',
+ inf_out_file_name = 'prior_inflate_restart', 'post_inflate_restart',
+ inf_diag_file_name = 'prior_inflate_diag', 'post_inflate_diag',
+ inf_initial = 1.01, 1.0,
+ inf_sd_initial = 0.6, 0.0,
+ inf_damping = 0.9, 1.0,
+ inf_lower_bound = 1.0, 1.0,
+ inf_upper_bound = 100.0, 1000000.0,
+ inf_sd_lower_bound = 0.6, 0.0
+/
+
+&smoother_nml
+ num_lags = 0,
+ start_from_restart = .false.,
+ output_restart = .false.,
+ restart_in_file_name = 'smoother_ics',
+ restart_out_file_name = 'smoother_restart' /
+
+&ensemble_manager_nml
+ single_restart_file_in = .true.,
+ single_restart_file_out = .true.,
+ perturbation_amplitude = 0.2 /
+
+&assim_tools_nml
+ filter_kind = 1,
+ cutoff = 0.001,
+ sort_obs_inc = .false.,
+ spread_restoration = .false.,
+ sampling_error_correction = .false.,
+ adaptive_localization_threshold = -1,
+ output_localization_diagnostics = .false.,
+ localization_diagnostics_file = 'localization_diagnostics',
+ print_every_nth_obs = 0 /
+
+&cov_cutoff_nml
+ select_localization = 1 /
+
+®_factor_nml
+ select_regression = 1,
+ input_reg_file = "time_mean_reg",
+ save_reg_diagnostics = .false.,
+ reg_diagnostics_file = "reg_diagnostics" /
+
+&obs_sequence_nml
+ write_binary_obs_sequence = .false. /
+
+&obs_kind_nml
+ assimilate_these_obs_types = 'RAW_STATE_VARIABLE' /
+
+&assim_model_nml
+ write_binary_restart_files = .false.,
+ netCDF_large_file_support = .false.
+ /
+
+&model_nml
+ sigma = 10.0,
+ r = 28.0,
+ b = 2.6666666666667,
+ deltat = 0.01,
+ time_step_days = 0,
+ time_step_seconds = 3600 /
+
+&utilities_nml
+ TERMLEVEL = 1,
+ module_details = .false.,
+ logfilename = 'dart_log.out',
+ nmlfilename = 'dart_log.nml',
+ write_nml = 'terminal' /
+
+&preprocess_nml
+ input_obs_def_mod_file = '../../../obs_def/DEFAULT_obs_def_mod.F90',
+ output_obs_def_mod_file = '../../../obs_def/obs_def_mod.f90',
+ input_obs_kind_mod_file = '../../../obs_kind/DEFAULT_obs_kind_mod.F90',
+ output_obs_kind_mod_file = '../../../obs_kind/obs_kind_mod.f90',
+ input_files = '../../../obs_def/obs_def_1d_state_mod.f90' /
+
+
+&obs_sequence_tool_nml
+ num_input_files = 2,
+ filename_seq = 'obs_seq.one', 'obs_seq.two',
+ filename_out = 'obs_seq.processed',
+ first_obs_days = -1,
+ first_obs_seconds = -1,
+ last_obs_days = -1,
+ last_obs_seconds = -1,
+ print_only = .false.,
+ gregorian_cal = .false.
+ /
+
+# other possible obs tool namelist items:
+#
+# keep only the U and V radiosonde winds:
+# obs_types = 'RADIOSONDE_U_WIND_COMPONENT',
+# 'RADIOSONDE_V_WIND_COMPONENT',
+# keep_types = .true.,
+#
+# remove the U and V radiosonde winds:
+# obs_types = 'RADIOSONDE_U_WIND_COMPONENT',
+# 'RADIOSONDE_V_WIND_COMPONENT',
+# keep_types = .false.,
+#
+# keep only observations with a DART QC of 0:
+# qc_metadata = 'Dart quality control',
+# min_qc = 0,
+# max_qc = 0,
+#
+# keep only radiosonde temp obs between 250 and 300 K:
+# copy_metadata = 'NCEP BUFR observation',
+# copy_type = 'RADIOSONDE_TEMPERATURE',
+# min_copy = 250.0,
+# max_copy = 300.0,
+#
+
+
+&restart_file_tool_nml
+ input_file_name = "filter_restart",
+ output_file_name = "filter_updated_restart",
+ ens_size = 1,
+ single_restart_file_in = .true.,
+ single_restart_file_out = .true.,
+ write_binary_restart_files = .true.,
+ overwrite_data_time = .false.,
+ new_data_days = -1,
+ new_data_secs = -1,
+ input_is_model_advance_file = .false.,
+ output_is_model_advance_file = .false.,
+ overwrite_advance_time = .false.,
+ new_advance_days = -1,
+ new_advance_secs = -1,
+ gregorian_cal = .false.
+/
+
+&obs_diag_nml
+ obs_sequence_name = 'obs_seq.final',
+ iskip_days = 0,
+ obs_select = 1,
+ rat_cri = 4.0,
+ input_qc_threshold = 3.0,
+ bin_width_seconds = 0,
+ lonlim1 = 0.0, 0.0, 0.5, -1.0,
+ lonlim2 = 1.0, 0.5, 1.5, -1.0,
+ reg_names = 'whole', 'yin', 'yang', 'bogus',
+ verbose = .false. /
+
Property changes on: DART/branches/development/models/lorenz_63/work/input.nml
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:eol-style
+ native
Copied: DART/branches/development/models/lorenz_63/work/input.workshop.nml (from rev 5680, DART/branches/development/models/lorenz_63/work/input.nml)
===================================================================
--- DART/branches/development/models/lorenz_63/work/input.workshop.nml (rev 0)
+++ DART/branches/development/models/lorenz_63/work/input.workshop.nml 2012-04-10 20:35:42 UTC (rev 5681)
@@ -0,0 +1,200 @@
+&perfect_model_obs_nml
+ start_from_restart = .true.,
+ output_restart = .true.,
+ async = 0,
+ init_time_days = 0,
+ init_time_seconds = 0,
+ first_obs_days = -1,
+ first_obs_seconds = -1,
+ last_obs_days = -1,
+ last_obs_seconds = -1,
+ output_interval = 1,
+ restart_in_file_name = "perfect_ics",
+ restart_out_file_name = "perfect_restart",
+ obs_seq_in_file_name = "obs_seq.in",
+ obs_seq_out_file_name = "obs_seq.out",
+ adv_ens_command = "./advance_model.csh",
+ output_timestamps = .false.,
+ trace_execution = .false.,
+ output_forward_op_errors = .false.,
+ print_every_nth_obs = -1,
+ silence = .false.,
+ /
+
+&filter_nml
+ async = 0,
+ adv_ens_command = "./advance_model.csh",
+ ens_size = 20,
+ start_from_restart = .true.,
+ output_restart = .true.,
+ obs_sequence_in_name = "obs_seq.out",
+ obs_sequence_out_name = "obs_seq.final",
+ restart_in_file_name = "filter_ics",
+ restart_out_file_name = "filter_restart",
+ init_time_days = 0,
+ init_time_seconds = 0,
+ first_obs_days = -1,
+ first_obs_seconds = -1,
+ last_obs_days = -1,
+ last_obs_seconds = -1,
+ num_output_state_members = 20,
+ num_output_obs_members = 0,
+ output_interval = 1,
+ num_groups = 1,
+ input_qc_threshold = 3.0,
+ outlier_threshold = -1.0,
+ output_forward_op_errors = .false.,
+ output_timestamps = .false.,
+ output_inflation = .true.,
+ trace_execution = .false.,
+ silence = .false.,
+
+ inf_flavor = 2, 0,
+ inf_initial_from_restart = .false., .false.,
+ inf_sd_initial_from_restart = .false., .false.,
+ inf_output_restart = .true., .true.,
+ inf_deterministic = .true., .true.,
+ inf_in_file_name = 'prior_inflate_ics', 'post_inflate_ics',
+ inf_out_file_name = 'prior_inflate_restart', 'post_inflate_restart',
+ inf_diag_file_name = 'prior_inflate_diag', 'post_inflate_diag',
+ inf_initial = 1.01, 1.0,
+ inf_sd_initial = 0.6, 0.0,
+ inf_damping = 0.9, 1.0,
+ inf_lower_bound = 1.0, 1.0,
+ inf_upper_bound = 100.0, 1000000.0,
+ inf_sd_lower_bound = 0.6, 0.0
+/
+
+&smoother_nml
+ num_lags = 0,
+ start_from_restart = .false.,
+ output_restart = .false.,
+ restart_in_file_name = 'smoother_ics',
+ restart_out_file_name = 'smoother_restart' /
+
+&ensemble_manager_nml
+ single_restart_file_in = .true.,
+ single_restart_file_out = .true.,
+ perturbation_amplitude = 0.2 /
+
+&assim_tools_nml
+ filter_kind = 1,
+ cutoff = 0.001,
+ sort_obs_inc = .false.,
+ spread_restoration = .false.,
+ sampling_error_correction = .false.,
+ adaptive_localization_threshold = -1,
+ output_localization_diagnostics = .false.,
+ localization_diagnostics_file = 'localization_diagnostics',
+ print_every_nth_obs = 0 /
+
+&cov_cutoff_nml
+ select_localization = 1 /
+
+®_factor_nml
+ select_regression = 1,
+ input_reg_file = "time_mean_reg",
+ save_reg_diagnostics = .false.,
+ reg_diagnostics_file = "reg_diagnostics" /
+
+&obs_sequence_nml
+ write_binary_obs_sequence = .false. /
+
+&obs_kind_nml
+ assimilate_these_obs_types = 'RAW_STATE_VARIABLE' /
+
+&assim_model_nml
+ write_binary_restart_files = .false.,
+ netCDF_large_file_support = .false.
+ /
+
+&model_nml
+ sigma = 10.0,
+ r = 28.0,
+ b = 2.6666666666667,
+ deltat = 0.01,
+ time_step_days = 0,
+ time_step_seconds = 3600 /
+
+&utilities_nml
+ TERMLEVEL = 1,
+ module_details = .false.,
+ logfilename = 'dart_log.out',
+ nmlfilename = 'dart_log.nml',
+ write_nml = 'terminal' /
+
+&preprocess_nml
+ input_obs_def_mod_file = '../../../obs_def/DEFAULT_obs_def_mod.F90',
+ output_obs_def_mod_file = '../../../obs_def/obs_def_mod.f90',
+ input_obs_kind_mod_file = '../../../obs_kind/DEFAULT_obs_kind_mod.F90',
+ output_obs_kind_mod_file = '../../../obs_kind/obs_kind_mod.f90',
+ input_files = '../../../obs_def/obs_def_1d_state_mod.f90' /
+
+
+&obs_sequence_tool_nml
+ num_input_files = 2,
+ filename_seq = 'obs_seq.one', 'obs_seq.two',
+ filename_out = 'obs_seq.processed',
+ first_obs_days = -1,
+ first_obs_seconds = -1,
+ last_obs_days = -1,
+ last_obs_seconds = -1,
+ print_only = .false.,
+ gregorian_cal = .false.
+ /
+
+# other possible obs tool namelist items:
+#
+# keep only the U and V radiosonde winds:
+# obs_types = 'RADIOSONDE_U_WIND_COMPONENT',
+# 'RADIOSONDE_V_WIND_COMPONENT',
+# keep_types = .true.,
+#
+# remove the U and V radiosonde winds:
+# obs_types = 'RADIOSONDE_U_WIND_COMPONENT',
+# 'RADIOSONDE_V_WIND_COMPONENT',
+# keep_types = .false.,
+#
+# keep only observations with a DART QC of 0:
+# qc_metadata = 'Dart quality control',
+# min_qc = 0,
+# max_qc = 0,
+#
+# keep only radiosonde temp obs between 250 and 300 K:
+# copy_metadata = 'NCEP BUFR observation',
+# copy_type = 'RADIOSONDE_TEMPERATURE',
+# min_copy = 250.0,
+# max_copy = 300.0,
+#
+
+
+&restart_file_tool_nml
+ input_file_name = "filter_restart",
+ output_file_name = "filter_updated_restart",
+ ens_size = 1,
+ single_restart_file_in = .true.,
+ single_restart_file_out = .true.,
+ write_binary_restart_files = .true.,
+ overwrite_data_time = .false.,
+ new_data_days = -1,
+ new_data_secs = -1,
+ input_is_model_advance_file = .false.,
+ output_is_model_advance_file = .false.,
+ overwrite_advance_time = .false.,
+ new_advance_days = -1,
+ new_advance_secs = -1,
+ gregorian_cal = .false.
+/
+
+&obs_diag_nml
+ obs_sequence_name = 'obs_seq.final',
+ iskip_days = 0,
+ obs_select = 1,
+ rat_cri = 4.0,
+ input_qc_threshold = 3.0,
+ bin_width_seconds = 0,
+ lonlim1 = 0.0, 0.0, 0.5, -1.0,
+ lonlim2 = 1.0, 0.5, 1.5, -1.0,
+ reg_names = 'whole', 'yin', 'yang', 'bogus',
+ verbose = .false. /
+
Modified: DART/branches/development/models/lorenz_63/work/workshop_setup.csh
===================================================================
--- DART/branches/development/models/lorenz_63/work/workshop_setup.csh 2012-04-10 15:35:27 UTC (rev 5680)
+++ DART/branches/development/models/lorenz_63/work/workshop_setup.csh 2012-04-10 20:35:42 UTC (rev 5681)
@@ -6,13 +6,8 @@
#
# $Id$
#
-# Script to manage the compilation of all components for this model;
-# executes a known "perfect model" experiment using an existing
-# observation sequence file (obs_seq.in) and initial conditions appropriate
-# for both 'perfect_model_obs' (perfect_ics) and 'filter' (filter_ics).
-# There are enough initial conditions for 80 ensemble members in filter.
-# Use ens_size = 81 and it WILL bomb. Guaranteed.
-# The 'input.nml' file controls all facets of this execution.
+# this script builds only perfect_model_obs and filter. to build the rest
+# of the executables, run './quickbuild.csh'.
#
# 'create_obs_sequence' and 'create_fixed_network_sequence' were used to
# create the observation sequence file 'obs_seq.in' - this defines
@@ -52,47 +47,29 @@
set MODEL = "lorenz_63"
-@ n = 1
+echo 'building and running preprocess'
-echo
-echo
-echo "---------------------------------------------------------------"
-echo "${MODEL} build number ${n} is preprocess"
-
csh mkmf_preprocess
-make || exit $n
+make || exit 1
./preprocess || exit 99
-#----------------------------------------------------------------------
-# Build all the single-threaded targets
-#----------------------------------------------------------------------
+echo 'copying the workshop version of the input.nml into place'
+cp -f input.workshop.nml input.nml
-foreach TARGET ( mkmf_* )
+echo 'building perfect_model_obs and filter'
+csh mkmf_perfect_model_obs
+make || exit 1
- set PROG = `echo $TARGET | sed -e 's#mkmf_##'`
+csh mkmf_filter
+make || exit 1
- switch ( $TARGET )
- case mkmf_preprocess:
- breaksw
- default:
- @ n = $n + 1
- echo
- echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
- \rm -f ${PROG}
- csh $TARGET || exit $n
- make || exit $n
- breaksw
- endsw
-end
+echo 'running perfect_model_obs'
+./perfect_model_obs || exit 2
-@ n = $n + 1
-./perfect_model_obs || exit $n
+echo 'running filter'
+./filter || exit 3
-@ n = $n + 1
-./filter || exit $n
-
exit 0
#
From nancy at ucar.edu Tue Apr 10 14:42:39 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Tue, 10 Apr 2012 14:42:39 -0600
Subject: [Dart-dev] [5682]
DART/branches/development/models/lorenz_96/work/workshop_setup.csh:
simplify the workshop_setup script so it only does what the workshop needs ,
Message-ID:
Revision: 5682
Author: nancy
Date: 2012-04-10 14:42:39 -0600 (Tue, 10 Apr 2012)
Log Message:
-----------
simplify the workshop_setup script so it only does what the workshop needs,
including building perfect_model_obs and filter.
Modified Paths:
--------------
DART/branches/development/models/lorenz_96/work/workshop_setup.csh
-------------- next part --------------
Modified: DART/branches/development/models/lorenz_96/work/workshop_setup.csh
===================================================================
--- DART/branches/development/models/lorenz_96/work/workshop_setup.csh 2012-04-10 20:35:42 UTC (rev 5681)
+++ DART/branches/development/models/lorenz_96/work/workshop_setup.csh 2012-04-10 20:42:39 UTC (rev 5682)
@@ -6,18 +6,19 @@
#
# $Id$
#
-# Script to manage the compilation of all components for this model;
-# executes a known "perfect model" experiment using an existing
+# This script builds only perfect_model_obs and filter. to build the rest
+# of the executables, run './quickbuild.csh'.
+#
+# Executes a known "perfect model" experiment using an existing
# observation sequence file (obs_seq.in) and initial conditions appropriate
# for both 'perfect_model_obs' (perfect_ics) and 'filter' (filter_ics).
-# There are enough initial conditions for 80 ensemble members in filter.
-# Use ens_size = 81 and it WILL bomb. Guaranteed.
+# There are enough initial conditions for up to 80 ensemble members in filter.
# The 'input.nml' file controls all facets of this execution.
#
# 'create_obs_sequence' and 'create_fixed_network_sequence' were used to
# create the observation sequence file 'obs_seq.in' - this defines
-# what/where/when we want observations. This script does not run these
-# programs - intentionally.
+# what/where/when we want observations. This script does not build these
+# programs.
#
# 'perfect_model_obs' results in a True_State.nc file that contains
# the true state, and obs_seq.out - a file that contains the "observations"
@@ -43,7 +44,7 @@
# 'preprocess' is a program that culls the appropriate sections of the
# observation module for the observations types in 'input.nml'; the
# resulting source file is used by all the remaining programs,
-# so this MUST be run first.
+# so it MUST be run first.
#----------------------------------------------------------------------
\rm -f preprocess *.o *.mod
@@ -52,49 +53,29 @@
set MODEL = "lorenz_96"
-@ n = 1
+echo 'building and running preprocess'
-echo
-echo
-echo "---------------------------------------------------------------"
-echo "${MODEL} build number ${n} is preprocess"
-
csh mkmf_preprocess
make || exit $n
./preprocess || exit 99
-#----------------------------------------------------------------------
-# Build all the single-threaded targets
-#----------------------------------------------------------------------
+echo 'copying the workshop version of the input.nml into place'
+cp -f input.workshop.nml input.nml
-foreach TARGET ( mkmf_* )
+echo 'building perfect_model_obs and filter'
+csh mkmf_perfect_model_obs
+make || exit 1
- set PROG = `echo $TARGET | sed -e 's#mkmf_##'`
+csh mkmf_filter
+make || exit 1
- switch ( $TARGET )
- case mkmf_preprocess:
- breaksw
- default:
- @ n = $n + 1
- echo
- echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
- \rm -f ${PROG}
- csh $TARGET || exit $n
- make || exit $n
- breaksw
- endsw
-end
+echo 'running perfect_model_obs'
+./perfect_model_obs || exit 2
-cp ./input.workshop.nml input.nml
+echo 'running filter'
+./filter || exit 3
-@ n = $n + 1
-./perfect_model_obs || exit $n
-
-@ n = $n + 1
-./filter || exit $n
-
exit 0
#
From nancy at ucar.edu Tue Apr 10 16:10:14 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Tue, 10 Apr 2012 16:10:14 -0600
Subject: [Dart-dev] [5683] DART/branches/development/models/template: update
these files so they build by default.
Message-ID:
Revision: 5683
Author: nancy
Date: 2012-04-10 16:10:14 -0600 (Tue, 10 Apr 2012)
Log Message:
-----------
update these files so they build by default. the model_mod is a
simple 1d format, and the converters have been adapted to compile
with it. same with model_mod_check. the full threed_sphere code
is in the full_model_mod.f90 and full_model_mod_check.f90 files.
Modified Paths:
--------------
DART/branches/development/models/template/dart_to_model.f90
DART/branches/development/models/template/model_mod.f90
DART/branches/development/models/template/model_to_dart.f90
DART/branches/development/models/template/work/input.nml
DART/branches/development/models/template/work/path_names_dart_to_model
DART/branches/development/models/template/work/path_names_model_mod_check
DART/branches/development/models/template/work/path_names_model_to_dart
Added Paths:
-----------
DART/branches/development/models/template/full_model_mod_check.f90
Removed Paths:
-------------
DART/branches/development/models/template/model_mod_check.f90
DART/branches/development/models/template/work/mkmf_trans_time
DART/branches/development/models/template/work/path_names_trans_time
-------------- next part --------------
Modified: DART/branches/development/models/template/dart_to_model.f90
===================================================================
--- DART/branches/development/models/template/dart_to_model.f90 2012-04-10 20:42:39 UTC (rev 5682)
+++ DART/branches/development/models/template/dart_to_model.f90 2012-04-10 22:10:14 UTC (rev 5683)
@@ -27,14 +27,14 @@
!----------------------------------------------------------------------
use types_mod, only : r8
-use utilities_mod, only : initialize_utilities, timestamp, &
+use utilities_mod, only : initialize_utilities, finalize_utilities, &
find_namelist_in_file, check_namelist_read, &
logfileunit, open_file, close_file
use assim_model_mod, only : open_restart_read, aread_state_restart, close_restart
use time_manager_mod, only : time_type, print_time, print_date, operator(-), &
get_time, get_date
-use model_mod, only : static_init_model, sv_to_restart_file, &
- get_model_size, get_base_time, get_model_restart_dirname
+use model_mod, only : static_init_model, dart_vector_to_model_file, &
+ get_model_size
implicit none
@@ -49,12 +49,12 @@
!------------------------------------------------------------------
character (len = 128) :: dart_to_model_input_file = 'dart.ic'
-logical :: advance_time_present = .false.
-character(len=256) :: model_restart_dirname = 'model_restartdir'
+logical :: advance_time_present = .false.
+character(len=256) :: model_restart_filename = 'model_restartfile'
namelist /dart_to_model_nml/ dart_to_model_input_file, &
advance_time_present, &
- model_restart_dirname
+ model_restart_filename
!----------------------------------------------------------------------
@@ -77,7 +77,7 @@
x_size = get_model_size()
allocate(statevector(x_size))
-! Read the namelist to get the input dirname.
+! Read the namelist to get the input filename.
call find_namelist_in_file("input.nml", "dart_to_model_nml", iunit)
read(iunit, nml = dart_to_model_nml, iostat = io)
@@ -85,7 +85,7 @@
write(*,*)
write(*,*) 'dart_to_model: converting DART file ', "'"//trim(dart_to_model_input_file)//"'"
-write(*,*) 'to model restart files in directory ', "'"//trim(model_restart_dirname)//"'"
+write(*,*) 'to model restart files named ', "'"//trim(model_restart_filename)//"'"
!----------------------------------------------------------------------
! Reads the valid time, the state, and the target time.
@@ -108,7 +108,7 @@
!----------------------------------------------------------------------
print *, 'calling sv to restart file'
-call sv_to_restart_file(statevector, model_restart_dirname, model_time)
+call dart_vector_to_model_file(statevector, model_restart_filename, model_time)
if ( advance_time_present ) then
call write_model_time_control(model_time, adv_to_time)
@@ -130,15 +130,17 @@
call print_date(adv_to_time,'dart_to_model:advance_to date',logfileunit)
endif
-! When called with 'end', timestamp will call finalize_utilities()
-call timestamp(string1=source, pos='end')
+call finalize_utilities()
!======================================================================
contains
!======================================================================
subroutine write_model_time_control(model_time, adv_to_time)
-! The idea is to write a text file with the following structure:
+! Write a text file that the model can use to figure out how
+! far to run until. Could be as simple as a text file containing:
+! YYYYMMDD hh:mm:ss
+! or for something a bit more complicated, here's another example:
!
!#TIMESTART
!2003 year
Copied: DART/branches/development/models/template/full_model_mod_check.f90 (from rev 5680, DART/branches/development/models/template/model_mod_check.f90)
===================================================================
--- DART/branches/development/models/template/full_model_mod_check.f90 (rev 0)
+++ DART/branches/development/models/template/full_model_mod_check.f90 2012-04-10 22:10:14 UTC (rev 5683)
@@ -0,0 +1,324 @@
+! DART software - Copyright 2004 - 2011 UCAR. This open source software is
+! provided by UCAR, "as is", without charge, subject to all terms of use at
+! http://www.image.ucar.edu/DAReS/DART/DART_download
+
+program model_mod_check
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
+!----------------------------------------------------------------------
+! purpose: test routines
+!----------------------------------------------------------------------
+
+use types_mod, only : r8, digits12, metadatalength
+use utilities_mod, only : initialize_utilities, timestamp, nc_check, &
+ open_file, close_file, find_namelist_in_file, &
+ check_namelist_read
+use location_mod, only : location_type, set_location, write_location, get_dist, &
+ query_location, LocationDims, get_location, VERTISHEIGHT
+use obs_kind_mod, only : get_raw_obs_kind_name, get_raw_obs_kind_index
+use assim_model_mod, only : open_restart_read, open_restart_write, close_restart, &
+ aread_state_restart, awrite_state_restart, &
+ netcdf_file_type, aoutput_diagnostics, &
+ init_diag_output, finalize_diag_output
+use time_manager_mod, only : time_type, set_calendar_type, GREGORIAN, &
+ read_time, get_time, set_time, &
+ print_date, get_date, &
+ print_time, write_time, &
+ operator(-)
+use model_mod, only : static_init_model, get_model_size, get_state_meta_data, &
+ model_interpolate, get_state_time
+ ! test_interpolate
+
+implicit none
+
+! version controlled file description for error handling, do not edit
+character(len=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
+
+!------------------------------------------------------------------
+! The namelist variables
+!------------------------------------------------------------------
+
+character (len = 129) :: input_file = 'dart.ics'
+character (len = 129) :: output_file = 'check_me'
+logical :: advance_time_present = .FALSE.
+logical :: verbose = .FALSE.
+integer :: x_ind = -1
+real(r8), dimension(3) :: loc_of_interest = -1.0_r8
+character(len=metadatalength) :: kind_of_interest = 'ANY'
+
+namelist /model_mod_check_nml/ input_file, output_file, &
+ advance_time_present, x_ind, &
+ loc_of_interest, kind_of_interest, verbose
+
+!----------------------------------------------------------------------
+! integer :: numlons, numlats, numlevs
+
+integer :: in_unit, out_unit, ios_out, iunit, io, offset
+integer :: x_size
+integer :: year, month, day, hour, minute, second
+integer :: secs, days
+
+type(time_type) :: model_time, adv_to_time
+real(r8), allocatable :: statevector(:)
+
+character(len=metadatalength) :: state_meta(1)
+type(netcdf_file_type) :: ncFileID
+type(location_type) :: loc
+
+real(r8) :: interp_val
+
+!----------------------------------------------------------------------
+! This portion checks the geometry information.
+!----------------------------------------------------------------------
+
+call initialize_utilities(progname='model_mod_check')
+call set_calendar_type(GREGORIAN)
+
+write(*,*)
+write(*,*)'Reading the namelist to get the input filename.'
+
+call find_namelist_in_file("input.nml", "model_mod_check_nml", iunit)
+read(iunit, nml = model_mod_check_nml, iostat = io)
+call check_namelist_read(iunit, io, "model_mod_check_nml")
+
+! This harvests all kinds of initialization information
+call static_init_model()
+
+x_size = get_model_size()
+write(*,'(''state vector has length'',i10)') x_size
+allocate(statevector(x_size))
+
+!----------------------------------------------------------------------
+! Write a supremely simple restart file. Most of the time, I just use
+! this as a starting point for a Matlab function that replaces the
+! values with something more complicated.
+!----------------------------------------------------------------------
+
+write(*,*)
+write(*,*)'Writing a trivial restart file.'
+
+statevector = 1.0_r8;
+model_time = set_time(21600, 149446) ! 06Z 4 March 2010
+
+iunit = open_restart_write('allones.ics')
+call awrite_state_restart(model_time, statevector, iunit)
+call close_restart(iunit)
+
+!----------------------------------------------------------------------
+! Reads the valid time from the header.rst file
+!----------------------------------------------------------------------
+
+model_time = get_state_time('../testdata1')
+call print_date( model_time,'model_mod_check:model date')
+call print_time( model_time,'model_mod_check:model time')
+
+!----------------------------------------------------------------------
+! Open a test DART initial conditions file.
+! Reads the valid time, the state, and (possibly) a target time.
+!----------------------------------------------------------------------
+
+write(*,*)
+write(*,*)'Reading '//trim(input_file)
+
+iunit = open_restart_read(input_file)
+if ( advance_time_present ) then
+ call aread_state_restart(model_time, statevector, iunit, adv_to_time)
+else
+ call aread_state_restart(model_time, statevector, iunit)
+endif
+
+call close_restart(iunit)
+call print_date( model_time,'model_mod_check:model date')
+call print_time( model_time,'model_mod_check:model time')
+
+!----------------------------------------------------------------------
+! Output the state vector to a netCDF file ...
+! This is the same procedure used by 'perfect_model_obs' & 'filter'
+! init_diag_output()
+! aoutput_diagnostics()
+! finalize_diag_output()
+!----------------------------------------------------------------------
+
+write(*,*)
+write(*,*)'Exercising the netCDF routines.'
+write(*,*)'Creating '//trim(output_file)//'.nc'
+
+state_meta(1) = 'restart test'
+ncFileID = init_diag_output(trim(output_file),'just testing a restart', 1, state_meta)
+
+call aoutput_diagnostics(ncFileID, model_time, statevector, 1)
+
+call nc_check( finalize_diag_output(ncFileID), 'model_mod_check:main', 'finalize')
+
+!----------------------------------------------------------------------
+! Checking get_state_meta_data (and get_state_indices, get_state_kind)
+! nx = 144; ny=72; nz=42; produce the expected values :
+! U( 1 : 435456)
+! V( 435457 : 870912)
+! T( 870913 : 1306368)
+! Q( 1306369 : 1741824)
+! PS( 1741825 : 1752193) (only 144x72)
+!----------------------------------------------------------------------
+
+if ( x_ind > 0 .and. x_ind <= x_size ) call check_meta_data( x_ind )
+
+write(*,*)'Manually Stopping'
+stop
+
+!----------------------------------------------------------------------
+! Trying to find the state vector index closest to a particular ...
+! Checking for valid input is tricky ... we don't know much.
+!----------------------------------------------------------------------
+
+if ( loc_of_interest(1) > 0.0_r8 ) call find_closest_gridpoint( loc_of_interest )
+
+!----------------------------------------------------------------------
+! Check the interpolation - print initially to STDOUT
+!----------------------------------------------------------------------
+
+
+write(*,*)
+write(*,*)'Testing model_interpolate ...'
+
+! KIND_SNOWCOVER_FRAC = 90, & comes from the obs_kind_mod.f90
+
+call model_interpolate(statevector, loc, 90 , interp_val, ios_out)
+
+if ( ios_out == 0 ) then
+ write(*,*)'model_interpolate SUCCESS: The interpolated value is ',interp_val
+else
+ write(*,*)'model_interpolate ERROR: model_interpolate failed with error code ',ios_out
+endif
+
+!----------------------------------------------------------------------
+! When called with 'end', timestamp will call finalize_utilities()
+! This must be the last few lines of the main program.
+!----------------------------------------------------------------------
+call timestamp(string1=source, pos='end')
+
+contains
+
+
+subroutine check_meta_data( iloc )
+
+integer, intent(in) :: iloc
+type(location_type) :: loc
+integer :: var_type
+character(len=129) :: string1
+
+write(*,*)
+write(*,*)'Checking metadata routines.'
+
+call get_state_meta_data( iloc, loc, var_type)
+
+call write_location(42, loc, fform='formatted', charstring=string1)
+write(*,*)' indx ',iloc,' is type ',var_type,trim(string1)
+
+end subroutine check_meta_data
+
+
+
+subroutine find_closest_gridpoint( loc_of_interest )
+! Simple exhaustive search to find the indices into the
+! state vector of a particular lon/lat/level. They will
+! occur multiple times - once for each state variable.
+real(r8), dimension(:), intent(in) :: loc_of_interest
+
+type(location_type) :: loc0, loc1
+integer :: mykindindex
+integer :: i, var_type, which_vert
+real(r8) :: closest, rlon, rlat, rlev
+real(r8), allocatable, dimension(:) :: thisdist
+real(r8), dimension(LocationDims) :: rloc
+character(len=32) :: kind_name
+logical :: matched
+
+! Check user input ... if there is no 'vertical' ...
+if ( (count(loc_of_interest >= 0.0_r8) < 3) .or. &
+ (LocationDims < 3 ) ) then
+ write(*,*)
+ write(*,*)'Interface not fully implemented.'
+ return
+endif
+
+write(*,*)
+write(*,'(''Checking for the indices into the state vector that are at'')')
+write(*,'(''lon/lat/lev'',3(1x,f10.5))')loc_of_interest(1:LocationDims)
+
+allocate( thisdist(get_model_size()) )
+thisdist = 9999999999.9_r8 ! really far away
+matched = .false.
+
+! Trying to support the ability to specify matching a particular KIND.
+! With staggered grids, the closest gridpoint might not be of the kind
+! you are interested in. mykindindex = -1 means anything will do.
+
+mykindindex = get_raw_obs_kind_index(kind_of_interest)
+
+rlon = loc_of_interest(1)
+rlat = loc_of_interest(2)
+rlev = loc_of_interest(3)
+
+! Since there can be/will be multiple variables with
+! identical distances, we will just cruise once through
+! the array and come back to find all the 'identical' values.
+do i = 1,get_model_size()
+
+ ! Really inefficient, but grab the 'which_vert' from the
+ ! grid and set our target location to have the same.
+ ! Then, compute the distance and compare.
+
+ call get_state_meta_data(i, loc1, var_type)
+
+ if ( (var_type == mykindindex) .or. (mykindindex < 0) ) then
+ which_vert = nint( query_location(loc1) )
+ loc0 = set_location(rlon, rlat, rlev, which_vert)
+ thisdist(i) = get_dist( loc1, loc0, no_vert= .true. )
+ matched = .true.
+ endif
+
+enddo
+
+closest = minval(thisdist)
+
+if (.not. matched) then
+ write(*,*)'No state vector elements of type '//trim(kind_of_interest)
+ return
+endif
+
+! Now that we know the distances ... report
+
+matched = .false.
+do i = 1,get_model_size()
+
+ if ( thisdist(i) == closest ) then
+ call get_state_meta_data(i, loc1, var_type)
+ rloc = get_location(loc1)
+ if (nint(rloc(3)) == nint(rlev)) then
+ kind_name = get_raw_obs_kind_name(var_type)
+ write(*,'(''lon/lat/lev'',3(1x,f10.5),'' is index '',i10,'' for '',a)') &
+ rloc, i, trim(kind_name)
+ matched = .true.
+ endif
+ endif
+
+enddo
+
+if ( .not. matched ) then
+ write(*,*)'Nothing matched the vertical.'
+endif
+
+deallocate( thisdist )
+
+end subroutine find_closest_gridpoint
+
+
+end program model_mod_check
Modified: DART/branches/development/models/template/model_mod.f90
===================================================================
--- DART/branches/development/models/template/model_mod.f90 2012-04-10 20:42:39 UTC (rev 5682)
+++ DART/branches/development/models/template/model_mod.f90 2012-04-10 22:10:14 UTC (rev 5683)
@@ -30,6 +30,9 @@
implicit none
private
+! required by DART code - will be called from filter and other
+! DART executables. interfaces to these routines are fixed and
+! cannot be changed in any way.
public :: get_model_size, &
adv_1step, &
get_state_meta_data, &
@@ -47,7 +50,13 @@
get_close_obs, &
ens_mean_for_model
+! not required by DART but for larger models can be useful for
+! utility programs that are tightly tied to the other parts of
+! the model_mod code.
+public :: model_file_to_dart_vector, &
+ dart_vector_to_model_file
+
! version controlled file description for error handling, do not edit
character(len=128), parameter :: &
source = "$URL$", &
@@ -599,7 +608,42 @@
end subroutine ens_mean_for_model
+!==================================================================
+! PUBLIC interfaces that aren't required by the DART code but are
+! generally useful for other related utility programs.
+! (less necessary for small models; generally used for larger models
+! with predefined file formats and control structures.)
+!==================================================================
+
+subroutine model_file_to_dart_vector(filename, state_vector, model_time)
+!------------------------------------------------------------------
+! Reads the current time and state variables from a model data
+! file and packs them into a dart state vector.
+
+character(len=*), intent(in) :: filename
+real(r8), intent(inout) :: state_vector(:)
+type(time_type), intent(out) :: model_time
+
+! code goes here
+
+end subroutine model_file_to_dart_vector
+
+
+subroutine dart_vector_to_model_file(state_vector, filename, statedate)
+!------------------------------------------------------------------
+! Writes the current time and state variables from a dart state
+! vector (1d array) into a ncommas netcdf restart file.
+!
+real(r8), intent(in) :: state_vector(:)
+character(len=*), intent(in) :: filename
+type(time_type), intent(in) :: statedate
+
+! code goes here
+
+end subroutine dart_vector_to_model_file
+
+
!===================================================================
! End of model_mod
!===================================================================
Deleted: DART/branches/development/models/template/model_mod_check.f90
===================================================================
--- DART/branches/development/models/template/model_mod_check.f90 2012-04-10 20:42:39 UTC (rev 5682)
+++ DART/branches/development/models/template/model_mod_check.f90 2012-04-10 22:10:14 UTC (rev 5683)
@@ -1,324 +0,0 @@
-! DART software - Copyright 2004 - 2011 UCAR. This open source software is
-! provided by UCAR, "as is", without charge, subject to all terms of use at
-! http://www.image.ucar.edu/DAReS/DART/DART_download
-
-program model_mod_check
-
-!
-! $URL$
-! $Id$
-! $Revision$
-! $Date$
-
-!----------------------------------------------------------------------
-! purpose: test routines
-!----------------------------------------------------------------------
-
-use types_mod, only : r8, digits12, metadatalength
-use utilities_mod, only : initialize_utilities, timestamp, nc_check, &
- open_file, close_file, find_namelist_in_file, &
- check_namelist_read
-use location_mod, only : location_type, set_location, write_location, get_dist, &
- query_location, LocationDims, get_location, VERTISHEIGHT
-use obs_kind_mod, only : get_raw_obs_kind_name, get_raw_obs_kind_index
-use assim_model_mod, only : open_restart_read, open_restart_write, close_restart, &
- aread_state_restart, awrite_state_restart, &
- netcdf_file_type, aoutput_diagnostics, &
- init_diag_output, finalize_diag_output
-use time_manager_mod, only : time_type, set_calendar_type, GREGORIAN, &
- read_time, get_time, set_time, &
- print_date, get_date, &
- print_time, write_time, &
- operator(-)
-use model_mod, only : static_init_model, get_model_size, get_state_meta_data, &
- model_interpolate, get_state_time
- ! test_interpolate
-
-implicit none
-
-! version controlled file description for error handling, do not edit
-character(len=128), parameter :: &
- source = "$URL$", &
- revision = "$Revision$", &
- revdate = "$Date$"
-
-!------------------------------------------------------------------
-! The namelist variables
-!------------------------------------------------------------------
-
-character (len = 129) :: input_file = 'dart.ics'
-character (len = 129) :: output_file = 'check_me'
-logical :: advance_time_present = .FALSE.
-logical :: verbose = .FALSE.
-integer :: x_ind = -1
-real(r8), dimension(3) :: loc_of_interest = -1.0_r8
-character(len=metadatalength) :: kind_of_interest = 'ANY'
-
-namelist /model_mod_check_nml/ input_file, output_file, &
- advance_time_present, x_ind, &
- loc_of_interest, kind_of_interest, verbose
-
-!----------------------------------------------------------------------
-! integer :: numlons, numlats, numlevs
-
-integer :: in_unit, out_unit, ios_out, iunit, io, offset
-integer :: x_size
-integer :: year, month, day, hour, minute, second
-integer :: secs, days
-
-type(time_type) :: model_time, adv_to_time
-real(r8), allocatable :: statevector(:)
-
-character(len=metadatalength) :: state_meta(1)
-type(netcdf_file_type) :: ncFileID
-type(location_type) :: loc
-
-real(r8) :: interp_val
-
-!----------------------------------------------------------------------
-! This portion checks the geometry information.
-!----------------------------------------------------------------------
-
-call initialize_utilities(progname='model_mod_check')
-call set_calendar_type(GREGORIAN)
-
-write(*,*)
-write(*,*)'Reading the namelist to get the input filename.'
-
-call find_namelist_in_file("input.nml", "model_mod_check_nml", iunit)
-read(iunit, nml = model_mod_check_nml, iostat = io)
-call check_namelist_read(iunit, io, "model_mod_check_nml")
-
-! This harvests all kinds of initialization information
-call static_init_model()
-
-x_size = get_model_size()
-write(*,'(''state vector has length'',i10)') x_size
-allocate(statevector(x_size))
-
-!----------------------------------------------------------------------
-! Write a supremely simple restart file. Most of the time, I just use
-! this as a starting point for a Matlab function that replaces the
-! values with something more complicated.
-!----------------------------------------------------------------------
-
-write(*,*)
-write(*,*)'Writing a trivial restart file.'
-
-statevector = 1.0_r8;
-model_time = set_time(21600, 149446) ! 06Z 4 March 2010
-
-iunit = open_restart_write('allones.ics')
-call awrite_state_restart(model_time, statevector, iunit)
-call close_restart(iunit)
-
-!----------------------------------------------------------------------
-! Reads the valid time from the header.rst file
-!----------------------------------------------------------------------
-
-model_time = get_state_time('../testdata1')
-call print_date( model_time,'model_mod_check:model date')
-call print_time( model_time,'model_mod_check:model time')
-
-!----------------------------------------------------------------------
-! Open a test DART initial conditions file.
-! Reads the valid time, the state, and (possibly) a target time.
-!----------------------------------------------------------------------
-
-write(*,*)
-write(*,*)'Reading '//trim(input_file)
-
-iunit = open_restart_read(input_file)
-if ( advance_time_present ) then
- call aread_state_restart(model_time, statevector, iunit, adv_to_time)
-else
- call aread_state_restart(model_time, statevector, iunit)
-endif
-
-call close_restart(iunit)
-call print_date( model_time,'model_mod_check:model date')
-call print_time( model_time,'model_mod_check:model time')
-
-!----------------------------------------------------------------------
-! Output the state vector to a netCDF file ...
-! This is the same procedure used by 'perfect_model_obs' & 'filter'
-! init_diag_output()
-! aoutput_diagnostics()
-! finalize_diag_output()
-!----------------------------------------------------------------------
-
-write(*,*)
-write(*,*)'Exercising the netCDF routines.'
-write(*,*)'Creating '//trim(output_file)//'.nc'
-
-state_meta(1) = 'restart test'
-ncFileID = init_diag_output(trim(output_file),'just testing a restart', 1, state_meta)
-
-call aoutput_diagnostics(ncFileID, model_time, statevector, 1)
-
-call nc_check( finalize_diag_output(ncFileID), 'model_mod_check:main', 'finalize')
-
-!----------------------------------------------------------------------
-! Checking get_state_meta_data (and get_state_indices, get_state_kind)
-! nx = 144; ny=72; nz=42; produce the expected values :
-! U( 1 : 435456)
-! V( 435457 : 870912)
-! T( 870913 : 1306368)
-! Q( 1306369 : 1741824)
-! PS( 1741825 : 1752193) (only 144x72)
-!----------------------------------------------------------------------
-
-if ( x_ind > 0 .and. x_ind <= x_size ) call check_meta_data( x_ind )
-
-write(*,*)'Manually Stopping'
-stop
-
-!----------------------------------------------------------------------
-! Trying to find the state vector index closest to a particular ...
-! Checking for valid input is tricky ... we don't know much.
-!----------------------------------------------------------------------
-
-if ( loc_of_interest(1) > 0.0_r8 ) call find_closest_gridpoint( loc_of_interest )
-
-!----------------------------------------------------------------------
-! Check the interpolation - print initially to STDOUT
-!----------------------------------------------------------------------
-
-
-write(*,*)
-write(*,*)'Testing model_interpolate ...'
-
-! KIND_SNOWCOVER_FRAC = 90, & comes from the obs_kind_mod.f90
-
-call model_interpolate(statevector, loc, 90 , interp_val, ios_out)
-
-if ( ios_out == 0 ) then
- write(*,*)'model_interpolate SUCCESS: The interpolated value is ',interp_val
-else
- write(*,*)'model_interpolate ERROR: model_interpolate failed with error code ',ios_out
-endif
-
-!----------------------------------------------------------------------
-! When called with 'end', timestamp will call finalize_utilities()
-! This must be the last few lines of the main program.
-!----------------------------------------------------------------------
-call timestamp(string1=source, pos='end')
-
-contains
-
-
-subroutine check_meta_data( iloc )
-
-integer, intent(in) :: iloc
-type(location_type) :: loc
-integer :: var_type
-character(len=129) :: string1
-
-write(*,*)
-write(*,*)'Checking metadata routines.'
-
-call get_state_meta_data( iloc, loc, var_type)
-
-call write_location(42, loc, fform='formatted', charstring=string1)
-write(*,*)' indx ',iloc,' is type ',var_type,trim(string1)
-
-end subroutine check_meta_data
-
-
-
-subroutine find_closest_gridpoint( loc_of_interest )
-! Simple exhaustive search to find the indices into the
-! state vector of a particular lon/lat/level. They will
-! occur multiple times - once for each state variable.
-real(r8), dimension(:), intent(in) :: loc_of_interest
-
-type(location_type) :: loc0, loc1
-integer :: mykindindex
-integer :: i, var_type, which_vert
-real(r8) :: closest, rlon, rlat, rlev
-real(r8), allocatable, dimension(:) :: thisdist
-real(r8), dimension(LocationDims) :: rloc
-character(len=32) :: kind_name
-logical :: matched
-
-! Check user input ... if there is no 'vertical' ...
-if ( (count(loc_of_interest >= 0.0_r8) < 3) .or. &
- (LocationDims < 3 ) ) then
- write(*,*)
- write(*,*)'Interface not fully implemented.'
- return
-endif
-
-write(*,*)
-write(*,'(''Checking for the indices into the state vector that are at'')')
-write(*,'(''lon/lat/lev'',3(1x,f10.5))')loc_of_interest(1:LocationDims)
-
-allocate( thisdist(get_model_size()) )
-thisdist = 9999999999.9_r8 ! really far away
-matched = .false.
-
-! Trying to support the ability to specify matching a particular KIND.
-! With staggered grids, the closest gridpoint might not be of the kind
-! you are interested in. mykindindex = -1 means anything will do.
-
-mykindindex = get_raw_obs_kind_index(kind_of_interest)
-
-rlon = loc_of_interest(1)
-rlat = loc_of_interest(2)
-rlev = loc_of_interest(3)
-
-! Since there can be/will be multiple variables with
-! identical distances, we will just cruise once through
-! the array and come back to find all the 'identical' values.
-do i = 1,get_model_size()
-
- ! Really inefficient, but grab the 'which_vert' from the
- ! grid and set our target location to have the same.
- ! Then, compute the distance and compare.
-
- call get_state_meta_data(i, loc1, var_type)
-
- if ( (var_type == mykindindex) .or. (mykindindex < 0) ) then
- which_vert = nint( query_location(loc1) )
- loc0 = set_location(rlon, rlat, rlev, which_vert)
- thisdist(i) = get_dist( loc1, loc0, no_vert= .true. )
- matched = .true.
- endif
-
-enddo
-
-closest = minval(thisdist)
-
-if (.not. matched) then
- write(*,*)'No state vector elements of type '//trim(kind_of_interest)
- return
-endif
-
-! Now that we know the distances ... report
-
-matched = .false.
-do i = 1,get_model_size()
-
- if ( thisdist(i) == closest ) then
- call get_state_meta_data(i, loc1, var_type)
- rloc = get_location(loc1)
- if (nint(rloc(3)) == nint(rlev)) then
- kind_name = get_raw_obs_kind_name(var_type)
- write(*,'(''lon/lat/lev'',3(1x,f10.5),'' is index '',i10,'' for '',a)') &
- rloc, i, trim(kind_name)
- matched = .true.
- endif
- endif
-
-enddo
-
-if ( .not. matched ) then
- write(*,*)'Nothing matched the vertical.'
-endif
-
-deallocate( thisdist )
-
-end subroutine find_closest_gridpoint
-
-
-end program model_mod_check
Modified: DART/branches/development/models/template/model_to_dart.f90
===================================================================
--- DART/branches/development/models/template/model_to_dart.f90 2012-04-10 20:42:39 UTC (rev 5682)
+++ DART/branches/development/models/template/model_to_dart.f90 2012-04-10 22:10:14 UTC (rev 5683)
@@ -18,7 +18,7 @@
! Write out state vector in "proprietary" format for DART.
! The output is a "DART restart file" format.
!
-! USAGE: The model dirname is read from the model_in namelist
+! USAGE: The model filename is read from the model_in namelist
!
! model_to_dart
!
@@ -26,10 +26,9 @@
!----------------------------------------------------------------------
use types_mod, only : r8
-use utilities_mod, only : initialize_utilities, timestamp, &
+use utilities_mod, only : initialize_utilities, finalize_utilities, &
find_namelist_in_file, check_namelist_read
-use model_mod, only : get_model_size, restart_file_to_sv, &
- get_model_restart_dirname
+use model_mod, only : get_model_size, model_file_to_dart_vector
use assim_model_mod, only : awrite_state_restart, open_restart_write, close_restart
use time_manager_mod, only : time_type, print_time, print_date
@@ -46,11 +45,11 @@
!-----------------------------------------------------------------------
character(len=128) :: model_to_dart_output_file = 'dart.ud'
-character(len=256) :: model_restart_dirname = 'model_restartdir'
+character(len=256) :: model_restart_filename = 'model_restartfile'
namelist /model_to_dart_nml/ &
model_to_dart_output_file, &
- model_restart_dirname
+ model_restart_filename
!----------------------------------------------------------------------
! global storage
@@ -66,7 +65,7 @@
call initialize_utilities(progname='model_to_dart', output_flag=verbose)
!----------------------------------------------------------------------
-! Read the namelist to get the output dirname.
+! Read the namelist to get the output filename.
!----------------------------------------------------------------------
call find_namelist_in_file("input.nml", "model_to_dart_nml", iunit)
@@ -74,8 +73,8 @@
call check_namelist_read(iunit, io, "model_to_dart_nml") ! closes, too.
write(*,*)
-write(*,*) 'model_to_dart: converting model restart files in directory ', &
- "'"//trim(model_restart_dirname)//"'"
+write(*,*) 'model_to_dart: converting model restart data in file ', &
+ "'"//trim(model_restart_filename)//"'"
write(*,*) ' to DART file ', "'"//trim(model_to_dart_output_file)//"'"
!----------------------------------------------------------------------
@@ -85,22 +84,20 @@
x_size = get_model_size()
allocate(statevector(x_size))
-call get_model_restart_dirname( model_restart_dirname )
+call model_file_to_dart_vector(model_restart_filename, statevector, model_time)
-call restart_file_to_sv(model_restart_dirname, statevector, model_time)
-
iunit = open_restart_write(model_to_dart_output_file)
call awrite_state_restart(model_time, statevector, iunit)
call close_restart(iunit)
!----------------------------------------------------------------------
-! When called with 'end', timestamp will call finalize_utilities()
+! finish up
!----------------------------------------------------------------------
call print_date(model_time, str='model_to_dart:model model date')
call print_time(model_time, str='model_to_dart:DART model time')
-call timestamp(string1=source, pos='end')
+call finalize_utilities()
end program model_to_dart
Modified: DART/branches/development/models/template/work/input.nml
===================================================================
--- DART/branches/development/models/template/work/input.nml 2012-04-10 20:42:39 UTC (rev 5682)
+++ DART/branches/development/models/template/work/input.nml 2012-04-10 22:10:14 UTC (rev 5683)
@@ -186,7 +186,18 @@
gregorian_cal = .true.
/
+&model_to_dart_nml
+ model_to_dart_output_file = 'filter_ics'
+ model_restart_filename = 'modelfile'
+/
+&dart_to_model_nml
+ dart_to_model_input_file = 'filter_restart'
+ advance_time_present = .false.
+ model_restart_filename = 'modelfile'
+/
+
+
&obs_diag_nml
obs_sequence_name = 'obs_seq.final',
iskip_days = 0,
Deleted: DART/branches/development/models/template/work/mkmf_trans_time
===================================================================
--- DART/branches/development/models/template/work/mkmf_trans_time 2012-04-10 20:42:39 UTC (rev 5682)
+++ DART/branches/development/models/template/work/mkmf_trans_time 2012-04-10 22:10:14 UTC (rev 5683)
@@ -1,18 +0,0 @@
-#!/bin/csh
-#
-# DART software - Copyright 2004 - 2011 UCAR. This open source software is
-# provided by UCAR, "as is", without charge, subject to all terms of use at
-# http://www.image.ucar.edu/DAReS/DART/DART_download
-#
-# $Id$
-
-../../../mkmf/mkmf -p trans_time -t ../../../mkmf/mkmf.template -c"-Duse_netCDF" \
- -a "../../.." path_names_trans_time
-
-exit $status
-
-#
-# $URL$
-# $Revision$
-# $Date$
-
Modified: DART/branches/development/models/template/work/path_names_dart_to_model
===================================================================
--- DART/branches/development/models/template/work/path_names_dart_to_model 2012-04-10 20:42:39 UTC (rev 5682)
+++ DART/branches/development/models/template/work/path_names_dart_to_model 2012-04-10 22:10:14 UTC (rev 5683)
@@ -1,7 +1,7 @@
models/template/dart_to_model.f90
assim_model/assim_model_mod.f90
common/types_mod.f90
-location/threed_sphere/location_mod.f90
+location/oned/location_mod.f90
models/template/model_mod.f90
mpi_utilities/null_mpi_utilities_mod.f90
obs_kind/obs_kind_mod.f90
Modified: DART/branches/development/models/template/work/path_names_model_mod_check
===================================================================
--- DART/branches/development/models/template/work/path_names_model_mod_check 2012-04-10 20:42:39 UTC (rev 5682)
+++ DART/branches/development/models/template/work/path_names_model_mod_check 2012-04-10 22:10:14 UTC (rev 5683)
@@ -1,7 +1,8 @@
models/template/model_mod_check.f90
assim_model/assim_model_mod.f90
common/types_mod.f90
-location/threed_sphere/location_mod.f90
+cov_cutoff/cov_cutoff_mod.f90
+location/oned/location_mod.f90
models/template/model_mod.f90
mpi_utilities/null_mpi_utilities_mod.f90
obs_def/obs_def_mod.f90
Modified: DART/branches/development/models/template/work/path_names_model_to_dart
===================================================================
--- DART/branches/development/models/template/work/path_names_model_to_dart 2012-04-10 20:42:39 UTC (rev 5682)
+++ DART/branches/development/models/template/work/path_names_model_to_dart 2012-04-10 22:10:14 UTC (rev 5683)
@@ -1,7 +1,7 @@
models/template/model_to_dart.f90
assim_model/assim_model_mod.f90
common/types_mod.f90
-location/threed_sphere/location_mod.f90
+location/oned/location_mod.f90
models/template/model_mod.f90
mpi_utilities/null_mpi_utilities_mod.f90
obs_kind/obs_kind_mod.f90
Deleted: DART/branches/development/models/template/work/path_names_trans_time
===================================================================
--- DART/branches/development/models/template/work/path_names_trans_time 2012-04-10 20:42:39 UTC (rev 5682)
+++ DART/branches/development/models/template/work/path_names_trans_time 2012-04-10 22:10:14 UTC (rev 5683)
@@ -1,5 +0,0 @@
-common/types_mod.f90
-models/template/utils/trans_time.f90
-mpi_utilities/null_mpi_utilities_mod.f90
-time_manager/time_manager_mod.f90
-utilities/utilities_mod.f90
From nancy at ucar.edu Tue Apr 10 16:11:43 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Tue, 10 Apr 2012 16:11:43 -0600
Subject: [Dart-dev] [5684]
DART/branches/development/models/template/model_mod_check.f90: missed this
file in the last checkin.
Message-ID:
Revision: 5684
Author: nancy
Date: 2012-04-10 16:11:43 -0600 (Tue, 10 Apr 2012)
Log Message:
-----------
missed this file in the last checkin. a ones version
of the model_mod_check program.
Added Paths:
-----------
DART/branches/development/models/template/model_mod_check.f90
-------------- next part --------------
Added: DART/branches/development/models/template/model_mod_check.f90
===================================================================
--- DART/branches/development/models/template/model_mod_check.f90 (rev 0)
+++ DART/branches/development/models/template/model_mod_check.f90 2012-04-10 22:11:43 UTC (rev 5684)
@@ -0,0 +1,255 @@
+! DART software - Copyright 2004 - 2011 UCAR. This open source software is
+! provided by UCAR, "as is", without charge, subject to all terms of use at
+! http://www.image.ucar.edu/DAReS/DART/DART_download
+
+program model_mod_check
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
+!----------------------------------------------------------------------
+! purpose: test routines. this version for models with oned locations.
+!----------------------------------------------------------------------
+
+use types_mod, only : r8, digits12, metadatalength
+use utilities_mod, only : initialize_utilities, finalize_utilities, nc_check, &
+ open_file, close_file, find_namelist_in_file, &
+ check_namelist_read
+use location_mod, only : location_type, set_location, write_location, get_dist, &
+ query_location, LocationDims, get_location
+use obs_kind_mod, only : get_raw_obs_kind_name, get_raw_obs_kind_index
+use assim_model_mod, only : open_restart_read, open_restart_write, close_restart, &
+ aread_state_restart, awrite_state_restart, &
+ netcdf_file_type, aoutput_diagnostics, &
+ init_diag_output, finalize_diag_output
+use time_manager_mod, only : time_type, set_calendar_type, NO_CALENDAR, &
+ read_time, get_time, set_time, &
+ print_time, write_time, operator(-)
+use model_mod, only : static_init_model, get_model_size, get_state_meta_data, &
+ model_interpolate
+
+implicit none
+
+! version controlled file description for error handling, do not edit
+character(len=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
+
+!------------------------------------------------------------------
+! The namelist variables
+!------------------------------------------------------------------
+
+character (len = 129) :: input_file = 'dart.ics'
+character (len = 129) :: output_file = 'check_me'
+logical :: advance_time_present = .FALSE.
+logical :: verbose = .FALSE.
+integer :: x_ind = -1
+real(r8) :: loc_of_interest = -1.0_r8
+character(len=metadatalength) :: kind_of_interest = 'ANY'
+
+namelist /model_mod_check_nml/ input_file, output_file, &
+ advance_time_present, x_ind, &
+ loc_of_interest, kind_of_interest, verbose
+
+!----------------------------------------------------------------------
+! integer :: numlons, numlats, numlevs
+
+integer :: in_unit, out_unit, ios_out, iunit, io, offset
+integer :: x_size
+integer :: year, month, day, hour, minute, second
+integer :: secs, days
+
+type(time_type) :: model_time, adv_to_time
+real(r8), allocatable :: statevector(:)
+
+character(len=metadatalength) :: state_meta(1)
+type(netcdf_file_type) :: ncFileID
+type(location_type) :: loc
+
+real(r8) :: interp_val
+
+!----------------------------------------------------------------------
+! This portion checks the geometry information.
+!----------------------------------------------------------------------
+
+call initialize_utilities(progname='model_mod_check')
+call set_calendar_type(NO_CALENDAR)
+
+write(*,*)
+write(*,*)'Reading the namelist to get the input filename.'
+
+call find_namelist_in_file("input.nml", "model_mod_check_nml", iunit)
+read(iunit, nml = model_mod_check_nml, iostat = io)
+call check_namelist_read(iunit, io, "model_mod_check_nml")
+
+! This harvests all kinds of initialization information
+call static_init_model()
+
+x_size = get_model_size()
+write(*,'(''state vector has length'',i10)') x_size
+allocate(statevector(x_size))
+
+!----------------------------------------------------------------------
+! Write a supremely simple restart file. Most of the time, I just use
+! this as a starting point for a Matlab function that replaces the
+! values with something more complicated.
+!----------------------------------------------------------------------
+
+write(*,*)
+write(*,*)'Writing a trivial restart file.'
+
+statevector = 1.0_r8;
+model_time = set_time(21600, 149446) ! 06Z 4 March 2010
+
+iunit = open_restart_write('allones.ics')
+call awrite_state_restart(model_time, statevector, iunit)
+call close_restart(iunit)
+
+!----------------------------------------------------------------------
+! Reads the valid time from the header.rst file
+!----------------------------------------------------------------------
+
+!model_time = get_state_time('../testdata1')
+model_time = set_time(0,0)
+call print_time( model_time,'model_mod_check:model time')
+
+!----------------------------------------------------------------------
+! Open a test DART initial conditions file.
+! Reads the valid time, the state, and (possibly) a target time.
+!----------------------------------------------------------------------
+
+write(*,*)
+write(*,*)'Reading '//trim(input_file)
+
+iunit = open_restart_read(input_file)
+if ( advance_time_present ) then
+ call aread_state_restart(model_time, statevector, iunit, adv_to_time)
+else
+ call aread_state_restart(model_time, statevector, iunit)
+endif
+
+call close_restart(iunit)
+call print_time( model_time,'model_mod_check:model time')
+
+!----------------------------------------------------------------------
+! Output the state vector to a netCDF file ...
+! This is the same procedure used by 'perfect_model_obs' & 'filter'
+! init_diag_output()
+! aoutput_diagnostics()
+! finalize_diag_output()
+!----------------------------------------------------------------------
+
+write(*,*)
+write(*,*)'Exercising the netCDF routines.'
+write(*,*)'Creating '//trim(output_file)//'.nc'
+
+state_meta(1) = 'restart test'
+ncFileID = init_diag_output(trim(output_file),'just testing a restart', 1, state_meta)
+
+call aoutput_diagnostics(ncFileID, model_time, statevector, 1)
+
+call nc_check( finalize_diag_output(ncFileID), 'model_mod_check:main', 'finalize')
+
+if ( x_ind > 0 .and. x_ind <= x_size ) call check_meta_data( x_ind )
+
+!----------------------------------------------------------------------
+! Trying to find the state vector index closest to a particular ...
+! Checking for valid input is tricky ... we don't know much.
+!----------------------------------------------------------------------
+
+if ( loc_of_interest >= 0.0_r8 ) call find_closest_gridpoint( loc_of_interest )
+
+!----------------------------------------------------------------------
+! Check the interpolation - print initially to STDOUT
+!----------------------------------------------------------------------
+
+
+write(*,*)
+write(*,*)'Testing model_interpolate ...'
+
+call model_interpolate(statevector, loc, 1 , interp_val, ios_out)
+
+if ( ios_out == 0 ) then
+ write(*,*)'model_interpolate SUCCESS: The interpolated value is ',interp_val
+else
+ write(*,*)'model_interpolate ERROR: model_interpolate failed with error code ',ios_out
+endif
+
+call finalize_utilities()
+
+! end of main program
+
+contains
+
+
+subroutine check_meta_data( iloc )
+
+integer, intent(in) :: iloc
+type(location_type) :: loc
+integer :: var_type
+character(len=129) :: string1
+
+write(*,*)
+write(*,*)'Checking metadata routines.'
+
+call get_state_meta_data( iloc, loc, var_type)
+
+call write_location(42, loc, fform='formatted', charstring=string1)
+write(*,*)' indx ',iloc,' is type ',var_type,trim(string1)
+
+end subroutine check_meta_data
+
+
+
+subroutine find_closest_gridpoint( loc_of_interest )
+! Simple exhaustive search to find the indices into the
+! state vector of a particular location.
+real(r8), intent(in) :: loc_of_interest
+
+type(location_type) :: loc0, loc1
+integer :: i, indx(1)
+real(r8) :: closest
+character(len=129) :: string1
+real(r8), allocatable, dimension(:) :: thisdist
+
+write(*,*)
+write(*,'(''Checking for the indices into the state vector that are at'')')
+call write_location(42, loc, fform='formatted', charstring=string1)
+write(*,*) trim(string1)
+
+allocate( thisdist(get_model_size()) )
+thisdist = 9999999999.9_r8 ! really far away
+
+
+loc0 = set_location(loc_of_interest)
+
+! Since there can be multiple variables with
+! identical distances, we will just cruise once through
+! the array and come back to find all the 'identical' values.
+do i = 1,get_model_size()
+
+ ! Really inefficient, but grab the 'which_vert' from the
+ ! grid and set our target location to have the same.
+ ! Then, compute the distance and compare.
+
+ call get_state_meta_data(i, loc1)
+ thisdist(i) = get_dist( loc1, loc0)
+
+enddo
+
+indx = minloc(thisdist)
+
+! Now that we know ... report
+
+write(*, *) 'closest to the given location is index ', indx(1)
+
+deallocate( thisdist )
+
+end subroutine find_closest_gridpoint
+
+
+end program model_mod_check
Property changes on: DART/branches/development/models/template/model_mod_check.f90
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:keywords
+ Date Rev Author HeadURL Id
Added: svn:eol-style
+ native
From nancy at ucar.edu Tue Apr 10 16:31:32 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Tue, 10 Apr 2012 16:31:32 -0600
Subject: [Dart-dev] [5685] DART/branches/development/models/template: minor
fiddles to make the skeletal model_mod_check run.
Message-ID:
Revision: 5685
Author: nancy
Date: 2012-04-10 16:31:31 -0600 (Tue, 10 Apr 2012)
Log Message:
-----------
minor fiddles to make the skeletal model_mod_check run.
the model_mod isn't a fully fleshed out file (intentionally)
so it's tricky to have a program checking it.
Modified Paths:
--------------
DART/branches/development/models/template/model_mod_check.f90
DART/branches/development/models/template/work/input.nml
-------------- next part --------------
Modified: DART/branches/development/models/template/model_mod_check.f90
===================================================================
--- DART/branches/development/models/template/model_mod_check.f90 2012-04-10 22:11:43 UTC (rev 5684)
+++ DART/branches/development/models/template/model_mod_check.f90 2012-04-10 22:31:31 UTC (rev 5685)
@@ -24,7 +24,7 @@
use assim_model_mod, only : open_restart_read, open_restart_write, close_restart, &
aread_state_restart, awrite_state_restart, &
netcdf_file_type, aoutput_diagnostics, &
- init_diag_output, finalize_diag_output
+ init_diag_output, finalize_diag_output, static_init_assim_model
use time_manager_mod, only : time_type, set_calendar_type, NO_CALENDAR, &
read_time, get_time, set_time, &
print_time, write_time, operator(-)
@@ -87,7 +87,7 @@
call check_namelist_read(iunit, io, "model_mod_check_nml")
! This harvests all kinds of initialization information
-call static_init_model()
+call static_init_assim_model()
x_size = get_model_size()
write(*,'(''state vector has length'',i10)') x_size
@@ -103,7 +103,7 @@
write(*,*)'Writing a trivial restart file.'
statevector = 1.0_r8;
-model_time = set_time(21600, 149446) ! 06Z 4 March 2010
+model_time = set_time(0, 10)
iunit = open_restart_write('allones.ics')
call awrite_state_restart(model_time, statevector, iunit)
@@ -114,7 +114,7 @@
!----------------------------------------------------------------------
!model_time = get_state_time('../testdata1')
-model_time = set_time(0,0)
+model_time = set_time(0, 10)
call print_time( model_time,'model_mod_check:model time')
!----------------------------------------------------------------------
@@ -154,7 +154,7 @@
call nc_check( finalize_diag_output(ncFileID), 'model_mod_check:main', 'finalize')
-if ( x_ind > 0 .and. x_ind <= x_size ) call check_meta_data( x_ind )
+!if ( x_ind > 0 .and. x_ind <= x_size ) call check_meta_data( x_ind )
!----------------------------------------------------------------------
! Trying to find the state vector index closest to a particular ...
@@ -198,7 +198,7 @@
call get_state_meta_data( iloc, loc, var_type)
-call write_location(42, loc, fform='formatted', charstring=string1)
+call write_location(0, loc, charstring=string1)
write(*,*)' indx ',iloc,' is type ',var_type,trim(string1)
end subroutine check_meta_data
@@ -216,16 +216,17 @@
character(len=129) :: string1
real(r8), allocatable, dimension(:) :: thisdist
+loc0 = set_location(loc_of_interest)
+
write(*,*)
-write(*,'(''Checking for the indices into the state vector that are at'')')
-call write_location(42, loc, fform='formatted', charstring=string1)
+write(*,'(''Checking for the index in the state vector that is closest to '')')
+call write_location(0, loc0, charstring=string1)
write(*,*) trim(string1)
allocate( thisdist(get_model_size()) )
thisdist = 9999999999.9_r8 ! really far away
-loc0 = set_location(loc_of_interest)
! Since there can be multiple variables with
! identical distances, we will just cruise once through
Modified: DART/branches/development/models/template/work/input.nml
===================================================================
--- DART/branches/development/models/template/work/input.nml 2012-04-10 22:11:43 UTC (rev 5684)
+++ DART/branches/development/models/template/work/input.nml 2012-04-10 22:31:31 UTC (rev 5685)
@@ -197,6 +197,15 @@
model_restart_filename = 'modelfile'
/
+&model_mod_check_nml
+ input_file = 'allones.ics'
+ output_file = 'check_me'
+ advance_time_present = .false.
+ x_ind = 1
+ loc_of_interest = 0.42
+ kind_of_interest = 'ANY'
+ verbose = .false.
+/
&obs_diag_nml
obs_sequence_name = 'obs_seq.final',
From nancy at ucar.edu Tue Apr 10 21:29:46 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Tue, 10 Apr 2012 21:29:46 -0600
Subject: [Dart-dev] [5687]
DART/branches/development/models/bgrid_solo/matlab: Rename to prevent clash
with DART/matlab/ens_correl.m,
Message-ID:
Revision: 5687
Author: thoar
Date: 2012-04-10 21:29:46 -0600 (Tue, 10 Apr 2012)
Log Message:
-----------
Rename to prevent clash with DART/matlab/ens_correl.m,
which has a different function.
Added Paths:
-----------
DART/branches/development/models/bgrid_solo/matlab/ensemble_correl.m
Removed Paths:
-------------
DART/branches/development/models/bgrid_solo/matlab/ens_correl.m
-------------- next part --------------
Deleted: DART/branches/development/models/bgrid_solo/matlab/ens_correl.m
===================================================================
--- DART/branches/development/models/bgrid_solo/matlab/ens_correl.m 2012-04-11 00:01:13 UTC (rev 5686)
+++ DART/branches/development/models/bgrid_solo/matlab/ens_correl.m 2012-04-11 03:29:46 UTC (rev 5687)
@@ -1,131 +0,0 @@
-%% ens_error
-
-%% DART software - Copyright 2004 - 2011 UCAR. This open source software is
-% provided by UCAR, "as is", without charge, subject to all terms of use at
-% http://www.image.ucar.edu/DAReS/DART/DART_download
-%
-%
-% $URL$
-% $Id$
-% $Revision$
-% $Date$
-
-fname = input('Input file name for True state');
-%fname = 'True_State.nc';
-tlon = getnc(fname, 'TmpI');
-num_tlon = size(tlon, 1);
-tlat = getnc(fname, 'TmpJ');
-num_tlat = size(tlat, 1);
-vlon = getnc(fname, 'VelI');
-num_vlon = size(vlon, 1);
-vlat = getnc(fname, 'VelJ');
-num_vlat = size(vlat, 1);
-level = getnc(fname, 'level');
-num_level = size(level, 1);
-times = getnc(fname, 'time');
-num_times = size(times, 1);
-
-
-state_vec = getnc(fname, 'state');
-
-% Load the ensemble file
-ens_fname = input('Input file name for ensemble');
-%ens_fname = 'Prior_Diag.nc'
-ens_vec = getnc(ens_fname, 'state');
-
-% Ensemble size is
-ens_size = size(ens_vec, 2);
-
-% Select field to plot (ps, t, u, v)
-field_num = input('Input field type, 1=ps, 2=t, 3=u, or 4=v')
-
-% Get level for free atmosphere fields
-if field_num > 1
- field_level = input('Input level');
-else
- field_level = 1;
-end
-
-% Select x and y coordinates
-x_coord = input('Select x coordinate');
-y_coord = input('Select y coordinate');
-
-% Select time
-time = input('Input time level for correlations')
-
-% Get the ensemble field for this time level only
-ens_1t = ens_vec(time, :, :);
-
-% Extract ps or T key point
-if field_num < 3
- offset = field_num + field_level - 1;
-
- key_ens = ens_1t(1, :, offset : num_level + 1 : (num_level + 1) * (num_tlon * num_tlat));
-
- ens = reshape(key_ens, [ens_size num_tlat num_tlon]);
- key = ens(:, y_coord, x_coord);
-
-% Otherwise it's on v-grid; extract key point
-else
-
- base = (num_level + 1) * (num_tlon * num_tlat);
- offset = (field_level - 1) * 2 + (field_num - 2);
- key_ens = ens_1t(:, base + offset : 2 * num_level : base + 2 * num_level * num_vlat * num_vlon);
- ens = reshape(key_ens, [ens_size num_vlat, num_vlon]);
- key = ens(:, y_coord, x_coord)
-
-end
-
-% Compute correlations of key variable with each state var
-% Set the size for the cor matrix
-cor = ens_1t(1, 1, :);
-
-for i = 1 : size(cor, 3)
- cor_mat = corrcoef(key, ens_1t(1, :, i));
- cor(i) = cor_mat(1, 2);
-end
-
-
-
-
-
-% Loop to plot a bunch of these
-for i = 1 : 100
-
-% Select field to plot (ps, t, u, v)
-field_num = input('Input field type, 1=ps, 2=t, 3=u, or 4=v')
-
-% Get level for free atmosphere fields
-if field_num > 1
- field_level = input('Input level');
-else
- field_level = 1;
-end
-
-% Extract ps or T fields
-if field_num < 3
- offset = field_num + field_level - 1;
-
- cor_vec = cor(offset : num_level + 1 : (num_level + 1) * (num_tlon * num_tlat));
- fcor = reshape(cor_vec, [num_tlat num_tlon]);
-
-% Otherwise it's on v-grid
-else
-
- base = (num_level + 1) * (num_tlon * num_tlat);
- offset = (field_level - 1) * 2 + (field_num - 2);
- cor_vec = cor(base + offset : 2 * num_level : base + 2 * num_level * num_vlat * num_vlon);
- fcor = reshape(cor_vec, [num_vlat, num_vlon]);
-
-end
-
-
-% Plot the correlation
-figure(1)
-contour_vals = [-0.9 -0.8 -0.7 -0.6 -0.4 0.4 0.5 0.6 0.7 0.8 0.9];
-[C, h] = contourf(fcor, contour_vals);
-clabel(C, h);
-colorbar;
-
-end
-
Copied: DART/branches/development/models/bgrid_solo/matlab/ensemble_correl.m (from rev 5686, DART/branches/development/models/bgrid_solo/matlab/ens_correl.m)
===================================================================
--- DART/branches/development/models/bgrid_solo/matlab/ensemble_correl.m (rev 0)
+++ DART/branches/development/models/bgrid_solo/matlab/ensemble_correl.m 2012-04-11 03:29:46 UTC (rev 5687)
@@ -0,0 +1,131 @@
+%% ens_error
+
+%% DART software - Copyright 2004 - 2011 UCAR. This open source software is
+% provided by UCAR, "as is", without charge, subject to all terms of use at
+% http://www.image.ucar.edu/DAReS/DART/DART_download
+%
+%
+% $URL$
+% $Id$
+% $Revision$
+% $Date$
+
+fname = input('Input file name for True state');
+%fname = 'True_State.nc';
+tlon = getnc(fname, 'TmpI');
+num_tlon = size(tlon, 1);
+tlat = getnc(fname, 'TmpJ');
+num_tlat = size(tlat, 1);
+vlon = getnc(fname, 'VelI');
+num_vlon = size(vlon, 1);
+vlat = getnc(fname, 'VelJ');
+num_vlat = size(vlat, 1);
+level = getnc(fname, 'level');
+num_level = size(level, 1);
+times = getnc(fname, 'time');
+num_times = size(times, 1);
+
+
+state_vec = getnc(fname, 'state');
+
+% Load the ensemble file
+ens_fname = input('Input file name for ensemble');
+%ens_fname = 'Prior_Diag.nc'
+ens_vec = getnc(ens_fname, 'state');
+
+% Ensemble size is
+ens_size = size(ens_vec, 2);
+
+% Select field to plot (ps, t, u, v)
+field_num = input('Input field type, 1=ps, 2=t, 3=u, or 4=v')
+
+% Get level for free atmosphere fields
+if field_num > 1
+ field_level = input('Input level');
+else
+ field_level = 1;
+end
+
+% Select x and y coordinates
+x_coord = input('Select x coordinate');
+y_coord = input('Select y coordinate');
+
+% Select time
+time = input('Input time level for correlations')
+
+% Get the ensemble field for this time level only
+ens_1t = ens_vec(time, :, :);
+
+% Extract ps or T key point
+if field_num < 3
+ offset = field_num + field_level - 1;
+
+ key_ens = ens_1t(1, :, offset : num_level + 1 : (num_level + 1) * (num_tlon * num_tlat));
+
+ ens = reshape(key_ens, [ens_size num_tlat num_tlon]);
+ key = ens(:, y_coord, x_coord);
+
+% Otherwise it's on v-grid; extract key point
+else
+
+ base = (num_level + 1) * (num_tlon * num_tlat);
+ offset = (field_level - 1) * 2 + (field_num - 2);
+ key_ens = ens_1t(:, base + offset : 2 * num_level : base + 2 * num_level * num_vlat * num_vlon);
+ ens = reshape(key_ens, [ens_size num_vlat, num_vlon]);
+ key = ens(:, y_coord, x_coord)
+
+end
+
+% Compute correlations of key variable with each state var
+% Set the size for the cor matrix
+cor = ens_1t(1, 1, :);
+
+for i = 1 : size(cor, 3)
+ cor_mat = corrcoef(key, ens_1t(1, :, i));
+ cor(i) = cor_mat(1, 2);
+end
+
+
+
+
+
+% Loop to plot a bunch of these
+for i = 1 : 100
+
+% Select field to plot (ps, t, u, v)
+field_num = input('Input field type, 1=ps, 2=t, 3=u, or 4=v')
+
+% Get level for free atmosphere fields
+if field_num > 1
+ field_level = input('Input level');
+else
+ field_level = 1;
+end
+
+% Extract ps or T fields
+if field_num < 3
+ offset = field_num + field_level - 1;
+
+ cor_vec = cor(offset : num_level + 1 : (num_level + 1) * (num_tlon * num_tlat));
+ fcor = reshape(cor_vec, [num_tlat num_tlon]);
+
+% Otherwise it's on v-grid
+else
+
+ base = (num_level + 1) * (num_tlon * num_tlat);
+ offset = (field_level - 1) * 2 + (field_num - 2);
+ cor_vec = cor(base + offset : 2 * num_level : base + 2 * num_level * num_vlat * num_vlon);
+ fcor = reshape(cor_vec, [num_vlat, num_vlon]);
+
+end
+
+
+% Plot the correlation
+figure(1)
+contour_vals = [-0.9 -0.8 -0.7 -0.6 -0.4 0.4 0.5 0.6 0.7 0.8 0.9];
+[C, h] = contourf(fcor, contour_vals);
+clabel(C, h);
+colorbar;
+
+end
+
From nancy at ucar.edu Tue Apr 10 21:38:39 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Tue, 10 Apr 2012 21:38:39 -0600
Subject: [Dart-dev] [5688] DART/branches/development: Support for
unstructured grids (mpas_atm) and replacing many
Message-ID:
Revision: 5688
Author: thoar
Date: 2012-04-10 21:38:37 -0600 (Tue, 10 Apr 2012)
Log Message:
-----------
Support for unstructured grids (mpas_atm) and replacing many
one-off (hard to support) functions with get_hyperslab().
Each model with a RunAllTests.m script exercises all of
the state-space diagnostic scripts.
The plot_total_err() script no longer plots the total error
and spread for each level separately, but performs a simple
average over all available levels. Then, a spatial weighting
to account for the area of each grid cell is applied, and the
square root is applied ... Root(weighted-mean(squared(error))).
For the 'higher-order' models, each variable is plotted separately
in its own figure window.
Modified Paths:
--------------
DART/branches/development/matlab/CheckModel.m
DART/branches/development/matlab/CheckModelCompatibility.m
DART/branches/development/matlab/GetBgridInfo.m
DART/branches/development/matlab/GetCamInfo.m
DART/branches/development/matlab/GetMITgcm_oceanInfo.m
DART/branches/development/matlab/GetNCindices.m
DART/branches/development/matlab/GetPe2lyrInfo.m
DART/branches/development/matlab/GetTIEGCMInfo.m
DART/branches/development/matlab/GetWRFInfo.m
DART/branches/development/matlab/ParseAlphaNumerics.m
DART/branches/development/matlab/PlotBins.m
DART/branches/development/matlab/PlotCEnsErrSpread.m
DART/branches/development/matlab/PlotCorrel.m
DART/branches/development/matlab/PlotEnsErrSpread.m
DART/branches/development/matlab/PlotEnsMeanTimeSeries.m
DART/branches/development/matlab/PlotEnsTimeSeries.m
DART/branches/development/matlab/PlotJeffCorrel.m
DART/branches/development/matlab/PlotPhaseSpace.m
DART/branches/development/matlab/PlotSawtooth.m
DART/branches/development/matlab/PlotTotalErr.m
DART/branches/development/matlab/PlotVarVarCorrel.m
DART/branches/development/matlab/SetCopyID.m
DART/branches/development/matlab/SetVariableID.m
DART/branches/development/matlab/SimpleMap.m
DART/branches/development/matlab/get_ens_series.m
DART/branches/development/matlab/get_state_copy.m
DART/branches/development/matlab/get_var_series.m
DART/branches/development/matlab/jeff_correl.m
DART/branches/development/matlab/plot_bins.m
DART/branches/development/matlab/plot_correl.m
DART/branches/development/matlab/plot_ens_err_spread.m
DART/branches/development/matlab/plot_ens_mean_time_series.m
DART/branches/development/matlab/plot_ens_time_series.m
DART/branches/development/matlab/plot_jeff_correl.m
DART/branches/development/matlab/plot_phase_space.m
DART/branches/development/matlab/plot_reg_factor.m
DART/branches/development/matlab/plot_sawtooth.m
DART/branches/development/matlab/plot_smoother_err.m
DART/branches/development/matlab/plot_total_err.m
DART/branches/development/matlab/plot_var_var_correl.m
DART/branches/development/matlab/total_err.m
DART/branches/development/models/9var/matlab/RunAllTests.m
DART/branches/development/models/bgrid_solo/matlab/RunAllTests.m
DART/branches/development/models/forced_lorenz_96/matlab/RunAllTests.m
DART/branches/development/models/ikeda/matlab/RunAllTests.m
DART/branches/development/models/lorenz_04/matlab/RunAllTests.m
DART/branches/development/models/lorenz_63/matlab/RunAllTests.m
DART/branches/development/models/lorenz_84/matlab/RunAllTests.m
DART/branches/development/models/lorenz_96/matlab/RunAllTests.m
DART/branches/development/models/lorenz_96_2scale/matlab/RunAllTests.m
DART/branches/development/models/simple_advection/matlab/RunAllTests.m
Added Paths:
-----------
DART/branches/development/matlab/BgridTotalError.m
DART/branches/development/matlab/CAMTotalError.m
DART/branches/development/matlab/GetMPAS_ATMInfo.m
DART/branches/development/matlab/WRFTotalError.m
DART/branches/development/matlab/continents.m
DART/branches/development/matlab/get_ensemble_indices.m
DART/branches/development/matlab/get_hyperslab.m
DART/branches/development/models/cam/matlab/RunAllTests.m
DART/branches/development/models/pe2lyr/matlab/
DART/branches/development/models/pe2lyr/matlab/RunAllTests.m
DART/branches/development/models/wrf/matlab/RunAllTests.m
-------------- next part --------------
Added: DART/branches/development/matlab/BgridTotalError.m
===================================================================
--- DART/branches/development/matlab/BgridTotalError.m (rev 0)
+++ DART/branches/development/matlab/BgridTotalError.m 2012-04-11 03:38:37 UTC (rev 5688)
@@ -0,0 +1,148 @@
+function BgridTotalError( pinfo )
+%% -------------------------------------------------------------------
+% Plot the total area-weighted error for each variable.
+%---------------------------------------------------------------------
+
+%% DART software - Copyright 2004 - 2011 UCAR. This open source software is
+% provided by UCAR, "as is", without charge, subject to all terms of use at
+% http://www.image.ucar.edu/DAReS/DART/DART_download
+%
+%
+% $URL: https://proxy.subversion.ucar.edu/DAReS/DART/branches/mpas/matlab/BgridTotalError.m $
+% $Id: BgridTotalError.m 5655 2012-04-05 23:17:16Z thoar $
+% $Revision: 5655 $
+% $Date: 2012-04-05 17:17:16 -0600 (Thu, 05 Apr 2012) $
+
+% Get the indices for the true state, ensemble mean and spread
+% The metadata is queried to determine which "copy" is appropriate.
+truth_index = get_copy_index(pinfo.truth_file, 'true state');
+ens_mean_index = get_copy_index(pinfo.diagn_file, 'ensemble mean');
+ens_spread_index = get_copy_index(pinfo.diagn_file, 'ensemble spread');
+
+%----------------------------------------------------------------------
+%
+%----------------------------------------------------------------------
+
+for ivar=1:pinfo.num_state_vars,
+
+ fprintf('Processing %s ...\n', pinfo.vars{ivar} )
+
+ rmse = zeros(pinfo.time_series_length,1);
+ sprd = zeros(pinfo.time_series_length,1);
+ varunits = nc_attget(pinfo.truth_file, pinfo.vars{ivar}, 'units');
+
+ % determine what grid the variable lives on
+ % determine the number of levels
+
+ nlevels = 1;
+
+ varinfo = nc_getvarinfo(pinfo.diagn_file,pinfo.vars{ivar});
+
+ for idim = 1:length(varinfo.Dimension),
+ dimname = varinfo.Dimension{idim};
+ dimlength = varinfo.Size(idim);
+ switch lower(dimname)
+ case {'tmpj', 'velj'}
+ latitudes = nc_varget(pinfo.diagn_file, dimname);
+ case {'tmpi', 'veli'}
+ longitudes = nc_varget(pinfo.diagn_file, dimname);
+ case {'lev'}
+ nlevels = dimlength;
+ end
+ end
+
+ % Calculate weights for area-averaging.
+ weights = SphereWeights(latitudes, longitudes);
+
+ for itime=1:pinfo.time_series_length,
+
+ truth = get_hyperslab('fname',pinfo.truth_file, 'varname',pinfo.vars{ivar}, ...
+ 'copyindex',truth_index, 'timeindex',pinfo.truth_time(1)+itime-1);
+ ens = get_hyperslab('fname',pinfo.diagn_file, 'varname',pinfo.vars{ivar}, ...
+ 'copyindex',ens_mean_index, 'timeindex',pinfo.diagn_time(1)+itime-1);
+ spread = get_hyperslab('fname',pinfo.diagn_file, 'varname',pinfo.vars{ivar}, ...
+ 'copyindex',ens_spread_index, 'timeindex',pinfo.diagn_time(1)+itime-1);
+
+ %% Calculate the weighted mean squared error for each level.
+ % tensors come back [nlev,nlat,nlon] - or - [nlat,nlon]
+
+ sqerr = (truth - ens).^2;
+ sqsprd = spread .^2;
+
+ if (nlevels > 1) % take the mean over the first dimension
+ sqerr = squeeze(mean(sqerr ,1));
+ sqsprd = squeeze(mean(sqsprd,1));
+ end
+
+ %% Create the (weighted) mean squared error
+
+ ms_err = sum(sqerr(:) .* weights);
+ ms_spread = sum(sqsprd(:) .* weights);
+
+ %% Take the square root of the mean squared error
+ rmse(itime) = sqrt(ms_err);
+ sprd(itime) = sqrt(ms_spread);
+
+ end % loop over time
+
+ %-------------------------------------------------------------------
+ % Each variable in its own figure window
+ %-------------------------------------------------------------------
+ figure(ivar); clf;
+ plot(pinfo.time,rmse,'-', pinfo.time,sprd,'--')
+
+ s{1} = sprintf('time-mean Ensemble Mean error = %f', mean(rmse));
+ s{2} = sprintf('time-mean Ensemble Spread = %f', mean(sprd));
+
+ h = legend(s); legend(h,'boxoff')
+ grid on;
+ xdates(pinfo.time)
+ ylabel(sprintf('global-area-weighted rmse (%s)',varunits))
+ s1 = sprintf('%s %s Ensemble Mean', pinfo.model,pinfo.vars{ivar});
+ title({s1,pinfo.diagn_file},'interpreter','none','fontweight','bold')
+
+end % loop around variables
+
+clear truth ens spread err XY_spread
+
+
+
+
+function weights = SphereWeights(lats,lons)
+%% SphereWeights creates [nlat*nlon,1] matrix of weights based on latitude
+%
+% lats,lons must be 1D arrays (in degrees)
+
+nlats = length(lats);
+nlons = length(lons);
+
+if ( numel(lats) ~= nlats )
+ disp('latitude array is of higher dimension than anticipated.')
+ error('Must be a vector.')
+end
+if ( numel(lons) ~= nlons )
+ disp('longitude array is of higher dimension than anticipated.')
+ error('Must be a vector.')
+end
+
+rads = zeros(nlats,1); % Ensure lats is a column vector,
+rads(:) = pi*lats/180.0; % and convert to radians.
+wts = cos( rads ) * ones(1,nlons); % Results in a [nlat-x-nlon] matrix.
+wts = wts ./ sum(wts(:)); % Normalize to unity.
+weights = wts(:);
+
+
+
+
+function xdates(dates)
+if (length(get(gca,'XTick')) > 6)
+ datetick('x','mm.dd.HH','keeplimits'); % 'mm/dd'
+ monstr = datestr(dates(1),31);
+ xlabelstring = sprintf('month/day/HH - %s start',monstr);
+else
+ datetick('x',31,'keeplimits'); %'yyyy-mm-dd HH:MM:SS'
+ monstr = datestr(dates(1),31);
+ xlabelstring = sprintf('%s start',monstr);
+end
+xlabel(xlabelstring)
+
Added: DART/branches/development/matlab/CAMTotalError.m
===================================================================
--- DART/branches/development/matlab/CAMTotalError.m (rev 0)
+++ DART/branches/development/matlab/CAMTotalError.m 2012-04-11 03:38:37 UTC (rev 5688)
@@ -0,0 +1,120 @@
+function CAMTotalError( pinfo )
+%% -------------------------------------------------------------------
+% Plot the total area-weighted error for each variable.
+%---------------------------------------------------------------------
+
+%% DART software - Copyright 2004 - 2011 UCAR. This open source software is
+% provided by UCAR, "as is", without charge, subject to all terms of use at
+% http://www.image.ucar.edu/DAReS/DART/DART_download
+%
+%
+% $URL: https://proxy.subversion.ucar.edu/DAReS/DART/branches/mpas/matlab/CAMTotalError.m $
+% $Id: CAMTotalError.m 5655 2012-04-05 23:17:16Z thoar $
+% $Revision: 5655 $
+% $Date: 2012-04-05 17:17:16 -0600 (Thu, 05 Apr 2012) $
+
+% Since the models are "compatible", get the info from either one.
+lons = nc_varget(pinfo.truth_file, 'lon');
+gw = nc_varget(pinfo.truth_file, 'gw');
+num_lons = length(lons);
+
+% make a matrix of weights for each horizontal slice
+% ensure the gaussian weights sum to unity.
+[~,weights] = meshgrid(ones(1,num_lons),gw);
+weights = weights/sum(weights(:));
+wts = weights(:);
+
+% Get the indices for the true state, ensemble mean and spread
+% The metadata is queried to determine which "copy" is appropriate.
+truth_index = get_copy_index(pinfo.truth_file, 'true state');
+ens_mean_index = get_copy_index(pinfo.diagn_file, 'ensemble mean');
+ens_spread_index = get_copy_index(pinfo.diagn_file, 'ensemble spread');
+
+%----------------------------------------------------------------------
+%
+%----------------------------------------------------------------------
+
+for ivar=1:pinfo.num_state_vars,
+
+ varname = pinfo.vars{ivar};
+
+ rmse = zeros(pinfo.time_series_length,1);
+ sprd = zeros(pinfo.time_series_length,1);
+
+ for itime=1:pinfo.time_series_length,
+
+ fprintf('Processing %s timestep %d of %d ...\n', ...
+ varname, itime, pinfo.time_series_length)
+
+ truth = get_hyperslab('fname',pinfo.truth_file, 'varname',varname, ...
+ 'copyindex',truth_index, 'timeindex',pinfo.truth_time(1)+itime-1);
+ ens = get_hyperslab('fname',pinfo.diagn_file, 'varname',varname, ...
+ 'copyindex',ens_mean_index, 'timeindex',pinfo.diagn_time(1)+itime-1);
+ spread = get_hyperslab('fname',pinfo.diagn_file, 'varname',varname, ...
+ 'copyindex',ens_spread_index, 'timeindex',pinfo.diagn_time(1)+itime-1);
+
+ if (length(size(truth)) == 2)
+ nlev = 1;
+ elseif (length(size(truth)) == 3)
+ nlev = size(truth,3);
+ else
+ error('Dang, this cannot happen in CAM.')
+ end
+
+ %% Calculate the weighted mean squared error for each level.
+
+ msqe_Z = zeros(nlev,1);
+ sprd_Z = zeros(nlev,1);
+
+ for ilevel=1:nlev,
+
+ slabS2E = (truth(:,:,ilevel) - ens(:,:,ilevel)).^2; % OK even if 2D iff ilevel = 1
+ XY_err = sum(slabS2E(:) .* wts);
+ slabS2E = spread(:,:,ilevel).^2;
+ XY_spread = sum(slabS2E(:) .* wts);
+
+ msqe_Z(ilevel) = XY_err;
+ sprd_Z(ilevel) = XY_spread;
+
+ end % loop over levels
+
+ %% Take the square root of the mean of all levels
+ rmse(itime) = sqrt(mean(msqe_Z));
+ sprd(itime) = sqrt(mean(sprd_Z));
+
+ end % loop over time
+
+ %-------------------------------------------------------------------
+ % Each variable in its own figure window
+ %-------------------------------------------------------------------
+ figure(ivar); clf;
+ varunits = nc_attget(pinfo.truth_file, pinfo.vars{ivar}, 'units');
+
+ plot(pinfo.time,rmse,'-', pinfo.time,sprd,'--')
+
+ s{1} = sprintf('time-mean Ensemble Mean error = %f', mean(rmse));
+ s{2} = sprintf('time-mean Ensemble Spread = %f', mean(sprd));
+
+ h = legend(s); legend(h,'boxoff')
+ grid on;
+ xdates(pinfo.time)
+ ylabel(sprintf('global-area-weighted rmse (%s)',varunits))
+ s1 = sprintf('%s %s Ensemble Mean', pinfo.model,pinfo.vars{ivar});
+ title({s1,pinfo.diagn_file},'interpreter','none','fontweight','bold')
+
+end % loop around variables
+
+clear truth ens spread err XY_spread
+
+
+function xdates(dates)
+if (length(get(gca,'XTick')) > 6)
+ datetick('x','mm.dd.HH','keeplimits'); % 'mm/dd'
+ monstr = datestr(dates(1),31);
+ xlabelstring = sprintf('month/day/HH - %s start',monstr);
+else
+ datetick('x',31,'keeplimits'); %'yyyy-mm-dd HH:MM:SS'
+ monstr = datestr(dates(1),31);
+ xlabelstring = sprintf('%s start',monstr);
+end
+xlabel(xlabelstring)
Modified: DART/branches/development/matlab/CheckModel.m
===================================================================
--- DART/branches/development/matlab/CheckModel.m 2012-04-11 03:29:46 UTC (rev 5687)
+++ DART/branches/development/matlab/CheckModel.m 2012-04-11 03:38:37 UTC (rev 5688)
@@ -1,4 +1,4 @@
-function vars = CheckModel(fname);
+function vars = CheckModel(fname)
%% CheckModel tries to ensure that a netcdf file has what we expect.
%
% vars is a structure containing a minimal amount of metadata about the netCDF file.
@@ -20,17 +20,22 @@
if ( exist(fname,'file') ~= 2 ), error('%s does not exist.',fname); end
% Get some information from the file
-model = nc_attget(fname,nc_global,'model');
-
+model = nc_attget(fname,nc_global,'model');
num_copies = dim_length(fname,'copy'); % determine # of ensemble members
-num_times = dim_length(fname,'time'); % determine # of output times
+[ens_size, ens_indices] = get_ensemble_indices(fname);
+times = nc_varget(fname,'time');
+timeunits = nc_attget(fname,'time','units');
+timebase = sscanf(timeunits,'%*s%*s%d%*c%d%*c%d'); % YYYY MM DD
+timeorigin = datenum(timebase(1),timebase(2),timebase(3));
+dates = times + timeorigin;
+num_times = length(dates);
+clear times timeunits timebase timeorigin
+
if (isempty(model))
error('%s has no ''model'' global attribute.',fname)
end
-copy = nc_varget(fname,'copy');
-
switch lower(model)
case {'9var','lorenz_63','lorenz_84','ikeda'}
@@ -44,12 +49,13 @@
vars = struct('model',model, ...
'def_var','state', ...
'num_state_vars',num_vars, ...
- 'num_ens_members',num_copies, ...
+ 'num_copies',num_copies, ...
+ 'num_ens_members',ens_size, ...
+ 'ensemble_indices',ens_indices, ...
+ 'time',dates, ...
'time_series_length',num_times, ...
'min_state_var',min(StateVariable), ...
'max_state_var',max(StateVariable), ...
- 'min_ens_mem',min(copy), ...
- 'max_ens_mem',max(copy), ...
'def_state_vars',def_state_vars);
vars.fname = fname;
@@ -67,12 +73,13 @@
vars = struct('model',model, ...
'def_var','state', ...
'num_state_vars',num_vars, ...
- 'num_ens_members',num_copies, ...
+ 'num_copies',num_copies, ...
+ 'num_ens_members',ens_size, ...
+ 'ensemble_indices',ens_indices, ...
+ 'time',dates, ...
'time_series_length',num_times, ...
'min_state_var',min(StateVariable), ...
'max_state_var',max(StateVariable), ...
- 'min_ens_mem',min(copy), ...
- 'max_ens_mem',max(copy), ...
'def_state_vars',def_state_vars);
vars.fname = fname;
@@ -87,8 +94,7 @@
time_step_seconds = nc_attget(fname, nc_global, 'model_time_step_seconds');
num_model_vars = nc_attget(fname, nc_global, 'model_num_state_vars');
- num_vars = dim_length(fname,'StateVariable'); % determine # of state varbls
- StateVariable = nc_varget(fname,'StateVariable');
+ num_vars = dim_length(fname,'StateVariable'); % determine # of state varbls
% The only trick is to pick an equally-spaced subset of state
% variables for the default.
@@ -101,14 +107,20 @@
'num_state_vars',num_vars, ...
'num_model_vars',num_model_vars, ...
'num_force_vars',num_vars - num_model_vars, ...
- 'num_ens_members',num_copies, ...
+ 'num_copies',num_copies, ...
+ 'num_ens_members',ens_size, ...
+ 'ensemble_indices',ens_indices, ...
+ 'time',dates, ...
'time_series_length',num_times, ...
'min_state_var', 1, 'max_state_var', num_vars, ...
'min_model_var', 1, 'max_model_var', num_model_vars, ...
'min_force_var', 1, 'max_force_var', num_vars - num_model_vars, ...
- 'min_ens_mem',min(copy), 'max_ens_mem', max(copy), ...
'def_state_vars',def_state_vars, ...
- 'def_force_vars',def_force_vars);
+ 'def_force_vars',def_force_vars, ...
+ 'forcing',forcing, ...
+ 'delta_t',delta_t, ...
+ 'time_step_days', time_step_days, ...
+ 'time_step_seconds', time_step_seconds);
vars.fname = fname;
@@ -129,13 +141,16 @@
vars = struct('model',model, ...
'def_var','X', ...
'num_state_vars',num_X, ...
- 'num_ens_members',num_copies, ...
+ 'num_copies',num_copies, ...
+ 'num_ens_members',ens_size, ...
+ 'ensemble_indices',ens_indices, ...
+ 'time',dates, ...
'time_series_length',num_times, ...
'min_state_var',min(Xdim), 'max_state_var',max(Xdim), ...
'min_X_var', min(Xdim), 'max_X_var', max(Xdim), ...
'min_Y_var', min(Ydim), 'max_Y_var', max(Ydim), ...
- 'min_ens_mem', min(copy), 'max_ens_mem', max(copy), ...
- 'def_state_vars',def_X_inds);
+ 'def_state_vars',def_X_inds, ...
+ 'def_Y_inds', def_Y_inds);
vars.fname = fname;
@@ -148,160 +163,71 @@
varnames = {'state'};
def_inds = [1 13 27];
else
- varnames = {'concentration','source','wind', ...
- 'mean_source','source_phase'};
+ varnames = get_DARTvars(fname);
def_inds = round([1 , num_locs/3 , 2*num_locs/3]);
end
vars = struct('model' ,model, ...
'loc1d' ,loc1d, ...
- 'num_ens_members' ,num_copies, ...
- 'min_ens_mem' ,min(copy), ...
- 'max_ens_mem' ,max(copy), ...
+ 'num_copies' ,num_copies, ...
+ 'num_ens_members' ,ens_size, ...
+ 'ensemble_indices' ,ens_indices, ...
+ 'time' ,dates, ...
'time_series_length',num_times, ...
'model_size' ,length(varnames)*length(loc1d), ...
'def_var' ,varnames{1}, ...
'min_state_var' ,1, ...
'max_state_var' ,num_locs, ...
+ 'num_state_vars' ,num_locs, ...
'def_state_vars' ,def_inds, ...
'num_vars' ,length(varnames));
vars.vars = varnames;
vars.fname = fname;
- case 'fms_bgrid'
+ case 'wrf'
- % A more robust way would be to use the netcdf low-level ops:
- % bob = var(f); % bob is a cell array of ncvars
- % name(bob{1}) % is the variable name string
- % bob{1}(:) % is the value of the netcdf variable (no offset/scale)
+ % requires a 'domain' and 'bottom_top_d01' dimension.
+ % without both of these, it will fail in an ugly fashion.
- varnames = {'ps','t','u','v'};
- num_vars = length(varnames);
- nlevels = dim_length(fname,'lev'); % determine # of state variables
+ varnames = get_DARTvars(fname);
+ num_vars = length(varnames);
+ num_domains = dim_length(fname,'domain');
+ num_levels = dim_length(fname,'bottom_top_d01');
-% times = nc_varget(fname,'time');
-% TmpI = nc_varget(fname,'TmpI'); % longitude
-% TmpJ = nc_varget(fname,'TmpJ'); % latitude
-% levels = nc_varget(fname,'level');
-% VelI = nc_varget(fname,'VelI'); % longitude
-% VelJ = nc_varget(fname,'VelJ'); % latitude
-
vars = struct('model',model, ...
+ 'def_var',varnames{1}, ...
+ 'def_state_vars',[], ...
'num_state_vars',num_vars, ...
- 'num_ens_members',num_copies, ...
+ 'num_copies',num_copies, ...
+ 'num_ens_members',ens_size, ...
+ 'ensemble_indices',ens_indices, ...
+ 'time',dates, ...
'time_series_length',num_times, ...
- 'min_ens_mem',min(copy), ...
- 'max_ens_mem',max(copy));
+ 'num_unstaggered_levels',num_levels, ...
+ 'num_domains',num_domains);
vars.vars = varnames;
vars.fname = fname;
+
+ case {'cam','tiegcm','fms_bgrid','pe2lyr','mitgcm_ocean','pbl_1d','mpas_atm'}
- case {'cam','tiegcm'}
-
varnames = get_DARTvars(fname);
num_vars = length(varnames);
- nlevels = dim_length(fname,'lev'); % determine # of state variables
vars = struct('model',model, ...
+ 'def_var',varnames{1}, ...
+ 'def_state_vars',[], ...
'num_state_vars',num_vars, ...
- 'num_ens_members',num_copies, ...
- 'time_series_length',num_times, ...
- 'min_ens_mem',min(copy), ...
- 'max_ens_mem',max(copy) );
+ 'num_copies',num_copies, ...
+ 'num_ens_members',ens_size, ...
+ 'ensemble_indices',ens_indices, ...
+ 'time',dates, ...
+ 'time_series_length',num_times);
vars.vars = varnames;
vars.fname = fname;
-
- case 'pbl_1d'
-
- % A more robust way would be to use the netcdf low-level ops:
- % bob = var(f); % bob is a cell array of ncvars
- % name(bob{1}) % is the variable name string
- % bob{1}(:) % is the value of the netcdf variable (no offset/scale)
-
- num_vars = 22; % ps, t, u, v
- z_level = dim_length(fname, 'z_level'); % determine # of state variables
- sl_level = dim_length(fname,'sl_level'); % determine # of state variables
- times = nc_varget(fname,'time');
- z_level = nc_varget(fname,'z_level');
- sl_level = nc_varget(fname,'sl_level');
-
- vars = struct('model',model, ...
- 'num_state_vars',num_vars, ...
- 'num_ens_members',num_copies, ...
- 'time_series_length',num_times, ...
- 'min_ens_mem',min(copy), ...
- 'max_ens_mem',max(copy));
-
- vars.fname = fname;
-
- case 'pe2lyr'
-
- % Since this is a 3D model, only the most rudimentary information
- % is gathered here. Each plot requires different information,
- % so there is a separate function (GetPe2lyrInfo.m) that gets
- % the information for each specific plot type.
-
- varnames = {'u','v','z'};
- num_vars = length(varnames);
-
- vars = struct('model',model, ...
- 'num_state_vars',num_vars, ...
- 'num_ens_members',num_copies, ...
- 'time_series_length',num_times, ...
- 'min_ens_mem',min(copy), ...
- 'max_ens_mem',max(copy) );
-
- vars.vars = varnames;
- vars.fname = fname;
-
- case 'mitgcm_ocean'
-
- % A more robust way would be to use the netcdf low-level ops:
- % bob = var(f); % bob is a cell array of ncvars
- % name(bob{1}) % is the variable name string
- % bob{1}(:) % is the value of the netcdf variable (no offset/scale)
- % have not yet figured out a way to only use non-coordinate variables.
-
- varnames = {'S','T','U','V','SSH'};
- num_vars = length(varnames);
- nlevels = dim_length(fname,'ZG'); % determine # of state variables
-
- vars = struct('model',model, ...
- 'num_state_vars',num_vars, ...
- 'num_ens_members',num_copies, ...
- 'time_series_length',num_times, ...
- 'min_ens_mem',min(copy), ...
- 'max_ens_mem',max(copy) );
-
- vars.vars = varnames;
- vars.fname = fname;
-
- case 'wrf'
-
- % requires a 'domain' and 'bottom_top_d01' dimension.
- % without both of these, it will fail in an ugly fashion.
-
- varnames = get_DARTvars(fname);
- num_vars = length(varnames);
- dinfo = nc_getdiminfo(fname,'domain');
- num_domains = dinfo.Length;
- dinfo = nc_getdiminfo(fname,'bottom_top_d01');
- num_levels = dinfo.Length;
-
- vars = struct('model',model, ...
- 'num_state_vars',num_vars, ...
- 'num_ens_members',num_copies, ...
- 'time_series_length',num_times, ...
- 'num_unstaggered_levels',num_levels, ...
- 'num_domains',num_domains, ...
- 'min_ens_mem',min(copy), ...
- 'max_ens_mem',max(copy));
-
- vars.vars = varnames;
- vars.fname = fname;
-
+
otherwise
error('model %s unknown',model)
@@ -309,14 +235,20 @@
end
-
-
function x = dim_length(fname,dimname)
+% Check for the existence of the named dimension and return it
+% if it exists. If it does not, error out with a useful message.
-y = nc_isvar(fname,dimname);
-if (y < 1)
- error('%s has no %s dimension/coordinate variable',fname,dimname)
+info = nc_info(fname);
+n = length(dimname);
+x = [];
+for i = 1:length(info.Dimension),
+ if ( strncmp(info.Dimension(i).Name, dimname, n) > 0 )
+ x = info.Dimension(i).Length;
+ break
+ end
end
-bob = nc_getdiminfo(fname,dimname);
-x = bob.Length;
+if isempty(x)
+ error('%s has no dimension named %s',fname,dimname)
+end
Modified: DART/branches/development/matlab/CheckModelCompatibility.m
===================================================================
--- DART/branches/development/matlab/CheckModelCompatibility.m 2012-04-11 03:29:46 UTC (rev 5687)
+++ DART/branches/development/matlab/CheckModelCompatibility.m 2012-04-11 03:38:37 UTC (rev 5688)
@@ -18,7 +18,6 @@
% $Revision$
% $Date$
-
if (nargin == 1) % better be a pinfo struct with at least these fields
file1 = arg1.truth_file; % string
file2 = arg1.diagn_file; % string
@@ -46,7 +45,7 @@
error('%s has no ''model'' global attribute.',file1)
end
-tnum_copies = dim_length(file1,'copy');
+tvars = get_DARTvars(file1);
tnum_times = dim_length(file1,'time');
times = nc_varget( file1,'time');
timeunits = nc_attget( file1,'time','units');
@@ -54,7 +53,7 @@
timeorigin = datenum(timebase(1),timebase(2),timebase(3));
ttimes = times + timeorigin;
-[tnum_vars,tdims] = ModelDimension(file1,tmodel);
+[tnum_vars,~] = ModelDimension(file1,tmodel);
if ( tnum_vars <= 0 )
error('Unable to determine resolution of %s.',file1)
end
@@ -66,7 +65,7 @@
error('%s has no ''model'' global attribute.',file2)
end
-dnum_copies = dim_length(file2,'copy');
+dvars = get_DARTvars(file2);
dnum_times = dim_length(file2,'time');
times = nc_varget( file2,'time');
timeunits = nc_attget( file2,'time','units');
@@ -74,12 +73,12 @@
timeorigin = datenum(timebase(1),timebase(2),timebase(3));
dtimes = times + timeorigin;
-[dnum_vars,ddims] = ModelDimension(file2,dmodel);
+[dnum_vars,~] = ModelDimension(file2,dmodel);
if ( dnum_vars <= 0 )
error('Unable to determine resolution of %s.',file2)
end
-% rudimentary bulletproofing
+%% rudimentary bulletproofing
if (strcmp(tmodel,dmodel) ~= 1)
fprintf('%s has model %s\n',file1,tmodel)
fprintf('%s has model %s\n',file2,dmodel)
@@ -93,13 +92,17 @@
error('no No NO ... both files must have same shape of state variables.')
end
-% if the lengths of the time arrays did not match, this used to be an
-% error. now we call a function to try to find any overlapping regions
-% in the time arrays and pass them back up to the called in the pinfo struct.
-% they then get used to extract the corresponding hyperslabs of data for
-% the matching times.
+% find the variables common to both files.
+vars = cell(0);
+for i = 1:length(dvars),
+ if any(strcmpi(dvars(i),tvars))
+ vars(length(vars)+1) = dvars(i);
+ end
+end
+pinfo_out.vars = vars;
+pinfo_out.num_state_vars = length(vars);
-% construct the pinfo struct in this function
+% Call a function to find the indices of theln - times common to both files.
pinfo_out = timearray_intersect(pinfo_out, file1, file2, ttimes, dtimes);
% fail here if the times had nothing in common.
@@ -114,15 +117,22 @@
error('These files have no timesteps in common')
end
+% Set the array of the times common to both files.
+T1 = pinfo_out.truth_time(1);
+T2 = pinfo_out.truth_time(1) + pinfo_out.truth_time(2) - 1;
+pinfo_out.time = ttimes(T1:T2);
+pinfo_out.time_series_length = pinfo_out.truth_time(2);
-%----------------
+
+
+function pret = timearray_intersect(pinfo, file1, file2, times1, times2)
% min1,max1 and min2,max2 are the index numbers of the intersection of the
% two input arrays. -1s in those numbers means no intersection. 1, length()
% means identical (could add a separate flag to simplify the calling code).
-function pret = timearray_intersect(pinfo, file1, file2, times1, times2)
-% for floating point comparisons, must be within this (single precision)
-% roundoff
+%% for floating point comparisons, must be within this (single precision)
+% roundoff
+
epsilon = 0.0000001;
% default return; no intersection
@@ -136,10 +146,10 @@
% a constant delta or not? compute delta array and validate those match?
% (to within an epsilon with floating pt roundoff)
-% check for the no-brainer case - identical time arrays.
-% watch out for the floating point compares, and the min/max are probably
-% redundant with the (1) and (l) comparisons, but until we put in checks
-% for monotonicity, it's a cheap safety check.
+%% check for the no-brainer case - identical time arrays.
+% watch out for the floating point compares, and the min/max are probably
+% redundant with the (1) and (l) comparisons, but until we put in checks
+% for monotonicity, it's a cheap safety check.
len = length(times1);
if ( (length(times1) == length(times2)) ...
&& (abs(min(times1) - min(times2)) < epsilon) ...
@@ -148,11 +158,12 @@
&& (times1(len) == times2(len)))
pret.truth_time = [1,len]; % start/count
pret.diagn_time = [1,len]; % start/count
+ pret.time = times1; % the common times in datenum-compatible form.
return
end
-% A is whichever array has the lower min. this reduces the number of
-% cases below we have to check for.
+%% A is whichever array has the lower min. this reduces the number of
+% cases below we have to check for.
if (min(times1) < min(times2))
A = times1;
B = times2;
@@ -161,9 +172,9 @@
A = times2;
end
-% precompute the data max, min, lengths using the A,B assignments
-% also, if differences are < epsilon, force equality to simplify
-% the comparison code below
+%% precompute the data max, min, lengths using the A,B assignments
+% also, if differences are < epsilon, force equality to simplify
+% the comparison code below
lenA = length(A);
lenB = length(B);
minA = min(A);
@@ -174,14 +185,14 @@
if (abs(maxA - minB) < epsilon) , minB = maxA; end
if (abs(maxA - maxB) < epsilon) , maxB = maxA; end
-% case 1: disjoint regions; simply return here because
-% return struct was initialized to the 'no intersection' case.
+%% case 1: disjoint regions; simply return here because
+% return struct was initialized to the 'no intersection' case.
if ((minA < minB) && (maxA < minB))
return
end
-% case 2: B fully contained in A; return corresponding index nums of overlap
-% include equal start & end points in this case.
+%% case 2: B fully contained in A; return corresponding index nums of overlap
+% include equal start & end points in this case.
if ((minA <= minB) && (maxB <= maxA))
minI = find(abs(A - minB) < epsilon);
maxI = find(abs(A - maxB) < epsilon);
@@ -195,8 +206,8 @@
maxJ = find(abs(B - maxA) < epsilon);
end
-% now map back to the original input order - this test must match exactly
-% the one used initially to assign A and B above.
+%% now map back to the original input order - this test must match exactly
+% the one used initially to assign A and B above.
if (min(times1) < min(times2))
min1 = minI;
max1 = maxI;
@@ -211,33 +222,40 @@
% now put the indices in the return struct and we are done.
pret.truth_time = [min1, max1-min1+1]; % start,count
-pret.diagn_time = [min2, min2-max2+1]; % start,count
+pret.diagn_time = [min2, max2-min2+1]; % start,count
+pret.time = times1(min1:max1); % the common times in datenum-compatible form.
% return here
function x = dim_length(fname,dimname)
+%% Check for the existence of the named dimension and return it
+% if it exists. If it does not, error out with a useful message.
-y = nc_isvar(fname,dimname);
-if (y < 1)
- error('%s has no %s dimension/coordinate variable',fname,dimname)
+info = nc_info(fname);
+n = length(dimname);
+x = [];
+for i = 1:length(info.Dimension),
+ if ( strncmp(info.Dimension(i).Name, dimname, n) > 0 )
+ x = info.Dimension(i).Length;
+ break
+ end
end
-bob = nc_getdiminfo(fname,dimname);
-x = bob.Length;
+if isempty(x)
+ error('%s has no dimension named %s',fname,dimname)
+end
function [x,y] = ModelDimension(fname,modelname)
-% Check the base geometry of the grid
-x = 0;
-y = NaN;
+%% Check the base geometry of the grid
switch lower(modelname)
case 'wrf'
- diminfo = nc_getdiminfo(fname, 'west_east_d01'); dnum_lons = diminfo.Length;
- diminfo = nc_getdiminfo(fname,'south_north_d01'); dnum_lats = diminfo.Length;
- diminfo = nc_getdiminfo(fname, 'bottom_top_d01'); dnum_lvls = diminfo.Length;
+ dnum_lons = dim_length(fname, 'west_east_d01');
+ dnum_lats = dim_length(fname,'south_north_d01');
+ dnum_lvls = dim_length(fname, 'bottom_top_d01');
x = 3;
y = [dnum_lons dnum_lats dnum_lvls];
@@ -269,6 +287,13 @@
x = 3;
y = [dnum_lons dnum_lats dnum_lvls];
+ case 'mpas_atm'
+
+ dnum_cells = dim_length(fname,'nCells');
+ dnum_lvls = dim_length(fname,'nVertLevels');
+ x = 2;
+ y = [dnum_cells dnum_lvls];
+
case 'lorenz_96_2scale'
dnum_X = dim_length(fname,'Xdim');
dnum_Y = dim_length(fname,'Ydim');
Modified: DART/branches/development/matlab/GetBgridInfo.m
===================================================================
--- DART/branches/development/matlab/GetBgridInfo.m 2012-04-11 03:29:46 UTC (rev 5687)
+++ DART/branches/development/matlab/GetBgridInfo.m 2012-04-11 03:38:37 UTC (rev 5688)
@@ -1,4 +1,4 @@
-function pinfo = GetBgridInfo(pinfo_in,fname,routine);
+function pinfo = GetBgridInfo(pinfo_in,fname,routine)
%% GetBgridInfo prepares a structure of information needed by the subsequent "routine"
% The information is gathered via rudimentary "input" routines.
%
@@ -23,159 +23,141 @@
pinfo = pinfo_in;
model = nc_attget(fname, nc_global, 'model');
-if strcmp(lower(model),'fms_bgrid') ~= 1
+if strcmpi(model,'fms_bgrid') ~= 1
error('Not so fast, this is not a bgrid model.')
end
-copy = nc_varget(fname,'copy');
-times = nc_varget(fname,'time');
levels = nc_varget(fname,'lev');
TmpI = nc_varget(fname,'TmpI'); % temperature/pressure grid longitude
TmpJ = nc_varget(fname,'TmpJ'); % temperature/pressure grid latitude
VelI = nc_varget(fname,'VelI'); % velocity grid longitude
VelJ = nc_varget(fname,'VelJ'); % velocity grid latitude
-prognostic_vars = {'ps','t','u','v'};
-
-% Coordinate between time types and dates
-
-timeunits = nc_attget(fname,'time','units');
-timebase = sscanf(timeunits,'%*s%*s%d%*c%d%*c%d'); % YYYY MM DD
-timeorigin = datenum(timebase(1),timebase(2),timebase(3));
-dates = times + timeorigin;
-
switch lower(deblank(routine))
case {'plotbins','plotenserrspread','plotensmeantimeseries','plotenstimeseries'}
- pgvar = GetVar(prognostic_vars); % Determine prognostic variable
- [level, lvlind] = GetLevel(pgvar,levels); % Determine level and index
- [lat , latind] = GetLatitude( pgvar,TmpJ,VelJ);
- [lon , lonind] = GetLongitude(pgvar,TmpI,VelI);
+ pgvar = GetVar(pinfo.vars); % Determine prognostic variable
+ [level, lvlind] = GetLevel( pgvar, levels); % Determine level and index
+ [lat , latind] = GetLatitude( pgvar, TmpJ, VelJ);
+ [lon , lonind] = GetLongitude(pgvar, TmpI, VelI);
- pinfo = setfield(pinfo, 'model', model);
- pinfo = setfield(pinfo, 'fname', fname);
- pinfo = setfield(pinfo, 'times', dates);
- pinfo = setfield(pinfo, 'var', pgvar);
- pinfo = setfield(pinfo, 'level', level);
- pinfo = setfield(pinfo, 'levelindex', lvlind);
- pinfo = setfield(pinfo, 'longitude', lon);
- pinfo = setfield(pinfo, 'lonindex', lonind);
- pinfo = setfield(pinfo, 'latitude', lat);
- pinfo = setfield(pinfo, 'latindex',latind);
+ pinfo.fname = fname;
+ pinfo.var = pgvar;
+ pinfo.level = level;
+ pinfo.levelindex = lvlind;
+ pinfo.longitude = lon;
+ pinfo.lonindex = lonind;
+ pinfo.latitude = lat;
+ pinfo.latindex = latind;
case 'plotcorrel'
disp('Getting information for the ''base'' variable.')
- base_var = GetVar(prognostic_vars);
- [base_time, base_tmeind] = GetTime( base_var,dates);
- [base_lvl, base_lvlind] = GetLevel( base_var,levels);
- [base_lat, base_latind] = GetLatitude( base_var,TmpJ,VelJ);
- [base_lon, base_lonind] = GetLongitude(base_var,TmpI,VelI);
+ base_var = GetVar(pinfo.vars);
+ [base_time, base_tmeind] = GetTime(pinfo.time);
+ [base_lvl, base_lvlind] = GetLevel( base_var, levels);
+ [base_lat, base_latind] = GetLatitude( base_var, TmpJ, VelJ);
+ [base_lon, base_lonind] = GetLongitude(base_var, TmpI, VelI);
disp('Getting information for the ''comparison'' variable.')
- comp_var = GetVar(prognostic_vars, base_var);
- [comp_lvl, comp_lvlind] = GetLevel( comp_var,levels, base_lvl);
+ comp_var = GetVar(pinfo.vars, base_var);
+ [comp_lvl, comp_lvlind] = GetLevel(comp_var,levels, base_lvl);
- pinfo = setfield(pinfo, 'model', model);
- pinfo = setfield(pinfo, 'fname', fname);
- pinfo = setfield(pinfo, 'times', dates);
- pinfo = setfield(pinfo, 'base_var', base_var);
- pinfo = setfield(pinfo, 'comp_var', comp_var);
- pinfo = setfield(pinfo, 'base_time', base_time);
- pinfo = setfield(pinfo, 'base_tmeind', base_tmeind);
- pinfo = setfield(pinfo, 'base_lvl', base_lvl);
- pinfo = setfield(pinfo, 'base_lvlind', base_lvlind);
- pinfo = setfield(pinfo, 'base_lat', base_lat);
- pinfo = setfield(pinfo, 'base_latind', base_latind);
- pinfo = setfield(pinfo, 'base_lon', base_lon);
- pinfo = setfield(pinfo, 'base_lonind', base_lonind);
- pinfo = setfield(pinfo, 'comp_lvl', comp_lvl);
- pinfo = setfield(pinfo, 'comp_lvlind', comp_lvlind);
+ pinfo.fname = fname;
+ pinfo.base_var = base_var;
+ pinfo.comp_var = comp_var;
+ pinfo.base_time = base_time;
+ pinfo.base_tmeind = base_tmeind;
+ pinfo.base_lvl = base_lvl;
+ pinfo.base_lvlind = base_lvlind;
+ pinfo.base_lat = base_lat;
+ pinfo.base_latind = base_latind;
+ pinfo.base_lon = base_lon;
+ pinfo.base_lonind = base_lonind;
+ pinfo.comp_lvl = comp_lvl;
+ pinfo.comp_lvlind = comp_lvlind;
case 'plotvarvarcorrel'
disp('Getting information for the ''base'' variable.')
- base_var = GetVar(prognostic_vars);
- [base_time, base_tmeind] = GetTime( base_var,dates);
+ base_var = GetVar(pinfo.vars);
+ [base_time, base_tmeind] = GetTime(pinfo.time);
[base_lvl , base_lvlind] = GetLevel( base_var,levels);
[base_lat , base_latind] = GetLatitude( base_var,TmpJ,VelJ);
[base_lon , base_lonind] = GetLongitude(base_var,TmpI,VelI);
disp('Getting information for the ''comparison'' variable.')
- comp_var = GetVar(prognostic_vars, base_var);
- [comp_lvl, comp_lvlind] = GetLevel( comp_var,levels, base_lvl);
- [comp_lat, comp_latind] = GetLatitude( comp_var,TmpJ,VelJ, base_lat);
- [comp_lon, comp_lonind] = GetLongitude(comp_var,TmpI,VelI, base_lon);
+ comp_var = GetVar(pinfo.vars, base_var);
+ [comp_lvl, comp_lvlind] = GetLevel( comp_var, levels, base_lvl);
+ [comp_lat, comp_latind] = GetLatitude( comp_var, TmpJ, VelJ, base_lat);
+ [comp_lon, comp_lonind] = GetLongitude(comp_var, TmpI, VelI, base_lon);
- pinfo = setfield(pinfo, 'model', model);
- pinfo = setfield(pinfo, 'fname', fname);
- pinfo = setfield(pinfo, 'times', dates);
- pinfo = setfield(pinfo, 'base_var', base_var);
- pinfo = setfield(pinfo, 'comp_var', comp_var);
- pinfo = setfield(pinfo, 'base_time', base_time);
- pinfo = setfield(pinfo, 'base_tmeind', base_tmeind);
- pinfo = setfield(pinfo, 'base_lvl', base_lvl);
- pinfo = setfield(pinfo, 'base_lvlind', base_lvlind);
- pinfo = setfield(pinfo, 'base_lat', base_lat);
- pinfo = setfield(pinfo, 'base_latind', base_latind);
- pinfo = setfield(pinfo, 'base_lon', base_lon);
- pinfo = setfield(pinfo, 'base_lonind', base_lonind);
- pinfo = setfield(pinfo, 'comp_lvl', comp_lvl);
- pinfo = setfield(pinfo, 'comp_lvlind', comp_lvlind);
- pinfo = setfield(pinfo, 'comp_lat', comp_lat);
- pinfo = setfield(pinfo, 'comp_latind', comp_latind);
- pinfo = setfield(pinfo, 'comp_lon', comp_lon);
- pinfo = setfield(pinfo, 'comp_lonind', comp_lonind);
+ pinfo.fname = fname;
+ pinfo.base_var = base_var;
+ pinfo.comp_var = comp_var;
+ pinfo.base_time = base_time;
+ pinfo.base_tmeind = base_tmeind;
+ pinfo.base_lvl = base_lvl;
+ pinfo.base_lvlind = base_lvlind;
+ pinfo.base_lat = base_lat;
+ pinfo.base_latind = base_latind;
+ pinfo.base_lon = base_lon;
+ pinfo.base_lonind = base_lonind;
+ pinfo.comp_lvl = comp_lvl;
@@ Diff output truncated at 40000 characters. @@
From nancy at ucar.edu Wed Apr 11 11:28:19 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Wed, 11 Apr 2012 11:28:19 -0600
Subject: [Dart-dev] [5692] DART/branches: Moving this from the deprecated
mpas branch to the development branch
Message-ID:
Revision: 5692
Author: thoar
Date: 2012-04-11 11:28:19 -0600 (Wed, 11 Apr 2012)
Log Message:
-----------
Moving this from the deprecated mpas branch to the development branch
in preparation for the removal of the mpas branch.
Added Paths:
-----------
DART/branches/development/models/mpas_ocn/
Removed Paths:
-------------
DART/branches/mpas/models/mpas_ocn/
-------------- next part --------------
Property changes on: DART/branches/development/models/mpas_ocn
___________________________________________________________________
Added: svn:mergeinfo
+ /DART/trunk/models/mpas_ocn:5020-5658
From nancy at ucar.edu Wed Apr 11 11:56:46 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Wed, 11 Apr 2012 11:56:46 -0600
Subject: [Dart-dev] [5693]
DART/branches/development/models/mpas_ocn/data/README.txt: Pointer to where
on the server the example ocean
Message-ID:
Revision: 5693
Author: nancy
Date: 2012-04-11 11:56:45 -0600 (Wed, 11 Apr 2012)
Log Message:
-----------
Pointer to where on the server the example ocean
mpas netcdf files are.
Added Paths:
-----------
DART/branches/development/models/mpas_ocn/data/README.txt
-------------- next part --------------
Added: DART/branches/development/models/mpas_ocn/data/README.txt
===================================================================
--- DART/branches/development/models/mpas_ocn/data/README.txt (rev 0)
+++ DART/branches/development/models/mpas_ocn/data/README.txt 2012-04-11 17:56:45 UTC (rev 5693)
@@ -0,0 +1,12 @@
+
+$Id$
+
+The data files for MPAS are huge.
+The data files may be downloaded from the DART server:
+
+http://www.image.ucar.edu/pub/DART/MPAS_OCN
+
+In particular, there is one restart and one output
+file there.
+
+
Property changes on: DART/branches/development/models/mpas_ocn/data/README.txt
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:keywords
+ Date Rev Author HeadURL Id
Added: svn:eol-style
+ native
From nancy at ucar.edu Wed Apr 11 16:23:46 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Wed, 11 Apr 2012 16:23:46 -0600
Subject: [Dart-dev] [5694] DART/trunk/utilities/closest_member_tool.f90: fix
that made it into Kodiak branch but wasn't on trunk.
Message-ID:
Revision: 5694
Author: nancy
Date: 2012-04-11 16:23:46 -0600 (Wed, 11 Apr 2012)
Log Message:
-----------
fix that made it into Kodiak branch but wasn't on trunk.
was using wrong loop variable in an informational message.
doesn't change results, but makes the messages more helpful.
Modified Paths:
--------------
DART/trunk/utilities/closest_member_tool.f90
Property Changed:
----------------
DART/trunk/utilities/closest_member_tool.f90
-------------- next part --------------
Modified: DART/trunk/utilities/closest_member_tool.f90
===================================================================
--- DART/trunk/utilities/closest_member_tool.f90 2012-04-11 17:56:45 UTC (rev 5693)
+++ DART/trunk/utilities/closest_member_tool.f90 2012-04-11 22:23:46 UTC (rev 5694)
@@ -248,7 +248,7 @@
if (mean_time /= member_time) then
call print_time(mean_time, "time of ensemble mean data")
call print_time(member_time, "time of ensemble member data")
- write(msgstring, *) 'member ', i, ' has a different timestamp than mean'
+ write(msgstring, *) 'member ', ens, ' has a different timestamp than mean'
call error_handler(E_ERR,'closest_member_tool', msgstring)
endif
@@ -281,7 +281,7 @@
if (mean_time /= member_time) then
call print_time(mean_time, "time of ensemble mean data")
call print_time(member_time, "time of ensemble member data")
- write(msgstring, *) 'member ', i, ' has a different timestamp than mean'
+ write(msgstring, *) 'member ', ens, ' has a different timestamp than mean'
call error_handler(E_ERR,'closest_member_tool', msgstring)
endif
Property changes on: DART/trunk/utilities/closest_member_tool.f90
___________________________________________________________________
Added: svn:mergeinfo
+ /DART/branches/close/closest_member_tool.f90:4780-4810
/DART/releases/Kodiak/utilities/closest_member_tool.f90:5020-5693
From nancy at ucar.edu Thu Apr 12 15:29:59 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Thu, 12 Apr 2012 15:29:59 -0600
Subject: [Dart-dev] [5695] DART/branches/development/location: 2D version of
the annulus code.
Message-ID:
Revision: 5695
Author: nancy
Date: 2012-04-12 15:29:58 -0600 (Thu, 12 Apr 2012)
Log Message:
-----------
2D version of the annulus code. supports limits for the
azimuth angle of -90/90 (latitude-like), 0-360 (longitude-
like with wrap around 360/0), or unlimited. radius limits
are set with a min/max value in a namelist and are assumed
to be in meters.
Modified Paths:
--------------
DART/branches/development/location/twod_annulus/README
DART/branches/development/location/twod_annulus/location_mod.f90
DART/branches/development/location/twod_annulus/test/input.nml
DART/branches/development/location/twod_annulus/test/path_names_location_test
DART/branches/development/location/twod_annulus/test/test.in
Added Paths:
-----------
DART/branches/development/location/twod_annulus/
-------------- next part --------------
Modified: DART/branches/development/location/twod_annulus/README
===================================================================
--- DART/branches/development/location/annulus/README 2012-04-11 17:28:19 UTC (rev 5692)
+++ DART/branches/development/location/twod_annulus/README 2012-04-12 21:29:58 UTC (rev 5695)
@@ -4,26 +4,15 @@
#
# DART $Id$
-Last modified 29 Jan, 2010 by nancy collins
+A location consists of the pair (azimuth, radius).
-made consistent with other location modules, including the
-revised get_close() routines. this code didn't have any
-min/max limits on the radius, and was still using lon/lat
-in a few subroutines. i put in a stub of a namelist for
-the radius limits, and changed the remaining lon/lats
-to azm and rad.
+This is copied from the cylindrical version of the
+annulus location module which has an azimuthal angle,
+a radius, and a height.
-Last modified June 28, 2004 by Jim Hansen.
-
-The location_mod.f90 for the annulus is a modified version
-of ~/DART/location/threed_sphere/location_mod.f90. The most
-important thing to keep in mind in the annulus version is that
-longitude actually mean azimuthal angle, and latitude actually
-means radius.
-
The location_mod.f90 requires the parameters inner_rad (inner
radius of the annulus) and outer_rad (outer radius of the annulus)
from the input.nml.
-Longitude (azimuthal angle) is in degrees, latitude (radius) is
-in meters.
+Azimuthal angle is in degrees, radius is in meters.
+
Modified: DART/branches/development/location/twod_annulus/location_mod.f90
===================================================================
--- DART/branches/development/location/annulus/location_mod.f90 2012-04-11 17:28:19 UTC (rev 5692)
+++ DART/branches/development/location/twod_annulus/location_mod.f90 2012-04-12 21:29:58 UTC (rev 5695)
@@ -10,12 +10,12 @@
! $Revision$
! $Date$
-! Implements location interfaces for a three dimensional annulus
-! with a vertical coordinate based on the models native set of
-! discrete levels. The internal representation of the location is
-! currently implemented as radians from 0 to 2 PI for the azimuthal
-! direction (longitude-like). The radial distance is latitude-like,
-! and the vertical coordinate is zero at the bottom of the annulus.
+! Implements location interfaces for a two dimensional annulus
+! discrete levels. The internal representation of the azimuth is
+! implemented as radians and is namelist selectable to be valid
+! from -PI/2 to PI/2 (like latitudes) or from 0 to 2 PI (like longitudes)
+! The radial distance is in meters and the inner and outer boundary
+! distances are namelist settable.
!
use types_mod, only : r8, PI, RAD2DEG, DEG2RAD, MISSING_R8, MISSING_I
@@ -36,8 +36,7 @@
operator(==), operator(/=), get_dist, get_close_obs_destroy, &
nc_write_location_atts, nc_get_location_varids, nc_write_location, &
vert_is_height, vert_is_pressure, vert_is_undef, vert_is_level, &
- vert_is_surface, has_vertical_localization, VERTISSURFACE, &
- VERTISLEVEL, VERTISHEIGHT
+ vert_is_surface, has_vertical_localization
! version controlled file description for error handling, do not edit
character(len=128), parameter :: &
@@ -47,17 +46,17 @@
type location_type
private
- real(r8) :: azm, rad, vloc
- integer :: which_vert
- ! which_vert determines if the location is by level or by height
- ! -1 ==> obs is on surface
- ! 1 ===> obs is by level
- ! 3 ===> obs is by height
+ real(r8) :: azm, rad
+ integer :: which_azm
+ ! which_azm determines the valid boundaries of the azimuth
+ ! -1 ==> no limits
+ ! 0 ==> -PI/2 to PI/2 (like latitudes)
+ ! 1 ==> 0 to 2PI (like longitudes)
end type location_type
-integer, parameter :: VERTISSURFACE = -1 ! surface
-integer, parameter :: VERTISLEVEL = 1 ! by level
-integer, parameter :: VERTISHEIGHT = 3 ! by height
+integer, parameter :: AZMISUNBOUND = -1 ! unbounded
+integer, parameter :: AZMISLAT = 0 ! like lats
+integer, parameter :: AZMISLON = 1 ! like lons
type get_close_type
private
@@ -69,14 +68,12 @@
logical :: ran_seq_init = .false.
logical, save :: module_initialized = .false.
-integer, parameter :: LocationDims = 3
-character(len = 129), parameter :: LocationName = "loc_annulus"
+integer, parameter :: LocationDims = 2
+character(len = 129), parameter :: LocationName = "loc_2d_annulus"
character(len = 129), parameter :: LocationLName = &
- "Annulus location: azimuthal angle, radius, and height"
+ "2D Annulus location: azimuthal angle, radius"
-! really just a placeholder. there was a comment that this code
-! needs a namelist with a min & max limit on the radius, but
-! the code no longer has one.
+! limits on the radius (sets inner and outer radius values)
real(r8) :: min_radius = 0.0_r8
real(r8) :: max_radius = 100000.0_r8
@@ -121,7 +118,7 @@
if(do_nml_term()) write( * , nml=location_nml)
! copy code from threed sphere module for handing the
-! options in the vertical? e.g. distances?
+! distances?
end subroutine initialize_module
@@ -129,9 +126,7 @@
function get_dist(loc1, loc2, kind1, kind2)
-! Compute distance between 2 locations. Right now the distance only
-! depends on the horizontal. A namelist option might need to be added
-! that supports computing a true 3d distance.
+! Compute distance between 2 locations.
type(location_type), intent(in) :: loc1, loc2
integer, optional, intent(in) :: kind1, kind2
@@ -141,8 +136,6 @@
if ( .not. module_initialized ) call initialize_module
-! FIXME: this does not take into account any vertical separation
-! convert from cylindrical to cartesian coordinates
x1 = loc1%rad * cos(loc1%azm)
y1 = loc1%rad * sin(loc1%azm)
x2 = loc2%rad * cos(loc2%azm)
@@ -168,10 +161,9 @@
loc_eq = .false.
-if ( loc1%which_vert /= loc2%which_vert ) return
+if ( loc1%which_azm /= loc2%which_azm ) return
if ( abs(loc1%azm - loc2%azm ) > epsilon(loc1%azm ) ) return
if ( abs(loc1%rad - loc2%rad ) > epsilon(loc1%rad ) ) return
-if ( abs(loc1%vloc - loc2%vloc) > epsilon(loc1%vloc) ) return
loc_eq = .true.
@@ -198,33 +190,32 @@
function get_location(loc)
! Given a location type (where the azimuthal angle is in radians), this
-! routine return the azimuthal angle in degrees, the radius, and the vert
+! routine return the azimuthal angle in degrees, and the radius.
type(location_type), intent(in) :: loc
-real(r8), dimension(3) :: get_location
+real(r8), dimension(2) :: get_location
if ( .not. module_initialized ) call initialize_module
get_location(1) = loc%azm * RAD2DEG
get_location(2) = loc%rad
-get_location(3) = loc%vloc
end function get_location
!----------------------------------------------------------------------------
-function set_location_single(azm, rad, vert_loc, which_vert)
+function set_location_single(azm, rad, which_azm)
-! Puts the given azimuthal angle (in degrees), radius, and vertical
+! Puts the given azimuthal angle (in degrees), and radius
! location into a location datatype.
real(r8), intent(in) :: azm, rad
-real(r8), intent(in) :: vert_loc
-integer, intent(in) :: which_vert
+integer, intent(in) :: which_azm
type (location_type) :: set_location_single
if ( .not. module_initialized ) call initialize_module
+! FIXME: test range based on which_azm
if(azm < 0.0_r8 .or. azm > 360.0_r8) then
write(errstring,*)'azimuthal angle (',azm,') is not within range [0,360]'
call error_handler(E_ERR, 'set_location', errstring, source, revision, revdate)
@@ -233,16 +224,8 @@
set_location_single%azm = azm * DEG2RAD
set_location_single%rad = rad
-if(which_vert /= VERTISSURFACE .and. &
- which_vert /= VERTISLEVEL .and. &
- which_vert /= VERTISHEIGHT ) then
- write(errstring,*)'which_vert (',which_vert,') must be -1, 1 or 3'
- call error_handler(E_ERR,'set_location', errstring, source, revision, revdate)
-endif
+set_location_single%which_azm = which_azm
-set_location_single%which_vert = which_vert
-set_location_single%vloc = vert_loc
-
end function set_location_single
!----------------------------------------------------------------------------
@@ -250,19 +233,19 @@
function set_location_array(list)
! Location semi-independent interface routine
-! given 4 float numbers, call the underlying set_location routine
+! given 3 float numbers, call the underlying set_location routine
real(r8), intent(in) :: list(:)
type (location_type) :: set_location_array
if ( .not. module_initialized ) call initialize_module
-if (size(list) < 4) then
- write(errstring,*)'requires 4 input values'
+if (size(list) < 3) then
+ write(errstring,*)'requires 3 input values'
call error_handler(E_ERR, 'set_location', errstring, source, revision, revdate)
endif
-set_location_array = set_location_single(list(1), list(2), list(3), nint(list(4)))
+set_location_array = set_location_single(list(1), list(2), nint(list(3)))
end function set_location_array
@@ -278,8 +261,7 @@
set_location_missing%azm = MISSING_R8
set_location_missing%rad = MISSING_R8
-set_location_missing%vloc = MISSING_R8
-set_location_missing%which_vert = MISSING_I
+set_location_missing%which_azm = MISSING_I
end function set_location_missing
@@ -300,22 +282,20 @@
! module for warnings about compiler bugs before you change
! this code.
-query_location = loc%which_vert
+query_location = loc%which_azm
if (.not. present(attr)) return
select case(attr)
- case ('which_vert','WHICH_VERT')
- query_location = loc%which_vert
+ case ('which_azm','WHICH_AZM')
+ query_location = loc%which_azm
case ('rad','RAD','radius','RADIUS')
query_location = loc%rad
case ('azm','AZM','azimuth','AZIMUTH')
query_location = loc%azm
- case ('vloc','VLOC')
- query_location = loc%vloc
case default
call error_handler(E_ERR, 'query_location:', &
- 'Only "azm","rad","vloc","which_vert" are legal attributes to request from location', &
+ 'Only "azm","rad","which_azm" are legal attributes to request from location', &
source, revision, revdate)
end select
@@ -340,8 +320,7 @@
logical :: writebuf
character(len = 128) :: string1
-! 10 format(1x,3(f22.14,1x),i4) ! old
-10 format(1X,F21.16,2(1X,G25.16),1X,I2)
+10 format(1X,F21.16,1X,G25.16,1X,I2)
if ( .not. module_initialized ) call initialize_module
@@ -351,12 +330,11 @@
! output file; test for ascii or binary, write what's asked, and return
if (.not. writebuf) then
if (ascii_file_format(fform)) then
- ! Write out pressure or level along with integer tag
- ! we know azm is between 0, 360, and which_vert is a single digit.
- write(locfile, '(''loc3a'')' )
- write(locfile, 10) loc%azm, loc%rad, loc%vloc, loc%which_vert
+ ! azm is between -90, 360, and which_vert is a single digit.
+ write(locfile, '(''loc2a'')' )
+ write(locfile, 10) loc%azm, loc%rad, loc%which_azm
else
- write(locfile) loc%azm, loc%rad, loc%vloc, loc%which_vert
+ write(locfile) loc%azm, loc%rad, loc%which_azm
endif
return
endif
@@ -374,31 +352,16 @@
! hectopascals instead of pascals for pressure, etc.
! this must be the sum of the longest of the formats below.
-charlength = 85
+charlength = 48
if (len(charstring) < charlength) then
write(errstring, *) 'charstring buffer must be at least ', charlength, ' chars long'
call error_handler(E_ERR, 'write_location', errstring, source, revision, revdate)
endif
-write(string1, '(A,F12.8,1X,G15.8,A)') 'Azm(deg)/Radius(m): ', &
- loc%azm*RAD2DEG, loc%rad, ' Depth:'
+write(charstring, '(A,F12.8,1X,G15.8)') 'Azm(deg)/Radius(m): ', &
+ loc%azm*RAD2DEG, loc%rad
-! i am attempting to make these line up so if you have a list of mixed
-! vertical units, they all take the same number of columns. thus the extra
-! white space around some of the labels below.
-select case (loc%which_vert)
- case (VERTISSURFACE)
- write(charstring, '(A,1X,G15.6,A)') trim(string1), loc%vloc, ' surface (hPa)'
- case (VERTISLEVEL)
- write(charstring, '(A,1X,F6.0,A)') trim(string1), loc%vloc, ' level'
- case (VERTISHEIGHT)
- write(charstring, '(A,1X,G15.6,A)') trim(string1), loc%vloc / 1000.0_r8, ' km'
- case default
- write(errstring, *) 'unrecognized key for vertical type: ', loc%which_vert
- call error_handler(E_ERR, 'write_location', errstring, source, revision, revdate)
-end select
-
end subroutine write_location
!----------------------------------------------------------------------------
@@ -419,16 +382,16 @@
if (ascii_file_format(fform)) then
read(locfile, '(a5)' ) header
- if(header /= 'loc3a') then
- write(errstring,*)'Expected location header "loc3a" in input file, got ', header
+ if(header /= 'loc2a') then
+ write(errstring,*)'Expected location header "loc2a" in input file, got ', header
call error_handler(E_ERR, 'read_location', errstring, source, revision, revdate)
endif
! Now read the location data value
read(locfile, *) read_location%azm, read_location%rad, &
- read_location%vloc, read_location%which_vert
+ read_location%which_azm
else
read(locfile) read_location%azm, read_location%rad, &
- read_location%vloc, read_location%which_vert
+ read_location%which_azm
endif
end function read_location
@@ -443,7 +406,8 @@
type(location_type), intent(out) :: location
logical, intent(in), optional :: set_to_default
-real(r8) :: azm, rad, minazm, maxazm, minrad, maxrad
+real(r8) :: azm, rad, minazm, maxazm, minrad, maxrad, minv, maxv
+integer :: r
if ( .not. module_initialized ) call initialize_module
@@ -451,47 +415,63 @@
if(present(set_to_default)) then
if(set_to_default) then
location%azm = 0.0_r8
- location%rad = 0.0_r8
- location%vloc = 0.0_r8
- location%which_vert = 0 ! zero is an invalid vert type
+ location%rad = min_radius
+ location%which_azm = -1 ! unlimited angle
return
endif
endif
-write(*, *)'Vertical coordinate options'
-write(*, *)'-1 -> surface, 1 -> model level, 3 -> depth'
+write(*, *)'Azimuth coordinate limit options'
+write(*, *)'-1 -> none, 0 -> -90, 90, 1 -> 0, 360'
-100 read(*, *) location%which_vert
-if(location%which_vert == VERTISLEVEL ) then
- write(*, *) 'Vertical coordinate model level'
- read(*, *) location%vloc
-else if(location%which_vert == VERTISHEIGHT ) then
- write(*, *) 'Vertical coordinate depth (in negative m)'
- read(*, *) location%vloc
- do while (location%vloc > 0)
- write(*, *) 'Depth must be negative (zero at top of fluid), please try again'
- read(*, *) location%vloc
- end do
-else if(location%which_vert == VERTISSURFACE ) then
- write(*, *) 'Vertical coordinate surface pressure (in hPa)'
- read(*, *) location%vloc
- location%vloc = 100.0 * location%vloc
+100 read(*, *) location%which_azm
+if(location%which_azm == AZMISUNBOUND ) then
+ minazm = -HUGE(r8)
+ maxazm = HUGE(r8)
+else if(location%which_azm == AZMISLAT ) then
+ minazm = -PI/2
+ maxazm = PI/2
+else if(location%which_azm == AZMISLON ) then
+ minazm = 0.0_r8
+ maxazm = 2.0_r8*PI
else
- write(*, *) 'Wrong choice of which_vert try again between -1, 1, and 3'
+ write(*, *) 'Wrong choice of which_azm try again, valid: -1, 0, and 1'
go to 100
end if
-write(*, *) 'Input azimuthal angle: value 0 to 360.0 or a negative number '
-write(*, *) 'for uniformly distributed random location in the horizontal.'
-read(*, *) azm
+r = 1
+do while (r > 0)
-do while(azm > 360.0_r8)
- write(*, *) 'Input value greater than 360.0 is illegal, please try again'
- read(*, *) azm
-end do
+ write(*, *) 'Input 0 to specify a value for the location, or'
+ write(*, *) '-1 for a uniformly distributed random location'
+ read(*, *) r
-if(azm < 0.0_r8) then
+ if (r > 0) write(*, *) 'Please input 0 or -1 for selection'
+enddo
+if (r == 0) then
+101 continue
+ if (location%which_azm == AZMISUNBOUND) then
+ write(*, *) 'Input value for aziumth in degrees '
+ read(*,*) azm
+ else if (location%which_azm == AZMISLAT) then
+ write(*, *) 'Input value for aziumth in degrees (-90 to 90) '
+ read(*,*) azm
+ if (azm < -90.0_r8 .or. azm > 90.0_r8) then
+ write(*,*) 'Illegal value; must be between -90 and 90'
+ goto 101
+ endif
+ else if (location%which_azm == AZMISLON) then
+ write(*, *) 'Input value for aziumth in degrees (0 to 360)'
+ read(*,*) azm
+ if (azm < 0.0_r8 .or. azm > 360.0_r8) then
+ write(*,*) 'Illegal value; must be between 0 and 360'
+ goto 101
+ endif
+ endif
+ location%azm = azm * DEG2RAD
+
+else
! Need to make sure random sequence is initialized
if(.not. ran_seq_init) then
@@ -499,31 +479,66 @@
ran_seq_init = .TRUE.
endif
- minazm = -1.0
- do while (minazm < 0.0 .or. minazm > 360.0)
- write(*, *) 'Input minimum azimuthal angle (0 to 360.0)'
- read(*, *) minazm
- if (minazm < 0.0 .or. minazm > 360.0) then
- write(*, *) 'Angle must be between 0 to 360.0'
- endif
- enddo
- minazm = minazm * DEG2RAD
+102 continue
+ write(*, *) 'Input minimum azimuth value in degrees '
+ read(*, *) minv
+ if (location%which_azm == AZMISLAT) then
+ if (minv < -90.0_r8) then
+ write(*,*) 'Illegal value; minimum must be >= -90'
+ goto 102
+ endif
+ else if (location%which_azm == AZMISLON) then
+ if (minv < 0.0_r8) then
+ write(*,*) 'Illegal value; minimum must be >= 0'
+ goto 102
+ endif
+ endif
- maxazm = -1.0
- do while (maxazm < 0.0 .or. maxazm > 360.0)
- write(*, *) 'Input maximum azimuthal angle (0 to 360.0)'
- read(*, *) maxazm
- if (maxazm < 0.0 .or. maxazm > 360.0) then
- write(*, *) 'Angle must be between 0 to 360.0'
+103 continue
+ write(*, *) 'Input maximum azimuth value in degrees '
+ read(*, *) maxv
+ if (location%which_azm == AZMISLAT) then
+ if (maxv > 90.0_r8) then
+ write(*,*) 'Illegal value; maximum must be <= 90'
+ goto 103
+ endif
+ else if (location%which_azm == AZMISLON) then
+ if (maxv > 360.0_r8) then
+ write(*,*) 'Illegal value; maximum must be <= 360'
+ goto 103
+ endif
+ endif
+
+ minv = minv * DEG2RAD
+ maxv = maxv * DEG2RAD
+
+ ! Azimuth is random from minazm to maxazm, handle wrap around 360.0
+ if (location%which_azm == AZMISLON) then
+ if (minv > maxv) maxv = maxv + 2.0_r8 * PI
+ endif
+
+ location%azm = random_uniform(ran_seq) * (maxv-minv) + minv
+
+ if (location%which_azm == AZMISLON) then
+ if (location%azm > 2.0_r8 * PI) location%azm = location%azm - 2.0_r8 * PI
+ endif
+
+endif
+
+if (r == 0) then
+ rad = -1.0
+ do while (rad < min_radius .or. rad > max_radius)
+ write(*, *) 'Input radius '
+ read(*, *) rad
+ if (rad < min_radius .or. rad > max_radius) then
+ write(*, *) 'Radius must be between ', min_radius, ' and ', max_radius
endif
enddo
- maxazm = maxazm * DEG2RAD
- ! Azimuth is random from minazm to maxazm, handle wrap around 360.0
- if (minazm > maxazm) maxazm = maxazm + 2.0_r8 * PI
- location%azm = random_uniform(ran_seq) * (maxazm-minazm) + minazm
- if (location%azm > 2.0_r8 * PI) location%azm = location%azm - 2.0_r8 * PI
+ location%rad = rad
+else
+
minrad = -1.0
do while (minrad < min_radius)
write(*, *) 'Input minimum radius '
@@ -532,7 +547,7 @@
write(*, *) 'Radius must be larger or equal to ', min_radius
endif
enddo
-
+
maxrad = -1.0
do while (maxrad > max_radius .or. maxrad <= minrad)
write(*, *) 'Input maximum radius '
@@ -545,25 +560,10 @@
! Radius must be area weighted to obtain proper random realizations
location%rad = sqrt(random_uniform(ran_seq)) * (maxrad-minrad) + minrad
- write(*, *) 'random location is ', location%azm / DEG2RAD, &
+ write(*, *) 'random location is ', location%azm * RAD2DEG, &
location%rad
+endif
-else
-
- rad = -1.0
- do while (rad < min_radius .or. rad > max_radius)
- write(*, *) 'Input radius '
- read(*, *) rad
- if (rad < min_radius .or. rad > max_radius) then
- write(*, *) 'Radius must be between ', min_radius, ' and ', max_radius
- endif
- enddo
-
- location%rad = rad
- location%azm = azm*DEG2RAD
-
-end if
-
end subroutine interactive_location
!----------------------------------------------------------------------------
@@ -604,25 +604,12 @@
call nc_check(nf90_put_att(ncFileID, VarID, 'long_name', &
trim(LocationLName)), 'nc_write_location_atts', 'location:long_name')
call nc_check(nf90_put_att(ncFileID, VarID, 'storage_order', &
- 'Azimuth Radius Vertical'), 'nc_write_location_atts', 'location:storage_order')
+ 'Azimuth Radius'), 'nc_write_location_atts', 'location:storage_order')
call nc_check(nf90_put_att(ncFileID, VarID, 'units', &
- 'degrees meters which_vert'), 'nc_write_location_atts', 'location:units')
+ 'degrees meters'), 'nc_write_location_atts', 'location:units')
! Define the ancillary vertical array and attributes
-call nc_check(nf90_def_var(ncid=ncFileID, name='which_vert', xtype=nf90_int, &
- dimids=(/ ObsNumDimID /), varid=VarID), &
- 'nc_write_location_atts', 'which_vert:def_var')
-
-call nc_check(nf90_put_att(ncFileID, VarID, 'long_name', 'vertical coordinate system code'), &
- 'nc_write_location_atts', 'which_vert:long_name')
-call nc_check(nf90_put_att(ncFileID, VarID, 'VERTISSURFACE', VERTISSURFACE), &
- 'nc_write_location_atts', 'which_vert:VERTISSURFACE')
-call nc_check(nf90_put_att(ncFileID, VarID, 'VERTISLEVEL', VERTISLEVEL), &
- 'nc_write_location_atts', 'which_vert:VERTISLEVEL')
-call nc_check(nf90_put_att(ncFileID, VarID, 'VERTISHEIGHT', VERTISHEIGHT), &
- 'nc_write_location_atts', 'which_vert:VERTISHEIGHT')
-
! If we made it to here without error-ing out ... we're good.
ierr = 0
@@ -652,8 +639,7 @@
call nc_check(nf90_inq_varid(ncFileID, 'location', varid=LocationVarID), &
'nc_get_location_varids', 'inq_varid:location '//trim(fname))
-call nc_check(nf90_inq_varid(ncFileID, 'which_vert', varid=WhichVertVarID), &
- 'nc_get_location_varids', 'inq_varid:which_vert '//trim(fname))
+WhichVertVarID = -99
end subroutine nc_get_location_varids
@@ -684,11 +670,6 @@
start=(/ 1, obsindex /), count=(/ LocationDims, 1 /) ), &
'nc_write_location', 'put_var:location')
-intval = loc%which_vert
-call nc_check(nf90_put_var(ncFileID, WhichVertVarID, intval, &
- start=(/ obsindex /), count=(/ 1 /) ), &
- 'nc_write_location','put_var:vert' )
-
end subroutine nc_write_location
!----------------------------------------------------------------------------
@@ -779,9 +760,9 @@
if ( .not. module_initialized ) call initialize_module
-if ((minl%which_vert /= maxl%which_vert) .or. &
- (minl%which_vert /= loc%which_vert)) then
- write(errstring,*)'which_vert (',loc%which_vert,') must be same in all args'
+if ((minl%which_azm /= maxl%which_azm) .or. &
+ (minl%which_azm /= loc%which_azm)) then
+ write(errstring,*)'which_azm (',loc%which_azm,') must be same in all args'
call error_handler(E_ERR, 'is_location_in_region', errstring, source, revision, revdate)
endif
@@ -789,10 +770,13 @@
! set to success only at the bottom after all tests have passed.
is_location_in_region = .false.
-! use the code in the utils module that knows how to wrap longitude/radians.
-if (.not. is_longitude_between(loc%azm, minl%azm, maxl%azm, doradians=.true.)) return
+if (loc%which_azm /= AZMISLON) then
+ if ((loc%azm < minl%azm) .or. (loc%azm > maxl%azm)) return
+else
+ ! use the code in the utils module that knows how to wrap longitude/radians.
+ if (.not. is_longitude_between(loc%azm, minl%azm, maxl%azm, doradians=.true.)) return
+endif
if ((loc%rad < minl%rad) .or. (loc%rad > maxl%rad)) return
-if ((loc%vloc < minl%vloc) .or. (loc%vloc > maxl%vloc)) return
is_location_in_region = .true.
@@ -815,18 +799,14 @@
function vert_is_surface(loc)
-! Given a location, return true if vertical coordinate is surface, else false.
+! Stub, always returns false.
logical :: vert_is_surface
type(location_type), intent(in) :: loc
if ( .not. module_initialized ) call initialize_module
-if(loc%which_vert == VERTISSURFACE ) then
- vert_is_surface = .true.
-else
- vert_is_surface = .false.
-endif
+vert_is_surface = .false.
end function vert_is_surface
@@ -834,7 +814,7 @@
function vert_is_pressure(loc)
-! Always returns false, as vertical coordinate is never pressure for the annulus.
+! Stub, always returns false.
logical :: vert_is_pressure
type(location_type), intent(in) :: loc
@@ -847,18 +827,14 @@
function vert_is_height(loc)
-! Given a location, return true if vertical coordinate is height, else false.
+! Stub, always returns false.
logical :: vert_is_height
type(location_type), intent(in) :: loc
if ( .not. module_initialized ) call initialize_module
-if(loc%which_vert == VERTISHEIGHT ) then
- vert_is_height = .true.
-else
- vert_is_height = .false.
-endif
+vert_is_height = .false.
end function vert_is_height
@@ -866,18 +842,14 @@
function vert_is_level(loc)
-! Given a location, return true if vertical coordinate is level, else false.
+! Stub, always returns false.
logical :: vert_is_level
type(location_type), intent(in) :: loc
if ( .not. module_initialized ) call initialize_module
-if(loc%which_vert == VERTISLEVEL ) then
- vert_is_level = .true.
-else
- vert_is_level = .false.
-endif
+vert_is_level = .false.
end function vert_is_level
@@ -898,7 +870,7 @@
!----------------------------------------------------------------------------
-! end of location/annulus/location_mod.f90
+! end of location/twod_annulus/location_mod.f90
!----------------------------------------------------------------------------
end module location_mod
Modified: DART/branches/development/location/twod_annulus/test/input.nml
===================================================================
--- DART/branches/development/location/annulus/test/input.nml 2012-04-11 17:28:19 UTC (rev 5692)
+++ DART/branches/development/location/twod_annulus/test/input.nml 2012-04-12 21:29:58 UTC (rev 5695)
@@ -1,4 +1,6 @@
&location_nml
+ min_radius = 100.0
+ max_radius = 100000.0
/
&utilities_nml
Modified: DART/branches/development/location/twod_annulus/test/path_names_location_test
===================================================================
--- DART/branches/development/location/annulus/test/path_names_location_test 2012-04-11 17:28:19 UTC (rev 5692)
+++ DART/branches/development/location/twod_annulus/test/path_names_location_test 2012-04-12 21:29:58 UTC (rev 5695)
@@ -3,5 +3,5 @@
random_seq/random_seq_mod.f90
time_manager/time_manager_mod.f90
utilities/utilities_mod.f90
-location/annulus/location_mod.f90
+location/twod_annulus/location_mod.f90
location/location_test.f90
Modified: DART/branches/development/location/twod_annulus/test/test.in
===================================================================
--- DART/branches/development/location/annulus/test/test.in 2012-04-11 17:28:19 UTC (rev 5692)
+++ DART/branches/development/location/twod_annulus/test/test.in 2012-04-12 21:29:58 UTC (rev 5695)
@@ -1,96 +1,66 @@
-3
--300
-240
-100
-3
--7000
+0
+0
+45
+1000
+0
-1
-240
-40
+0
+90
1000
-12000
-3
--30
+10000
+0
+0
+30
+10000
+0
+0
+33
+1001
+0
+0
+50
+3000
+0
+0
+-89
+1000
+0
-1
-140
-240
-10
-20
-3
--5000
+0
+90
+100
+10000
+0
+0
+45
+3456
+0
-1
-340
-359
+0
+90
+100
10000
-20000
-3
--2000
+0
-1
-140
-250
-1
-20
-3
--200
+0
+90
+100
+10000
+0
-1
-15
-25
+0
+90
+1000
10000
-100000
-3
--8000
+0
-1
-140
-250
-10
-200
-3
--100
--1
-130
-250
-10
-200
-3
--9000
--1
-240
-250
-51
-60
--1
-998
--1
-50
-60
+0
+90
+100
10000
-10200
-1
-10
+0
-1
-40
-50
-600
-900
-3
--10
--1
-240
-250
-10
-50
-1
-15
--1
-20
-25
-10
-20
-3
--100
--1
-40
-250
-10
-200
-
+0
+90
+100
+10000
From nancy at ucar.edu Fri Apr 13 15:29:35 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Fri, 13 Apr 2012 15:29:35 -0600
Subject: [Dart-dev] [5696]
DART/branches/development/obs_sequence/obs_seq_coverage.f90: Fixed problem
writing ReportTime netCDF variable.
Message-ID:
Revision: 5696
Author: thoar
Date: 2012-04-13 15:29:34 -0600 (Fri, 13 Apr 2012)
Log Message:
-----------
Fixed problem writing ReportTime netCDF variable.
Modified Paths:
--------------
DART/branches/development/obs_sequence/obs_seq_coverage.f90
-------------- next part --------------
Modified: DART/branches/development/obs_sequence/obs_seq_coverage.f90
===================================================================
--- DART/branches/development/obs_sequence/obs_seq_coverage.f90 2012-04-12 21:29:58 UTC (rev 5695)
+++ DART/branches/development/obs_sequence/obs_seq_coverage.f90 2012-04-13 21:29:34 UTC (rev 5696)
@@ -222,7 +222,7 @@
if (temporal_coverage_percent < 100.0_r8) then
write(string1,*)'namelist: temporal_coverage_percent (',temporal_coverage_percent,&
') must be == 100.0 for now.)'
- call error_handler(E_ERR, 'obs_seq_coverage', string1, source, revision, revdate)
+! call error_handler(E_ERR, 'obs_seq_coverage', string1, source, revision, revdate)
endif
if ((obs_sequence_name /= '') .and. (obs_sequence_list /= '')) then
@@ -267,12 +267,22 @@
verification_interval_seconds, temporal_coverage_percent)
if (verbose) then
+
write(*,*) ! whitespace
- write(*,*)'At least',nT_minimum,' observations times are required at:'
+ write(*,*)'The analysis times (the start of the forecasts) are:'
+ do i=1,size(verification_times,1)
+ write(string1,*)'analysis # ',i,' at '
+ call print_date(verification_times(i,1),trim(string1))
+ enddo
+
+ write(*,*) ! whitespace
+ write(*,*)'At least',nT_minimum,' observations times are required during:'
do i=1,num_verification_times
write(string1,*)'verification # ',i,' at '
call print_date(all_verif_times(i),trim(string1))
enddo
+
+
write(*,*) ! whitespace
endif
@@ -493,7 +503,7 @@
station_id = add_new_station(flavor, obs_loc, stations)
endif
- if ( is_time_wanted( obs_time, station_id, stations, timeindex) ) &
+ if ( time_is_wanted( obs_time, station_id, stations, timeindex) ) &
call update_time( obs_time, station_id, stations, timeindex)
100 continue
@@ -531,6 +541,8 @@
num_out_total = num_out_total + stations(i)%ntimes
endif
+ if (debug) write(*,*) 'Station ID ',i,' has ',stations(i)%ntimes, ' reports.'
+
enddo
if (verbose) write(*,*)'There were ',num_out_stat,' stations matching the input criterion.'
@@ -717,7 +729,7 @@
!============================================================================
-function is_time_wanted(ObsTime, stationid, stationlist, timeindex)
+function time_is_wanted(ObsTime, stationid, stationlist, timeindex)
! The station has a list of the observation times closest to the
! verification times. Determine if the observation time is closer to
@@ -727,13 +739,13 @@
integer, intent(in) :: stationid
type(station), dimension(:), intent(in) :: stationlist
integer, intent(out) :: timeindex
-logical :: is_time_wanted
+logical :: time_is_wanted
type(time_type) :: stndelta, obdelta
integer :: i
timeindex = 0
-is_time_wanted = .FALSE.
+time_is_wanted = .FALSE.
! the time_minus function always returns a positive difference
@@ -742,9 +754,10 @@
obdelta = ObsTime - all_verif_times(i)
! If observation is not within half a verification step,
- ! try the next one.
+ ! try the next verification time.
if (obdelta >= half_stride) cycle TimeLoop
+ ! we must be close now ...
stndelta = stationlist(stationid)%times(i) - all_verif_times(i)
! Check to see if the observation is closer to the verification time
@@ -752,14 +765,14 @@
if (obdelta < stndelta) then
if (debug) call print_time(stationlist(stationid)%times(i),'replacing ')
if (debug) call print_time(ObsTime,'with this observation time')
- timeindex = i
- is_time_wanted = .TRUE.
+ timeindex = i
+ time_is_wanted = .TRUE.
exit TimeLoop
endif
enddo TimeLoop
-end function is_time_wanted
+end function time_is_wanted
!============================================================================
@@ -793,7 +806,7 @@
! as long as ntimes /= 0 we are OK.
! When the stations get written to the netCDF file, count the
! number of non-zero times in the times array for a real count.
-stationlist(stationid)%ntimes = timeindex
+stationlist(stationid)%ntimes = stationlist(stationid)%ntimes + 1
! Stuff the time in the appropriate slot ... finally.
stationlist(stationid)%times(timeindex) = ObsTime
@@ -1226,7 +1239,6 @@
WriteObs : do stationindex = 1,num_stations
- ntimes = stations(stationindex)%ntimes
istart(1) = stationindex
icount(1) = 1
@@ -1261,7 +1273,7 @@
! time : fill, write
!----------------------------------------------------------------------------
mytimes = 0.0_digits12
- do i = 1,stations(stationindex)%ntimes
+ do i = 1,ntimes
call get_time(stations(stationindex)%times(i), secs, days)
mytimes(i) = days + secs/(60.0_digits12 * 60.0_digits12 * 24.0_digits12)
enddo
From nancy at ucar.edu Fri Apr 13 16:29:52 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Fri, 13 Apr 2012 16:29:52 -0600
Subject: [Dart-dev] [5697]
DART/branches/development/obs_sequence/obs_seq_verify.f90: Fixed some logic
problems with determining the appropriate forecast lag.
Message-ID:
Revision: 5697
Author: thoar
Date: 2012-04-13 16:29:52 -0600 (Fri, 13 Apr 2012)
Log Message:
-----------
Fixed some logic problems with determining the appropriate forecast lag.
Renamed variables to help interpretability.
Using the right variable indices for 'number of analyses'
and 'number of forecasts in each analysis' and
'number of observations at each location'.
They were not being used correctly before.
Modified Paths:
--------------
DART/branches/development/obs_sequence/obs_seq_verify.f90
-------------- next part --------------
Modified: DART/branches/development/obs_sequence/obs_seq_verify.f90
===================================================================
--- DART/branches/development/obs_sequence/obs_seq_verify.f90 2012-04-13 21:29:34 UTC (rev 5696)
+++ DART/branches/development/obs_sequence/obs_seq_verify.f90 2012-04-13 22:29:52 UTC (rev 5697)
@@ -29,26 +29,26 @@
! +--------------------------------------------- obs value, prior, obs_err.
!
! I think the logic of the program should be as follows:
-! 1) The list of 'stations' is read from a netCDF file -- the product of obs_seq_coverage.f90
+! 1) The list of 'stations' is read from a netCDF file -- the product of obs_seq_coverage.f90
! 2) The set of forecast lead times must be determined. Having 8 might not be
! specific enough ... we want 8 separated by 3 hours ... for example.
! 3) A series of obs_seq.fcst files (each from one analysisT and containing multiple
! forecast lead times) is read and stuffed into an appropriate structure.
! 4) The structure is written into the netCDF file.
! 5) On to the next obs_seq.fcst file ... (step 3)
-! 6) wrap up ...
-!
+! 6) wrap up ...
+!
! Soyoung's wish list:
! Now I'm done running filter for 24-hr forecast with 3-hrly observations as an
! evaluation mode only, and am ready to hand obs_seq.final over to you for the final
! conversion process.
-!
+!
! be1005en.ucar.edu:/ptmp/syha/wrfruns/ENS_FCST/Verify>
! -rw-r--r-- 1 syha ncar 1006513852 Nov 19 12:24 Prior_Diag.nc
! -rw-r--r-- 1 syha ncar 1006513856 Nov 19 12:24 Posterior_Diag.nc
! -rw-r--r-- 1 syha ncar 111484368 Nov 19 12:24 prior_inflate_restart
! -rw-r--r-- 1 syha ncar 126848308 Nov 19 12:24 obs_seq.final
-!
+!
! Ideally, in obs_seq_fcst.nc (if I can name it on my own), I would like to have a
! data structure of (copy, station, level, ensemble, date, time) for each variable
! and each obs type, where copy is (observation value, prior observation value
@@ -130,8 +130,9 @@
logical, allocatable, dimension(:) :: DesiredStations
type(station), allocatable, dimension(:) :: stations
-integer :: ensemble_size ! the # of ensemble members in the obs_seq file
+integer :: ensemble_size ! the # of ensemble members in the obs_seq file
integer :: num_stations ! This is the current number of unique locations
+integer :: num_verif_times ! number of all possible verification times.
!---------------------------------------------------------------------
! variables associated with the observation
@@ -184,8 +185,8 @@
integer :: dart_qc_index ! copy index of the DART qc value
integer :: obs_copy_index ! copy index of the observation
integer :: station_id
-integer :: time_index ! verification time/forecast lead time index
-integer :: AnalysisIndex ! index of the forecast experiment
+integer :: fcst_T_index ! verification time/forecast lead time index
+integer :: AnalysisIndex ! index of the forecast experiment
character(len=metadatalength), dimension(:), allocatable :: module_obs_copy_names
integer, dimension(:), allocatable :: copy_indices
integer, dimension(:), allocatable :: forecast_leads
@@ -200,11 +201,11 @@
integer :: i, io, ncunit
type(time_type) :: obs_time
-type(time_type) :: analysisT ! valid time of analysis at start of forecast
+type(time_type) :: analysisT ! valid time of analysis at start of forecast
character(len = 129) :: ncName, string1, string2
-! ~# of degrees for 1/2 meter at Earth equator
+! ~# of degrees for 1/2 meter at Earth equator
! 360 deg-earth/(40000 km-earth * 1000m-km)
real(r8), parameter :: HALF_METER = 180.0_r8 / (40000.0_r8 * 1000.0_r8)
@@ -213,8 +214,8 @@
!=======================================================================
call initialize_utilities('obs_seq_verify')
-call register_module(source,revision,revdate)
-call static_init_obs_sequence() ! Initialize the obs sequence module
+call register_module(source,revision,revdate)
+call static_init_obs_sequence() ! Initialize the obs sequence module
call init_obs(obs1, 0, 0)
call init_obs(obs2, 0, 0)
@@ -287,7 +288,7 @@
if (allocated( qc_copy_names)) deallocate( qc_copy_names)
if (allocated(obs_copy_names)) deallocate(obs_copy_names)
- ! Determine the next input filename ...
+ ! Determine the next input filename ...
if (obs_sequence_list == '') then
obs_seq_in_file_name = trim(next_file(obs_sequence_name,ifile))
@@ -298,6 +299,7 @@
if ( file_exist(trim(obs_seq_in_file_name)) ) then
write(*,*) ! whitespace
+ write(*,*) ! whitespace
write(string1,*)'opening ', trim(obs_seq_in_file_name)
call error_handler(E_MSG,'obs_seq_verify:',string1,source,revision,revdate)
else
@@ -376,12 +378,12 @@
qc_copy_names(i) = adjustl(string1)
enddo
- ! Determine which qc copy is original qc and dart qc
+ ! Determine which qc copy is original qc and dart qc
call find_our_copies(seq, obs_copy_index, copy_indices, qc_index, dart_qc_index )
! The first trip through sets the module_obs_copy_names so we can
- ! be sure we are stuffing compatible objects into the same slots
+ ! be sure we are stuffing compatible objects into the same slots
if ( ifile == 1 ) then
module_obs_copy_names = obs_copy_names(copy_indices(1:ensemble_size))
else
@@ -403,9 +405,9 @@
ngood = 0
- if ( .not. get_first_obs(seq, obs1) ) &
- call error_handler(E_ERR,'obs_seq_verify', &
- 'No first observation in sequence.', &
+ if ( .not. get_first_obs(seq, obs1) ) &
+ call error_handler(E_ERR,'obs_seq_verify', &
+ 'No first observation in sequence.', &
source,revision,revdate)
!--------------------------------------------------------------------
@@ -420,6 +422,7 @@
obs_time = get_obs_def_time( obs_def)
obs_loc = get_obs_def_location(obs_def)
+ ! if (debug .and. any(nread == (/1, 295, 1908, 6265/) )) then
if (debug .and. (nread == 1)) then
call print_time(obs_time,'First observation time')
call print_date(obs_time,'First observation date')
@@ -428,7 +431,7 @@
write(*,*)'looking for observation kinds of ',obtype_integer, &
get_obs_kind_name(obtype_integer)
- write(*,*)'first observation "kind" is ',flavor, &
+ write(*,*)'First observation "kind" is ',flavor, &
get_obs_kind_name(flavor)
write(*,*)'observation values are:'
do i = 1,size(copy_values)
@@ -460,28 +463,28 @@
station_id = find_station_location(flavor, obs_loc, stations)
if ( station_id < 1 ) goto 100
- if ( is_time_unwanted( obs_time, station_id, stations, time_index) ) &
- goto 100
+ if ( .not. time_wanted( obs_time, station_id, fcst_T_index)) goto 100
- if (debug) write(*,*)'obs ',nread,' is station ',station_id,' at time ',time_index
+ if (debug) write(*,*)'obs ',nread,' is station ',station_id,' at fcst index ',fcst_T_index
call get_qc( obs1, qc_values)
call get_obs_values(obs1, copy_values)
- if ( qc_index > 0) stations(station_id)%orgqc( time_index) = qc_values( qc_index)
- if (dart_qc_index > 0) stations(station_id)%dartqc(time_index) = qc_values(dart_qc_index)
+ if ( qc_index > 0) stations(station_id)%orgqc( fcst_T_index) = qc_values( qc_index)
+ if (dart_qc_index > 0) stations(station_id)%dartqc(fcst_T_index) = qc_values(dart_qc_index)
- stations(station_id)%obserror( time_index) = get_obs_def_error_variance(obs_def)
- stations(station_id)%observation(time_index) = copy_values(obs_copy_index)
- stations(station_id)%forecast(:, time_index) = copy_values(copy_indices)
+ stations(station_id)%obserror( fcst_T_index) = get_obs_def_error_variance(obs_def)
+ stations(station_id)%observation(fcst_T_index) = copy_values(obs_copy_index)
+ stations(station_id)%forecast(:, fcst_T_index) = copy_values(copy_indices)
- if (debug) then ! GIGANTIC OUTPUT - BE CAREFUL
+ ! if (debug) then ! GIGANTIC OUTPUT - BE CAREFUL
+ if (debug .and. (station_id == 1)) then ! LESS GIGANTIC OUTPUT
do i = 1,size(copy_indices)
- write(*,'(''ob'',3(1x,i6),4(1x,e15.5))') &
- nread, time_index, copy_indices(i), &
- stations(station_id)%obserror( time_index),&
- stations(station_id)%observation(time_index),&
- stations(station_id)%forecast(i, time_index),&
+ write(*,'(''ob'',3(1x,i6),4(1x,f14.7))') &
+ nread, fcst_T_index, copy_indices(i), &
+ stations(station_id)%obserror( fcst_T_index),&
+ stations(station_id)%observation(fcst_T_index),&
+ stations(station_id)%forecast(i, fcst_T_index),&
copy_values(copy_indices(i))
enddo
write(*,*) ! a little whitespace
@@ -496,12 +499,14 @@
enddo ObservationLoop
!--------------------------------------------------------------------
! So by now, all the observations have been stuffed into the 'station'
- ! array - not that we know if the station array is complete ...
+ ! array - not that we know if the station array is complete ...
! Take what we have (i.e. for one analysis time) and push it into
! the output forecast netcdf file.
- call WriteNetCDF(ncunit, trim(ncName), stations)
+ call WriteNetCDF(ncunit, trim(ncName), ifile)
+ call reset_stations()
+
enddo ObsFileLoop
call CloseNetCDF(ncunit, trim(ncName))
@@ -524,11 +529,30 @@
call timestamp(source,revision,revdate,'end') ! That closes the log file, too.
+
+
!======================================================================
CONTAINS
!======================================================================
+
+subroutine reset_stations()
+
+integer :: i
+
+do i = 1,size(stations)
+ stations(i)%orgqc = MISSING_I
+ stations(i)%dartqc = MISSING_I
+ stations(i)%obserror = MISSING_R8
+ stations(i)%observation = MISSING_R8
+ stations(i)%forecast = MISSING_R8
+enddo
+
+end subroutine reset_stations
+
+
+
function find_station_location(ObsType, ObsLocation, stationlist) result(station_id)
!----------------------------------------------------------------------------
! Simply try to find a matching lat/lon for an observation type
@@ -553,8 +577,8 @@
obslocarray = get_location(ObsLocation) ! returns degrees
stnlocarray = get_location(stationlist(i)%location)
- londiff = abs(obslocarray(1) - stnlocarray(1))
- latdiff = abs(obslocarray(2) - stnlocarray(2))
+ londiff = abs(obslocarray(1) - stnlocarray(1))
+ latdiff = abs(obslocarray(2) - stnlocarray(2))
if ( (londiff <= HALF_METER) .and. &
(latdiff <= HALF_METER) .and. &
@@ -584,11 +608,10 @@
integer :: nstations
integer :: DimID, VarID
-integer :: nmax, ntimes, nforecasts, nverify, locNdim, strlen
+integer :: nmax, nanalyses, nforecasts, locNdim, strlen
integer :: ncid, i, j, istation, ndims, mylen
integer :: my_type
integer :: seconds, days
-type(time_type) :: mytime
type(location_type) :: myloc
integer, dimension(nf90_max_var_dims) :: dimIDs
@@ -611,7 +634,7 @@
!-----------------------------------------------------------------------
! Determine the maximum number of stations from the station dimension,
-! the number of times, and the number of dimensions in the location
+! the number of times, and the number of dimensions in the location
! used for integer array indicating yes/no - do we want the station
call nc_check(nf90_inq_dimid(ncid, 'station', dimid=DimID), &
@@ -622,19 +645,19 @@
! used for array of all possible verification times needed
call nc_check(nf90_inq_dimid(ncid, 'time', dimid=DimID), &
'fill_stations', 'inquire time dimid '//trim(filename))
-call nc_check(nf90_inquire_dimension(ncid, DimID, len=ntimes), &
+call nc_check(nf90_inquire_dimension(ncid, DimID, len=num_verif_times), &
'fill_stations', 'inquire time len '//trim(filename))
-! used for array of the analysis times / 'zero-length' forecast times
+! used for array of the analysis times / 'zero-length' forecast times
call nc_check(nf90_inq_dimid(ncid, 'analysisT', dimid=DimID), &
'fill_stations', 'inquire analysisT dimid '//trim(filename))
-call nc_check(nf90_inquire_dimension(ncid, DimID, len=nforecasts), &
+call nc_check(nf90_inquire_dimension(ncid, DimID, len=nanalyses), &
'fill_stations', 'inquire analysisT len '//trim(filename))
-! used for array of the verification times
+! used for array of the verification times
call nc_check(nf90_inq_dimid(ncid, 'forecast_lead', dimid=DimID), &
'fill_stations', 'inquire forecast_lead dimid '//trim(filename))
-call nc_check(nf90_inquire_dimension(ncid, DimID, len=nverify), &
+call nc_check(nf90_inquire_dimension(ncid, DimID, len=nforecasts), &
'fill_stations', 'inquire forecast_lead len '//trim(filename))
call nc_check(nf90_inq_dimid(ncid, 'stringlength', dimid=DimID), &
@@ -670,12 +693,12 @@
endif
allocate(allstations(nmax), obs_types(nmax), which_vert(nmax), &
- ntimearray(nmax), first_time(nmax), last_time(nmax))
+ ntimearray(nmax), first_time(nmax), last_time(nmax))
allocate(locations(locNdim,nmax))
-allocate(forecast_leads(nverify)) ! how far into the forecast (seconds)
-allocate(ReportTimes(nverify,nmax)) ! observation times that are closest
-allocate(ExperimentTimes(nverify,nforecasts)) ! verification times of interest
-allocate(VerifyTimes(nforecasts,nverify)) ! verification times of interest
+allocate(forecast_leads(nforecasts)) ! how far into the forecast (seconds)
+allocate(ReportTimes(num_verif_times,nmax)) ! observation times that are closest
+allocate(ExperimentTimes(nforecasts,nanalyses)) ! verification times of interest
+allocate(VerifyTimes(nanalyses,nforecasts)) ! verification times of interest
!-----------------------------------------------------------------------
! Read all the information from the station list netCDF file.
@@ -735,21 +758,26 @@
! Convert all the Experiment Times to DART time types.
! While we're at it, let's reshape them to our liking:
-if (debug) write(*,*)'size(VerifyTimes,1) is ',size(VerifyTimes,1),'nforecasts is ',nforecasts
-if (debug) write(*,*)'size(VerifyTimes,2) is ',size(VerifyTimes,2),'nverify is',nverify
+if (debug) then
+ write(*,*)'nanalyses/nforecasts are :',nanalyses,nforecasts
+ write(*,*)'shape of VerifyTimes is :',shape(VerifyTimes)
+ write(*,*)'shape of ReportTimes is :',shape(ReportTimes)
+ write(*,*)' expected :',num_verif_times,nmax
+ write(*,*)'ReportTimes for station 1 :',ReportTimes(:,1)
+endif
-do j = 1,nforecasts
-do i = 1,nverify
+do j = 1,nanalyses
+do i = 1,nforecasts
days = floor(ExperimentTimes(i,j))
seconds = nint((ExperimentTimes(i,j) - days) * 86400.0_digits12)
VerifyTimes(j,i) = set_time(seconds, days)
-
+
enddo
enddo
!-----------------------------------------------------------------------
-! Allocate the desired number of stations.
+! Allocate the desired number of stations.
! The 'allstations' array contains either 0 (unwanted) or 1 (desired)
! from the temporal coverage standpoint. Combine that with namelist input
! to generate subset of stations we want.
@@ -786,57 +814,60 @@
call error_handler(E_ERR,'fill_stations',string1,source,revision,revdate)
endif
- stations(i)%obs_type = get_obs_kind_index(obs_types(istation))
+ allocate(stations(i)%times( num_verif_times))
+ allocate(stations(i)%orgqc( nforecasts))
+ allocate(stations(i)%dartqc( nforecasts))
+ allocate(stations(i)%obserror( nforecasts))
+ allocate(stations(i)%observation(nforecasts))
+ allocate(stations(i)%forecast(nensemble,nforecasts))
- myloc = set_location(locations(1,istation), locations(2,istation), &
- locations(3,istation), which_vert(istation) )
- stations(i)%location = myloc
+ stations(i)%orgqc = MISSING_I ! RESET EVERY ANALYSIS
+ stations(i)%dartqc = MISSING_I ! RESET EVERY ANALYSIS
+ stations(i)%obserror = MISSING_R8 ! RESET EVERY ANALYSIS
+ stations(i)%observation = MISSING_R8 ! RESET EVERY ANALYSIS
+ stations(i)%forecast = MISSING_R8 ! RESET EVERY ANALYSIS
+ stations(i)%times = set_time(0,0) ! SET ONE TIME ONLY
+ stations(i)%ntimes = ntimearray(istation) ! SET ONE TIME ONLY
+ stations(i)%obs_type = get_obs_kind_index(obs_types(istation))
+ myloc = set_location(locations(1,istation), &
+ locations(2,istation), &
+ locations(3,istation), which_vert(istation) )
+ stations(i)%location = myloc
+
days = floor(first_time(istation))
seconds = nint((first_time(istation) - days) * 86400.0_digits12)
- mytime = set_time(seconds, days)
- stations(i)%first_time = mytime
+ stations(i)%first_time = set_time(seconds, days)
days = floor(last_time(istation))
seconds = nint((last_time(istation) - days) * 86400.0_digits12)
- mytime = set_time(seconds, days)
- stations(i)%last_time = mytime
+ stations(i)%last_time = set_time(seconds, days)
- stations(i)%ntimes = nverify
-
- allocate(stations(i)%times( nverify))
- allocate(stations(i)%orgqc( nverify))
- allocate(stations(i)%dartqc( nverify))
- allocate(stations(i)%obserror( nverify))
- allocate(stations(i)%observation(nverify))
- allocate(stations(i)%forecast(nensemble,nverify))
-
- do j = 1,nverify
+ do j = 1,num_verif_times
days = floor(ReportTimes(j,istation))
seconds = nint((ReportTimes(j,istation) - days) * 86400.0_digits12)
- mytime = set_time(seconds, days)
- stations(i)%times(j) = mytime
+ stations(i)%times(j) = set_time(seconds, days)
enddo
-
- stations(i)%orgqc = MISSING_I
- stations(i)%dartqc = MISSING_I
- stations(i)%obserror = MISSING_R8
- stations(i)%observation = MISSING_R8
- stations(i)%forecast = MISSING_R8
+
+ if (verbose .and. (istation == 1)) then
+ write(*,*)
+ write(*,*)'station 1 ReportTimes is ',ReportTimes(:,1)
+ endif
+
! The only thing left to fill is the analaysisT ... which
- ! comes from the obs_seq.fcst directory name or something.
+ ! comes from the obs_seq.fcst directory name or something.
! It surely does not come from the station list netcdf file.
enddo StationLoop
!-----------------------------------------------------------------------
! Print a summary of all the station information if so desired.
-! FIXME can think of lots of other things to check ...
+! FIXME can think of lots of other things to check ...
if (verbose) then
write(*,*) ! whitespace
- write(string1,*)'There are ',nstations,' stations of interest,'
- write(string2,*)'and ',nverify, ' times of interest.'
+ write(string1,*)'There are ',nstations,' stations/locations of interest,'
+ write(string2,*)'and ',nforecasts, ' times of interest.'
call error_handler(E_MSG,'fill_stations:',string1,text2=string2)
endif
@@ -851,7 +882,7 @@
!============================================================================
-function is_time_unwanted(ObsTime, stationid, stationlist, timeindex)
+function time_wanted(ObsTime, stationid, timeindex)
!----------------------------------------------------------------------------
! Determine if the observation time is one
! of the times for the particular station.
@@ -859,37 +890,35 @@
type(time_type), intent(in) :: ObsTime
integer, intent(in) :: stationid
-type(station), dimension(:), intent(in) :: stationlist
integer, intent(out) :: timeindex
-logical :: is_time_unwanted
+logical :: time_wanted
integer :: i
-type(time_type) :: one_second, dt
+timeindex = 0
+time_wanted = .FALSE.
-one_second = set_time(1,0)
+if ( stations(stationid)%ntimes == 0 ) return
-timeindex = 0
-is_time_unwanted = .TRUE.
+TimeLoop : do i = 1,num_verif_times
-if ( stationlist(stationid)%ntimes == 0 ) return
+ if ( ObsTime == stations(stationid)%times(i) ) then
-TimeLoop : do i = 1,stationlist(stationid)%ntimes
+ timeindex = i - AnalysisIndex + 1
+ time_wanted = .TRUE.
- dt = stationlist(stationid)%times(i) - ObsTime
+ if (debug) then
+ write(string1,*)'desired ob at station ',stationid,' timeindex ',i
+ call print_time(ObsTime,trim(string1))
+ write(*,*)'analysis index ',AnalysisIndex,' implies forecast index ',timeindex
+ endif
- if (dt <= one_second) then
- if (debug) write(string1,*)'desired ob at station ',stationid,' time ',i
- if (debug) call print_time(ObsTime,trim(string1))
-
- timeindex = i
- is_time_unwanted = .FALSE.
exit TimeLoop
endif
enddo TimeLoop
-end function is_time_unwanted
+end function time_wanted
!============================================================================
@@ -920,7 +949,7 @@
(/ 'observation ', &
'forecast ', &
'observation error variance' /)
-
+
if(.not. byteSizesOK()) then
call error_handler(E_ERR,'InitNetCDF', &
'Compiler does not support required kinds of variables.',source,revision,revdate)
@@ -976,7 +1005,7 @@
call nc_check(nf90_def_dim(ncid=ncid, name='ensemble', len=ensemble_size, &
dimid = NmembersDimID), 'InitNetCDF', 'def_dim:ensemble '//trim(fname))
-call nc_check(nf90_def_dim(ncid=ncid, name='forecast_lead', len=stations(1)%ntimes, &
+call nc_check(nf90_def_dim(ncid=ncid, name='forecast_lead', len=size(forecast_leads), &
dimid = ForecastDimID), 'InitNetCDF', 'def_dim:forecast_lead '//trim(fname))
! namelist quantities
@@ -1195,7 +1224,7 @@
! Finish up ...
!----------------------------------------------------------------------------
-call nc_check(nf90_sync( ncid), 'InitNetCDF', 'sync '//trim(fname))
+call nc_check(nf90_sync( ncid), 'InitNetCDF', 'sync '//trim(fname))
InitNetCDF = ncid
@@ -1205,17 +1234,18 @@
!============================================================================
-subroutine WriteNetCDF(ncid, fname, stations)
+subroutine WriteNetCDF(ncid, fname, ifile)
!----------------------------------------------------------------------------
integer, intent(in) :: ncid
character(len=*), intent(in) :: fname
-type(station), dimension(:), intent(in) :: stations
+integer, intent(in) :: ifile
integer, dimension(1) :: istart, icount
integer :: ilev, obscopyindex, priorcopyindex, errorcopyindex, ensmem
integer :: stationindex, i, seconds, days
+character(len=nf90_max_name) :: dimName
integer, dimension(nf90_max_var_dims) :: dimIDs, dimLengths
integer :: TimeVarID, VarID, ndims
integer :: QCVarID, DARTQCVarID
@@ -1235,7 +1265,6 @@
integer :: ForecastDimlen
real(digits12) :: fdays
-real(digits12), allocatable, dimension(:) :: mytimes
real(r8), allocatable, dimension(:,:,:,:) :: datmat
if (debug) write(*,*)'DEBUG --- entering WriteNetCDF'
@@ -1283,9 +1312,13 @@
call nc_check(nf90_inq_varid(ncid, 'dart_qc', varid=DARTQCVarID), &
'WriteNetCDF', 'inq_varid:dart_qc '//trim(fname))
-! Increase the record dimension
+! FIXME Check to see if the record dimension (the analysis dimension) matches
+! the information from the input filename. Each input file corresponds
+! to a new Analysis Time ...
-istart(1) = AnalysisDimlen + 1
+! Increase the record dimension ... once for each input/analysis file
+
+istart(1) = ifile
icount(1) = 1
call get_time(analysisT,seconds,days)
@@ -1305,13 +1338,12 @@
write(*,*) ! a little whitespace
do i = 1,ndims
write(string1,*)'dimlen ',i,' of ',trim(obtype_string),trim(fname)
- call nc_check(nf90_inquire_dimension(ncid, dimIDs(i), len=dimLengths(i)), &
+ call nc_check(nf90_inquire_dimension(ncid, dimIDs(i), name=dimName, len=dimLengths(i)), &
'WriteNetCDF', string1)
- ! FIXME check the dimlength agains that expected ...
- write(*,*)trim(obtype_string),' dimlen ',i,' is ',dimLengths(i)
+ ! FIXME check the dimlength against that expected ...
+ write(*,*)trim(obtype_string),' dimID ',i,' length/name ',dimLengths(i),trim(dimName)
enddo
- write(*,*) ! a little whitespace
endif
!----------------------------------------------------------------------------
@@ -1319,35 +1351,49 @@
!----------------------------------------------------------------------------
! This routine gets called for every analysis time
-allocate(mytimes(AnalysisDimlen))
allocate(datmat(ForecastDimlen, NmembersDimlen, CopyDimlen, LevelsDimlen))
! FIXME These are hardwired for now ... kills me
ilev = 1
- obscopyindex = 1
-priorcopyindex = 2
-errorcopyindex = 3
+ obscopyindex = 1
+priorcopyindex = 2
+errorcopyindex = 3
WriteObs : do stationindex = 1,num_stations
- if (debug) write(*,*)'writing station ',stationindex,' to output.'
+ ! if (debug) write(*,*)'writing station ',stationindex,' to output.'
! FIXME - some sort of error check on making sure the time of the station
- ! matches the time of the forecast verification
+ ! matches the time of the forecast verification
+ datmat = MISSING_R8
+
do ensmem = 1,NmembersDimlen
do i = 1,ForecastDimlen
! observation value
- datmat(i,ensmem, obscopyindex,ilev) = stations(stationindex)%observation(i)
+ datmat(i,ensmem, obscopyindex,ilev) = stations(stationindex)%observation(i)
! ensemble prior observation value
- datmat(i,ensmem,priorcopyindex,ilev) = stations(stationindex)%forecast(ensmem,i)
+ datmat(i,ensmem,priorcopyindex,ilev) = stations(stationindex)%forecast(ensmem,i)
! observation error variance
- datmat(i,ensmem,errorcopyindex,ilev) = stations(stationindex)%obserror(i)
+ datmat(i,ensmem,errorcopyindex,ilev) = stations(stationindex)%obserror(i)
enddo
enddo
+ if (verbose .and. (stationindex == 1)) then
+ write(*,*)
+ write(*,*)'station 1/ens 1 summary before being written @ analysis T index ',istart(1),':'
+ write(*,*)'observation ',datmat(:,1,obscopyindex,1)
+ write(*,*)'prior ',datmat(:,1,priorcopyindex,1)
+ write(*,*)'error ',datmat(:,1,errorcopyindex,1)
+ ! write(*,*)
+ ! write(*,*)'station 1/ens 1 summary from stations structure.'
+ ! write(*,*)'observation ',stations(1)%observation
+ ! write(*,*)'prior ',stations(1)%forecast(1,:)
+ ! write(*,*)'error ',stations(1)%obserror
+ endif
+
call nc_check(nf90_put_var(ncid, VarId, datmat, &
start=(/ 1, 1, 1, ilev, stationindex, istart(1) /), &
count=(/ ForecastDimlen, NmembersDimlen, CopyDimlen, LevelsDimlen, 1, 1 /) ), &
@@ -1365,14 +1411,13 @@
enddo WriteObs
-deallocate(mytimes)
deallocate(datmat)
!----------------------------------------------------------------------------
! finished ...
!----------------------------------------------------------------------------
-call nc_check(nf90_sync( ncid), 'WriteNetCDF', 'sync '//trim(fname))
+call nc_check(nf90_sync( ncid), 'WriteNetCDF', 'sync '//trim(fname))
if (debug) write(*,*)'DEBUG --- leaving WriteNetCDF'
@@ -1395,7 +1440,7 @@
! files used. For expediency, should learn how to allocate some
! extra space for this ... possible FIXME
-call nc_check(nf90_redef(ncid), 'CloseNetCDF', 'redef '//trim(fname))
+call nc_check(nf90_redef(ncid), 'CloseNetCDF', 'redef '//trim(fname))
! write all observation sequence files used
FILEloop : do i = 1,SIZE(obs_seq_filenames)
@@ -1411,9 +1456,9 @@
enddo FILEloop
-call nc_check(nf90_enddef(ncid), 'CloseNetCDF', 'enddef '//trim(fname))
-call nc_check(nf90_sync( ncid), 'CloseNetCDF', 'sync '//trim(fname))
-call nc_check(nf90_close( ncid), 'CloseNetCDF', 'close '//trim(fname))
+call nc_check(nf90_enddef(ncid), 'CloseNetCDF', 'enddef '//trim(fname))
+call nc_check(nf90_sync( ncid), 'CloseNetCDF', 'sync '//trim(fname))
+call nc_check(nf90_close( ncid), 'CloseNetCDF', 'close '//trim(fname))
end subroutine CloseNetCDF
@@ -1447,8 +1492,8 @@
function find_ensemble_size()
!----------------------------------------------------------------------------
! The only way I know of to determine the ensemble size is to read the
-! copy metadata from one of the obs_seq.xxx files. I'm just going to
-! open the first file, read the entire damn sequence, and count them up.
+! copy metadata from one of the obs_seq.xxx files. I'm just going to
+! open the first file, read the entire damn sequence, and count them up.
!
! Then, I need to preserve all the indices for the observation value
! as well as the indices for the ensemble members. The observation error
@@ -1475,7 +1520,7 @@
!-----------------------------------------------------------------------
! Read the entire observation sequence - allocates 'seq' internally
-! And then cruise throught the metadata
+! And then cruise throught the metadata
!-----------------------------------------------------------------------
call read_obs_seq(obs_seq_in_file_name, 0, 0, 0, seq)
@@ -1507,7 +1552,7 @@
subroutine find_analysis_time(filename, ExpIndex, analysis_time)
!----------------------------------------------------------------------------
-! Parse the filename into an integer string that defines the
+! Parse the filename into an integer string that defines the
! analysis time.
!
@@ -1574,7 +1619,7 @@
TimeLoop : do j = 1,size(VerifyTimes,1)
if ( mytime == VerifyTimes(j,1) ) then
- analysis_time = mytime
+ analysis_time = mytime
ExpIndex = j
exit TimeLoop
endif
@@ -1584,7 +1629,7 @@
write(string1,*)'Cannot find an analysis time that matches '//lj_filename(indx+0:indx+9)
call error_handler(E_ERR,'find_analysis_time',string1,source,revision,revdate)
endif
-
+
end subroutine find_analysis_time
@@ -1609,7 +1654,7 @@
dart_qcindex = -1
indices = -1
-! Find the observation copy
+! Find the observation copy
ObsDataLoop : do i=1, get_num_copies(myseq)
metadata = get_copy_meta_data(myseq,i)
@@ -1651,7 +1696,7 @@
! Here is the sanity check to make sure the indices pick off just the
! prior ensemble members.
-if (verbose) then
+if (debug) then
write(*,*) ! just a little whitespace
do i = 1,size(indices)
metadata = get_copy_meta_data(myseq,indices(i))
@@ -1669,18 +1714,18 @@
if(index(get_qc_meta_data(myseq,i),'DART quality control') > 0) dart_qcindex = i
enddo QCMetaDataLoop
-if ( qcindex < 0 ) then
- write(string1,*)'metadata:Quality Control copyindex not found'
+if ( qcindex < 0 ) then
+ write(string1,*)'metadata:Quality Control copyindex not found'
call error_handler(E_MSG,'find_qc_indices:',string1,source,revision,revdate)
endif
-if ( dart_qcindex < 0 ) then
- write(string1,*)'metadata:DART quality control copyindex not found'
+if ( dart_qcindex < 0 ) then
+ write(string1,*)'metadata:DART quality control copyindex not found'
call error_handler(E_MSG,'find_qc_indices:',string1,source,revision,revdate)
endif
! Just echo what we know
-if (verbose) then
+if (debug) then
write(*,*)'QC index', qcindex,' ',trim(get_qc_meta_data(myseq, qcindex))
write(*,*)'QC index',dart_qcindex,' ',trim(get_qc_meta_data(myseq,dart_qcindex))
write(*,*)
From nancy at ucar.edu Fri Apr 13 16:46:02 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Fri, 13 Apr 2012 16:46:02 -0600
Subject: [Dart-dev] [5698]
DART/branches/development/obs_sequence/obs_seq_coverage.f90: Fixed code
segment writing the observation definitions.
Message-ID:
Revision: 5698
Author: thoar
Date: 2012-04-13 16:46:02 -0600 (Fri, 13 Apr 2012)
Log Message:
-----------
Fixed code segment writing the observation definitions.
Incorrectly looping over the first N observation times for
each 'station' instead of all N times and ignoring the
time slots that were/are empty.
Modified Paths:
--------------
DART/branches/development/obs_sequence/obs_seq_coverage.f90
-------------- next part --------------
Modified: DART/branches/development/obs_sequence/obs_seq_coverage.f90
===================================================================
--- DART/branches/development/obs_sequence/obs_seq_coverage.f90 2012-04-13 22:29:52 UTC (rev 5697)
+++ DART/branches/development/obs_sequence/obs_seq_coverage.f90 2012-04-13 22:46:02 UTC (rev 5698)
@@ -1417,9 +1417,12 @@
call set_obs_def_kind( obs_def, stations(i)%obs_type)
call set_obs_def_location(obs_def, stations(i)%location)
- TimeLoop : do j = 1,stations(i)%ntimes
- call set_obs_def_time( obs_def, stations(i)%times(j))
- call write_obs_def(iunit, obs_def, i, 'formatted')
+
+ TimeLoop : do j = 1,num_verification_times
+ if (stations(i)%times(j) /= no_time) then
+ call set_obs_def_time( obs_def, stations(i)%times(j))
+ call write_obs_def(iunit, obs_def, i, 'formatted')
+ endif
enddo TimeLoop
if (verbose) then
From nancy at ucar.edu Sun Apr 15 17:16:34 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Sun, 15 Apr 2012 17:16:34 -0600
Subject: [Dart-dev] [5699] DART/trunk: Reset the focus on the
oned_ensemble.m script ?\226?\128 ?\166 crosshairs now visible.
Message-ID:
Revision: 5699
Author: thoar
Date: 2012-04-15 17:16:34 -0600 (Sun, 15 Apr 2012)
Log Message:
-----------
Reset the focus on the oned_ensemble.m script ?\226?\128?\166 crosshairs now visible.
The crosshairs in the twod_ensemble.m worked, so I just compared the differences
between the two files and took a lucky stab at it. I don't understand the code,
but the crosshairs work in both files. There is no functional change in the
twod_ensemble code.
I also aligned things to improve readability.
Modified Paths:
--------------
DART/trunk/DART_LAB/matlab/oned_ensemble.m
DART/trunk/DART_LAB/matlab/twod_ensemble.m
Property Changed:
----------------
DART/trunk/models/bgrid_solo/work/
DART/trunk/models/lorenz_63/work/
DART/trunk/models/wrf/work/
-------------- next part --------------
Modified: DART/trunk/DART_LAB/matlab/oned_ensemble.m
===================================================================
--- DART/trunk/DART_LAB/matlab/oned_ensemble.m 2012-04-13 22:46:02 UTC (rev 5698)
+++ DART/trunk/DART_LAB/matlab/oned_ensemble.m 2012-04-15 23:16:34 UTC (rev 5699)
@@ -78,29 +78,29 @@
handles.output = hObject;
% Insert the ensemble structure into this
-handles.ens_size = 0;
-handles.ens_members = 0;
-handles.h_obs_plot = 0;
-handles.h_update_ens = 0;
-handles.h_ens_member = 0;
-handles.h_obs_ast = 0;
-handles.h_update_lines = 0;
-handles.observation = 0;
-handles.obs_error_sd = 0;
-handles.inflation = 1.5;
-handles.plot_inflation = false;
-handles.h_inf_ens_member = 0;
-handles.h_inf_up_ens = 0;
-handles.h_inf_lines = 0;
-handles.h_inf_axis = 0;
+handles.ens_size = 0;
+handles.ens_members = 0;
+handles.h_obs_plot = 0;
+handles.h_update_ens = 0;
+handles.h_ens_member = 0;
+handles.h_obs_ast = 0;
+handles.h_update_lines = 0;
+handles.observation = 0;
+handles.obs_error_sd = 0;
+handles.inflation = 1.5;
+handles.plot_inflation = false;
+handles.h_inf_ens_member = 0;
+handles.h_inf_up_ens = 0;
+handles.h_inf_lines = 0;
+handles.h_inf_axis = 0;
% Update handles structure
guidata(hObject, handles);
% Get the initial observation, obs_error_sd and inflation from the gui
-handles.observation = str2double(get(handles.edit_observation, 'String'));
+handles.observation = str2double(get(handles.edit_observation, 'String'));
handles.obs_error_sd = str2double(get(handles.edit_obs_error_sd, 'String'));
-handles.inflation = str2double(get(handles.edit_inflation, 'String'));
+handles.inflation = str2double(get(handles.edit_inflation, 'String'));
% Go ahead and plot the initial observational error distribution
handles.h_obs_plot = plot_gaussian(handles.observation, handles.obs_error_sd, 1);
@@ -124,6 +124,11 @@
% Update handles structure
guidata(hObject, handles);
+% Reset focus to the menu gui window
+% Setting the axes clears the legend, gcbo restores focus
+axes(handles.axes1);
+
+
% UIWAIT makes oned_ensemble wait for user response (see UIRESUME)
% uiwait(handles.figure1);
@@ -153,22 +158,22 @@
% Disable the update ensemble button and all other active buttons
set(handles.pushbutton_update_ens, 'Enable', 'Off');
-set(handles.edit_observation, 'Enable', 'Off');
-set(handles.edit_obs_error_sd, 'Enable', 'Off');
-set(handles.edit_inflation, 'Enable', 'Off');
+set(handles.edit_observation, 'Enable', 'Off');
+set(handles.edit_obs_error_sd, 'Enable', 'Off');
+set(handles.edit_inflation, 'Enable', 'Off');
% Clear out any old ensemble members if they exist
-set(handles.h_ens_member, 'Visible', 'off');
-set(handles.h_inf_ens_member, 'Visible', 'off');
+set(handles.h_ens_member, 'Visible', 'off');
+set(handles.h_inf_ens_member, 'Visible', 'off');
-set(handles.h_update_lines, 'Visible', 'off');
-set(handles.h_inf_lines, 'Visible', 'off');
-set(handles.h_inf_axis, 'Visible', 'off');
+set(handles.h_update_lines, 'Visible', 'off');
+set(handles.h_inf_lines, 'Visible', 'off');
+set(handles.h_inf_axis, 'Visible', 'off');
% Turn off any old update points
-set(handles.h_update_ens, 'Visible', 'off');
-set(handles.h_inf_up_ens, 'Visible', 'off');
-set(handles.h_inf_ens_member, 'Visible', 'off');
+set(handles.h_update_ens, 'Visible', 'off');
+set(handles.h_inf_up_ens, 'Visible', 'off');
+set(handles.h_inf_ens_member, 'Visible', 'off');
clear_labels(handles);
@@ -179,7 +184,7 @@
upper = max(handles.observation + 3*handles.obs_error_sd, max(handles.ens_members));
axis([lower upper -0.4 1]);
-set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
+set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
set(gca, 'YTickLabel', [0 0.2 0.4 0.6 0.8]);
% Messages should start 1/10 of the way across the screen
@@ -239,21 +244,21 @@
% Ensemble created, comupte mean and sd, clean up and return
% Set the global gui storage
-handles.ens_size = ens_size;
+handles.ens_size = ens_size;
handles.ens_members = x;
% Update handles structure
guidata(hObject, handles);
% Turn off the data entry messages
-set(h_click, 'Visible', 'off');
+set(h_click, 'Visible', 'off');
set(h_finish, 'Visible', 'off');
% Enable the update ensemble button
set(handles.pushbutton_update_ens, 'Enable', 'On');
-set(handles.edit_observation, 'Enable', 'On');
-set(handles.edit_obs_error_sd, 'Enable', 'On');
-set(handles.edit_inflation, 'Enable', 'On');
+set(handles.edit_observation, 'Enable', 'On');
+set(handles.edit_obs_error_sd, 'Enable', 'On');
+set(handles.edit_inflation, 'Enable', 'On');
%----------------------------------------------------------------------
@@ -269,21 +274,21 @@
% str2double(get(hObject,'String')) returns contents of edit_observation as a double
% Turn off any old updated points
-set(handles.h_update_ens, 'Visible', 'off');
-set(handles.h_inf_up_ens, 'Visible', 'off');
+set(handles.h_update_ens, 'Visible', 'off');
+set(handles.h_inf_up_ens, 'Visible', 'off');
set(handles.h_inf_ens_member, 'Visible', 'off');
% Remove mean and sd of old posterior
clear_labels(handles);
% And the lines in between
-set(handles.h_update_lines, 'Visible', 'off');
-set(handles.h_inf_lines, 'Visible', 'off');
-set(handles.h_inf_axis, 'Visible', 'off');
+set(handles.h_update_lines, 'Visible', 'off');
+set(handles.h_inf_lines, 'Visible', 'off');
+set(handles.h_inf_axis, 'Visible', 'off');
% Enable things that an error might have turned off
-set(handles.edit_obs_error_sd, 'Enable', 'on')
-set(handles.edit_inflation, 'Enable', 'on')
+set(handles.edit_obs_error_sd, 'Enable', 'on')
+set(handles.edit_inflation, 'Enable', 'on')
set(handles.pushbutton_create_new, 'Enable', 'on')
% Only enable the update ensemble pushbutton if an ensemble has been created
@@ -292,14 +297,14 @@
end
% Get the value of the observation
-if(isfinite(str2double(get(hObject, 'String'))))
+if(isfinite( str2double(get(hObject, 'String'))))
observation = str2double(get(hObject, 'String'));
else
set(handles.edit_observation, 'String', '???');
% Disable other input to guarantee only one error at a time!
- set(handles.edit_obs_error_sd, 'Enable', 'off')
- set(handles.edit_inflation, 'Enable', 'off')
+ set(handles.edit_obs_error_sd, 'Enable', 'off')
+ set(handles.edit_inflation, 'Enable', 'off')
set(handles.pushbutton_create_new, 'Enable', 'off')
set(handles.pushbutton_update_ens, 'Enable', 'off')
return
@@ -322,7 +327,7 @@
upper = max(handles.observation + 3*handles.obs_error_sd, max(handles.ens_members));
axis([lower upper -0.4 1]);
-set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
+set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
set(gca, 'YTickLabel', [0 0.2 0.4 0.6 0.8]);
hold on
@@ -360,21 +365,21 @@
% str2double(get(hObject,'String')) returns contents of edit_obs_error_sd as a double
% Turn off any old updated points
-set(handles.h_update_ens, 'Visible', 'off');
-set(handles.h_inf_up_ens, 'Visible', 'off');
-set(handles.h_inf_ens_member, 'Visible', 'off');
+set(handles.h_update_ens, 'Visible', 'off');
+set(handles.h_inf_up_ens, 'Visible', 'off');
+set(handles.h_inf_ens_member, 'Visible', 'off');
% Remove mean and sd of old posterior
clear_labels(handles);
% And the lines in between
-set(handles.h_update_lines, 'Visible', 'off');
-set(handles.h_inf_lines, 'Visible', 'off');
-set(handles.h_inf_axis, 'Visible', 'off');
+set(handles.h_update_lines, 'Visible', 'off');
+set(handles.h_inf_lines, 'Visible', 'off');
+set(handles.h_inf_axis, 'Visible', 'off');
% Enable things that an error might have turned off
-set(handles.edit_observation, 'Enable', 'on')
-set(handles.edit_inflation, 'Enable', 'on')
+set(handles.edit_observation, 'Enable', 'on')
+set(handles.edit_inflation, 'Enable', 'on')
set(handles.pushbutton_create_new, 'Enable', 'on')
% Only enable the update ensemble pushbutton if an ensemble has been created
@@ -383,15 +388,15 @@
end
% Get the value of the observation
-if(isfinite(str2double(get(hObject, 'String'))) && ...
- str2double(get(hObject, 'String')) > 0)
+if(isfinite( str2double(get(hObject, 'String'))) && ...
+ str2double(get(hObject, 'String')) > 0)
obs_error_sd = str2double(get(hObject, 'String'));
else
set(handles.edit_obs_error_sd, 'String', '???');
% Disable other input to guarantee only one error at a time!
- set(handles.edit_observation, 'Enable', 'off')
- set(handles.edit_inflation, 'Enable', 'off')
+ set(handles.edit_observation, 'Enable', 'off')
+ set(handles.edit_inflation, 'Enable', 'off')
set(handles.pushbutton_create_new, 'Enable', 'off')
set(handles.pushbutton_update_ens, 'Enable', 'off')
return
@@ -412,7 +417,7 @@
set(handles.h_obs_plot, 'Color', 'r', 'Linestyle', '--', 'Linewidth', 2);
-set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
+set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
set(gca, 'YTickLabel', [0 0.2 0.4 0.6 0.8]);
hold on
@@ -477,8 +482,8 @@
% handles structure with handles and user data (see GUIDATA)
% Turn off any old points
-set(handles.h_update_ens, 'Visible', 'off');
-set(handles.h_inf_up_ens, 'Visible', 'off');
+set(handles.h_update_ens, 'Visible', 'off');
+set(handles.h_inf_up_ens, 'Visible', 'off');
set(handles.h_inf_ens_member, 'Visible', 'off');
% Remove mean and sd of old posterior
@@ -486,8 +491,8 @@
% And the lines in between
set(handles.h_update_lines, 'Visible', 'off');
-set(handles.h_inf_lines, 'Visible', 'off');
-set(handles.h_inf_axis, 'Visible', 'off');
+set(handles.h_inf_lines, 'Visible', 'off');
+set(handles.h_inf_axis, 'Visible', 'off');
ensemble = handles.ens_members;
@@ -549,8 +554,8 @@
% Update mean and sd of old posterior
inf_prior_sd = std(inf_ens(1:handles.ens_size));
-set(handles.text9, 'String', ['Inflated = ', num2str(prior_mean)]);
-set(handles.text9, 'Visible', 'on');
+set(handles.text9, 'String', ['Inflated = ', num2str(prior_mean)]);
+set(handles.text9, 'Visible', 'on');
set(handles.text10, 'String', ['Inflated = ', num2str(inf_prior_sd)]);
set(handles.text10, 'Visible', 'on');
@@ -619,17 +624,16 @@
function clear_labels(handles)
% Turns off all labels except for the prior mean and SD
-set(handles.text9, 'Visible', 'off');
+set(handles.text7, 'Visible', 'off');
+set(handles.text8, 'Visible', 'off');
+set(handles.text9, 'Visible', 'off');
set(handles.text10, 'Visible', 'off');
-set(handles.text8, 'Visible', 'off');
-set(handles.text7, 'Visible', 'off');
+set(handles.text11, 'Visible', 'off');
set(handles.text12, 'Visible', 'off');
-set(handles.text11, 'Visible', 'off');
-
function edit_inflation_Callback(hObject, eventdata, handles)
% hObject handle to edit_inflation (see GCBO)
% eventdata reserved - to be defined in a future version of MATLAB
@@ -639,21 +643,21 @@
% str2double(get(hObject,'String')) returns contents of edit_inflation as a double
% Turn off any old updated points
-set(handles.h_update_ens, 'Visible', 'off');
-set(handles.h_inf_up_ens, 'Visible', 'off');
-set(handles.h_inf_ens_member, 'Visible', 'off');
+set(handles.h_update_ens, 'Visible', 'off');
+set(handles.h_inf_up_ens, 'Visible', 'off');
+set(handles.h_inf_ens_member, 'Visible', 'off');
% Remove mean and sd of old posterior
clear_labels(handles);
% And the lines in between
-set(handles.h_update_lines, 'Visible', 'off');
-set(handles.h_inf_lines, 'Visible', 'off');
-set(handles.h_inf_axis, 'Visible', 'off');
+set(handles.h_update_lines, 'Visible', 'off');
+set(handles.h_inf_lines, 'Visible', 'off');
+set(handles.h_inf_axis, 'Visible', 'off');
% Enable things that an error might have turned off
-set(handles.edit_observation, 'Enable', 'on')
-set(handles.edit_obs_error_sd, 'Enable', 'on')
+set(handles.edit_observation, 'Enable', 'on')
+set(handles.edit_obs_error_sd, 'Enable', 'on')
set(handles.pushbutton_create_new, 'Enable', 'on')
% Only enable the update ensemble pushbutton if an ensemble has been created
@@ -662,15 +666,15 @@
end
% Get the value of the observation
-if(isfinite(str2double(get(hObject, 'String'))) && ...
- str2double(get(hObject, 'String')) > 0)
+if(isfinite( str2double(get(hObject, 'String'))) && ...
+ str2double(get(hObject, 'String')) > 0)
inflation = str2double(get(hObject, 'String'));
else
set(handles.edit_inflation, 'String', '???');
% Disable other input to guarantee only one error at a time!
- set(handles.edit_observation, 'Enable', 'off')
- set(handles.edit_obs_error_sd, 'Enable', 'off')
+ set(handles.edit_observation, 'Enable', 'off')
+ set(handles.edit_obs_error_sd, 'Enable', 'off')
set(handles.pushbutton_create_new, 'Enable', 'off')
set(handles.pushbutton_update_ens, 'Enable', 'off')
return
@@ -691,7 +695,7 @@
set(handles.h_obs_plot, 'Color', 'r', 'Linestyle', '--', 'Linewidth', 2);
-set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
+set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
set(gca, 'YTickLabel', [0 0.2 0.4 0.6 0.8]);
hold on
Modified: DART/trunk/DART_LAB/matlab/twod_ensemble.m
===================================================================
--- DART/trunk/DART_LAB/matlab/twod_ensemble.m 2012-04-13 22:46:02 UTC (rev 5698)
+++ DART/trunk/DART_LAB/matlab/twod_ensemble.m 2012-04-15 23:16:34 UTC (rev 5699)
@@ -66,25 +66,26 @@
handles.output = hObject;
% Insert the ensemble structure into this
-handles.ens_size = 0;
-handles.ens_members = 0;
-handles.h_update_ens = 0;
-handles.h_ens_member = 0;
-handles.h_best_fit = 0;
+handles.ens_size = 0;
+handles.ens_members = 0;
+handles.h_update_ens = 0;
+handles.h_ens_member = 0;
+handles.h_best_fit = 0;
handles.h_marg_obs_plot = 0;
-handles.h_obs_ast = 0;
-handles.h_obs_marg = 0;
-handles.h_gui_marg = 0;
-handles.h_unobs = 0;
-handles.h_marg = 0;
-handles.h_marg_update = 0;
-handles.h_marg_inc = 0;
-handles.h_marg_state = 0;
-handles.h_state_inc = 0;
-handles.h_joint_update = 0;
-handles.h_joint_inc = 0;
-handles.h_correl = 0;
-handles.first_correl = true;
+handles.h_obs_ast = 0;
+handles.h_obs_marg = 0;
+handles.h_gui_marg = 0;
+handles.h_unobs = 0;
+handles.h_marg = 0;
+handles.h_marg_update = 0;
+handles.h_marg_inc = 0;
+handles.h_marg_state = 0;
+handles.h_state_inc = 0;
+handles.h_joint_update = 0;
+handles.h_joint_inc = 0;
+handles.h_correl = 0;
+handles.first_correl = true;
+
% Also include the subplot handles r1, r2, r3
handles.r1 = 0;
handles.r2 = 0;
@@ -94,10 +95,10 @@
guidata(hObject, handles);
% Go ahead and plot the initial observational error distribution
-h_observation = get(handles.edit1);
+h_observation = get(handles.edit1);
h_obs_error_sd = get(handles.edit2);
-observation = str2double(h_observation.String);
-obs_error_sd = str2double(h_obs_error_sd.String);
+observation = str2double(h_observation.String);
+obs_error_sd = str2double(h_obs_error_sd.String);
% Plot this on the marginal plot on the gui figure
handles.h_marg_obs_plot = plot_gaussian(observation, obs_error_sd, 1);
@@ -118,7 +119,6 @@
% Plot an axis; display is fixed from x = 0 to 10
plot([0 10], [0 0], 'k', 'LineWidth', 2);
-
% Setup the joint distribution plot plus the two marginals
figure(1)
Property changes on: DART/trunk/models/bgrid_solo/work
___________________________________________________________________
Added: svn:ignore
+ .cppdefs
Makefile
Property changes on: DART/trunk/models/lorenz_63/work
___________________________________________________________________
Added: svn:ignore
+ .cppdefs
Makefile
Property changes on: DART/trunk/models/wrf/work
___________________________________________________________________
Added: svn:ignore
+ .cppdefs
From nancy at ucar.edu Mon Apr 16 10:03:56 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 16 Apr 2012 10:03:56 -0600
Subject: [Dart-dev] [5700]
DART/branches/development/obs_sequence/obs_seq_coverage.f90: Missed setting
the netCDF variable 'ntimes' correctly.
Message-ID:
Revision: 5700
Author: thoar
Date: 2012-04-16 10:03:56 -0600 (Mon, 16 Apr 2012)
Log Message:
-----------
Missed setting the netCDF variable 'ntimes' correctly.
Had a debug setting. The netCDF variable 'ntimes' now accurately
reflects the number of times each station is 'reported'.
This information can also be determined from counting
up the non-missing time values for each station in
the 'ReportTime' variable.
Modified Paths:
--------------
DART/branches/development/obs_sequence/obs_seq_coverage.f90
-------------- next part --------------
Modified: DART/branches/development/obs_sequence/obs_seq_coverage.f90
===================================================================
--- DART/branches/development/obs_sequence/obs_seq_coverage.f90 2012-04-15 23:16:34 UTC (rev 5699)
+++ DART/branches/development/obs_sequence/obs_seq_coverage.f90 2012-04-16 16:03:56 UTC (rev 5700)
@@ -1266,7 +1266,7 @@
start=(/ stationindex /), count=(/ 1 /) ), &
'WriteNetCDF', 'put_var:last_time')
- call nc_check(nf90_put_var(ncid, NTimesVarId, (/ ntimes /), &
+ call nc_check(nf90_put_var(ncid, NTimesVarId, (/ stations(stationindex)%ntimes /), &
start=istart, count=icount), 'WriteNetCDF', 'put_var:ntimes')
!----------------------------------------------------------------------------
From nancy at ucar.edu Mon Apr 16 16:03:13 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 16 Apr 2012 16:03:13 -0600
Subject: [Dart-dev] [5701] DART/branches/development: copied the index sort
routine from the sort module and made
Message-ID:
Revision: 5701
Author: nancy
Date: 2012-04-16 16:03:12 -0600 (Mon, 16 Apr 2012)
Log Message:
-----------
copied the index sort routine from the sort module and made
a time sort routine in the time_manager module. major revamp
of the obs_selection tool - was doing a naive iteration of the
entire selection file which was too slow for real world problems.
i now sort the selection list by time, and then can start at
the last offset and stop searching when i've passed the time
of interest. this has speeded up the tool to where i believe
it's useful again. also fixed some message strings that still
said 'obs_sequence_tool' instead of 'obs_selection', and fixed
a place where i overwrote 'source' instead of using a different
variable name.
Modified Paths:
--------------
DART/branches/development/obs_sequence/obs_selection.f90
DART/branches/development/time_manager/time_manager_mod.f90
-------------- next part --------------
Modified: DART/branches/development/obs_sequence/obs_selection.f90
===================================================================
--- DART/branches/development/obs_sequence/obs_selection.f90 2012-04-16 16:03:56 UTC (rev 5700)
+++ DART/branches/development/obs_sequence/obs_selection.f90 2012-04-16 22:03:12 UTC (rev 5701)
@@ -2,6 +2,19 @@
! provided by UCAR, "as is", without charge, subject to all terms of use at
! http://www.image.ucar.edu/DAReS/DART/DART_download
+! nsc 12apr2012 -
+! was too slow for large lists and large obs_seq files.
+! sorted the obs_def list by time and then started the search
+! at the time of the next obs, and quit looping when past that time.
+! really speeded up - may not have to do anything more complicated
+! at this time.
+! if more speed is needed, next likely place to pick up speed is
+! by sorting all obs at the same time by locations (maybe just
+! by the x coord for starters), or binning in spatial bins if
+! still too slow. but the current fixes should go a long way
+! to making the performance acceptable.
+!
+
program obs_selection
!
@@ -27,7 +40,8 @@
read_obs_kind
use time_manager_mod, only : time_type, operator(>), print_time, set_time, &
print_date, set_calendar_type, GREGORIAN, &
- operator(/=), NO_CALENDAR, get_calendar_type
+ operator(/=), operator(<=), NO_CALENDAR, &
+ get_calendar_type, time_index_sort, operator(==)
use obs_sequence_mod, only : obs_sequence_type, obs_type, write_obs_seq, &
init_obs, assignment(=), get_obs_def, &
init_obs_sequence, static_init_obs_sequence, &
@@ -54,18 +68,18 @@
type(obs_sequence_type) :: seq_in, seq_out
type(obs_type) :: obs_in, next_obs_in
type(obs_type) :: obs_out, prev_obs_out
+type(time_type) :: t1, t2
logical :: is_there_one, is_this_last
integer :: size_seq_in, num_copies_in, num_qc_in
integer :: size_seq_out, num_copies_out, num_qc_out
-integer :: num_inserted, iunit, io, i, j, total_num_inserted
+integer :: num_inserted, iunit, io, i, j
+integer :: total_num_inserted, base_index, next_base_index
integer :: max_num_obs, file_id
integer :: first_seq
character(len = 129) :: read_format, meta_data
logical :: pre_I_format, cal
-character(len = 129) :: msgstring
+character(len = 255) :: msgstring, msgstring1, msgstring2, msgstring3
-! could go into namelist if you wanted more control
-integer, parameter :: print_every = 20
!----------------------------------------------------------------
! Namelist input with default values
@@ -77,6 +91,7 @@
integer :: num_input_files = 0
type(obs_def_type), allocatable :: obs_def_list(:)
integer :: obs_def_count
+integer :: print_every_nth_obs = 100
character(len = 129) :: filename_seq(max_num_input_files) = ''
@@ -216,7 +231,7 @@
! Read obs seq to be added, and insert obs from it to the output seq
first_seq = -1
-do i = 1, num_input_files
+FILES: do i = 1, num_input_files
if (.not. process_file(i)) cycle
@@ -268,7 +283,21 @@
if ( is_there_one ) then
- if (good_selection(obs_in, obs_def_list, obs_def_count)) then
+ ! figure out the time of the first obs in this file, and set the
+ ! offset for the first item in the selection file that's at this time.
+ t1 = get_time_from_obs(obs_in)
+ base_index = set_base(t1, obs_def_list, obs_def_count)
+
+ if (base_index < 0) then
+ write(msgstring2, *) 'skipping all obs in ', trim(filename_seq(i))
+ call error_handler(E_MSG, 'obs_selection', &
+ 'first time in obs_sequence file is after all times in selection file', &
+ source, revision, revdate, text2=msgstring2)
+ cycle FILES
+ endif
+ next_base_index = base_index
+
+ if (good_selection(obs_in, obs_def_list, obs_def_count, next_base_index)) then
obs_out = obs_in
call insert_obs_in_seq(seq_out, obs_out) ! new_obs linked list info changes
@@ -280,9 +309,27 @@
call get_next_obs(seq_in, obs_in, next_obs_in, is_this_last)
ObsLoop : do while ( .not. is_this_last)
- obs_in = next_obs_in ! essentially records position in seq_out
+ ! if the time of the next obs is different from this one, bump
+ ! up the start of the search index offset.
+ t1 = get_time_from_obs(obs_in)
+ t2 = get_time_from_obs(next_obs_in)
+ if (t1 /= t2) then
+ base_index = next_base_index
+ next_base_index = set_base(t2, obs_def_list, obs_def_count, base_index)
+
+ if (next_base_index < 0) then
+ ! next obs in selection file is after all the rest of the obs in this
+ ! input obs_seq file, so we can move on now.
+ write(msgstring, *) 'done with ', trim(filename_seq(i))
+ call error_handler(E_MSG, 'obs_selection', msgstring, &
+ source, revision, revdate)
+ cycle FILES
+ endif
+ endif
- if (good_selection(obs_in, obs_def_list, obs_def_count)) then
+ obs_in = next_obs_in ! next obs is the current one now
+
+ if (good_selection(obs_in, obs_def_list, obs_def_count, next_base_index)) then
obs_out = obs_in
! Since the stride through the observation sequence file is always
@@ -299,9 +346,11 @@
prev_obs_out = obs_out ! update position in seq_in for next insert
num_inserted = num_inserted + 1
- if (print_every > 0) then
- if (mod(num_inserted,print_every) == 0) then
- print*, 'inserted number ',num_inserted,' of ',size_seq_in
+ if (print_every_nth_obs > 0) then
+ if (mod(num_inserted,print_every_nth_obs) == 0) then
+ write(msgstring,*) 'inserted number ',num_inserted,' of ',size_seq_in, ' possible obs'
+ call error_handler(E_MSG, 'obs_selection', msgstring, &
+ source, revision, revdate)
endif
endif
@@ -309,6 +358,7 @@
call get_next_obs(seq_in, obs_in, next_obs_in, is_this_last)
+
enddo ObsLoop
total_num_inserted = total_num_inserted + num_inserted
@@ -328,10 +378,10 @@
call destroy_obs_sequence(seq_in)
-enddo
+enddo FILES
write(msgstring,*) 'Starting to process output sequence file ', trim(filename_out)
-call error_handler(E_MSG,'obs_sequence_tool',msgstring)
+call error_handler(E_MSG,'obs_selection',msgstring)
if (.not. print_only) then
print*, 'Total number of obs inserted : ', total_num_inserted
@@ -365,7 +415,7 @@
subroutine obs_seq_modules_used()
! Initialize modules used that require it
-call initialize_utilities('obs_sequence_tool')
+call initialize_utilities('obs_selection')
call register_module(source,revision,revdate)
call static_init_obs_sequence()
@@ -381,7 +431,7 @@
integer :: index
logical :: from_file
-character(len=32) :: source
+character(len=32) :: fsource
! ok, here's the new logic:
! if the user specifies neither filename_seq nor filename_seq_list, we
@@ -399,7 +449,7 @@
if (filename_seq(1) == '' .and. filename_seq_list == '') then
if (num_input_files /= 0 .and. num_input_files /= 1) then
- call error_handler(E_ERR,'obs_sequence_tool', &
+ call error_handler(E_ERR,'obs_selection', &
'if no filenames specified, num_input_files must be 0 or 1', &
source,revision,revdate)
endif
@@ -411,7 +461,7 @@
! make sure the namelist specifies one or the other but not both
if (filename_seq(1) /= '' .and. filename_seq_list /= '') then
- call error_handler(E_ERR,'obs_sequence_tool', &
+ call error_handler(E_ERR,'obs_selection', &
'cannot specify both filename_seq and filename_seq_list', &
source,revision,revdate)
endif
@@ -419,10 +469,10 @@
! if they have specified a file which contains a list, read it into
! the filename_seq array and set the count.
if (filename_seq_list /= '') then
- source = 'filename_seq_list'
+ fsource = 'filename_seq_list'
from_file = .true.
else
- source = 'filename_seq'
+ fsource = 'filename_seq'
from_file = .false.
endif
@@ -432,8 +482,8 @@
if (filename_seq(index) == '') then
if (index == 1) then
- call error_handler(E_ERR,'obs_sequence_tool', &
- trim(source)//' contains no filenames', &
+ call error_handler(E_ERR,'obs_selection', &
+ 'namelist item ', trim(fsource)//' contains no filenames', &
source,revision,revdate)
endif
! leaving num_input_files unspecified (or set to 0) means use
@@ -445,21 +495,21 @@
! if they do give a count, make it match.
if (num_input_files == (index - 1)) return
- write(msgstring, *) 'if num_input_files is 0, the number of files will be automatically computed'
- call error_handler(E_MSG,'obs_sequence_tool', msgstring)
- write(msgstring, *) 'if num_input_files is not 0, it must match the number of filenames specified'
- call error_handler(E_MSG,'obs_sequence_tool', msgstring)
write(msgstring, *) 'num_input_files is ', num_input_files, &
- ' but '//trim(source)//' has filecount ', index - 1
- call error_handler(E_ERR,'obs_sequence_tool', msgstring, &
- source,revision,revdate)
+ ' but namelist item '//trim(fsource)//' has filecount ', index - 1
+
+ write(msgstring2, *) 'if num_input_files is 0, the number of files will be automatically computed'
+ write(msgstring3, *) 'if num_input_files is not 0, it must match the number of filenames specified'
+
+ call error_handler(E_ERR,'obs_selection', msgstring, &
+ source,revision,revdate, text2=msgstring2, text3=msgstring3)
endif
endif
enddo
write(msgstring, *) 'cannot specify more than ',max_num_input_files,' files'
-call error_handler(E_ERR,'obs_sequence_tool', msgstring, &
+call error_handler(E_ERR,'obs_selection', msgstring, &
source,revision,revdate)
end subroutine handle_filenames
@@ -488,7 +538,6 @@
integer :: num_copies2, num_qc2
integer :: num_copies , num_qc, i
character(len=129) :: str1, str2
-character(len=255) :: msgstring1, msgstring2
num_copies1 = get_num_copies(seq1)
num_qc1 = get_num_qc( seq1)
@@ -499,7 +548,7 @@
num_copies = num_copies2
num_qc = num_qc2
-! get this ready in case we have to use it
+! get this ready in case we have to use it below. do not overwrite it!
if (present(fname1) .and. present(fname2)) then
write(msgstring1,*)'Sequence files ', trim(fname1), ' and ', trim(fname2), &
' are not compatible'
@@ -510,42 +559,38 @@
if ( num_copies1 /= num_copies2 ) then
write(msgstring2,*)'Different numbers of data copies found: ', &
num_copies1, ' vs ', num_copies2
- call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
- num_copies = -1
+ call error_handler(E_ERR, 'obs_selection', msgstring1, &
+ source, revision, revdate, text2=msgstring2)
endif
if ( num_qc1 /= num_qc2 ) then
write(msgstring2,*)'Different different numbers of QCs found: ', &
num_qc1, ' vs ', num_qc2
- call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
- num_qc = -1
+ call error_handler(E_MSG, 'obs_selection', msgstring1, &
+ source, revision, revdate, text2=msgstring2)
endif
-if ( num_copies < 0 .or. num_qc < 0 ) then
- call error_handler(E_ERR, 'obs_sequence_tool', msgstring1, source, revision, revdate)
-endif
! watch the code flow in this loop and the one below it.
-! the smoothest code order is to determine what the strings are,
-! and then try different things to match them. if a match is found,
-! cycle. if you get to the bottom of the loop, there is no match
-! and a single set of (fatal) error messages is called.
+! if a match is found, cycle. if there is no match
+! a single set of (fatal) error messages is called.
CopyMetaData : do i=1, num_copies
str1 = get_copy_meta_data(seq1,i)
str2 = get_copy_meta_data(seq2,i)
- ! easy case - they match. cycle to next copy.
+ ! they match. cycle to next copy.
if( str1 == str2 ) then
- write(msgstring2,*)'metadata ',trim(str1), ' in both.'
- call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
+ ! for now, don't print out if things are ok. this could become
+ ! part of a verbose option.
+ !write(msgstring2,*)'metadata ',trim(str1), ' in both.'
+ !call error_handler(E_MSG, 'obs_selection', msgstring2)
cycle CopyMetaData
endif
! if you get here, the metadata is not the same and the user has not
! given us strings that are ok to match. fail.
write(msgstring2,*)'metadata value mismatch. seq1: ', trim(str1)
- call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
- write(msgstring2,*)'metadata value mismatch. seq2: ', trim(str2)
- call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
- call error_handler(E_ERR, 'obs_sequence_tool', msgstring1, source, revision, revdate)
+ write(msgstring3,*)'metadata value mismatch. seq2: ', trim(str2)
+ call error_handler(E_ERR, 'obs_selection', msgstring1, &
+ source, revision, revdate, text2=msgstring2, text3=msgstring3)
enddo CopyMetaData
@@ -553,20 +598,20 @@
str1 = get_qc_meta_data(seq1,i)
str2 = get_qc_meta_data(seq2,i)
- ! easy case - they match. cycle to next copy.
+ ! they match. cycle to next copy.
if( str1 == str2 ) then
- write(msgstring2,*)'metadata ',trim(str1), ' in both.'
- call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
+ ! see comment in copy section above about a verbose option.
+ !write(msgstring2,*)'metadata ',trim(str1), ' in both.'
+ !call error_handler(E_MSG, 'obs_selection', msgstring2)
cycle QCMetaData
endif
! if you get here, the metadata is not the same and the user has not
! given us strings that are ok to match. fail.
write(msgstring2,*)'qc metadata value mismatch. seq1: ', trim(str1)
- call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
- write(msgstring2,*)'qc metadata value mismatch. seq2: ', trim(str2)
- call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
- call error_handler(E_ERR, 'obs_sequence_tool', msgstring1, source, revision, revdate)
+ write(msgstring3,*)'qc metadata value mismatch. seq2: ', trim(str2)
+ call error_handler(E_ERR, 'obs_selection', msgstring1, &
+ source, revision, revdate, text2=msgstring2, text3=msgstring3)
enddo QCMetaData
@@ -607,7 +652,7 @@
size_seq_in = get_num_obs(seq_in)
if (size_seq_in == 0) then
msgstring = 'Obs_seq file '//trim(filename)//' is empty.'
- call error_handler(E_MSG,'obs_sequence_tool',msgstring)
+ call error_handler(E_MSG,'obs_selection',msgstring)
return
endif
@@ -630,7 +675,7 @@
if ( .not. is_there_one ) then
write(msgstring,*)'no first observation in ',trim(filename)
- call error_handler(E_MSG,'obs_sequence_tool', msgstring)
+ call error_handler(E_MSG,'obs_selection', msgstring)
endif
! process it here
@@ -649,8 +694,6 @@
else
type_count(this_obs_kind) = type_count(this_obs_kind) + 1
endif
-! print *, 'obs kind index = ', this_obs_kind
-! if(this_obs_kind > 0)print *, 'obs name = ', get_obs_kind_name(this_obs_kind)
call get_next_obs(seq_in, obs, next_obs, is_this_last)
if (.not. is_this_last) then
@@ -706,7 +749,6 @@
character(len=*), intent(in) :: filename
type(obs_type) :: obs, next_obs
-type(obs_def_type) :: this_obs_def
logical :: is_there_one, is_this_last
integer :: size_seq
integer :: key
@@ -717,7 +759,7 @@
size_seq = get_num_obs(seq)
if (size_seq == 0) then
msgstring = 'Obs_seq file '//trim(filename)//' is empty.'
- call error_handler(E_MSG,'obs_sequence_tool:validate',msgstring)
+ call error_handler(E_MSG,'obs_selection:validate',msgstring)
return
endif
@@ -732,18 +774,15 @@
if ( .not. is_there_one ) then
write(msgstring,*)'no first observation in sequence ' // trim(filename)
- call error_handler(E_MSG,'obs_sequence_tool:validate', msgstring, source, revision, revdate)
+ call error_handler(E_MSG,'obs_selection:validate', msgstring, source, revision, revdate)
endif
-call get_obs_def(obs, this_obs_def)
-last_time = get_obs_def_time(this_obs_def)
+last_time = get_time_from_obs(obs)
-
is_this_last = .false.
ObsLoop : do while ( .not. is_this_last)
- call get_obs_def(obs, this_obs_def)
- this_time = get_obs_def_time(this_obs_def)
+ this_time = get_time_from_obs(obs)
if (last_time > this_time) then
! bad time order of observations in linked list
@@ -753,10 +792,10 @@
if (cal) call print_date(this_time, ' which is date: ')
key = get_obs_key(obs)
- write(msgstring,*)'obs number ', key, ' has earlier time than previous obs'
- call error_handler(E_MSG,'obs_sequence_tool:validate', msgstring)
+ write(msgstring2,*)'obs number ', key, ' has earlier time than previous obs'
write(msgstring,*)'observations must be in increasing time order, file ' // trim(filename)
- call error_handler(E_ERR,'obs_sequence_tool:validate', msgstring, source, revision, revdate)
+ call error_handler(E_ERR,'obs_selection:validate', msgstring, &
+ source, revision, revdate, text2=msgstring2)
endif
last_time = this_time
@@ -784,7 +823,6 @@
integer :: num_copies , num_qc, i
character(len=129) :: str1
-character(len=255) :: msgstring1
num_copies = get_num_copies(seq1)
num_qc = get_num_qc( seq1)
@@ -832,6 +870,9 @@
type(obs_sequence_type) :: seq_in
logical :: is_this_last
real(r8) :: dummy
+ type(obs_def_type), allocatable :: temp_sel_list(:)
+ type(time_type), allocatable :: temp_time(:)
+ integer, allocatable :: sort_index(:)
! if the list of which obs to select comes from the coverage tool,
! it's a list of obs_defs. if it's a full obs_seq file, then
@@ -846,15 +887,36 @@
source,revision,revdate)
endif
- allocate(selection_list(count))
-
! set up the mapping table for the kinds here
call read_obs_kind(iunit, .false.)
+ ! this one stays around and is a return from this subroutine
+ allocate(selection_list(count))
+
+ ! these are temporaries for sorting into time order
+ allocate(temp_sel_list(count), temp_time(count), sort_index(count))
+
+ ! read into array in whatever order these are in the file
do i = 1, count
- call read_obs_def(iunit, selection_list(i), 0, dummy)
+ call read_obs_def(iunit, temp_sel_list(i), 0, dummy)
enddo
+ ! extract just the times into an array
+ do i = 1, count
+ temp_time(i) = get_obs_def_time(temp_sel_list(i))
+ enddo
+
+ ! sort into time order
+ call time_index_sort(temp_time, sort_index, count)
+
+ ! copy into output array using that order
+ do i = 1, count
+ selection_list(i) = temp_sel_list(sort_index(i))
+ enddo
+
+
+ deallocate(temp_sel_list, temp_time, sort_index)
+
call close_file(iunit)
else
@@ -875,6 +937,9 @@
source,revision,revdate)
endif
+ ! in an obs_seq file, using get_next_obs you will
+ ! be guarenteed to get these in increasing time order.
+
is_this_last = .false.
do i = 1, count
if (is_this_last) exit
@@ -891,15 +956,68 @@
selection_count = count
+write(msgstring, *) 'selection file contains ', count, ' entries'
+call error_handler(E_MSG, 'obs_selection', msgstring, source, revision, revdate)
+ call print_time(get_obs_def_time(selection_list(1)), 'time of first selection:')
+if (cal) call print_date(get_obs_def_time(selection_list(1)), ' which is date:')
+ call print_time(get_obs_def_time(selection_list(count)), 'time of last selection:')
+if (cal) call print_date(get_obs_def_time(selection_list(count)), ' which is date:')
+
end subroutine read_selection_list
+!---------------------------------------------------------------------
+function set_base(obs_time, selection_list, selection_count, startindex)
+! find offset of first obs_def entry that has a time >= to the given one
+! if optional startindex is given, start looking there.
+
+ type(time_type), intent(in) :: obs_time
+ type(obs_def_type), intent(in) :: selection_list(:)
+ integer, intent(in) :: selection_count
+ integer, optional, intent(in) :: startindex
+ integer :: set_base
+
+ integer :: i, s
+ type(time_type) :: def_time
+
+ ! if we know an offset to start from, use it. otherwise, start at 1.
+ if (present(startindex)) then
+ s = startindex
+ else
+ s = 1
+ endif
+
+ ! find the index of the first item in this list which is >= given one
+ ! we will start subsequent searches at this offset.
+ do i = s, selection_count
+
+ def_time = get_obs_def_time(selection_list(i))
+
+ ! if we have looped through the obs_def list far enough so
+ ! the next obs_def entry has a time more than or equal to the
+ ! one of the next observation, stop and return this index.
+ if (obs_time <= def_time) then
+ set_base = i
+ return
+ endif
+
+ enddo
+
+! we got all the way through the file and the last obs_def entry
+! was still before the observation time we are looking for.
+set_base = -1
+
+end function set_base
+
+
+
! compare horiz location, time, type - ignores vertical
!---------------------------------------------------------------------
-function good_selection(obs_in, selection_list, selection_count)
+function good_selection(obs_in, selection_list, selection_count, startindex)
type(obs_type), intent(in) :: obs_in
type(obs_def_type), intent(in) :: selection_list(:)
integer, intent(in) :: selection_count
+ integer, intent(in) :: startindex
logical :: good_selection
! first pass, iterate list.
@@ -917,17 +1035,39 @@
base_obs_time = get_obs_def_time(base_obs_def)
base_obs_type = get_obs_kind(base_obs_def)
+ ! this program now time-sorts the selection list first, so we
+ ! are guarenteed the obs_defs will be encountered in time order.
+ ! now optimize in two ways: first, the caller will pass in an
+ ! offset that is less than or equal to the first obs for this time,
+ ! and second this routine will return when the obs_def time is
+ ! larger than the time to match. that should save a lot of looping.
+
+ if (startindex < 1 .or. startindex > selection_count) then
+ write(msgstring2, *) 'startindex ', startindex, ' is not between 1 and ', selection_count
+ call error_handler(E_ERR, 'good_selection', &
+ 'invalid startindex, internal error should not happen', &
+ source, revision, revdate, text2=msgstring2)
+ endif
+
+ ! the obs_def list is time-sorted now. if you get to a larger
+ ! time without a match you can bail early.
+ good_selection = .false.
+
! first select on time - it is an integer comparison
! and quicker than location test. then type, and
! finally location.
- do i = 1, selection_count
+ do i = startindex, selection_count
+ test_obs_time = get_obs_def_time(selection_list(i))
+
+ ! if past the possible times, return now.
+ if (base_obs_time > test_obs_time) return
+
+ if (base_obs_time /= test_obs_time) cycle
+
test_obs_type = get_obs_kind(selection_list(i))
if (base_obs_type /= test_obs_type) cycle
- test_obs_time = get_obs_def_time(selection_list(i))
- if (base_obs_time /= test_obs_time) cycle
-
test_obs_loc = get_obs_def_location(selection_list(i))
if ( .not. horiz_location_equal(base_obs_loc, test_obs_loc)) cycle
@@ -936,8 +1076,7 @@
return
enddo
- ! got to end of selection list without a match, cycle.
- good_selection = .false.
+ ! if you get here, no match, and return value is already false.
end function good_selection
@@ -975,6 +1114,18 @@
end function horiz_location_equal
+!---------------------------------------------------------------------------
+function get_time_from_obs(this_obs)
+ type(obs_type), intent(in) :: this_obs
+ type(time_type) :: get_time_from_obs
+
+type(obs_def_type) :: this_obs_def
+
+call get_obs_def(this_obs, this_obs_def)
+get_time_from_obs = get_obs_def_time(this_obs_def)
+
+end function get_time_from_obs
+
!---------------------------------------------------------------------
end program obs_selection
Modified: DART/branches/development/time_manager/time_manager_mod.f90
===================================================================
--- DART/branches/development/time_manager/time_manager_mod.f90 2012-04-16 16:03:56 UTC (rev 5700)
+++ DART/branches/development/time_manager/time_manager_mod.f90 2012-04-16 22:03:12 UTC (rev 5701)
@@ -50,7 +50,7 @@
! Subroutines and functions operating on time_type
public :: set_time, set_time_missing, increment_time, decrement_time, get_time
-public :: interval_alarm, repeat_alarm, generate_seed
+public :: interval_alarm, repeat_alarm, generate_seed, time_index_sort
! List of available calendar types
public :: THIRTY_DAY_MONTHS, JULIAN, GREGORIAN, NOLEAP, NO_CALENDAR, &
@@ -3158,5 +3158,78 @@
!-------------------------------------------------------------------------
+subroutine time_index_sort(t, index, num)
+
+! Uses a heap sort alogrithm on t, returns array of sorted indices
+! Sorts from earliest (smallest value) time to latest (largest value);
+! uses time > and < operators to do the compare. When index = 1
+! that's the earliest time.
+
+integer, intent(in) :: num
+type(time_type), intent(in) :: t(num)
+integer, intent(out) :: index(num)
+
+integer :: ind, i, j, l_val_index, level
+type(time_type) :: l_val
+
+
+if ( .not. module_initialized ) call time_manager_init
+
+! INITIALIZE THE INDEX ARRAY TO INPUT ORDER
+do i = 1, num
+ index(i) = i
+end do
+
+! Only one element, just send it back
+if(num <= 1) return
+
+level = num / 2 + 1
+ind = num
+
+! Keep looping until finished
+do
+ ! Keep going down levels until bottom
+ if(level > 1) then
+ level = level - 1
+ l_val = t(index(level))
+ l_val_index = index(level)
+ else
+ l_val = t(index(ind))
+ l_val_index = index(ind)
+
+
+ index(ind) = index(1)
+ ind = ind - 1
+ if(ind == 1) then
+ index(1) = l_val_index
+ return
+ endif
+ endif
+
+ i = level
+ j = 2 * level
+
+ do while(j <= ind)
+ if(j < ind) then
+ if(t(index(j)) < t(index(j + 1))) j = j + 1
+ endif
+ if(l_val < t(index(j))) then
+ index(i) = index(j)
+ i = j
+ j = 2 * j
+ else
+ j = ind + 1
+ endif
+
+ end do
+ index(i) = l_val_index
+
+end do
+
+end subroutine time_index_sort
+
+
+!-------------------------------------------------------------------------
+
end module time_manager_mod
From nancy at ucar.edu Mon Apr 16 16:07:58 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Mon, 16 Apr 2012 16:07:58 -0600
Subject: [Dart-dev] [5702] DART/branches/development/obs_sequence: fix the
error messages when the namelist items don't
Message-ID:
Revision: 5702
Author: nancy
Date: 2012-04-16 16:07:58 -0600 (Mon, 16 Apr 2012)
Log Message:
-----------
fix the error messages when the namelist items don't
contain any filenames or the wrong number of names.
Modified Paths:
--------------
DART/branches/development/obs_sequence/obs_selection.f90
DART/branches/development/obs_sequence/obs_sequence_tool.f90
-------------- next part --------------
Modified: DART/branches/development/obs_sequence/obs_selection.f90
===================================================================
--- DART/branches/development/obs_sequence/obs_selection.f90 2012-04-16 22:03:12 UTC (rev 5701)
+++ DART/branches/development/obs_sequence/obs_selection.f90 2012-04-16 22:07:58 UTC (rev 5702)
@@ -483,7 +483,7 @@
if (filename_seq(index) == '') then
if (index == 1) then
call error_handler(E_ERR,'obs_selection', &
- 'namelist item ', trim(fsource)//' contains no filenames', &
+ 'namelist item '//trim(fsource)//' contains no filenames', &
source,revision,revdate)
endif
! leaving num_input_files unspecified (or set to 0) means use
Modified: DART/branches/development/obs_sequence/obs_sequence_tool.f90
===================================================================
--- DART/branches/development/obs_sequence/obs_sequence_tool.f90 2012-04-16 22:03:12 UTC (rev 5701)
+++ DART/branches/development/obs_sequence/obs_sequence_tool.f90 2012-04-16 22:07:58 UTC (rev 5702)
@@ -1533,7 +1533,7 @@
integer :: index
logical :: from_file
-character(len=32) :: source
+character(len=32) :: fsource
! ok, here's the new logic:
! if the user specifies neither filename_seq nor filename_seq_list, we
@@ -1571,10 +1571,10 @@
! if they have specified a file which contains a list, read it into
! the filename_seq array and set the count.
if (filename_seq_list /= '') then
- source = 'filename_seq_list'
+ fsource = 'filename_seq_list'
from_file = .true.
else
- source = 'filename_seq'
+ fsource = 'filename_seq'
from_file = .false.
endif
@@ -1585,7 +1585,7 @@
if (filename_seq(index) == '') then
if (index == 1) then
call error_handler(E_ERR,'obs_sequence_tool', &
- trim(source)//' contains no filenames', &
+ 'namelist item '//trim(fsource)//' contains no filenames', &
source,revision,revdate)
endif
! leaving num_input_files unspecified (or set to 0) means use
@@ -1602,7 +1602,7 @@
write(msgstring, *) 'if num_input_files is not 0, it must match the number of filenames specified'
call error_handler(E_MSG,'obs_sequence_tool', msgstring)
write(msgstring, *) 'num_input_files is ', num_input_files, &
- ' but '//trim(source)//' has filecount ', index - 1
+ ' but namelist item '//trim(fsource)//' has filecount ', index - 1
call error_handler(E_ERR,'obs_sequence_tool', msgstring, &
source,revision,revdate)
From nancy at ucar.edu Tue Apr 17 16:22:54 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Tue, 17 Apr 2012 16:22:54 -0600
Subject: [Dart-dev] [5704] DART/trunk/DART_LAB/DART_LAB.html: Added some
titles to clarify what the sections in the presentation directory are about
.
Message-ID:
Revision: 5704
Author: thoar
Date: 2012-04-17 16:22:54 -0600 (Tue, 17 Apr 2012)
Log Message:
-----------
Added some titles to clarify what the sections in the presentation directory are about.
Modified Paths:
--------------
DART/trunk/DART_LAB/DART_LAB.html
-------------- next part --------------
Modified: DART/trunk/DART_LAB/DART_LAB.html
===================================================================
--- DART/trunk/DART_LAB/DART_LAB.html 2012-04-16 22:17:03 UTC (rev 5703)
+++ DART/trunk/DART_LAB/DART_LAB.html 2012-04-17 22:22:54 UTC (rev 5704)
@@ -53,10 +53,10 @@
Here are the PDF files for the presentation part of the tutorial:
@@ -75,7 +75,7 @@
license is needed to run these scripts.
-The exercises include the following:
+The exercises use the following functions:
- gaussian_product
@@ -86,10 +86,8 @@
- twod_ensemble
-To run these, cd into the matlab directory, start matlab,
-and type the names at the prompt. Matlab must be started
-with the Java virtual machine enabled as these scripts
-open windows and display graphical images as they run.
+To run these, cd into the DART_LAB/matlab directory, start matlab,
+and type the names at the prompt.
From nancy at ucar.edu Wed Apr 18 10:03:30 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Wed, 18 Apr 2012 10:03:30 -0600
Subject: [Dart-dev] [5705]
DART/branches/development/obs_sequence/obs_selection.f90: one more try at
making this faster - only go into mask file if we
Message-ID:
Revision: 5705
Author: nancy
Date: 2012-04-18 10:03:30 -0600 (Wed, 18 Apr 2012)
Log Message:
-----------
one more try at making this faster - only go into mask file if we
know this is an obs type of interest. also fix a mem leak - if we
left the main processing loop early i didn't delete the existing
obs_sequence structure. added timestamps in several places (namelist
controlled) in case we encounter another slow case so i can see where
the time is going. and finally, rename some internal variables to try
to stem the kinds/types confusion.
Modified Paths:
--------------
DART/branches/development/obs_sequence/obs_selection.f90
-------------- next part --------------
Modified: DART/branches/development/obs_sequence/obs_selection.f90
===================================================================
--- DART/branches/development/obs_sequence/obs_selection.f90 2012-04-17 22:22:54 UTC (rev 5704)
+++ DART/branches/development/obs_sequence/obs_selection.f90 2012-04-18 16:03:30 UTC (rev 5705)
@@ -30,7 +30,7 @@
find_namelist_in_file, check_namelist_read, &
error_handler, E_ERR, E_MSG, nmlfileunit, &
do_nml_file, do_nml_term, get_next_filename, &
- open_file, close_file
+ open_file, close_file, finalize_utilities
use location_mod, only : location_type, get_location, set_location, &
LocationName, read_location, operator(==), &
write_location
@@ -72,10 +72,11 @@
logical :: is_there_one, is_this_last
integer :: size_seq_in, num_copies_in, num_qc_in
integer :: size_seq_out, num_copies_out, num_qc_out
-integer :: num_inserted, iunit, io, i, j
+integer :: num_inserted, iunit, io, i, j, ocount
integer :: total_num_inserted, base_index, next_base_index
-integer :: max_num_obs, file_id
-integer :: first_seq
+integer :: max_num_obs, file_id, this_type
+logical, allocatable :: type_wanted(:)
+integer :: first_seq, num_good_called, num_good_searched
character(len = 129) :: read_format, meta_data
logical :: pre_I_format, cal
character(len = 255) :: msgstring, msgstring1, msgstring2, msgstring3
@@ -103,12 +104,15 @@
logical :: selections_is_obs_seq = .false.
logical :: print_only = .false.
+logical :: partial_write = .false.
+logical :: print_timestamps = .false.
character(len=32) :: calendar = 'Gregorian'
namelist /obs_selection_nml/ &
num_input_files, filename_seq, filename_seq_list, filename_out, &
- selections_file, selections_is_obs_seq, print_only, calendar
+ selections_file, selections_is_obs_seq, print_only, calendar, &
+ print_timestamps, partial_write
!----------------------------------------------------------------
! Start of the program:
@@ -147,10 +151,14 @@
call set_calendar_type(calendar)
cal = (get_calendar_type() /= NO_CALENDAR)
-call read_selection_list(selections_file, selections_is_obs_seq, obs_def_list, obs_def_count)
+call read_selection_list(selections_file, selections_is_obs_seq, obs_def_list, obs_def_count, type_wanted)
! end of namelist processing and setup
+! some statistics for timing/debugging
+num_good_called = 0
+num_good_searched = 0
+
! Read header information for the sequences to see if we need
! to accomodate additional copies or qc values from subsequent sequences.
! Also, calculate how many observations to be added to the first sequence.
@@ -165,6 +173,8 @@
! pass 1:
+if (print_timestamps) call timestamp(string1='start of pass1', pos='brief')
+
first_seq = -1
do i = 1, num_input_files
@@ -173,19 +183,13 @@
'num_input_files and filename_seq mismatch',source,revision,revdate)
endif
- ! count up the number of observations we are going to eventually have.
- ! if all the observations in a file are not part of the linked list, the
- ! output number of observations might be much smaller than the total size in
- ! the header. it is slower, but go ahead and read in the entire sequence
- ! and count up the real number of obs - trim_seq will do the count even if
- ! it is not trimming in time. this allows us to create an empty obs_seq
- ! output file of exactly the right size.
+ ! count up the max number of observations possible if every obs in the
+ ! input file was copied to the output.
call read_obs_seq_header(filename_seq(i), num_copies_in, num_qc_in, &
size_seq_in, max_num_obs, file_id, read_format, pre_I_format, &
close_the_file = .true.)
- call destroy_obs_sequence(seq_in)
if (max_num_obs == 0) then
process_file(i) = .false.
write(msgstring,*) 'No obs in input sequence file ', trim(filename_seq(i))
@@ -208,6 +212,8 @@
enddo
+if (print_timestamps) call timestamp(string1='end of pass1', pos='brief')
+
! no valid obs found? if the index value is still negative, we are
! still waiting to process the first one and never found one.
if (first_seq < 0 .or. size_seq_out == 0) then
@@ -218,6 +224,8 @@
! pass 2:
+if (print_timestamps) call timestamp(string1='start of pass2', pos='brief')
+
! blank line, start of actually creating output file
call error_handler(E_MSG,' ',' ')
@@ -235,8 +243,12 @@
if (.not. process_file(i)) cycle
+ write(msgstring, *) 'input file ', i
+ if (print_timestamps) call timestamp(string1='start of '//trim(msgstring), pos='brief')
+
write(msgstring,*) 'Starting to process input sequence file ', trim(filename_seq(i))
call error_handler(E_MSG,'obs_selection',msgstring)
+ call timestamp(' at ', pos='brief')
call read_obs_seq(filename_seq(i), 0, 0, 0, seq_in)
@@ -278,44 +290,74 @@
! NOTE: insert_obs_in_seq CHANGES the obs passed in.
! Must pass a copy of incoming obs to insert_obs_in_seq.
!--------------------------------------------------------------
+ num_good_called = 0
+ num_good_searched = 0
+
num_inserted = 0
is_there_one = get_first_obs(seq_in, obs_in)
- if ( is_there_one ) then
+ if ( .not. is_there_one ) then
+ write(msgstring2,*) 'no valid observations in ',trim(filename_seq(i))
+ call error_handler(E_MSG,'obs_selection', 'skipping to next input file', &
+ source, revision, revdate, text2=msgstring2)
- ! figure out the time of the first obs in this file, and set the
- ! offset for the first item in the selection file that's at this time.
- t1 = get_time_from_obs(obs_in)
- base_index = set_base(t1, obs_def_list, obs_def_count)
+ call destroy_obs_sequence(seq_in)
- if (base_index < 0) then
- write(msgstring2, *) 'skipping all obs in ', trim(filename_seq(i))
- call error_handler(E_MSG, 'obs_selection', &
- 'first time in obs_sequence file is after all times in selection file', &
- source, revision, revdate, text2=msgstring2)
- cycle FILES
- endif
- next_base_index = base_index
+ write(msgstring, *) 'input file ', i
+ if (print_timestamps) call timestamp(string1='end of '//trim(msgstring), pos='brief')
- if (good_selection(obs_in, obs_def_list, obs_def_count, next_base_index)) then
- obs_out = obs_in
+ cycle FILES
+ endif
- call insert_obs_in_seq(seq_out, obs_out) ! new_obs linked list info changes
+ if (print_timestamps) call timestamp(string1='start of first obs', pos='brief')
+ ocount = 1
- prev_obs_out = obs_out ! records new position in seq_out
- num_inserted = num_inserted + 1
- endif
+ ! figure out the time of the first obs in this file, and set the
+ ! offset for the first item in the selection file that's at this time.
+ t1 = get_time_from_obs(obs_in)
+ base_index = set_base(t1, obs_def_list, obs_def_count)
- call get_next_obs(seq_in, obs_in, next_obs_in, is_this_last)
- ObsLoop : do while ( .not. is_this_last)
+ if (base_index < 0) then
+ write(msgstring2, *) 'skipping all obs in ', trim(filename_seq(i))
+ call error_handler(E_MSG, 'obs_selection', &
+ 'first time in obs_sequence file is after all times in selection file', &
+ source, revision, revdate, text2=msgstring2)
+ call destroy_obs_sequence(seq_in)
+ write(msgstring, *) 'input file ', i
+ if (print_timestamps) call timestamp(string1='cyc 1 of '//trim(msgstring), pos='brief')
+ cycle FILES
+ endif
+ next_base_index = base_index
+ if (good_selection(obs_in, obs_def_list, obs_def_count, next_base_index)) then
+ obs_out = obs_in
+
+ call insert_obs_in_seq(seq_out, obs_out) ! new_obs linked list info changes
+
+ prev_obs_out = obs_out ! records new position in seq_out
+ num_inserted = num_inserted + 1
+ endif
+
+ call get_next_obs(seq_in, obs_in, next_obs_in, is_this_last)
+ ObsLoop : do while ( .not. is_this_last)
+
+ ocount = ocount + 1
+
+ ! before we fool with checking times and setting offsets into
+ ! the selection list, skip until we are handling an obs type
+ ! that we care about.
+ this_type = get_type_from_obs(next_obs_in)
+
+ ! support identity obs - cannot exit early for them.
+ if (this_type < 0 .or. type_wanted(this_type)) then
+
! if the time of the next obs is different from this one, bump
! up the start of the search index offset.
- t1 = get_time_from_obs(obs_in)
t2 = get_time_from_obs(next_obs_in)
if (t1 /= t2) then
base_index = next_base_index
next_base_index = set_base(t2, obs_def_list, obs_def_count, base_index)
+ t1 = t2
if (next_base_index < 0) then
! next obs in selection file is after all the rest of the obs in this
@@ -323,15 +365,16 @@
write(msgstring, *) 'done with ', trim(filename_seq(i))
call error_handler(E_MSG, 'obs_selection', msgstring, &
source, revision, revdate)
+ call destroy_obs_sequence(seq_in)
+ write(msgstring, *) 'input file ', i
+ if (print_timestamps) call timestamp(string1='cyc 2 of '//trim(msgstring), pos='brief')
cycle FILES
endif
endif
- obs_in = next_obs_in ! next obs is the current one now
+ if (good_selection(next_obs_in, obs_def_list, obs_def_count, next_base_index)) then
+ obs_out = next_obs_in
- if (good_selection(obs_in, obs_def_list, obs_def_count, next_base_index)) then
- obs_out = obs_in
-
! Since the stride through the observation sequence file is always
! guaranteed to be in temporally-ascending order, we can use the
! 'previous' observation as the starting point to search for the
@@ -356,28 +399,43 @@
endif
- call get_next_obs(seq_in, obs_in, next_obs_in, is_this_last)
+ endif
+ obs_in = next_obs_in ! next obs is the current one now
- enddo ObsLoop
+ call get_next_obs(seq_in, obs_in, next_obs_in, is_this_last)
- total_num_inserted = total_num_inserted + num_inserted
+ if (print_timestamps) then
+ if (mod(ocount,10000) == 0) then
+ write(msgstring, *) 'processed obs ', ocount, ' of ', size_seq_in
+ if (print_timestamps) call timestamp(string1=trim(msgstring), pos='brief')
+ endif
+ endif
- else
- write(msgstring,*)'no first observation in ',trim(filename_seq(i))
- call error_handler(E_MSG,'obs_selection', msgstring)
- endif
+ enddo ObsLoop
+ total_num_inserted = total_num_inserted + num_inserted
+
+
if (.not. print_only) then
print*, '-------------- Obs seq file # : ', i
print*, 'Number of obs in previous seq : ', size_seq_out
- print*, 'Number of obs to be inserted : ', size_seq_in
- print*, 'Number of obs really inserted : ', num_inserted
+ print*, 'Number of obs possible to get : ', size_seq_in
+ print*, 'Number of obs really accepted : ', num_inserted
print*, '---------------------------------------------------------'
+ if (partial_write) call write_obs_seq(seq_out, filename_out)
endif
call destroy_obs_sequence(seq_in)
+ write(msgstring, *) 'input file ', i
+ if (print_timestamps) call timestamp(string1='end of '//trim(msgstring), pos='brief')
+
+ ! DEBUG diagnostics
+ !print *, 'size of mask file = ', obs_def_count
+ !print *, 'average search length = ', num_good_searched / num_good_called
+ !print *, 'number of time search called = ', num_good_called
+
enddo FILES
write(msgstring,*) 'Starting to process output sequence file ', trim(filename_out)
@@ -406,7 +464,7 @@
call destroy_obs( obs_out)
!call destroy_obs(prev_obs_out)
-call timestamp(source,revision,revdate,'end')
+call finalize_utilities()
contains
@@ -632,19 +690,16 @@
logical :: is_there_one, is_this_last
integer :: size_seq_in
integer :: i
-integer :: this_obs_kind
+integer :: this_obs_type
! max_obs_kinds is a public from obs_kind_mod.f90 and really is
-! counting the max number of types, not kinds
+! counting the max number of types, not kinds.
integer :: type_count(max_obs_kinds), identity_count
! Initialize input obs_types
-do i = 1, max_obs_kinds
- type_count(i) = 0
-enddo
+type_count(:) = 0
identity_count = 0
-! make sure there are obs left to process before going on.
! num_obs should be ok since we just constructed this seq so it should
! have no unlinked obs. if it might for some reason, use this instead:
! size_seq_in = get_num_key_range(seq_in) !current size of seq_in
@@ -687,12 +742,11 @@
ObsLoop : do while ( .not. is_this_last)
- call get_obs_def(obs, this_obs_def)
- this_obs_kind = get_obs_kind(this_obs_def)
- if (this_obs_kind < 0) then
+ this_obs_type = get_type_from_obs(obs)
+ if (this_obs_type < 0) then
identity_count = identity_count + 1
else
- type_count(this_obs_kind) = type_count(this_obs_kind) + 1
+ type_count(this_obs_type) = type_count(this_obs_type) + 1
endif
call get_next_obs(seq_in, obs, next_obs, is_this_last)
@@ -852,11 +906,12 @@
!---------------------------------------------------------------------
subroutine read_selection_list(select_file, select_is_seq, &
- selection_list, selection_count)
+ selection_list, selection_count, type_wanted)
character(len=*), intent(in) :: select_file
logical, intent(in) :: select_is_seq
type(obs_def_type), allocatable, intent(out) :: selection_list(:)
integer, intent(out) :: selection_count
+ logical, allocatable, intent(out) :: type_wanted(:)
! the plan:
! open file
@@ -864,7 +919,7 @@
! call read_obs_def right number of times
! close file
- integer :: iunit, count, i, copies, qcs
+ integer :: iunit, count, i, copies, qcs, this_type
character(len=15) :: label ! must be 'num_definitions'
type(obs_type) :: obs, prev_obs
type(obs_sequence_type) :: seq_in
@@ -890,15 +945,21 @@
! set up the mapping table for the kinds here
call read_obs_kind(iunit, .false.)
- ! this one stays around and is a return from this subroutine
- allocate(selection_list(count))
+ ! these ones stay around and are returned from this subroutine
+ allocate(selection_list(count), type_wanted(max_obs_kinds))
! these are temporaries for sorting into time order
allocate(temp_sel_list(count), temp_time(count), sort_index(count))
+ ! assume no types are wanted
+ type_wanted(:) = .false.
+
! read into array in whatever order these are in the file
+ ! and bookkeep what types are encountered
do i = 1, count
call read_obs_def(iunit, temp_sel_list(i), 0, dummy)
+ this_type = get_obs_kind(temp_sel_list(i))
+ if (this_type > 0) type_wanted(this_type) = .true.
enddo
! extract just the times into an array
@@ -945,6 +1006,8 @@
if (is_this_last) exit
call get_obs_def(obs, selection_list(i))
+ this_type = get_obs_kind(selection_list(i))
+ if (this_type > 0) type_wanted(this_type) = .true.
prev_obs = obs
call get_next_obs(seq_in, prev_obs, obs, is_this_last)
@@ -1049,6 +1112,9 @@
source, revision, revdate, text2=msgstring2)
endif
+ ! statistics for timing/debugging
+ num_good_called = num_good_called + 1
+
! the obs_def list is time-sorted now. if you get to a larger
! time without a match you can bail early.
good_selection = .false.
@@ -1061,7 +1127,10 @@
test_obs_time = get_obs_def_time(selection_list(i))
! if past the possible times, return now.
- if (base_obs_time > test_obs_time) return
+ if (base_obs_time > test_obs_time) then
+ num_good_searched = i - startindex + 1
+ return
+ endif
if (base_obs_time /= test_obs_time) cycle
@@ -1072,11 +1141,13 @@
if ( .not. horiz_location_equal(base_obs_loc, test_obs_loc)) cycle
! all match - good return.
+ num_good_searched = i - startindex + 1
good_selection = .true.
return
enddo
! if you get here, no match, and return value is already false.
+num_good_searched = selection_count - startindex + 1
end function good_selection
@@ -1126,6 +1197,18 @@
end function get_time_from_obs
+!---------------------------------------------------------------------------
+function get_type_from_obs(this_obs)
+ type(obs_type), intent(in) :: this_obs
+ integer :: get_type_from_obs
+
+type(obs_def_type) :: this_obs_def
+
+call get_obs_def(this_obs, this_obs_def)
+get_type_from_obs = get_obs_kind(this_obs_def)
+
+end function get_type_from_obs
+
!---------------------------------------------------------------------
end program obs_selection
From nancy at ucar.edu Wed Apr 18 14:56:46 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Wed, 18 Apr 2012 14:56:46 -0600
Subject: [Dart-dev] [5707] DART/branches/development: tracking changes from
the trunk.
Message-ID:
Revision: 5707
Author: thoar
Date: 2012-04-18 14:56:45 -0600 (Wed, 18 Apr 2012)
Log Message:
-----------
tracking changes from the trunk.
closest_member_tool.f90 uses the right index in an error message,
the matlab scripts both show the crosshairs now, and the DART_LAB.html
has a more descriptive list of the sections.
Modified Paths:
--------------
DART/branches/development/DART_LAB/DART_LAB.html
DART/branches/development/DART_LAB/matlab/oned_ensemble.m
DART/branches/development/DART_LAB/matlab/twod_ensemble.m
DART/branches/development/utilities/closest_member_tool.f90
Property Changed:
----------------
DART/branches/development/
DART/branches/development/adaptive_inflate/
DART/branches/development/assim_tools/assim_tools_mod.f90
DART/branches/development/models/bgrid_solo/work/
DART/branches/development/models/cam/
DART/branches/development/models/lorenz_63/work/
DART/branches/development/models/mpas_atm/
DART/branches/development/models/mpas_ocn/
DART/branches/development/models/wrf/work/
DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
DART/branches/development/utilities/
DART/branches/development/utilities/closest_member_tool.f90
-------------- next part --------------
Property changes on: DART/branches/development
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/trunk:4680-5660
+ /DART/trunk:4680-5706
Modified: DART/branches/development/DART_LAB/DART_LAB.html
===================================================================
--- DART/branches/development/DART_LAB/DART_LAB.html 2012-04-18 17:47:16 UTC (rev 5706)
+++ DART/branches/development/DART_LAB/DART_LAB.html 2012-04-18 20:56:45 UTC (rev 5707)
@@ -53,10 +53,10 @@
Here are the PDF files for the presentation part of the tutorial:
@@ -75,7 +75,7 @@
license is needed to run these scripts.
-The exercises include the following:
+The exercises use the following functions:
- gaussian_product
@@ -86,10 +86,8 @@
- twod_ensemble
-To run these, cd into the matlab directory, start matlab,
-and type the names at the prompt. Matlab must be started
-with the Java virtual machine enabled as these scripts
-open windows and display graphical images as they run.
+To run these, cd into the DART_LAB/matlab directory, start matlab,
+and type the names at the prompt.
Modified: DART/branches/development/DART_LAB/matlab/oned_ensemble.m
===================================================================
--- DART/branches/development/DART_LAB/matlab/oned_ensemble.m 2012-04-18 17:47:16 UTC (rev 5706)
+++ DART/branches/development/DART_LAB/matlab/oned_ensemble.m 2012-04-18 20:56:45 UTC (rev 5707)
@@ -78,29 +78,29 @@
handles.output = hObject;
% Insert the ensemble structure into this
-handles.ens_size = 0;
-handles.ens_members = 0;
-handles.h_obs_plot = 0;
-handles.h_update_ens = 0;
-handles.h_ens_member = 0;
-handles.h_obs_ast = 0;
-handles.h_update_lines = 0;
-handles.observation = 0;
-handles.obs_error_sd = 0;
-handles.inflation = 1.5;
-handles.plot_inflation = false;
-handles.h_inf_ens_member = 0;
-handles.h_inf_up_ens = 0;
-handles.h_inf_lines = 0;
-handles.h_inf_axis = 0;
+handles.ens_size = 0;
+handles.ens_members = 0;
+handles.h_obs_plot = 0;
+handles.h_update_ens = 0;
+handles.h_ens_member = 0;
+handles.h_obs_ast = 0;
+handles.h_update_lines = 0;
+handles.observation = 0;
+handles.obs_error_sd = 0;
+handles.inflation = 1.5;
+handles.plot_inflation = false;
+handles.h_inf_ens_member = 0;
+handles.h_inf_up_ens = 0;
+handles.h_inf_lines = 0;
+handles.h_inf_axis = 0;
% Update handles structure
guidata(hObject, handles);
% Get the initial observation, obs_error_sd and inflation from the gui
-handles.observation = str2double(get(handles.edit_observation, 'String'));
+handles.observation = str2double(get(handles.edit_observation, 'String'));
handles.obs_error_sd = str2double(get(handles.edit_obs_error_sd, 'String'));
-handles.inflation = str2double(get(handles.edit_inflation, 'String'));
+handles.inflation = str2double(get(handles.edit_inflation, 'String'));
% Go ahead and plot the initial observational error distribution
handles.h_obs_plot = plot_gaussian(handles.observation, handles.obs_error_sd, 1);
@@ -124,6 +124,11 @@
% Update handles structure
guidata(hObject, handles);
+% Reset focus to the menu gui window
+% Setting the axes clears the legend, gcbo restores focus
+axes(handles.axes1);
+
+
% UIWAIT makes oned_ensemble wait for user response (see UIRESUME)
% uiwait(handles.figure1);
@@ -153,22 +158,22 @@
% Disable the update ensemble button and all other active buttons
set(handles.pushbutton_update_ens, 'Enable', 'Off');
-set(handles.edit_observation, 'Enable', 'Off');
-set(handles.edit_obs_error_sd, 'Enable', 'Off');
-set(handles.edit_inflation, 'Enable', 'Off');
+set(handles.edit_observation, 'Enable', 'Off');
+set(handles.edit_obs_error_sd, 'Enable', 'Off');
+set(handles.edit_inflation, 'Enable', 'Off');
% Clear out any old ensemble members if they exist
-set(handles.h_ens_member, 'Visible', 'off');
-set(handles.h_inf_ens_member, 'Visible', 'off');
+set(handles.h_ens_member, 'Visible', 'off');
+set(handles.h_inf_ens_member, 'Visible', 'off');
-set(handles.h_update_lines, 'Visible', 'off');
-set(handles.h_inf_lines, 'Visible', 'off');
-set(handles.h_inf_axis, 'Visible', 'off');
+set(handles.h_update_lines, 'Visible', 'off');
+set(handles.h_inf_lines, 'Visible', 'off');
+set(handles.h_inf_axis, 'Visible', 'off');
% Turn off any old update points
-set(handles.h_update_ens, 'Visible', 'off');
-set(handles.h_inf_up_ens, 'Visible', 'off');
-set(handles.h_inf_ens_member, 'Visible', 'off');
+set(handles.h_update_ens, 'Visible', 'off');
+set(handles.h_inf_up_ens, 'Visible', 'off');
+set(handles.h_inf_ens_member, 'Visible', 'off');
clear_labels(handles);
@@ -179,7 +184,7 @@
upper = max(handles.observation + 3*handles.obs_error_sd, max(handles.ens_members));
axis([lower upper -0.4 1]);
-set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
+set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
set(gca, 'YTickLabel', [0 0.2 0.4 0.6 0.8]);
% Messages should start 1/10 of the way across the screen
@@ -239,21 +244,21 @@
% Ensemble created, comupte mean and sd, clean up and return
% Set the global gui storage
-handles.ens_size = ens_size;
+handles.ens_size = ens_size;
handles.ens_members = x;
% Update handles structure
guidata(hObject, handles);
% Turn off the data entry messages
-set(h_click, 'Visible', 'off');
+set(h_click, 'Visible', 'off');
set(h_finish, 'Visible', 'off');
% Enable the update ensemble button
set(handles.pushbutton_update_ens, 'Enable', 'On');
-set(handles.edit_observation, 'Enable', 'On');
-set(handles.edit_obs_error_sd, 'Enable', 'On');
-set(handles.edit_inflation, 'Enable', 'On');
+set(handles.edit_observation, 'Enable', 'On');
+set(handles.edit_obs_error_sd, 'Enable', 'On');
+set(handles.edit_inflation, 'Enable', 'On');
%----------------------------------------------------------------------
@@ -269,21 +274,21 @@
% str2double(get(hObject,'String')) returns contents of edit_observation as a double
% Turn off any old updated points
-set(handles.h_update_ens, 'Visible', 'off');
-set(handles.h_inf_up_ens, 'Visible', 'off');
+set(handles.h_update_ens, 'Visible', 'off');
+set(handles.h_inf_up_ens, 'Visible', 'off');
set(handles.h_inf_ens_member, 'Visible', 'off');
% Remove mean and sd of old posterior
clear_labels(handles);
% And the lines in between
-set(handles.h_update_lines, 'Visible', 'off');
-set(handles.h_inf_lines, 'Visible', 'off');
-set(handles.h_inf_axis, 'Visible', 'off');
+set(handles.h_update_lines, 'Visible', 'off');
+set(handles.h_inf_lines, 'Visible', 'off');
+set(handles.h_inf_axis, 'Visible', 'off');
% Enable things that an error might have turned off
-set(handles.edit_obs_error_sd, 'Enable', 'on')
-set(handles.edit_inflation, 'Enable', 'on')
+set(handles.edit_obs_error_sd, 'Enable', 'on')
+set(handles.edit_inflation, 'Enable', 'on')
set(handles.pushbutton_create_new, 'Enable', 'on')
% Only enable the update ensemble pushbutton if an ensemble has been created
@@ -292,14 +297,14 @@
end
% Get the value of the observation
-if(isfinite(str2double(get(hObject, 'String'))))
+if(isfinite( str2double(get(hObject, 'String'))))
observation = str2double(get(hObject, 'String'));
else
set(handles.edit_observation, 'String', '???');
% Disable other input to guarantee only one error at a time!
- set(handles.edit_obs_error_sd, 'Enable', 'off')
- set(handles.edit_inflation, 'Enable', 'off')
+ set(handles.edit_obs_error_sd, 'Enable', 'off')
+ set(handles.edit_inflation, 'Enable', 'off')
set(handles.pushbutton_create_new, 'Enable', 'off')
set(handles.pushbutton_update_ens, 'Enable', 'off')
return
@@ -322,7 +327,7 @@
upper = max(handles.observation + 3*handles.obs_error_sd, max(handles.ens_members));
axis([lower upper -0.4 1]);
-set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
+set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
set(gca, 'YTickLabel', [0 0.2 0.4 0.6 0.8]);
hold on
@@ -360,21 +365,21 @@
% str2double(get(hObject,'String')) returns contents of edit_obs_error_sd as a double
% Turn off any old updated points
-set(handles.h_update_ens, 'Visible', 'off');
-set(handles.h_inf_up_ens, 'Visible', 'off');
-set(handles.h_inf_ens_member, 'Visible', 'off');
+set(handles.h_update_ens, 'Visible', 'off');
+set(handles.h_inf_up_ens, 'Visible', 'off');
+set(handles.h_inf_ens_member, 'Visible', 'off');
% Remove mean and sd of old posterior
clear_labels(handles);
% And the lines in between
-set(handles.h_update_lines, 'Visible', 'off');
-set(handles.h_inf_lines, 'Visible', 'off');
-set(handles.h_inf_axis, 'Visible', 'off');
+set(handles.h_update_lines, 'Visible', 'off');
+set(handles.h_inf_lines, 'Visible', 'off');
+set(handles.h_inf_axis, 'Visible', 'off');
% Enable things that an error might have turned off
-set(handles.edit_observation, 'Enable', 'on')
-set(handles.edit_inflation, 'Enable', 'on')
+set(handles.edit_observation, 'Enable', 'on')
+set(handles.edit_inflation, 'Enable', 'on')
set(handles.pushbutton_create_new, 'Enable', 'on')
% Only enable the update ensemble pushbutton if an ensemble has been created
@@ -383,15 +388,15 @@
end
% Get the value of the observation
-if(isfinite(str2double(get(hObject, 'String'))) && ...
- str2double(get(hObject, 'String')) > 0)
+if(isfinite( str2double(get(hObject, 'String'))) && ...
+ str2double(get(hObject, 'String')) > 0)
obs_error_sd = str2double(get(hObject, 'String'));
else
set(handles.edit_obs_error_sd, 'String', '???');
% Disable other input to guarantee only one error at a time!
- set(handles.edit_observation, 'Enable', 'off')
- set(handles.edit_inflation, 'Enable', 'off')
+ set(handles.edit_observation, 'Enable', 'off')
+ set(handles.edit_inflation, 'Enable', 'off')
set(handles.pushbutton_create_new, 'Enable', 'off')
set(handles.pushbutton_update_ens, 'Enable', 'off')
return
@@ -412,7 +417,7 @@
set(handles.h_obs_plot, 'Color', 'r', 'Linestyle', '--', 'Linewidth', 2);
-set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
+set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
set(gca, 'YTickLabel', [0 0.2 0.4 0.6 0.8]);
hold on
@@ -477,8 +482,8 @@
% handles structure with handles and user data (see GUIDATA)
% Turn off any old points
-set(handles.h_update_ens, 'Visible', 'off');
-set(handles.h_inf_up_ens, 'Visible', 'off');
+set(handles.h_update_ens, 'Visible', 'off');
+set(handles.h_inf_up_ens, 'Visible', 'off');
set(handles.h_inf_ens_member, 'Visible', 'off');
% Remove mean and sd of old posterior
@@ -486,8 +491,8 @@
% And the lines in between
set(handles.h_update_lines, 'Visible', 'off');
-set(handles.h_inf_lines, 'Visible', 'off');
-set(handles.h_inf_axis, 'Visible', 'off');
+set(handles.h_inf_lines, 'Visible', 'off');
+set(handles.h_inf_axis, 'Visible', 'off');
ensemble = handles.ens_members;
@@ -549,8 +554,8 @@
% Update mean and sd of old posterior
inf_prior_sd = std(inf_ens(1:handles.ens_size));
-set(handles.text9, 'String', ['Inflated = ', num2str(prior_mean)]);
-set(handles.text9, 'Visible', 'on');
+set(handles.text9, 'String', ['Inflated = ', num2str(prior_mean)]);
+set(handles.text9, 'Visible', 'on');
set(handles.text10, 'String', ['Inflated = ', num2str(inf_prior_sd)]);
set(handles.text10, 'Visible', 'on');
@@ -619,17 +624,16 @@
function clear_labels(handles)
% Turns off all labels except for the prior mean and SD
-set(handles.text9, 'Visible', 'off');
+set(handles.text7, 'Visible', 'off');
+set(handles.text8, 'Visible', 'off');
+set(handles.text9, 'Visible', 'off');
set(handles.text10, 'Visible', 'off');
-set(handles.text8, 'Visible', 'off');
-set(handles.text7, 'Visible', 'off');
+set(handles.text11, 'Visible', 'off');
set(handles.text12, 'Visible', 'off');
-set(handles.text11, 'Visible', 'off');
-
function edit_inflation_Callback(hObject, eventdata, handles)
% hObject handle to edit_inflation (see GCBO)
% eventdata reserved - to be defined in a future version of MATLAB
@@ -639,21 +643,21 @@
% str2double(get(hObject,'String')) returns contents of edit_inflation as a double
% Turn off any old updated points
-set(handles.h_update_ens, 'Visible', 'off');
-set(handles.h_inf_up_ens, 'Visible', 'off');
-set(handles.h_inf_ens_member, 'Visible', 'off');
+set(handles.h_update_ens, 'Visible', 'off');
+set(handles.h_inf_up_ens, 'Visible', 'off');
+set(handles.h_inf_ens_member, 'Visible', 'off');
% Remove mean and sd of old posterior
clear_labels(handles);
% And the lines in between
-set(handles.h_update_lines, 'Visible', 'off');
-set(handles.h_inf_lines, 'Visible', 'off');
-set(handles.h_inf_axis, 'Visible', 'off');
+set(handles.h_update_lines, 'Visible', 'off');
+set(handles.h_inf_lines, 'Visible', 'off');
+set(handles.h_inf_axis, 'Visible', 'off');
% Enable things that an error might have turned off
-set(handles.edit_observation, 'Enable', 'on')
-set(handles.edit_obs_error_sd, 'Enable', 'on')
+set(handles.edit_observation, 'Enable', 'on')
+set(handles.edit_obs_error_sd, 'Enable', 'on')
set(handles.pushbutton_create_new, 'Enable', 'on')
% Only enable the update ensemble pushbutton if an ensemble has been created
@@ -662,15 +666,15 @@
end
% Get the value of the observation
-if(isfinite(str2double(get(hObject, 'String'))) && ...
- str2double(get(hObject, 'String')) > 0)
+if(isfinite( str2double(get(hObject, 'String'))) && ...
+ str2double(get(hObject, 'String')) > 0)
inflation = str2double(get(hObject, 'String'));
else
set(handles.edit_inflation, 'String', '???');
% Disable other input to guarantee only one error at a time!
- set(handles.edit_observation, 'Enable', 'off')
- set(handles.edit_obs_error_sd, 'Enable', 'off')
+ set(handles.edit_observation, 'Enable', 'off')
+ set(handles.edit_obs_error_sd, 'Enable', 'off')
set(handles.pushbutton_create_new, 'Enable', 'off')
set(handles.pushbutton_update_ens, 'Enable', 'off')
return
@@ -691,7 +695,7 @@
set(handles.h_obs_plot, 'Color', 'r', 'Linestyle', '--', 'Linewidth', 2);
-set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
+set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
set(gca, 'YTickLabel', [0 0.2 0.4 0.6 0.8]);
hold on
Modified: DART/branches/development/DART_LAB/matlab/twod_ensemble.m
===================================================================
--- DART/branches/development/DART_LAB/matlab/twod_ensemble.m 2012-04-18 17:47:16 UTC (rev 5706)
+++ DART/branches/development/DART_LAB/matlab/twod_ensemble.m 2012-04-18 20:56:45 UTC (rev 5707)
@@ -66,25 +66,26 @@
handles.output = hObject;
% Insert the ensemble structure into this
-handles.ens_size = 0;
-handles.ens_members = 0;
-handles.h_update_ens = 0;
-handles.h_ens_member = 0;
-handles.h_best_fit = 0;
+handles.ens_size = 0;
+handles.ens_members = 0;
+handles.h_update_ens = 0;
+handles.h_ens_member = 0;
+handles.h_best_fit = 0;
handles.h_marg_obs_plot = 0;
-handles.h_obs_ast = 0;
-handles.h_obs_marg = 0;
-handles.h_gui_marg = 0;
-handles.h_unobs = 0;
-handles.h_marg = 0;
-handles.h_marg_update = 0;
-handles.h_marg_inc = 0;
-handles.h_marg_state = 0;
-handles.h_state_inc = 0;
-handles.h_joint_update = 0;
-handles.h_joint_inc = 0;
-handles.h_correl = 0;
-handles.first_correl = true;
+handles.h_obs_ast = 0;
+handles.h_obs_marg = 0;
+handles.h_gui_marg = 0;
+handles.h_unobs = 0;
+handles.h_marg = 0;
+handles.h_marg_update = 0;
+handles.h_marg_inc = 0;
+handles.h_marg_state = 0;
+handles.h_state_inc = 0;
+handles.h_joint_update = 0;
+handles.h_joint_inc = 0;
+handles.h_correl = 0;
+handles.first_correl = true;
+
% Also include the subplot handles r1, r2, r3
handles.r1 = 0;
handles.r2 = 0;
@@ -94,10 +95,10 @@
guidata(hObject, handles);
% Go ahead and plot the initial observational error distribution
-h_observation = get(handles.edit1);
+h_observation = get(handles.edit1);
h_obs_error_sd = get(handles.edit2);
-observation = str2double(h_observation.String);
-obs_error_sd = str2double(h_obs_error_sd.String);
+observation = str2double(h_observation.String);
+obs_error_sd = str2double(h_obs_error_sd.String);
% Plot this on the marginal plot on the gui figure
handles.h_marg_obs_plot = plot_gaussian(observation, obs_error_sd, 1);
@@ -118,7 +119,6 @@
% Plot an axis; display is fixed from x = 0 to 10
plot([0 10], [0 0], 'k', 'LineWidth', 2);
-
% Setup the joint distribution plot plus the two marginals
figure(1)
Property changes on: DART/branches/development/adaptive_inflate
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/branches/inf_restart:4784-4812
/DART/trunk/adaptive_inflate:4680-5660
+ /DART/branches/inf_restart:4784-4812
/DART/trunk/adaptive_inflate:4680-5706
Property changes on: DART/branches/development/assim_tools/assim_tools_mod.f90
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/releases/Kodiak/assim_tools/assim_tools_mod.f90:5020-5583
/DART/trunk/assim_tools/assim_tools_mod.f90:4680-5660
+ /DART/releases/Kodiak/assim_tools/assim_tools_mod.f90:5020-5583
/DART/trunk/assim_tools/assim_tools_mod.f90:4680-5706
Property changes on: DART/branches/development/models/bgrid_solo/work
___________________________________________________________________
Added: svn:ignore
+ .cppdefs
Makefile
Property changes on: DART/branches/development/models/cam
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/branches/cam-update:4903-4923
/DART/trunk/models/cam:4680-5660
+ /DART/branches/cam-update:4903-4923
/DART/trunk/models/cam:4680-5706
Property changes on: DART/branches/development/models/lorenz_63/work
___________________________________________________________________
Added: svn:ignore
+ .cppdefs
Makefile
Property changes on: DART/branches/development/models/mpas_atm
___________________________________________________________________
Deleted: svn:mergeinfo
- /DART/trunk/models/mpas_atm:5020-5658
Property changes on: DART/branches/development/models/mpas_ocn
___________________________________________________________________
Deleted: svn:mergeinfo
- /DART/trunk/models/mpas_ocn:5020-5658
Property changes on: DART/branches/development/models/wrf/work
___________________________________________________________________
Added: svn:ignore
+ .cppdefs
Property changes on: DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/branches/mpas/obs_kind/DEFAULT_obs_kind_mod.F90:5183-5672
/DART/releases/Kodiak/obs_kind/DEFAULT_obs_kind_mod.F90:5020-5663
/DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90:4680-5662
+ /DART/branches/mpas/obs_kind/DEFAULT_obs_kind_mod.F90:5183-5672
/DART/releases/Kodiak/obs_kind/DEFAULT_obs_kind_mod.F90:5020-5663
/DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90:4680-5706
Property changes on: DART/branches/development/utilities
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/branches/close:4780-4810
/DART/trunk/utilities:4680-5660
+ /DART/branches/close:4780-4810
/DART/trunk/utilities:4680-5706
Modified: DART/branches/development/utilities/closest_member_tool.f90
===================================================================
--- DART/branches/development/utilities/closest_member_tool.f90 2012-04-18 17:47:16 UTC (rev 5706)
+++ DART/branches/development/utilities/closest_member_tool.f90 2012-04-18 20:56:45 UTC (rev 5707)
@@ -248,7 +248,7 @@
if (mean_time /= member_time) then
call print_time(mean_time, "time of ensemble mean data")
call print_time(member_time, "time of ensemble member data")
- write(msgstring, *) 'member ', i, ' has a different timestamp than mean'
+ write(msgstring, *) 'member ', ens, ' has a different timestamp than mean'
call error_handler(E_ERR,'closest_member_tool', msgstring)
endif
@@ -281,7 +281,7 @@
if (mean_time /= member_time) then
call print_time(mean_time, "time of ensemble mean data")
call print_time(member_time, "time of ensemble member data")
- write(msgstring, *) 'member ', i, ' has a different timestamp than mean'
+ write(msgstring, *) 'member ', ens, ' has a different timestamp than mean'
call error_handler(E_ERR,'closest_member_tool', msgstring)
endif
Property changes on: DART/branches/development/utilities/closest_member_tool.f90
___________________________________________________________________
Added: svn:mergeinfo
+ /DART/branches/close/closest_member_tool.f90:4780-4810
/DART/releases/Kodiak/utilities/closest_member_tool.f90:5020-5693
/DART/trunk/utilities/closest_member_tool.f90:4680-5706
From nancy at ucar.edu Wed Apr 18 16:12:05 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Wed, 18 Apr 2012 16:12:05 -0600
Subject: [Dart-dev] [5708] DART/branches/development/models/wrf: add simple
support for skipping the update of selected fields
Message-ID:
Revision: 5708
Author: nancy
Date: 2012-04-18 16:12:04 -0600 (Wed, 18 Apr 2012)
Log Message:
-----------
add simple support for skipping the update of selected fields
when copying data from dart back to the wrfinput netcdf files.
the 4th column must be *exactly* 'NO_COPY_BACK' to take effect
(upper case and all). the field values will be updated by
dart during the assimilation, but they won't be copied back
to the wrfinput file during the running of dart_to_wrf.
it will also print a line to the log saying that it's skipping
the field because of name list control.
Modified Paths:
--------------
DART/branches/development/models/wrf/WRF_DART_utilities/dart_to_wrf.f90
DART/branches/development/models/wrf/model_mod.f90
DART/branches/development/models/wrf/work/input.nml
-------------- next part --------------
Modified: DART/branches/development/models/wrf/WRF_DART_utilities/dart_to_wrf.f90
===================================================================
--- DART/branches/development/models/wrf/WRF_DART_utilities/dart_to_wrf.f90 2012-04-18 20:56:45 UTC (rev 5707)
+++ DART/branches/development/models/wrf/WRF_DART_utilities/dart_to_wrf.f90 2012-04-18 22:12:04 UTC (rev 5708)
@@ -193,6 +193,12 @@
my_field = trim(wrf_state_variables(1, my_index))
if (debug) print*, 'field: ', trim(my_field)
+ if (.not. wrf%var_update_list(my_index)) then
+ write(*,*) ''
+ write(*,*)'skipping update of ', trim(my_field), ' because of namelist control'
+ cycle
+ endif
+
! get stagger and variable size
call nc_check( nf90_inq_varid(ncid(id),wrf_state_variables(1,my_index), &
var_id), 'dart_to_wrf', &
Modified: DART/branches/development/models/wrf/model_mod.f90
===================================================================
--- DART/branches/development/models/wrf/model_mod.f90 2012-04-18 20:56:45 UTC (rev 5707)
+++ DART/branches/development/models/wrf/model_mod.f90 2012-04-18 22:12:04 UTC (rev 5708)
@@ -297,6 +297,7 @@
integer, dimension(:,:), pointer :: var_size
integer, dimension(:), pointer :: var_type
integer, dimension(:), pointer :: var_index_list
+ logical, dimension(:), pointer :: var_update_list
integer, dimension(:), pointer :: dart_kind
integer, dimension(:,:), pointer :: land
real(r8), dimension(:), pointer :: lower_bound,upper_bound
@@ -319,7 +320,7 @@
! have a single, module global error string (rather than
! replicate it in each subroutine and use up more stack space)
-character(len=129) :: errstring
+character(len=129) :: errstring, msgstring2, msgstring3
contains
@@ -337,6 +338,7 @@
integer :: ind, i, j, k, id, dart_index
integer :: my_index
integer :: var_element_list(max_state_variables)
+logical :: var_update_list(max_state_variables)
!----------------------------------------------------------------------
@@ -355,12 +357,10 @@
! Temporary warning until this namelist item is removed.
if (adv_mod_command /= '') then
- call error_handler(E_MSG, 'static_init_model:', "WARNING")
+ msgstring2 = "Set the model advance command in the &dart_to_wrf_nml namelist"
call error_handler(E_MSG, 'static_init_model:', &
- "WARNING: adv_mod_command ignored in &model_mod namelist")
- call error_handler(E_MSG, 'static_init_model:', &
- "WARNING: Set the model advance command in &dart_to_wrf_nml")
- call error_handler(E_MSG, 'static_init_model:', "WARNING")
+ "WARNING: adv_mod_command ignored in &model_mod namelist", &
+ text2=msgstring2)
endif
allocate(wrf%dom(num_domains))
@@ -369,12 +369,11 @@
if ( default_state_variables ) then
wrf_state_variables = 'NULL'
call fill_default_state_table(wrf_state_variables)
+ msgstring2 = 'Set "default_state_variables" to .false. in the namelist'
+ msgstring3 = 'to use the "wrf_state_variables" list instead.'
call error_handler(E_MSG, 'static_init_model:', &
- 'Using predefined wrf variable list for dart state vector.')
- call error_handler(E_MSG, 'static_init_model:', &
- 'Set "default_state_variables" to .false. in the namelist')
- call error_handler(E_MSG, 'static_init_model:', &
- 'to use the "wrf_state_variables" list instead.')
+ 'Using predefined wrf variable list for dart state vector.', &
+ text2=msgstring2, text3=msgstring3)
endif
@@ -418,11 +417,11 @@
elseif (vert_localization_coord == VERTISSCALEHEIGHT) then
wrf%dom(:)%localization_coord = VERTISSCALEHEIGHT
else
- write(errstring,*)'vert_localization_coord must be one of ', &
+ write(msgstring2,*)'vert_localization_coord must be one of ', &
VERTISLEVEL, VERTISPRESSURE, VERTISHEIGHT, VERTISSCALEHEIGHT
- call error_handler(E_MSG,'static_init_model', errstring, source, revision,revdate)
write(errstring,*)'vert_localization_coord is ', vert_localization_coord
- call error_handler(E_ERR,'static_init_model', errstring, source, revision,revdate)
+ call error_handler(E_ERR,'static_init_model', errstring, source, revision,revdate, &
+ text2=msgstring2)
endif
! the agreement amongst the dart/wrf users was that there was no need to
@@ -494,7 +493,7 @@
!-------------------------------------------------------
! get the number of wrf variables wanted in this domain's state
- wrf%dom(id)%number_of_wrf_variables = get_number_of_wrf_variables(id,wrf_state_variables,var_element_list)
+ wrf%dom(id)%number_of_wrf_variables = get_number_of_wrf_variables(id,wrf_state_variables,var_element_list, var_update_list)
! allocate and store the table locations of the variables valid on this domain
allocate(wrf%dom(id)%var_index_list(wrf%dom(id)%number_of_wrf_variables))
@@ -503,6 +502,10 @@
! allocation for wrf variable types
allocate(wrf%dom(id)%var_type(wrf%dom(id)%number_of_wrf_variables))
+! allocation for update/nocopyback/noupdate
+ allocate(wrf%dom(id)%var_update_list(wrf%dom(id)%number_of_wrf_variables))
+ wrf%dom(id)%var_update_list = var_update_list(1:wrf%dom(id)%number_of_wrf_variables)
+
! allocation for dart kinds
allocate(wrf%dom(id)%dart_kind(wrf%dom(id)%number_of_wrf_variables))
@@ -4990,13 +4993,12 @@
! Following changed to intent(inout) for ifc compiler;should be like this
real(r8), intent(inout) :: x(:)
-call error_handler(E_MSG,'init_conditions:', &
- 'WARNING!! WRF model has no built-in default state')
-call error_handler(E_MSG,'init_conditions:', &
- "cannot run with 'start_from_restart = .false.' ")
+msgstring2 = "cannot run with 'start_from_restart = .false.' "
+msgstring3 = 'use ensemble_init in the WRF utils dir, or use wrf_to_dart'
call error_handler(E_ERR,'init_conditions', &
- 'use ensemble_init in the WRF utils dir, or use wrf_to_dart', &
- source, revision, revdate)
+ 'WARNING!! WRF model has no built-in default state', &
+ source, revision, revdate, &
+ text2=msgstring2, text3=msgstring3)
end subroutine init_conditions
@@ -6590,12 +6592,13 @@
! Checking for exact equality on real variable types is generally a bad idea.
- if( (wrf%dom(id)%proj%hemi == 1.0_r8 .and. obslat == -90.0_r8) .or. &
- (wrf%dom(id)%proj%hemi == -1.0_r8 .and. obslat == 90.0_r8) .or. &
- (wrf%dom(id)%proj%code == PROJ_MERC .and. abs(obslat) >= 90.0_r8) ) then
+ if( (wrf%dom(id)%proj%hemi == 1.0_r8 .and. obslat < -90.0_r8) .or. &
+ (wrf%dom(id)%proj%hemi == -1.0_r8 .and. obslat > 90.0_r8) .or. &
+ (wrf%dom(id)%proj%code == PROJ_MERC .and. abs(obslat) > 90.0_r8) ) then
-!nc -- strange that there is nothing in this if-case structure
-print*, 'model_mod.f90 :: subroutine get_domain_info :: in empty if-case'
+ ! catch latitudes that are out of range - ignore them but print out a warning.
+ write(errstring, *) 'obs with latitude out of range: ', obslat
+ call error_handler(E_MSG, 'model_mod', errstring)
else
call latlon_to_ij(wrf%dom(id)%proj,min(max(obslat,-89.9999999_r8),89.9999999_r8),obslon,iloc,jloc)
@@ -7899,14 +7902,14 @@
!--------------------------------------------
!--------------------------------------------
-integer function get_number_of_wrf_variables(id, state_table, var_element_list)
+integer function get_number_of_wrf_variables(id, state_table, var_element_list, var_update_list)
integer, intent(in) :: id
character(len=*), intent(in) :: state_table(num_state_table_columns,max_state_variables)
integer, intent(out), optional :: var_element_list(max_state_variables)
+logical, intent(out), optional :: var_update_list(max_state_variables)
+
integer :: ivar, num_vars
-! was this for debugging? seems unused.
-!character(len=129) :: my_string
logical :: debug = .false.
if ( present(var_element_list) ) var_element_list = -1
@@ -7915,11 +7918,18 @@
num_vars = 0
do while ( trim(state_table(5,ivar)) /= 'NULL' )
- !my_string = state_table(5,ivar)
-
if ( variable_is_on_domain(state_table(5,ivar),id) ) then
num_vars = num_vars + 1
if ( present(var_element_list) ) var_element_list(num_vars) = ivar
+
+ if (present(var_update_list)) then
+ if (state_table(4,ivar) == 'NO_COPY_BACK') then
+ var_update_list(num_vars) = .false.
+ else
+ var_update_list(num_vars) = .true.
+ endif
+ endif
+
endif
ivar = ivar + 1
Modified: DART/branches/development/models/wrf/work/input.nml
===================================================================
--- DART/branches/development/models/wrf/work/input.nml 2012-04-18 20:56:45 UTC (rev 5707)
+++ DART/branches/development/models/wrf/work/input.nml 2012-04-18 22:12:04 UTC (rev 5708)
@@ -168,6 +168,8 @@
# otherwise it uses a hardcoded default list: U, V, W, PH, T, MU, QV only.
# see ../wrf_state_variables_table for a full list of what wrf fields are
# supported in the DART state vector, and what settings should be used here.
+# 'UPDATE' and 'NO_COPY_BACK' are supported in the 4th column; 'NO_UPDATE' is
+# not yet supported.
&model_nml
default_state_variables = .true.,
From nancy at ucar.edu Thu Apr 26 13:33:18 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Thu, 26 Apr 2012 13:33:18 -0600
Subject: [Dart-dev] [5709]
DART/trunk/observations/NCEP/ascii_to_obs/real_obs_mod.f90: bug fix from
ryan.
Message-ID:
Revision: 5709
Author: nancy
Date: 2012-04-26 13:33:18 -0600 (Thu, 26 Apr 2012)
Log Message:
-----------
bug fix from ryan. options were added to the name list
to selectively include dew point and rh obs, but the code
was still skipping them because it was missing the lines
that tested for and included them.
Modified Paths:
--------------
DART/trunk/observations/NCEP/ascii_to_obs/real_obs_mod.f90
-------------- next part --------------
Modified: DART/trunk/observations/NCEP/ascii_to_obs/real_obs_mod.f90
===================================================================
--- DART/trunk/observations/NCEP/ascii_to_obs/real_obs_mod.f90 2012-04-18 22:12:04 UTC (rev 5708)
+++ DART/trunk/observations/NCEP/ascii_to_obs/real_obs_mod.f90 2012-04-26 19:33:18 UTC (rev 5709)
@@ -286,12 +286,12 @@
if(obs_prof == 5) then
if ( zob2 == 0.0_r8 .and. inc_specific_humidity ) then
- obs_kind_gen = KIND_SPECIFIC_HUMIDITY
- if(obstype == 120 .or. obstype == 132) obs_kind = RADIOSONDE_SPECIFIC_HUMIDITY
+ obs_kind_gen = KIND_SPECIFIC_HUMIDITY
+ if(obstype == 120 .or. obstype == 132) obs_kind = RADIOSONDE_SPECIFIC_HUMIDITY
if(obstype == 130 .or. obstype == 131) obs_kind = AIRCRAFT_SPECIFIC_HUMIDITY
if(obstype == 133 ) obs_kind = ACARS_SPECIFIC_HUMIDITY
- if(obstype == 180 .or. obstype == 182) obs_kind = MARINE_SFC_SPECIFIC_HUMIDITY
- if(obstype == 181 .or. obstype == 183) obs_kind = LAND_SFC_SPECIFIC_HUMIDITY
+ if(obstype == 180 .or. obstype == 182) obs_kind = MARINE_SFC_SPECIFIC_HUMIDITY
+ if(obstype == 181 .or. obstype == 183) obs_kind = LAND_SFC_SPECIFIC_HUMIDITY
else if ( zob2 == 1.0_r8 .and. inc_relative_humidity ) then
obs_kind_gen = KIND_RELATIVE_HUMIDITY
if(obstype == 120 .or. obstype == 132) obs_kind = RADIOSONDE_RELATIVE_HUMIDITY
@@ -308,40 +308,40 @@
if(obstype == 181 .or. obstype == 183) obs_kind = LAND_SFC_DEWPOINT
endif
endif
-
+
if(obs_prof == 3) then
- obs_kind_gen = KIND_SURFACE_PRESSURE
- if(obstype == 120 ) obs_kind = RADIOSONDE_SURFACE_ALTIMETER
- if(obstype == 180 .or. obstype == 182) obs_kind = MARINE_SFC_ALTIMETER
- if(obstype == 181 ) obs_kind = LAND_SFC_ALTIMETER
+ obs_kind_gen = KIND_SURFACE_PRESSURE
+ if(obstype == 120 ) obs_kind = RADIOSONDE_SURFACE_ALTIMETER
+ if(obstype == 180 .or. obstype == 182) obs_kind = MARINE_SFC_ALTIMETER
+ if(obstype == 181 ) obs_kind = LAND_SFC_ALTIMETER
endif
if(obs_prof == 2) then
- obs_kind_gen = KIND_U_WIND_COMPONENT
- if(obstype == 220 .or. obstype == 232) obs_kind = RADIOSONDE_U_WIND_COMPONENT
- if(obstype == 221 ) obs_kind = RADIOSONDE_U_WIND_COMPONENT
- if(obstype == 230 .or. obstype == 231) obs_kind = AIRCRAFT_U_WIND_COMPONENT
- if(obstype == 233 ) obs_kind = ACARS_U_WIND_COMPONENT
- if(obstype == 242 .or. obstype == 243) obs_kind = SAT_U_WIND_COMPONENT
- if(obstype == 245 .or. obstype == 246) obs_kind = SAT_U_WIND_COMPONENT
- if(obstype == 252 .or. obstype == 253) obs_kind = SAT_U_WIND_COMPONENT
- if(obstype == 255 ) obs_kind = SAT_U_WIND_COMPONENT
- if(obstype == 280 .or. obstype == 282) obs_kind = MARINE_SFC_U_WIND_COMPONENT
- if(obstype == 281 .or. obstype == 284) obs_kind = LAND_SFC_U_WIND_COMPONENT
+ obs_kind_gen = KIND_U_WIND_COMPONENT
+ if(obstype == 220 .or. obstype == 232) obs_kind = RADIOSONDE_U_WIND_COMPONENT
+ if(obstype == 221 ) obs_kind = RADIOSONDE_U_WIND_COMPONENT
+ if(obstype == 230 .or. obstype == 231) obs_kind = AIRCRAFT_U_WIND_COMPONENT
+ if(obstype == 233 ) obs_kind = ACARS_U_WIND_COMPONENT
+ if(obstype == 242 .or. obstype == 243) obs_kind = SAT_U_WIND_COMPONENT
+ if(obstype == 245 .or. obstype == 246) obs_kind = SAT_U_WIND_COMPONENT
+ if(obstype == 252 .or. obstype == 253) obs_kind = SAT_U_WIND_COMPONENT
+ if(obstype == 255 ) obs_kind = SAT_U_WIND_COMPONENT
+ if(obstype == 280 .or. obstype == 282) obs_kind = MARINE_SFC_U_WIND_COMPONENT
+ if(obstype == 281 .or. obstype == 284) obs_kind = LAND_SFC_U_WIND_COMPONENT
endif
if(obs_prof == 9) then
- obs_kind_gen = KIND_V_WIND_COMPONENT
- if(obstype == 220 .or. obstype == 232) obs_kind = RADIOSONDE_V_WIND_COMPONENT
- if(obstype == 221 ) obs_kind = RADIOSONDE_V_WIND_COMPONENT
- if(obstype == 230 .or. obstype == 231) obs_kind = AIRCRAFT_V_WIND_COMPONENT
- if(obstype == 233 ) obs_kind = ACARS_V_WIND_COMPONENT
- if(obstype == 242 .or. obstype == 243) obs_kind = SAT_V_WIND_COMPONENT
- if(obstype == 245 .or. obstype == 246) obs_kind = SAT_V_WIND_COMPONENT
- if(obstype == 252 .or. obstype == 253) obs_kind = SAT_V_WIND_COMPONENT
- if(obstype == 255 ) obs_kind = SAT_V_WIND_COMPONENT
- if(obstype == 280 .or. obstype == 282) obs_kind = MARINE_SFC_V_WIND_COMPONENT
- if(obstype == 281 .or. obstype == 284) obs_kind = LAND_SFC_V_WIND_COMPONENT
+ obs_kind_gen = KIND_V_WIND_COMPONENT
+ if(obstype == 220 .or. obstype == 232) obs_kind = RADIOSONDE_V_WIND_COMPONENT
+ if(obstype == 221 ) obs_kind = RADIOSONDE_V_WIND_COMPONENT
+ if(obstype == 230 .or. obstype == 231) obs_kind = AIRCRAFT_V_WIND_COMPONENT
+ if(obstype == 233 ) obs_kind = ACARS_V_WIND_COMPONENT
+ if(obstype == 242 .or. obstype == 243) obs_kind = SAT_V_WIND_COMPONENT
+ if(obstype == 245 .or. obstype == 246) obs_kind = SAT_V_WIND_COMPONENT
+ if(obstype == 252 .or. obstype == 253) obs_kind = SAT_V_WIND_COMPONENT
+ if(obstype == 255 ) obs_kind = SAT_V_WIND_COMPONENT
+ if(obstype == 280 .or. obstype == 282) obs_kind = MARINE_SFC_V_WIND_COMPONENT
+ if(obstype == 281 .or. obstype == 284) obs_kind = LAND_SFC_V_WIND_COMPONENT
endif
if (obs_kind < 0) then
@@ -376,16 +376,18 @@
(SATWND .and. (subset =='SATWND')) ) then
! then select the obs kind requested
- if( (obs_T .and. (obs_kind_gen == KIND_TEMPERATURE )) .or. &
- (obs_U .and. (obs_kind_gen == KIND_U_WIND_COMPONENT )) .or. &
- (obs_V .and. (obs_kind_gen == KIND_V_WIND_COMPONENT )) .or. &
- (obs_PS .and. (obs_kind_gen == KIND_SURFACE_PRESSURE)) .or. &
- (obs_QV .and. (obs_kind_gen == KIND_SPECIFIC_HUMIDITY)) ) then
+ if( (obs_T .and. (obs_kind_gen == KIND_TEMPERATURE )) .or. &
+ (obs_U .and. (obs_kind_gen == KIND_U_WIND_COMPONENT )) .or. &
+ (obs_V .and. (obs_kind_gen == KIND_V_WIND_COMPONENT )) .or. &
+ (obs_PS .and. (obs_kind_gen == KIND_SURFACE_PRESSURE)) .or. &
+ (obs_QV .and. (obs_kind_gen == KIND_SPECIFIC_HUMIDITY)) .or. &
+ (inc_relative_humidity .and. (obs_kind_gen == KIND_RELATIVE_HUMIDITY)) .or. &
+ (inc_dewpoint .and. (obs_kind_gen == KIND_DEWPOINT)) ) then
pass = .false.
endif
endif
-
+
! if pass is still true, we want to ignore this obs.
if(pass) then
iskip(fail_notwanted) = iskip(fail_notwanted) + 1
@@ -414,7 +416,7 @@
print*, 'Max limit for observation count reached. Increase value in namelist'
stop
endif
-
+
! set vertical coordinate for upper-air observations
if (subset == 'AIRCAR' .or. subset == 'AIRCFT' .or. &
subset == 'SATWND' .or. subset == 'ADPUPA' ) then
From nancy at ucar.edu Thu Apr 26 13:38:05 2012
From: nancy at ucar.edu (nancy at ucar.edu)
Date: Thu, 26 Apr 2012 13:38:05 -0600
Subject: [Dart-dev] [5711]
DART/branches/development/observations/NCEP/ascii_to_obs/ real_obs_mod.f90:
bug fix from ryan; correctly output dew point and rh obs
Message-ID:
Revision: 5711
Author: nancy
Date: 2012-04-26 13:38:05 -0600 (Thu, 26 Apr 2012)
Log Message:
-----------
bug fix from ryan; correctly output dew point and rh obs
if selected in the name list. also fix indentation levels
with whitespace changes.
Modified Paths:
--------------
DART/branches/development/observations/NCEP/ascii_to_obs/real_obs_mod.f90
Property Changed:
----------------
DART/branches/development/observations/NCEP/ascii_to_obs/real_obs_mod.f90
-------------- next part --------------
Modified: DART/branches/development/observations/NCEP/ascii_to_obs/real_obs_mod.f90
===================================================================
--- DART/branches/development/observations/NCEP/ascii_to_obs/real_obs_mod.f90 2012-04-26 19:36:45 UTC (rev 5710)
+++ DART/branches/development/observations/NCEP/ascii_to_obs/real_obs_mod.f90 2012-04-26 19:38:05 UTC (rev 5711)
@@ -286,12 +286,12 @@
if(obs_prof == 5) then
if ( zob2 == 0.0_r8 .and. inc_specific_humidity ) then
- obs_kind_gen = KIND_SPECIFIC_HUMIDITY
- if(obstype == 120 .or. obstype == 132) obs_kind = RADIOSONDE_SPECIFIC_HUMIDITY
+ obs_kind_gen = KIND_SPECIFIC_HUMIDITY
+ if(obstype == 120 .or. obstype == 132) obs_kind = RADIOSONDE_SPECIFIC_HUMIDITY
if(obstype == 130 .or. obstype == 131) obs_kind = AIRCRAFT_SPECIFIC_HUMIDITY
if(obstype == 133 ) obs_kind = ACARS_SPECIFIC_HUMIDITY
- if(obstype == 180 .or. obstype == 182) obs_kind = MARINE_SFC_SPECIFIC_HUMIDITY
- if(obstype == 181 .or. obstype == 183) obs_kind = LAND_SFC_SPECIFIC_HUMIDITY
+ if(obstype == 180 .or. obstype == 182) obs_kind = MARINE_SFC_SPECIFIC_HUMIDITY
+ if(obstype == 181 .or. obstype == 183) obs_kind = LAND_SFC_SPECIFIC_HUMIDITY
else if ( zob2 == 1.0_r8 .and. inc_relative_humidity ) then
obs_kind_gen = KIND_RELATIVE_HUMIDITY
if(obstype == 120 .or. obstype == 132) obs_kind = RADIOSONDE_RELATIVE_HUMIDITY
@@ -308,40 +308,40 @@
if(obstype == 181 .or. obstype == 183) obs_kind = LAND_SFC_DEWPOINT
endif
endif
-
+
if(obs_prof == 3) then
- obs_kind_gen = KIND_SURFACE_PRESSURE
- if(obstype == 120 ) obs_kind = RADIOSONDE_SURFACE_ALTIMETER
- if(obstype == 180 .or. obstype == 182) obs_kind = MARINE_SFC_ALTIMETER
- if(obstype == 181 ) obs_kind = LAND_SFC_ALTIMETER
+ obs_kind_gen = KIND_SURFACE_PRESSURE
+ if(obstype == 120 ) obs_kind = RADIOSONDE_SURFACE_ALTIMETER
+ if(obstype == 180 .or. obstype == 182) obs_kind = MARINE_SFC_ALTIMETER
+ if(obstype == 181 ) obs_kind = LAND_SFC_ALTIMETER
endif
if(obs_prof == 2) then
- obs_kind_gen = KIND_U_WIND_COMPONENT
- if(obstype == 220 .or. obstype == 232) obs_kind = RADIOSONDE_U_WIND_COMPONENT
- if(obstype == 221 ) obs_kind = RADIOSONDE_U_WIND_COMPONENT
- if(obstype == 230 .or. obstype == 231) obs_kind = AIRCRAFT_U_WIND_COMPONENT
- if(obstype == 233 ) obs_kind = ACARS_U_WIND_COMPONENT
- if(obstype == 242 .or. obstype == 243) obs_kind = SAT_U_WIND_COMPONENT
- if(obstype == 245 .or. obstype == 246) obs_kind = SAT_U_WIND_COMPONENT
- if(obstype == 252 .or. obstype == 253) obs_kind = SAT_U_WIND_COMPONENT
- if(obstype == 255 ) obs_kind = SAT_U_WIND_COMPONENT
- if(obstype == 280 .or. obstype == 282) obs_kind = MARINE_SFC_U_WIND_COMPONENT
- if(obstype == 281 .or. obstype == 284) obs_kind = LAND_SFC_U_WIND_COMPONENT
+ obs_kind_gen = KIND_U_WIND_COMPONENT
+ if(obstype == 220 .or. obstype == 232) obs_kind = RADIOSONDE_U_WIND_COMPONENT
+ if(obstype == 221 ) obs_kind = RADIOSONDE_U_WIND_COMPONENT
+ if(obstype == 230 .or. obstype == 231) obs_kind = AIRCRAFT_U_WIND_COMPONENT
+ if(obstype == 233 ) obs_kind = ACARS_U_WIND_COMPONENT
+ if(obstype == 242 .or. obstype == 243) obs_kind = SAT_U_WIND_COMPONENT
+ if(obstype == 245 .or. obstype == 246) obs_kind = SAT_U_WIND_COMPONENT
+ if(obstype == 252 .or. obstype == 253) obs_kind = SAT_U_WIND_COMPONENT
+ if(obstype == 255 ) obs_kind = SAT_U_WIND_COMPONENT
+ if(obstype == 280 .or. obstype == 282) obs_kind = MARINE_SFC_U_WIND_COMPONENT
+ if(obstype == 281 .or. obstype == 284) obs_kind = LAND_SFC_U_WIND_COMPONENT
endif
if(obs_prof == 9) then
- obs_kind_gen = KIND_V_WIND_COMPONENT
- if(obstype == 220 .or. obstype == 232) obs_kind = RADIOSONDE_V_WIND_COMPONENT
- if(obstype == 221 ) obs_kind = RADIOSONDE_V_WIND_COMPONENT
- if(obstype == 230 .or. obstype == 231) obs_kind = AIRCRAFT_V_WIND_COMPONENT
- if(obstype == 233 ) obs_kind = ACARS_V_WIND_COMPONENT
- if(obstype == 242 .or. obstype == 243) obs_kind = SAT_V_WIND_COMPONENT
- if(obstype == 245 .or. obstype == 246) obs_kind = SAT_V_WIND_COMPONENT
- if(obstype == 252 .or. obstype == 253) obs_kind = SAT_V_WIND_COMPONENT
- if(obstype == 255 ) obs_kind = SAT_V_WIND_COMPONENT
- if(obstype == 280 .or. obstype == 282) obs_kind = MARINE_SFC_V_WIND_COMPONENT
- if(obstype == 281 .or. obstype == 284) obs_kind = LAND_SFC_V_WIND_COMPONENT
+ obs_kind_gen = KIND_V_WIND_COMPONENT
+ if(obstype == 220 .or. obstype == 232) obs_kind = RADIOSONDE_V_WIND_COMPONENT
+ if(obstype == 221 ) obs_kind = RADIOSONDE_V_WIND_COMPONENT
+ if(obstype == 230 .or. obstype == 231) obs_kind = AIRCRAFT_V_WIND_COMPONENT
+ if(obstype == 233 ) obs_kind = ACARS_V_WIND_COMPONENT
+ if(obstype == 242 .or. obstype == 243) obs_kind = SAT_V_WIND_COMPONENT
+ if(obstype == 245 .or. obstype == 246) obs_kind = SAT_V_WIND_COMPONENT
+ if(obstype == 252 .or. obstype == 253) obs_kind = SAT_V_WIND_COMPONENT
+ if(obstype == 255 ) obs_kind = SAT_V_WIND_COMPONENT
+ if(obstype == 280 .or. obstype == 282) obs_kind = MARINE_SFC_V_WIND_COMPONENT
+ if(obstype == 281 .or. obstype == 284) obs_kind = LAND_SFC_V_WIND_COMPONENT
endif
if (obs_kind < 0) then
@@ -376,16 +376,18 @@
(SATWND .and. (subset =='SATWND')) ) then
! then select the obs kind requested
- if( (obs_T .and. (obs_kind_gen == KIND_TEMPERATURE )) .or. &
- (obs_U .and. (obs_kind_gen == KIND_U_WIND_COMPONENT )) .or. &
- (obs_V .and. (obs_kind_gen == KIND_V_WIND_COMPONENT )) .or. &
- (obs_PS .and. (obs_kind_gen == KIND_SURFACE_PRESSURE)) .or. &
- (obs_QV .and. (obs_kind_gen == KIND_SPECIFIC_HUMIDITY)) ) then
+ if( (obs_T .and. (obs_kind_gen == KIND_TEMPERATURE )) .or. &
+ (obs_U .and. (obs_kind_gen == KIND_U_WIND_COMPONENT )) .or. &
+ (obs_V .and. (obs_kind_gen == KIND_V_WIND_COMPONENT )) .or. &
+ (obs_PS .and. (obs_kind_gen == KIND_SURFACE_PRESSURE)) .or. &
+ (obs_QV .and. (obs_kind_gen == KIND_SPECIFIC_HUMIDITY)) .or. &
+ (inc_relative_humidity .and. (obs_kind_gen == KIND_RELATIVE_HUMIDITY)) .or. &
+ (inc_dewpoint .and. (obs_kind_gen == KIND_DEWPOINT)) ) then
pass = .false.
endif
endif
-
+
! if pass is still true, we want to ignore this obs.
if(pass) then
iskip(fail_notwanted) = iskip(fail_notwanted) + 1
@@ -414,7 +416,7 @@
print*, 'Max limit for observation count reached. Increase value in namelist'
stop
endif
-
+
! set vertical coordinate for upper-air observations
if (subset == 'AIRCAR' .or. subset == 'AIRCFT' .or. &
subset == 'SATWND' .or. subset == 'ADPUPA' ) then
Property changes on: DART/branches/development/observations/NCEP/ascii_to_obs/real_obs_mod.f90
___________________________________________________________________
Added: svn:mergeinfo
+ /DART/trunk/observations/NCEP/ascii_to_obs/real_obs_mod.f90:4680-5710