[Dart-dev] [6208] DART/branches/development/models/am2: Removed the command-line input mechanism for trans_sv_pv and trans_pv_sv
nancy at ucar.edu
nancy at ucar.edu
Fri May 31 08:39:59 MDT 2013
Revision: 6208
Author: thoar
Date: 2013-05-31 08:39:58 -0600 (Fri, 31 May 2013)
Log Message:
-----------
Removed the command-line input mechanism for trans_sv_pv and trans_pv_sv
in favor of the namelist-driven mechanism that is used by everyone else.
The command-line input was not supported by the gfortran compiler
(which precipitated the change).
The model_mod.f90 did not use the 'module_initialized' strategy,
so this is now implemented for all the public interfaces.
The test to check if the netCDF dimensions are as expected
was rewritten to be compiler-agnostic.
The coupler.res file was added as it is needed to by trans_pv_sv.f90
Modified Paths:
--------------
DART/branches/development/models/am2/model_mod.f90
DART/branches/development/models/am2/trans_pv_sv.f90
DART/branches/development/models/am2/trans_sv_pv.f90
DART/branches/development/models/am2/work/input.nml
Added Paths:
-----------
DART/branches/development/models/am2/work/coupler.res
-------------- next part --------------
Modified: DART/branches/development/models/am2/model_mod.f90
===================================================================
--- DART/branches/development/models/am2/model_mod.f90 2013-05-30 23:32:12 UTC (rev 6207)
+++ DART/branches/development/models/am2/model_mod.f90 2013-05-31 14:39:58 UTC (rev 6208)
@@ -26,7 +26,7 @@
use time_manager_mod, only : time_type, set_time, print_time, set_calendar_type, GREGORIAN
use utilities_mod, only : open_file, close_file, find_namelist_in_file, check_namelist_read, &
register_module, error_handler, file_exist, E_ERR, E_WARN, E_MSG, &
- nmlfileunit, do_output, nc_check, do_nml_file, do_nml_term
+ nmlfileunit, do_output, nc_check, do_nml_file, do_nml_term, logfileunit
use mpi_utilities_mod, only : my_task_id, task_count
use location_mod, only : location_type, get_close_maxdist_init, &
get_close_obs_init, get_close_obs, set_location, &
@@ -71,6 +71,13 @@
end_model_instance, &
read_model_init, &
write_model_init
+
+ ! version controlled file description for error handling, do not edit
+ character(len=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
+
!==============================================================================================
!
! Global declarations
@@ -90,8 +97,8 @@
!----------------------------------------------------------------------
! Namelist variables with default values follow
+ !----------------------------------------------------------------------
- !----------------------------------------------------------------------
integer, parameter :: maxnum_tracers = 10
character(len = nf90_max_name), dimension(maxnum_tracers) :: &
tracer_names = '', tracer_files = '', tracer_obs_kind_names = "", tracer_config_files = ''
@@ -121,12 +128,16 @@
model_config_file, model_restart_file, &
highest_obs_pressure_mb, highest_state_pressure_mb, max_obs_lat_degree, &
Time_step_seconds, Time_step_days
+
!----------------------------------------------------------------------
!
! Useful global storage
!
+ character(len=256) :: string1
+ logical, save :: module_initialized = .false.
type(time_type) :: Time_step_atmos
+
!
! Model top pressure is used for converting pressure thickness delp to surface pressure
! It should ideally be availible in phalf but the restart files I have don't have
@@ -169,17 +180,11 @@
!
real, dimension(:, :), allocatable :: surface_geopotential
real, dimension(:), allocatable :: ak, bk, akmid, bkmid
+
!-----------------------------------------------------------------------
- ! version controlled file description for error handling, do not edit
- character(len=128) :: version = "$Revision$"
- character(len=128) :: tag = "$Id$"
- character(len=128), parameter :: &
- source = "$URL$", &
- revision = "$Revision$", &
- revdate = "$Date$"
- !-----------------------------------------------------------------------
contains
+
! ----------------------------------------------------------------------------
!
! Public procedures
@@ -198,6 +203,12 @@
logical :: do_out
! --------------------------------------------------------------------------
+ if ( module_initialized ) return ! only need to do this once.
+
+ ! Since this routine calls other routines that could call this routine
+ ! we'll say we've been initialized pretty dang early.
+ module_initialized = .true.
+
call register_module(source, revision, revdate)
! Calendar information is not passed to the model; it must be set in the model namelist
@@ -304,7 +315,11 @@
! ----------------------------------------------------------------------------
integer function get_model_size()
+
+ if ( .not. module_initialized ) call static_init_model
+
get_model_size = model_size
+
end function get_model_size
! ----------------------------------------------------------------------------
@@ -323,15 +338,17 @@
which_vert
real(r8) :: local_lat, local_lon, vert_loc
+ if ( .not. module_initialized ) call static_init_model
- start = 1; field_number = 0; local_index = 0
+ start = 1
+ field_number = 0
+ local_index = 0
- !
! Figure out which field the index points to and the index within that field
! Walk through each field, compute its start and end point, and see if index_in
! lies between them.
! Assign the observation type while we're at it.
- !
+
do i = 1, num_2d_prog_vars
finish = start + (num_lons * num_lats) - 1
if(index_in >= start .and. index_in <= finish) then
@@ -427,6 +444,8 @@
character(len=NF90_MAX_NAME) :: str1
!-------------------------------------------------------------------------------
+ if ( .not. module_initialized ) call static_init_model
+
ierr = -1 ! assume it's not going to work
!
@@ -628,6 +647,9 @@
real, dimension(num_levels, num_lons, num_lats) :: tempField
logical, dimension(num_levels, num_lons, num_lats) :: allTrue
! --------------------
+
+ if ( .not. module_initialized ) call static_init_model
+
allTrue(:, :, :) = .true.
ierr = -1 ! Assume the worst
if ( output_state_vector ) then
@@ -699,38 +721,54 @@
! is not going to be used (the model will only be advanced as
! a separate model-specific executable), this can be a
! NULL INTERFACE.
- !
+ 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
+
+ write(string1,*)'DART should not be trying to advance AM2'
+ call error_handler(E_ERR,'adv_1step',string1,source,revision,revdate)
+
+ x(:) = MISSING_R8 ! just to satisfy compiler
+
end subroutine adv_1step
! ----------------------------------------------------------------------------
subroutine init_time(time)
- type(time_type), intent(out) :: 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.
- !
+ type(time_type), intent(out) :: time
- ! for now, just set to 0
- time = set_time(0, 0)
+ ! 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 ( .not. module_initialized ) call static_init_model
+
+ ! for now, just set to 0
+ time = set_time(0, 0)
+
end subroutine init_time
! ----------------------------------------------------------------------------
subroutine init_conditions(x)
- real(r8), intent(out) :: x(:)
- !
+ real(r8), intent(out) :: 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 ( .not. module_initialized ) call static_init_model
+ write(string1,*)'DART cannot initialize AM2'
+ call error_handler(E_ERR,'init_conditions',string1,source,revision,revdate)
+
+ x(:) = MISSING_R8 ! just to satisfy compiler
+
end subroutine init_conditions
! ----------------------------------------------------------------------------
@@ -771,7 +809,6 @@
real(kind = r8), dimension(:), &
allocatable :: theseLons, theseLats
- !
! Notes after talking to Jeff A
! We interpolate the KINDS we have: U, V, T, tracers, and PS; we also allow for surface height
! **adding in KIND_PRESSURE**
@@ -783,6 +820,8 @@
! easiest way to get around that is to interpolate in the vertical at each of the four
! corners first, then interpolate in the horizontal
+ if ( .not. module_initialized ) call static_init_model
+
! -------------------------------------------------------------
!
! Which variable are we looking for?
@@ -1052,17 +1091,17 @@
! ----------------------------------------------------------------------------
function get_model_time_step()
- type(time_type) :: 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
+ ! 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.
- ! Time_step_atmos is global static storage
- get_model_time_step = Time_step_atmos
+ if ( .not. module_initialized ) call static_init_model
+ ! Time_step_atmos is global static storage
+ get_model_time_step = Time_step_atmos
+
end function get_model_time_step
! ----------------------------------------------------------------------------
@@ -1073,6 +1112,8 @@
! 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 ( .not. module_initialized ) call static_init_model
+
! good style ... perhaps you could deallocate stuff (from static_init_model?).
! deallocate(state_loc)
@@ -1096,16 +1137,19 @@
! should be returned as .true. if the model wants to do its own
! perturbing of states.
+ if ( .not. module_initialized ) call static_init_model
- interf_provided = .false.
+ interf_provided = .false.
end subroutine pert_model_state
! ----------------------------------------------------------------------------
subroutine ens_mean_for_model(ens_mean)
- real(r8), intent(in) :: ens_mean(:)
+ real(r8), intent(in) :: ens_mean(:)
+ if ( .not. module_initialized ) call static_init_model
+
end subroutine ens_mean_for_model
! ----------------------------------------------------------------------------
@@ -1116,11 +1160,12 @@
subroutine init_model_instance(var)
type(model_type), intent(out) :: var
- !
+
! Initializes an instance of a model state variable
! In our case this means storage allocation
- !
+ if ( .not. module_initialized ) call static_init_model
+
call end_model_instance(var)
allocate(var%u (num_lons, num_lats, num_levels), &
var%v (num_lons, num_lats, num_levels), &
@@ -1136,11 +1181,12 @@
subroutine end_model_instance(var)
type(model_type), intent(inout) :: var
- !
+
! Ends an instance of a model state variable
! i.e. frees allocated storage
- !
+ if ( .not. module_initialized ) call static_init_model
+
if(associated(var%ps )) deallocate(var%ps)
if(associated(var%u )) deallocate(var%u)
if(associated(var%v )) deallocate(var%v)
@@ -1161,6 +1207,8 @@
integer :: ncfileid_t, varID
integer :: i
+ if ( .not. module_initialized ) call static_init_model
+
! Do restart file first
call nc_check(nf90_open(path = trim(rst_file_name), mode = nf90_nowrite, ncid = ncfileid), &
'read_model_init', 'opening '// trim(rst_file_name))
@@ -1205,6 +1253,8 @@
real, dimension(:, :, :), allocatable :: tempVar
+ if ( .not. module_initialized ) call static_init_model
+
allocate(tempVar(num_lons, num_lats, num_levels))
call nc_check(nf90_open(path = trim(rst_file_name), mode = nf90_write, ncid = ncfileid), &
@@ -1284,6 +1334,8 @@
real, dimension(:,:,:,:), allocatable :: tracers
integer :: i, j, k, t
+ if ( .not. module_initialized ) call static_init_model
+
if(size(state_vector) /= model_size) &
call error_handler(E_ERR, 'prog_var_to_vector', "State vector is incorrect size for model_type", &
source, revision, revdate)
@@ -1350,6 +1402,8 @@
! -----------------------------------------------
+ if ( .not. module_initialized ) call static_init_model
+
if(size(state_vector) /= model_size) &
call error_handler(E_ERR, 'prog_var_to_vector', "State vector is incorrect size for model_type", &
source, revision, revdate)
@@ -1436,9 +1490,12 @@
integer, intent(in) :: ncFileId
!
! Called by static_model_init; fills in global variables related to the coordinates
- !
+ ! DimStrings must be in this order
integer :: i, temp_size
integer, dimension(num_dims) :: dim_ids
+ character(len=5), dimension(6) :: DimStrings = &
+ (/ 'lat ', 'latu ', 'lon ', 'lonv ', 'pfull', 'phalf' /)
+ logical :: inOrder = .true.
do i = 1, num_dims
call nc_check(nf90_inq_dimid(ncfileid, trim(dim_names(i)), dim_ids(i)), &
@@ -1450,15 +1507,19 @@
end do
do i = 1, size(dim_names)
- if(all(trim(dim_names(i)) /= (/ 'lat', 'latu', 'lon', 'lonv', 'pfull', 'phalf' /)) ) &
+ if ( trim(dim_names(i)) /= trim(DimStrings(i)) ) inOrder = .false.
+ end do
+
+ if ( .not. inOrder ) then
call error_handler(E_ERR, 'read_dimension_info', &
"Mapping between dim names and variables is messed up", source, revision, revdate)
- end do
- if(dim_lens(1) /= dim_lens(2) .or. dim_lens(3) /= dim_lens(4) .or. dim_lens(5) /= dim_lens(6) - 1) &
+ endif
+
+ if(dim_lens(1) /= dim_lens(2) .or. dim_lens(3) /= dim_lens(4) .or. &
+ dim_lens(5) /= dim_lens(6) - 1) &
call error_handler(E_ERR, 'read_dimension_info', &
"Dimension sizes aren't what we expect", source, revision, revdate)
-
num_lats = dim_lens(1)
allocate(lat(num_lats), latu(num_lats))
call nc_check(nf90_get_var(ncfileid, dim_var_ids(1), lat), &
Modified: DART/branches/development/models/am2/trans_pv_sv.f90
===================================================================
--- DART/branches/development/models/am2/trans_pv_sv.f90 2013-05-30 23:32:12 UTC (rev 6207)
+++ DART/branches/development/models/am2/trans_pv_sv.f90 2013-05-31 14:39:58 UTC (rev 6208)
@@ -2,14 +2,8 @@
! provided by UCAR, "as is", without charge, subject to all terms of use at
! http://www.image.ucar.edu/DAReS/DART/DART_download
-program trans_pv_sv
+program am2_to_dart
-! <next few lines under version control, do not edit>
-! $URL$
-! $Id$
-! $Revision$
-! $Date$
-
!----------------------------------------------------------------------
! purpose: interface between AM2 and DART
!
@@ -24,64 +18,78 @@
!----------------------------------------------------------------------
use types_mod, only : r8
-use utilities_mod, only : get_unit, file_exist, &
- initialize_utilities, finalize_utilities
+use utilities_mod, only : initialize_utilities, finalize_utilities, &
+ nmlfileunit, do_nml_file, do_nml_term, &
+ find_namelist_in_file, check_namelist_read, &
+ open_file, close_file
use model_mod, only : model_type, init_model_instance, end_model_instance, &
prog_var_to_vector, read_model_init
-use assim_model_mod, only : assim_model_type, static_init_assim_model, &
- init_assim_model, get_model_size , set_model_state_vector, write_state_restart, &
- set_model_time, open_restart_read, open_restart_write, close_restart, &
- aread_state_restart
-use time_manager_mod, only : time_type, read_time, set_time, set_date
+use assim_model_mod, only : get_model_size, awrite_state_restart, &
+ open_restart_write, close_restart
+use time_manager_mod, only : time_type, set_time, set_date
implicit none
-interface
- integer function iargc()
- end function iargc
-end interface
+! version controlled file description for error handling, do not edit
+character(len=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
-!integer, external :: iargc
+!-----------------------------------------------------------------------
+! namelist parameters with default values.
+!-----------------------------------------------------------------------
-character (len = 128) :: dartSVout, RstFileIn, TrcFileIn
-character (len = 256) :: string1, string2
+character(len=128) :: restart_file = 'fv_rst.res.nc'
+character(len=128) :: tracer_file = 'atmos_tracers.res.nc'
+character(len=128) :: am2_to_dart_output_file = 'dart_ics'
+namelist /am2_to_dart_nml/ restart_file, tracer_file, am2_to_dart_output_file
+
!----------------------------------------------------------------------
+! global storage
+!----------------------------------------------------------------------
-! Temporary allocatable storage to read in a native format for cam state
-type(assim_model_type) :: x
+character(len=256) :: string1
type(model_type) :: var
-type(time_type) :: model_time, adv_to_time
-real(r8), allocatable :: x_state(:)
-integer :: file_unit, x_size, big_cld_iw, small_trcs
+type(time_type) :: model_time
+real(r8), allocatable :: statevector(:)
+integer :: iunit, io, x_size, big_cld_iw, small_trcs
integer :: year, month, day, hour, minute, second
-logical :: do_output = .false.
-if(iargc() == 0) stop "You must specify State Vector and input AM2 files"
-call getarg(1, dartSVout)
-call getarg(2, RstFileIn)
-call getarg(3, TrcFileIn)
+!if(iargc() == 0) stop "You must specify State Vector and input AM2 files"
+!call getarg(1, am2_to_dart_output_file)
+!call getarg(2, restart_file)
+!call getarg(3, tracer_file)
-call initialize_utilities('Trans_pv_sv')
+call initialize_utilities('am2_to_dart')
-if(file_exist('element1')) do_output = .true.
+! Read the namelist entry
+call find_namelist_in_file("input.nml", "am2_to_dart_nml", iunit)
+read(iunit, nml = am2_to_dart_nml, iostat = io)
+call check_namelist_read(iunit, io, "am2_to_dart_nml")
-! Static init assim model calls static_init_model
-! which now (merge/MPI) calls read_model_init)
-call static_init_assim_model()
+! Record the namelist values
+if (do_nml_file()) write(nmlfileunit, nml=am2_to_dart_nml)
+if (do_nml_term()) write( * , nml=am2_to_dart_nml)
-! Initialize the assim_model instance
-call init_assim_model(x)
+write(*,*)
+write(*,'(''am2_to_dart:converting am2 restart file '',A, &
+ &'' to DART file '',A)') &
+ trim(restart_file), trim(am2_to_dart_output_file)
-! Allocate the local state vector
+!----------------------------------------------------------------------
+! Get to work
+!----------------------------------------------------------------------
+
x_size = get_model_size()
-allocate(x_state(x_size))
+allocate(statevector(x_size))
! Allocate the instance of the AM2 model type for storage
call init_model_instance(var)
! Read the file AM2 state fragments into var, but not time
-call read_model_init(RstFileIn, TrcFileIn, var)
+call read_model_init(restart_file, tracer_file, var)
! Ensure that all tracers that are <=1e-10 get set to zero.
! Further, ensure that CF is <=1 and exit if CLW or CIW are >1e-1
@@ -98,34 +106,31 @@
!where(var%tracers(:,:,:,3) > 1) var%tracers(:,:,:,3) = 1
! transform fields into state vector for DART
-call prog_var_to_vector(var, x_state)
-
+call prog_var_to_vector(var, statevector)
call end_model_instance(var)
-! Put this in the structure
-call set_model_state_vector(x, x_state)
-
! Get current model time from line 3 of coupler.res
-open(50, file = 'coupler.res',form = 'formatted', action = 'read')
-read(50,*) string1
-!print*, string1
-read(50,*) string2
-!print*, string2
-read(50,*) year, month, day, hour, minute, second
-close(50)
+iunit = open_file('coupler.res',form = 'formatted', action = 'read')
+read(iunit,*) string1
+read(iunit,*) string1
+read(iunit,*) year, month, day, hour, minute, second
+call close_file(iunit)
! Set model_time
model_time = set_date(year, month, day, hour, minute, second)
-call set_model_time(x, model_time)
-!call close_restart(file_unit)
-
-! Get channel for output,
! write out state vector in "proprietary" format
-file_unit = open_restart_write(dartSVout)
-call write_state_restart(x, file_unit)
-call close_restart(file_unit)
+iunit = open_restart_write(am2_to_dart_output_file)
+call awrite_state_restart(model_time, statevector, iunit)
+call close_restart(iunit)
-call finalize_utilities()
+call finalize_utilities('am2_to_dart')
-end program trans_pv_sv
+end program am2_to_dart
+
+! <next few lines under version control, do not edit>
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
Modified: DART/branches/development/models/am2/trans_sv_pv.f90
===================================================================
--- DART/branches/development/models/am2/trans_sv_pv.f90 2013-05-30 23:32:12 UTC (rev 6207)
+++ DART/branches/development/models/am2/trans_sv_pv.f90 2013-05-31 14:39:58 UTC (rev 6208)
@@ -2,14 +2,8 @@
! provided by UCAR, "as is", without charge, subject to all terms of use at
! http://www.image.ucar.edu/DAReS/DART/DART_download
-program trans_sv_pv
+program dart_to_am2
-! <next few lines under version control, do not edit>
-! $URL$
-! $Id$
-! $Revision$
-! $Date$
-
!----------------------------------------------------------------------
! purpose: interface between AM2 and DART
!
@@ -25,15 +19,16 @@
!
!----------------------------------------------------------------------
-use types_mod, only : r8
-use utilities_mod, only : get_unit, file_exist, open_file, &
- initialize_utilities, finalize_utilities, check_namelist_read
-use model_mod, only : model_type, init_model_instance, write_model_init, &
- vector_to_prog_var
-use assim_model_mod, only : assim_model_type, static_init_assim_model, &
- init_assim_model, get_model_size, get_model_state_vector, read_state_restart, &
- open_restart_read, close_restart, get_model_time
-use time_manager_mod, only : time_type, read_time, get_time, operator(-)
+use types_mod, only : r8
+use utilities_mod, only : get_unit, file_exist, open_file, logfileunit, &
+ initialize_utilities, finalize_utilities, &
+ find_namelist_in_file, check_namelist_read, close_file
+use model_mod, only : model_type, static_init_model, init_model_instance, &
+ write_model_init, vector_to_prog_var
+use assim_model_mod, only : get_model_size, aread_state_restart, &
+ open_restart_read, close_restart
+use time_manager_mod, only : time_type, read_time, get_time, &
+ print_time, print_date, operator(-)
implicit none
@@ -43,24 +38,30 @@
revision = "$Revision$", &
revdate = "$Date$"
-interface
- integer function iargc()
- end function iargc
-end interface
+type(model_type) :: var
+type(time_type) :: adv_to_time, model_time, deltat
+real(r8), allocatable :: statevector(:)
+integer :: x_size, sec, day, iunit, io
-!integer, external :: iargc
+!------------------------------------------------------------------
+! The namelist variables
+!------------------------------------------------------------------
-type(assim_model_type) :: x
-type(model_type) :: var
-type(time_type) :: adv_to_time, curr_time, deltat
-real(r8), allocatable :: x_state(:)
-integer :: file_unit, mem_unit, x_size, sec, day, iunit, io, iunit2
-character (len = 128) :: dartSVin, RstFileOut, TrcFileOut
-logical :: do_output = .false.
+character (len = 128) :: dart_to_am2_input_file = 'dart_restart'
+character (len = 128) :: restart_file = 'fv_rst.res.nc'
+character (len = 128) :: tracer_file = 'atmos_tracers.res.nc'
+logical :: advance_time_present = .false.
+namelist /dart_to_am2_nml/ dart_to_am2_input_file, &
+ restart_file, tracer_file, &
+ advance_time_present
+
+!------------------------------------------------------------------
! Namelist coupler_nml default values
-integer :: months = 0, days = 0, hours = 0
-integer :: dt_atmos = 1800, dt_ocean = 21600, dt_cpld = 21600
+!------------------------------------------------------------------
+
+integer :: months = 0, days = 0, hours = 0
+integer :: dt_atmos = 1800, dt_ocean = 21600, dt_cpld = 21600
integer, dimension(6) :: current_date = (/2007,1,1,0,0,0/)
character (len = 8) :: calendar = "'julian'"
!character (len = 15) :: current_date = '2006,1,1,0,0,0,'
@@ -68,92 +69,92 @@
namelist /coupler_nml/ &
months, days, hours, dt_atmos, dt_ocean, dt_cpld, current_date, calendar
-call initialize_utilities('Trans_sv_pv')
+!------------------------------------------------------------------
-if(file_exist('element1')) do_output = .true.
+call initialize_utilities('dart_to_am2')
-! Static init assim model calls static_init_model
-if (do_output) then
- WRITE(*,'(////A)') '========================================================================='
- PRINT*,'static_init_assim_model in trans_sv_pv'
+call find_namelist_in_file("input.nml", "dart_to_am2_nml", iunit)
+read(iunit, nml = dart_to_am2_nml, iostat = io)
+call check_namelist_read(iunit, io, "dart_to_am2_nml")
+
+call static_init_model()
+x_size = get_model_size()
+allocate(statevector(x_size))
+
+!----------------------------------------------------------------------
+! Reads the valid time, the state, and the target time.
+!----------------------------------------------------------------------
+
+iunit = open_restart_read(dart_to_am2_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 static_init_assim_model()
-call init_assim_model(x)
+call close_restart(iunit)
-! Allocate the instance of the cam model type for storage
+!----------------------------------------------------------------------
+! Update the current AM2 restart file
+!----------------------------------------------------------------------
+
+! Allocate the instance of the am2 model type
call init_model_instance(var)
-if(iargc() == 0) stop "You must specify State Vector and output AM2 files"
-call getarg(1, dartSVin)
-call getarg(2, RstFileOut)
-call getarg(3, TrcFileOut)
+! decompose vector back into AM2 fields
+call vector_to_prog_var (statevector, var)
+deallocate (statevector)
-! FROM KEVIN'S CAM INTERFACE:
-!--------------------------------------------------------------------------------
-!if (file_exist( 'temp_ic' )) then
-! file_in = 'temp_ic'
-! file_name = 'caminput.nc'
- ! Get file for DART vector input
-! file_unit = open_restart_read(file_in)
- ! read in target time and state vector from DART and throwing away the time(s)
- ! since those are handled by trans_time.f90
-! call read_state_restart(x, file_unit, adv_to_time)
-!else if (file_exist( 'member' )) then
-! mem_unit = open_file ('member')
-! read(mem_unit,'(A)') file_in
-! read(mem_unit,'(A)') file_name
-! PRINT*,' file_in = ',file_in
-! file_unit = open_restart_read(file_in)
- ! read state vector from DART and throw away the time
-! call read_state_restart(x, file_unit)
-!endif
-!--------------------------------------------------------------------------------
+! if any of the tracer fields are negative, change them to zero
+! also, restrain CF to be between 0 and 1
+where(var%tracers < 0) var%tracers = 0
+where(var%tracers(:,:,:,3) > 1) var%tracers(:,:,:,3) = 1
-file_unit = open_restart_read(dartSVin)
-call read_state_restart(x, file_unit, adv_to_time)
-call close_restart(file_unit)
+! write fields to the netCDF initial file
+call write_model_init(restart_file, tracer_file, var)
-curr_time = get_model_time(x)
-deltat = adv_to_time - curr_time
-call get_time(deltat,sec,day)
+!----------------------------------------------------------------------
+! Write a new coupler namelist with advance-to-time if need be.
+!----------------------------------------------------------------------
-! Read append.nml's coupler_nml values
-iunit = 5
-iunit2 = 6
-open(unit=iunit,file="append.nml",action='read')
-open(unit=iunit2,file="newappend.nml",action='write')
+call print_date( model_time,'dart_to_am2: AM2 model date')
+call print_time( model_time,'dart_to_am2: DART model time')
+call print_date( model_time,'dart_to_am2: AM2 model date',logfileunit)
+call print_time( model_time,'dart_to_am2: DART model time',logfileunit)
-read(iunit, nml = coupler_nml, iostat = io)
-call check_namelist_read(iunit,io,"coupler_nml")
+if (advance_time_present) then
-! Change days and hours to advance
-days = day
-hours = sec/3600
+ deltat = adv_to_time - model_time
+ call get_time(deltat,sec,day)
-calendar = "'julian'"
+ ! Read append.nml's coupler_nml values
+ call find_namelist_in_file("append.nml","coupler_nml",iunit)
+ read(iunit, nml = coupler_nml, iostat = io)
+ call check_namelist_read(iunit, io, "coupler_nml")
-!Write newappend.nml with new days and hours variables
-write(iunit2,nml = coupler_nml, iostat = io)
-close(iunit)
-close(iunit2)
+ ! Change days and hours to advance
+ days = day
+ hours = sec/3600
-! Get the state part of the assim_model type x
-x_size = get_model_size()
-allocate(x_state(x_size))
-x_state = get_model_state_vector(x)
+ !Write newappend.nml with new days and hours variables
+ iunit = get_unit()
+ open(unit=iunit,file="newappend.nml",action='write')
+ write(iunit,nml = coupler_nml, iostat = io)
+ call close_file(iunit)
-! decompose vector back into AM2 fields
-call vector_to_prog_var (x_state, var)
-deallocate (x_state)
+ call print_time(adv_to_time,'dart_to_am2:advance_to time')
+ call print_date(adv_to_time,'dart_to_am2:advance_to date')
+ call print_time(adv_to_time,'dart_to_am2:advance_to time',logfileunit)
+ call print_date(adv_to_time,'dart_to_am2:advance_to date',logfileunit)
-! if any of the tracer fields are negative, change them to zero
-! also, restrain CF to be between 0 and 1
-where(var%tracers < 0) var%tracers = 0
-where(var%tracers(:,:,:,3) > 1) var%tracers(:,:,:,3) = 1
+endif
-! write fields to the netCDF initial file
-call write_model_init(RstFileOut, TrcFileOut, var)
+call finalize_utilities('dart_to_am2')
-call finalize_utilities()
+end program dart_to_am2
-end program trans_sv_pv
+! <next few lines under version control, do not edit>
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
Added: DART/branches/development/models/am2/work/coupler.res
===================================================================
--- DART/branches/development/models/am2/work/coupler.res (rev 0)
+++ DART/branches/development/models/am2/work/coupler.res 2013-05-31 14:39:58 UTC (rev 6208)
@@ -0,0 +1,3 @@
+ 2 (Calendar: no_calendar=0, thirty_day_months=1, julian=2, gregorian=3, noleap=4)
+ 1982 1 1 0 0 0 Model start time: year, month, day, hour, minute, second
+ 1982 1 2 0 0 0 Current model time: year, month, day, hour, minute, second
Modified: DART/branches/development/models/am2/work/input.nml
===================================================================
--- DART/branches/development/models/am2/work/input.nml 2013-05-30 23:32:12 UTC (rev 6207)
+++ DART/branches/development/models/am2/work/input.nml 2013-05-31 14:39:58 UTC (rev 6208)
@@ -19,7 +19,7 @@
output_forward_op_errors = .false.,
print_every_nth_obs = -1,
silence = .false.,
- /
+ /
&filter_nml
async = 2,
@@ -62,19 +62,20 @@
inf_lower_bound = 1.0, 1.0,
inf_upper_bound = 1000000.0, 1000000.0,
inf_sd_lower_bound = 0.0, 0.0
-/
-! ! inf_flavor is 0:none, 1:obs space, 2: varying state space, 3: fixed state_space
+ /
&smoother_nml
num_lags = 0
start_from_restart = .false.
output_restart = .false.
restart_in_file_name = 'smoother_ics'
- restart_out_file_name = 'smoother_restart' /
+ restart_out_file_name = 'smoother_restart'
+ /
&ensemble_manager_nml
single_restart_file_in = .false.,
- single_restart_file_out = .false. /
+ single_restart_file_out = .false.
+ /
&assim_tools_nml
filter_kind = 1,
@@ -85,24 +86,28 @@
adaptive_localization_threshold = -1,
output_localization_diagnostics = .false.,
localization_diagnostics_file = 'localization_diagnostics',
- print_every_nth_obs = 0 /
+ print_every_nth_obs = 0
+ /
&cov_cutoff_nml
- select_localization = 1 /
+ select_localization = 1
+ /
®_factor_nml
select_regression = 1,
input_reg_file = "time_mean_reg"
save_reg_diagnostics = .false.,
- reg_diagnostics_file = 'reg_diagnostics' /
+ reg_diagnostics_file = 'reg_diagnostics'
+ /
&obs_sequence_nml
- write_binary_obs_sequence = .false. /
+ write_binary_obs_sequence = .false.
+ /
&assim_model_nml
- write_binary_restart_files = .true.,
+ write_binary_restart_files = .false.,
netCDF_large_file_support = .true.
- /
+ /
&model_nml
model_config_file = 'fv_rst.res.nc',
@@ -125,8 +130,22 @@
highest_state_pressure_mb = 150.0,
max_obs_lat_degree = 85.0,
Time_step_seconds = 21600,
- Time_step_days = 0 /
+ Time_step_days = 0
+ /
+&am2_to_dart_nml
+ restart_file = 'fv_rst.res.nc',
+ tracer_file = 'atmos_tracers.res.nc',
+ am2_to_dart_output_file = 'dart_ics'
+ /
+
+&dart_to_am2_nml
+ dart_to_am2_input_file = 'dart_restart',
+ restart_file = 'fv_rst.res.nc',
+ tracer_file = 'atmos_tracers.res.nc',
+ advance_time_present = .false.
+ /
+
&location_nml
horiz_dist_only = .false.,
vert_normalization_pressure = 100000.0,
@@ -134,9 +153,11 @@
vert_normalization_level = 20.0,
approximate_distance = .true.,
nlon = 71,
- nlat = 36 /
+ nlat = 36
+ /
&preprocess_nml
+ overwrite_output = .true.,
input_obs_kind_mod_file = '../../../obs_kind/DEFAULT_obs_kind_mod.F90',
output_obs_kind_mod_file = '../../../obs_kind/obs_kind_mod.f90',
input_obs_def_mod_file = '../../../obs_def/DEFAULT_obs_def_mod.F90',
@@ -145,8 +166,8 @@
'../../../obs_def/obs_def_gps_mod.f90',
'../../../obs_def/obs_def_QuikSCAT_mod.f90',
'../../../obs_def/obs_def_AIRS_mod.f90',
- '../../../obs_def/obs_def_cloud_mod.f90' /
-
+ '../../../obs_def/obs_def_cloud_mod.f90'
+ /
&obs_kind_nml
assimilate_these_obs_types = 'RADIOSONDE_TEMPERATURE',
@@ -162,17 +183,18 @@
'SAT_V_WIND_COMPONENT',
'CLOUD_LIQUID_WATER',
'CLOUD_ICE',
- 'CLOUD_FRACTION' /
+ 'CLOUD_FRACTION'
+ /
! evaluate_these_obs_types = 'RADIOSONDE_SURFACE_PRESSURE' /
-
&utilities_nml
TERMLEVEL = 1,
module_details = .false.,
logfilename = 'dart_log.out',
nmlfilename = 'dart_log.nml',
- write_nml = 'file' /
+ write_nml = 'file'
+ /
&mpi_utilities_nml
/
@@ -237,7 +259,7 @@
new_advance_days = -1,
new_advance_secs = -1,
gregorian_cal = .true.
-/
+ /
# The times in the namelist for the obs_diag program are vectors
# that follow the following sequence:
@@ -266,6 +288,7 @@
latlim2 = 80.0, -20.0, 20.0, 55.0,
reg_names = 'Northern Hemisphere', 'Southern Hemisphere', 'Tropics', 'North America',
print_mismatched_locs = .false.,
- verbose = .false. /
+ verbose = .false.
+ /
More information about the Dart-dev
mailing list