[Dart-dev] [5683] DART/branches/development/models/template: update these files so they build by default.
nancy at ucar.edu
nancy at ucar.edu
Tue Apr 10 16:10:14 MDT 2012
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
+
+! <next few lines under version control, do not edit>
+! $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
-
-! <next few lines under version control, do not edit>
-! $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
! <edit model_to_dart_output_file in input.nml:model_to_dart_nml>
! 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
-
-# <next few lines under version control, do not edit>
-# $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
More information about the Dart-dev
mailing list