[Dart-dev] [3824] DART/trunk/models/wrf: Updated to the latest version.
nancy at ucar.edu
nancy at ucar.edu
Fri Apr 17 13:08:42 MDT 2009
An HTML attachment was scrubbed...
URL: http://mailman.ucar.edu/pipermail/dart-dev/attachments/20090417/9eb5fd1b/attachment-0001.html
-------------- next part --------------
Modified: DART/trunk/models/wrf/WRF_DART_utilities/dart_to_wrf.f90
===================================================================
--- DART/trunk/models/wrf/WRF_DART_utilities/dart_to_wrf.f90 2009-04-17 18:51:39 UTC (rev 3823)
+++ DART/trunk/models/wrf/WRF_DART_utilities/dart_to_wrf.f90 2009-04-17 19:08:42 UTC (rev 3824)
@@ -11,7 +11,7 @@
! $Revision$
! $Date$
-use types_mod, only : r8
+use types_mod, only : r8, missing_r8
use time_manager_mod, only : time_type, write_time, read_time, get_date, set_date, operator(-), &
get_time, print_time, set_calendar_type, GREGORIAN, julian_day
use utilities_mod, only : get_unit, file_exist, open_file, close_file, &
@@ -23,7 +23,10 @@
awrite_state_restart
use model_mod, only : max_state_variables, &
num_state_table_columns, read_wrf_dimensions, &
+ num_bounds_table_columns, &
get_number_of_wrf_variables, &
+ get_variable_bounds, &
+ set_variable_bound_defaults, &
get_variable_size_from_file, wrf_dom, &
fill_default_state_table, &
trans_1Dto3D, trans_1Dto2D,&
@@ -47,6 +50,7 @@
logical :: output_state_vector = .false. ! state vs. prognostic format
logical :: default_state_variables = .true. ! use default state list?
character(len=129) :: wrf_state_variables(num_state_table_columns,max_state_variables) = 'NULL'
+character(len=129) :: wrf_state_bounds(num_bounds_table_columns,max_state_variables) = 'NULL'
integer :: num_moist_vars = 3
integer :: num_domains = 1
integer :: calendar_type = GREGORIAN
@@ -70,6 +74,7 @@
namelist /model_nml/ output_state_vector, num_moist_vars, &
num_domains, calendar_type, surf_obs, soil_data, h_diab, &
default_state_variables, wrf_state_variables, &
+ wrf_state_bounds, &
adv_mod_command, assimilation_period_seconds, &
allow_obs_below_vol, vert_localization_coord, &
center_search_half_length, center_spline_grid_scale, &
@@ -82,10 +87,13 @@
real(r8), pointer :: dart(:)
real(r8), pointer :: wrf_var_3d(:,:,:), wrf_var_2d(:,:)
+real(r8) :: lb, ub
type(time_type) :: dart_time(2)
integer :: number_dart_values, ndays, &
year, month, day, hour, minute, second
-integer :: ind, dart_ind, my_index
+integer :: ndims, idims(2), dimids(2)
+integer :: i, ivtype, ind, dart_ind, my_index
+character(len=80) :: varname
character(len=19) :: timestring
character(len=1) :: idom
@@ -170,6 +178,38 @@
allocate(wrf%dom(id)%var_index_list(wrf%dom(id)%number_of_wrf_variables))
wrf%dom(id)%var_index_list = var_element_list(1:wrf%dom(id)%number_of_wrf_variables)
+! allocate bounds lists and instructions
+ allocate(wrf%dom(id)%lower_bound(wrf%dom(id)%number_of_wrf_variables))
+ allocate(wrf%dom(id)%upper_bound(wrf%dom(id)%number_of_wrf_variables))
+ allocate(wrf%dom(id)%clamp_or_fail(wrf%dom(id)%number_of_wrf_variables))
+ call set_variable_bound_defaults(wrf%dom(id)%number_of_wrf_variables, &
+ wrf%dom(id)%lower_bound, &
+ wrf%dom(id)%upper_bound, &
+ wrf%dom(id)%clamp_or_fail)
+
+! assign default bounds and link the bounds to the correct variable locations
+ do ind = 1,wrf%dom(id)%number_of_wrf_variables
+
+ ! actual location in state variable table
+ my_index = wrf%dom(id)%var_index_list(ind)
+
+ call get_variable_bounds(wrf_state_bounds, &
+ wrf_state_variables(1,my_index), &
+ wrf%dom(id)%lower_bound(ind), &
+ wrf%dom(id)%upper_bound(ind), &
+ wrf%dom(id)%clamp_or_fail(ind))
+
+ if ( debug ) then
+ write(*,*) 'Bounds for variable ', &
+ trim(wrf_state_variables(1,my_index)), &
+ ' are ',wrf%dom(id)%lower_bound(ind), &
+ wrf%dom(id)%upper_bound(ind), &
+ wrf%dom(id)%clamp_or_fail(ind)
+ endif
+
+ enddo
+
+
! allocate var size
allocate(wrf%dom(id)%var_size(3,wrf%dom(id)%number_of_wrf_variables))
@@ -242,7 +282,7 @@
my_index = wrf%dom(id)%var_index_list(ind)
if ( debug ) then
- write(*,*)'Rolling up variable ',trim(wrf_state_variables(1,my_index))
+ write(*,*) 'Rolling up variable ',trim(wrf_state_variables(1,my_index))
endif
! get stagger and variable size
@@ -253,8 +293,8 @@
if ( wrf%dom(id)%var_size(3,ind) == 1 ) then
if ( debug ) then
- write(*,*)trim(wrf_state_variables(1,my_index)),' is 2D'
- write(*,*)'size ',wrf%dom(id)%var_size(:,ind)
+ write(*,*) trim(wrf_state_variables(1,my_index)),' is 2D'
+ write(*,*) 'size ',wrf%dom(id)%var_size(:,ind)
endif
allocate(wrf_var_2d(wrf%dom(id)%var_size(1,ind),wrf%dom(id)%var_size(2,ind)))
@@ -273,8 +313,8 @@
else
if ( debug ) then
- write(*,*)trim(wrf_state_variables(1,my_index)),' is 3D'
- write(*,*)'size ',wrf%dom(id)%var_size(:,ind)
+ write(*,*) trim(wrf_state_variables(1,my_index)),' is 3D'
+ write(*,*) 'size ',wrf%dom(id)%var_size(:,ind)
endif
allocate(wrf_var_3d(wrf%dom(id)%var_size(1,ind),wrf%dom(id)%var_size(2,ind),wrf%dom(id)%var_size(3,ind)))
@@ -285,29 +325,63 @@
wrf%dom(id)%var_size(1,ind), &
wrf%dom(id)%var_size(2,ind),wrf%dom(id)%var_size(3,ind))
- ! better way to set 0, or even necessary with WRF functionality?
-! trim(wrf_state_variables(1,my_index)) == 'QICE' .or. &
-! trim(wrf_state_variables(1,my_index)) == 'QSNOW' .or. &
-! trim(wrf_state_variables(1,my_index)) == 'QGRAUP' .or. &
-! trim(wrf_state_variables(1,my_index)) == 'QNDROP' .or. &
-! trim(wrf_state_variables(1,my_index)) == 'QNGRAUPEL' .or. &
-! trim(wrf_state_variables(1,my_index)) == 'QNSNOW' .or. &
-! trim(wrf_state_variables(1,my_index)) == 'QNRAIN' .or. &
-! trim(wrf_state_variables(1,my_index)) == 'QNICE' .or. &
-! trim(wrf_state_variables(1,my_index)) == 'QNICE' ) then
- if ( trim(wrf_state_variables(1,my_index)) == 'QVAPOR' .or. &
- trim(wrf_state_variables(1,my_index)) == 'QRAIN' .or. &
- trim(wrf_state_variables(1,my_index)) == 'QCLOUD' ) then
+ ! check for bounds
+ lb = wrf%dom(id)%lower_bound(my_index)
+ ub = wrf%dom(id)%upper_bound(my_index)
+ ! check bounds and fail if requested
+ if ( trim(wrf%dom(id)%clamp_or_fail(my_index)) == 'FAIL' ) then
+
+ if (minval(wrf_var_3d) < lb ) then
+ call error_handler(E_ERR,'dart_to_wrf', &
+ 'Variable '//trim(wrf_state_variables(1,my_index))// &
+ ' failed lower bounds check.', source, revision,revdate)
+ endif
+
+ if (maxval(wrf_var_3d) > ub ) then
+ call error_handler(E_ERR,'dart_to_wrf', &
+ 'Variable '//trim(wrf_state_variables(1,my_index))// &
+ ' failed upper bounds check.', source, revision,revdate)
+ endif
+
+ endif ! bounds check failure request
+
+ ! apply bounds if asked
+ if ( lb /= missing_r8 ) then
+
if ( debug ) then
- write(*,*)'Setting 0 lower bound on ', &
+ write(*,*) 'Setting lower bound ',lb,' on ', &
trim(wrf_state_variables(1,my_index))
endif
- wrf_var_3d = max(0.0_r8,wrf_var_3d)
+ wrf_var_3d = max(lb,wrf_var_3d)
+
+ endif
+ if ( ub /= missing_r8 ) then
+
+ if ( debug ) then
+ write(*,*) 'Setting upper bound ',ub,' on ', &
+ trim(wrf_state_variables(1,my_index))
+ endif
+
+ wrf_var_3d = min(ub,wrf_var_3d)
+
endif
+! if ( trim(wrf_state_variables(1,my_index)) == 'QVAPOR' .or. &
+! trim(wrf_state_variables(1,my_index)) == 'QRAIN' .or. &
+! trim(wrf_state_variables(1,my_index)) == 'QCLOUD' ) then
+!
+! if ( debug ) then
+! write(*,*) 'Setting 0 lower bound on ', &
+! trim(wrf_state_variables(1,my_index))
+! endif
+
+! wrf_var_3d = max(0.0_r8,wrf_var_3d)
+
+! endif
+
call nc_check( nf90_put_var(ncid(id), var_id, wrf_var_3d), &
'dart_to_wrf','put_var '//wrf_state_variables(1,my_index) )
Modified: DART/trunk/models/wrf/WRF_DART_utilities/wrf_to_dart.f90
===================================================================
--- DART/trunk/models/wrf/WRF_DART_utilities/wrf_to_dart.f90 2009-04-17 18:51:39 UTC (rev 3823)
+++ DART/trunk/models/wrf/WRF_DART_utilities/wrf_to_dart.f90 2009-04-17 19:08:42 UTC (rev 3824)
@@ -23,6 +23,7 @@
awrite_state_restart
use model_mod, only : max_state_variables, &
num_state_table_columns, read_wrf_dimensions, &
+ num_bounds_table_columns, &
get_number_of_wrf_variables, &
get_variable_size_from_file, wrf_dom, &
fill_default_state_table, &
@@ -47,6 +48,7 @@
logical :: output_state_vector = .false. ! state vs. prognostic format
logical :: default_state_variables = .true. ! use default state list?
character(len=129) :: wrf_state_variables(num_state_table_columns,max_state_variables) = 'NULL'
+character(len=129) :: wrf_state_bounds(num_bounds_table_columns,max_state_variables) = 'NULL'
integer :: num_moist_vars = 3
integer :: num_domains = 1
integer :: calendar_type = GREGORIAN
@@ -70,6 +72,7 @@
namelist /model_nml/ output_state_vector, num_moist_vars, &
num_domains, calendar_type, surf_obs, soil_data, h_diab, &
default_state_variables, wrf_state_variables, &
+ wrf_state_bounds, &
adv_mod_command, assimilation_period_seconds, &
allow_obs_below_vol, vert_localization_coord, &
center_search_half_length, center_spline_grid_scale, &
@@ -83,7 +86,7 @@
real(r8), pointer :: dart(:)
real(r8), allocatable :: wrf_var_3d(:,:,:), wrf_var_2d(:,:)
type(time_type) :: dart_time(2)
-integer :: number_dart_values, &
+integer :: number_dart_values, ndays, &
year, month, day, hour, minute, second
integer :: ndims, idims(2), dimids(2)
integer :: i, ivtype, ind, dart_ind, my_index
Modified: DART/trunk/models/wrf/model_mod.f90
===================================================================
--- DART/trunk/models/wrf/model_mod.f90 2009-04-17 18:51:39 UTC (rev 3823)
+++ DART/trunk/models/wrf/model_mod.f90 2009-04-17 19:08:42 UTC (rev 3824)
@@ -106,6 +106,8 @@
fill_default_state_table, &
read_wrf_dimensions, &
get_number_of_wrf_variables, &
+ get_variable_bounds, &
+ set_variable_bound_defaults, &
get_variable_size_from_file, &
trans_3Dto1D, trans_1Dto3D, &
trans_2Dto1D, trans_1Dto2D, &
@@ -113,7 +115,8 @@
! public parameters
public :: max_state_variables, &
- num_state_table_columns
+ num_state_table_columns, &
+ num_bounds_table_columns
! types
public :: wrf_dom, wrf_static_data_for_dart
@@ -129,6 +132,7 @@
! miscellaneous
integer, parameter :: max_state_variables = 100
integer, parameter :: num_state_table_columns = 5
+integer, parameter :: num_bounds_table_columns = 4
!-----------------------------------------------------------------------
! Model namelist parameters with default values.
@@ -141,6 +145,7 @@
logical :: output_state_vector = .false. ! output prognostic variables
logical :: default_state_variables = .true. ! use default state list?
character(len=129) :: wrf_state_variables(num_state_table_columns,max_state_variables) = 'NULL'
+character(len=129) :: wrf_state_bounds(num_bounds_table_columns,max_state_variables) = 'NULL'
integer :: num_moist_vars = 3
integer :: num_domains = 1
integer :: calendar_type = GREGORIAN
@@ -169,6 +174,7 @@
namelist /model_nml/ output_state_vector, num_moist_vars, &
num_domains, calendar_type, surf_obs, soil_data, h_diab, &
default_state_variables, wrf_state_variables, &
+ wrf_state_bounds, &
adv_mod_command, assimilation_period_seconds, &
allow_obs_below_vol, vert_localization_coord, &
center_search_half_length, center_spline_grid_scale, &
@@ -231,6 +237,8 @@
integer, dimension(:), pointer :: var_index_list
integer, dimension(:), pointer :: dart_kind
integer, dimension(:,:), pointer :: land
+ real(r8), dimension(:), pointer :: lower_bound,upper_bound
+ character(len=10), dimension(:),pointer :: clamp_or_fail
character(len=129),dimension(:),pointer :: description, units, stagger
integer, dimension(:,:,:,:), pointer :: dart_ind
@@ -258,9 +266,10 @@
integer :: ncid
integer :: io, iunit
+character (len=80) :: name
character (len=1) :: idom
logical, parameter :: debug = .false.
-integer :: ind, i, j, k, id, dart_index
+integer :: var_id, ind, i, j, k, id, dart_index, model_type
integer :: my_index
integer :: var_element_list(max_state_variables)
@@ -501,9 +510,8 @@
my_index = wrf%dom(id)%var_index_list(ind)
if ( debug ) then
- write(*,*)'Assigning dart vector indices for var_type ',wrf%dom(id)%var_type(ind)
- write(*,*)'affiliated with WRF variable ', &
- trim(wrf_state_variables(1,my_index)),' of size ',wrf%dom(id)%var_size(:,ind)
+ write(*,*) 'Assigning dart vector indices for var_type ',wrf%dom(id)%var_type(ind)
+ write(*,*) 'affiliated with WRF variable ',trim(wrf_state_variables(1,my_index)),' of size ',wrf%dom(id)%var_size(:,ind)
endif
wrf%dom(id)%var_index(1,ind) = dart_index
@@ -518,7 +526,7 @@
enddo
wrf%dom(id)%var_index(2,ind) = dart_index - 1
- if ( debug ) write(*,*)'assigned start, stop ',wrf%dom(id)%var_index(:,ind)
+ if ( debug ) write(*,*) 'assigned start, stop ',wrf%dom(id)%var_index(:,ind)
enddo ! loop through all viable state variables on this domain
@@ -528,7 +536,7 @@
wrf%model_size = dart_index - 1
allocate (ens_mean(wrf%model_size))
-if(debug) write(*,*)' wrf model size is ',wrf%model_size
+if(debug) write(*,*) ' wrf model size is ',wrf%model_size
end subroutine static_init_model
@@ -5872,8 +5880,8 @@
character(len=129), intent(out) :: default_table(num_state_table_columns,max_state_variables)
integer :: row
+
default_table = 'NULL'
-
row = 0
! fill default state variable table here.
@@ -5894,31 +5902,25 @@
'KIND_VERTICAL_VELOCITY', &
'TYPE_W ', &
'UPDATE ', &
- '999 '/)
+ '999 ' /)
row = row+1
+default_table(:,row) = (/ 'PH ', &
+ 'KIND_GEOPOTENTIAL_HEIGHT', &
+ 'TYPE_GZ ', &
+ 'UPDATE ', &
+ '999 ' /)
+row = row+1
default_table(:,row) = (/ 'T ', &
'KIND_POTENTIAL_TEMPERATURE', &
'TYPE_T ', &
'UPDATE ', &
- '999 '/)
+ '999 ' /)
row = row+1
-default_table(:,row) = (/ 'QVAPOR ', &
- 'KIND_VAPOR_MIXING_RATIO', &
- 'TYPE_QV ', &
- 'UPDATE ', &
- '999 '/)
-row = row+1
-default_table(:,row) = (/ 'PH ', &
- 'KIND_GEOPOTENTIAL_HEIGHT', &
- 'TYPE_GZ ', &
- 'UPDATE ', &
- '999 '/)
-row = row+1
default_table(:,row) = (/ 'MU ', &
'KIND_PRESSURE', &
'TYPE_MU ', &
'UPDATE ', &
- '999 '/)
+ '999 ' /)
return
@@ -5934,7 +5936,7 @@
integer, intent(in) :: id
character(len=129), intent(in) :: state_table(num_state_table_columns,max_state_variables)
integer, intent(out), optional :: var_element_list(max_state_variables)
-integer :: ivar, num_vars
+integer :: ivar, num_vars, domain_int, i
character(len=129) :: my_string
logical :: debug = .false.
@@ -5969,6 +5971,92 @@
!--------------------------------------------
!--------------------------------------------
+subroutine set_variable_bound_defaults(nbounds,lb,ub,instructions)
+
+ implicit none
+
+ integer, intent(in) :: nbounds
+ real(r8), dimension(nbounds), intent(out) :: lb, ub
+ character(len=10), dimension(nbounds), intent(out) :: instructions
+
+ lb(:) = missing_r8
+ ub(:) = missing_r8
+ instructions(:) = 'NULL'
+
+ return
+
+end subroutine set_variable_bound_defaults
+
+!--------------------------------------------
+!--------------------------------------------
+
+subroutine get_variable_bounds(bounds_table,wrf_var_name,lb,ub,instructions)
+
+! matches WRF variable name in bounds table to input name, and assigns
+! the bounds and instructions if they exist
+
+ implicit none
+
+ character(len=129), intent(in) :: bounds_table(num_bounds_table_columns,max_state_variables)
+ character(len=129), intent(in) :: wrf_var_name
+ real(r8), intent(out) :: lb,ub
+ character(len=10), intent(out) :: instructions
+
+ character(len=30) :: wrf_varname_trim, bounds_varname_trim
+ character(len=30) :: bound_trim
+ integer :: ivar
+ logical :: debug = .false.
+
+ wrf_varname_trim = ''
+ wrf_varname_trim = trim(wrf_var_name)
+
+ ivar = 1
+ do while ( trim(bounds_table(1,ivar)) /= 'NULL' )
+
+ bounds_varname_trim = trim(bounds_table(1,ivar))
+
+ if ( bounds_varname_trim == wrf_varname_trim ) then
+
+ bound_trim = trim(bounds_table(2,ivar))
+ if ( bound_trim /= 'NULL' ) then
+ read(bound_trim,'(d16.8)') lb
+ else
+ lb = missing_r8
+ endif
+
+ bound_trim = trim(bounds_table(3,ivar))
+ if ( bound_trim /= 'NULL' ) then
+ read(bound_trim,'(d16.8)') ub
+ else
+ ub = missing_r8
+ endif
+
+ ! instructions are required
+ instructions = trim(bounds_table(4,ivar))
+
+ if ( instructions == 'NULL' ) then
+ call error_handler(E_ERR,'get_variable_bounds','instructions for bounds on '//wrf_varname_trim//' are required',&
+ source,revision,revdate)
+ endif
+
+ endif
+
+ ivar = ivar + 1
+
+ enddo !ivar
+
+ if ( debug ) then
+ write(*,*) 'In get_variable_bounds assigned ',wrf_varname_trim
+ write(*,*) ' bounds ',lb,ub,instructions
+ endif
+
+ return
+
+end subroutine get_variable_bounds
+
+!--------------------------------------------
+!--------------------------------------------
+
logical function variable_is_on_domain(domain_id_string, id)
implicit none
@@ -6016,15 +6104,39 @@
character(len=129),intent(out) :: stagger
logical, parameter :: debug = .false.
-integer :: var_id, ndims
+integer :: var_id, ndims, dimids(10)
+integer :: idim, strlen
stagger = ''
+
+! get variable ID
call nc_check( nf90_inq_varid(ncid, trim(wrf_var_name), var_id), &
- 'get_variable_size_from_file', &
+ 'get_variable_size_from_file', &
'inq_varid '//wrf_var_name)
- call nc_check( nf90_inquire_variable(ncid, var_id,ndims=ndims), &
- 'get_variable_size_from_file', &
+
+! get number of dimensions and dimension IDs
+ call nc_check( nf90_inquire_variable(ncid, var_id,ndims=ndims, &
+ dimids=dimids), &
+ 'get_variable_size_from_file', &
'inquire_variable '//wrf_var_name)
+
+! get dimension length, ignoring first dimension (time)
+ do idim = 1,ndims-1
+ call nc_check( nf90_inquire_dimension(ncid, dimids(idim), &
+ len=var_size(idim)), &
+ 'get_variable_size_from_file', &
+ 'inquire_dimension '//wrf_var_name)
+ enddo
+
+! if a 2D variable fill the vertical dimension with 1
+ if ( ndims < 4 ) var_size(ndims) = 1
+
+ if ( debug ) then
+ print*,'In get_variable_size_from_file got variable size ',var_size
+ endif
+
+
+! get variable attribute stagger
call nc_check( nf90_get_att(ncid, var_id, 'stagger', stagger), &
'get_variable_size_from_file', &
'get_att '//wrf_var_name//' '//stagger)
@@ -6033,28 +6145,6 @@
print*,'In get_variable_size_from_file got stagger ',trim(stagger),' for variable ',trim(wrf_var_name)
endif
-! NOTE: using default to deal with empty strings - not the best solution
- select case (trim(stagger))
-! case ('') ! mass grid unstaggered vertical
-! var_size = (/we,sn,bt/)
- case ('Z') ! mass grid staggered vertical
- var_size = (/we,sn,bts/)
- case ('X') ! U grid unstaggered vertical
- var_size = (/wes,sn,bt/)
- case ('Y') ! V grid unstaggered vertical
- var_size = (/we,sns,bt/)
- case default
- if ( debug ) print*,'Defaulting to unstaggered for ',wrf_var_name
- var_size = (/we,sn,bt/)
-! print*,'Could not determine stagger or size for ',wrf_var_name
-! print*,'on domain ',id
- end select
-
-! make vertical dimension 1 if a 2D variable
- if ( ndims < 4 ) then ! looking for (time,z,y,x)
- var_size(3) = 1
- endif
-
return
end subroutine get_variable_size_from_file
@@ -6110,14 +6200,18 @@
integer :: ivar, my_index
logical :: debug = .false.
+ character(len=30) :: wrf_varname_trim, wrf_state_var_trim
get_type_ind_from_type_string = -1
do ivar = 1,wrf%dom(id)%number_of_wrf_variables
my_index = wrf%dom(id)%var_index_list(ivar)
+
+ wrf_state_var_trim = trim(wrf_state_variables(1,my_index))
+ wrf_varname_trim = trim(wrf_varname)
- if ( trim(wrf_state_variables(1,my_index)) == trim(wrf_varname) ) then
+ if ( wrf_state_var_trim == wrf_varname_trim ) then
get_type_ind_from_type_string = ivar
@@ -6125,7 +6219,7 @@
enddo ! ivar
- if ( debug ) write(*,*)'get_type_from_ind ',trim(wrf_varname),' ',get_type_ind_from_type_string
+ if ( debug ) write(*,*) 'get_type_from_ind ',trim(wrf_varname),' ',get_type_ind_from_type_string
return
More information about the Dart-dev
mailing list