[Dart-dev] [5684] DART/branches/development/models/template/model_mod_check.f90: missed this file in the last checkin.

nancy at ucar.edu nancy at ucar.edu
Tue Apr 10 16:11:43 MDT 2012


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
+
+! <next few lines under version control, do not edit>
+! $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


More information about the Dart-dev mailing list