[Dart-dev] [5661] DART/branches/development: Synchronizing the development branch with the trunk.
nancy at ucar.edu
nancy at ucar.edu
Fri Apr 6 15:04:53 MDT 2012
Revision: 5661
Author: thoar
Date: 2012-04-06 15:04:52 -0600 (Fri, 06 Apr 2012)
Log Message:
-----------
Synchronizing the development branch with the trunk.
All the good bits on the trunk are now also on the development branch.
Modified Paths:
--------------
DART/branches/development/location/threed_sphere/location_mod.f90
DART/branches/development/models/PBL_1d/work/path_names_create_real_network_seq
DART/branches/development/models/pe2lyr/model_mod.f90
DART/branches/development/models/wrf/WRF_BC/module_netcdf_interface.f90
Added Paths:
-----------
DART/branches/development/models/PBL_1d/create_real_network.f90
DART/branches/development/models/PBL_1d/create_real_network.nml
Removed Paths:
-------------
DART/branches/development/models/PBL_1d/create_real_network/
DART/branches/development/models/PBL_1d/create_real_network.f90
Property Changed:
----------------
DART/branches/development/
DART/branches/development/adaptive_inflate/
DART/branches/development/adaptive_inflate/adaptive_inflate_mod.f90
DART/branches/development/assim_tools/assim_tools_mod.f90
DART/branches/development/models/cam/
DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
DART/branches/development/utilities/
-------------- next part --------------
Property changes on: DART/branches/development
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/trunk:4680-5293
+ /DART/trunk:4680-5660
Property changes on: DART/branches/development/adaptive_inflate
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/branches/inf_restart:4784-4812
/DART/trunk/adaptive_inflate:4680-5372
+ /DART/branches/inf_restart:4784-4812
/DART/trunk/adaptive_inflate:4680-5660
Property changes on: DART/branches/development/adaptive_inflate/adaptive_inflate_mod.f90
___________________________________________________________________
Deleted: svn:mergeinfo
- /DART/branches/inf_restart/adaptive_inflate_mod.f90:4784-4812
/DART/trunk/adaptive_inflate/adaptive_inflate_mod.f90:4680-5630
Property changes on: DART/branches/development/assim_tools/assim_tools_mod.f90
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/releases/Kodiak/assim_tools/assim_tools_mod.f90:5020-5583
/DART/trunk/assim_tools/assim_tools_mod.f90:4680-5293
+ /DART/releases/Kodiak/assim_tools/assim_tools_mod.f90:5020-5583
/DART/trunk/assim_tools/assim_tools_mod.f90:4680-5660
Modified: DART/branches/development/location/threed_sphere/location_mod.f90
===================================================================
--- DART/branches/development/location/threed_sphere/location_mod.f90 2012-04-06 20:06:46 UTC (rev 5660)
+++ DART/branches/development/location/threed_sphere/location_mod.f90 2012-04-06 21:04:52 UTC (rev 5661)
@@ -753,7 +753,7 @@
read(*, *) location%vloc
location%vloc = 100.0 * location%vloc
else if(location%which_vert == VERTISHEIGHT ) then
- write(*, *) 'Vertical coordinate height (in gpm)'
+ write(*, *) 'Vertical coordinate height (in meters)'
read(*, *) location%vloc
else if(location%which_vert == VERTISSURFACE ) then
! most 3d sphere users want height in meters, not pressure.
Deleted: DART/branches/development/models/PBL_1d/create_real_network.f90
===================================================================
--- DART/branches/development/models/PBL_1d/create_real_network.f90 2012-04-06 20:06:46 UTC (rev 5660)
+++ DART/branches/development/models/PBL_1d/create_real_network.f90 2012-04-06 21:04:52 UTC (rev 5661)
@@ -1,380 +0,0 @@
-! DART software - Copyright 2004 - 2011 UCAR. This open source software is
-! provided by UCAR, "as is", without charge, subject to all terms of use at
-! http://www.image.ucar.edu/DAReS/DART/DART_download
-
-program create_real_network_seq
-
-! <next few lines under version control, do not edit>
-! $URL$
-! $Id$
-! $Revision$
-! $Date$
-
-! JPH
-! This code originated from create_fixed_network. It uses module_wrf to get
-! obs from smos file, with file, date, and interval controlled via the wrf1d
-! namelist. Note that an obs_def is still required to control which
-! obs are actually written out. Normally, this would be created with
-! create_obs_sequence. This would be run in place of both create_fixed_network
-! and perfect_model_obs.
-
-use types_mod, only : r8, missing_r8, missing_i, metadatalength
-use utilities_mod, only : timestamp, register_module, open_file, &
- close_file, find_namelist_in_file, &
- error_handler, check_namelist_read, &
- initialize_utilities, E_ERR
-use obs_kind_mod, only : assimilate_this_obs_kind, evaluate_this_obs_kind
-use obs_def_mod, only : obs_def_type, get_obs_def_time, set_obs_def_time,&
- get_obs_kind, get_obs_name
-use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
- get_num_obs, init_obs_sequence, get_first_obs, &
- write_obs_seq, set_copy_meta_data, &
- get_obs_def, set_obs_def, append_obs_to_seq, &
- get_next_obs, insert_obs_in_seq, init_obs, &
- assignment(=), static_init_obs_sequence, &
- get_num_copies, get_num_qc, &
- get_copy_meta_data, get_qc_meta_data, &
- set_qc_meta_data, read_obs_seq_header, &
- set_obs_values, set_qc, get_qc
-use time_manager_mod, only : time_type, operator(*), operator(+), set_time, &
- set_date, increment_time, get_time, print_time, &
- operator(==), operator(/), operator(<), operator(-)
-use model_mod, only : static_init_model, real_obs_period, start_real_obs
-use module_wrf, only : static_init_wrf, init_wrf, nt_f_smos, &
- start_year_f, start_month_f,start_day_f, &
- start_hour_f, start_minute_f, &
- start_forecast, interval_smos, &
- init_f_type, u10_init_f, v10_init_f, &
- q2_init_f, t2_init_f, forecast_length
-
-
-implicit none
-
-! version controlled file description for error handling, do not edit
-character(len=128), parameter :: &
- source = "$URL$", &
- revision = "$Revision$", &
- revdate = "$Date$"
-
-
-type(obs_sequence_type) :: seq, seq_in, seq_out
-type(obs_type) :: obs, next_obs, new_obs
-type(obs_def_type) :: obs_def
-character(len = 129) :: file_name, obs_seq_in_file_name
-logical :: is_there_one, is_this_last
-type(time_type) :: ob_time, init_time, this_time
-type(time_type) :: obs_seq_period, obs_list_period
-type(time_type),dimension(:), allocatable :: obs_list_time
-type(time_type),dimension(:), allocatable :: obs_seq_time
-type(time_type) :: start_seq_time, flen_time, end_time
-integer :: seconds, days, i, j, network_size, num_times, num_copies, num_qc
-integer :: obs_seq_file_id, iunit, io
-integer :: cnum_copies, cnum_qc, cnum_obs, cnum_max
-integer :: additional_qc, additional_copies
-integer :: last_key_used, time_step_number
-integer :: num_obs, obs_kind_ind
-real(r8) :: this_obs_val, this_qc_val
-real(r8), dimension(:), allocatable :: obs_vals, qc_vals, qc_sequence
-logical :: assimilate_this_ob, evaluate_this_ob, pre_I_format
-character(len=metadatalength) :: copy_meta_data(2), qc_meta_data, obs_seq_read_format
-integer :: wrf_rnd_seed = -1
-
-! Record the current time, date, etc. to the logfile
-call initialize_utilities('Create_real_network_seq')
-call register_module(source,revision,revdate)
-
-! The only necessary namelist variables come from the model
-
-! Call the underlying model's static initialization for calendar info
-call static_init_model()
-
-! Initialize the obs_sequence module
-call static_init_obs_sequence
-
-! fail if we are not initializing from OBS (this could be easily modified
-! to get values from WRF, and may come in handy later!
-if ( init_f_type /= 'OBS' ) then
- call error_handler(E_ERR, 'create_real_network', &
- 'CANNOT PRODUCE OBS SEQUENCE FROM WRF OUTPUT YET', source, revision, revdate)
-endif
-
-! Write the sequence to a file
-write(*, *) 'Input filename for network definition sequence (usually set_def.out )'
-read(*, *) file_name
-call read_obs_seq(file_name, 0, 0, 0, seq_in)
-
-! Find out how many obs there are
-network_size = get_num_obs(seq_in)
-
-! Initialize the obs_type variables
-num_copies = get_num_copies(seq_in)
-num_qc = get_num_qc(seq_in)
-call init_obs(obs, num_copies, num_qc)
-call init_obs(next_obs, num_copies, num_qc)
-call init_obs(new_obs, num_copies, num_qc)
-
-! set init time and period, including increment for forecast start and
-! increment to the proper time of day. One might want to start the assimilation
-! later then when constrained to start the obs list.
- init_time = set_date(start_year_f, start_month_f, start_day_f, &
- start_hour_f, start_minute_f, 0)
- init_time = increment_time(init_time,start_forecast,0)
- flen_time = set_time(forecast_length,0)
- end_time = init_time + flen_time
- real_obs_period = max(real_obs_period,interval_smos)
-
- call get_time(init_time,seconds,days)
-
- start_seq_time = increment_time(init_time,start_real_obs,0)
- obs_seq_period = set_time(real_obs_period, 0)
- obs_list_period = set_time(interval_smos, 0)
-
- if ( interval_smos >= real_obs_period ) then
- num_times = (end_time - start_seq_time) / set_time(interval_smos,0) + 1
- else
- num_times = (end_time - start_seq_time) / set_time(real_obs_period,0) + 1
- endif
-
- ! time information comes from the wrf1d_namelist.input
- ! only supports regularly-repeating obs right now
- allocate(obs_seq_time(num_times))
- allocate(obs_list_time(nt_f_smos))
-
- ! associate a time with each obs in the input list
- do j = 1, nt_f_smos
- obs_list_time(j) = init_time + (j - 1) * obs_list_period
- enddo
-
- ! Initialize the output sequence
- call init_obs_sequence(seq, num_copies, &
- num_qc, network_size * num_times)
-
- ! Get the metadata (might want a call in obs_sequence to do this)
- do i = 1, num_copies
- call set_copy_meta_data(seq, i, get_copy_meta_data(seq_in, i))
- end do
- do i = 1, num_qc
- call set_qc_meta_data(seq, i, get_qc_meta_data(seq_in, i))
- end do
-
- ! while looping through the times, generate a list of obs times
- ! and qc values
- do j = 1, num_times
- write(*, *) j
- ob_time = start_seq_time + (j - 1) * obs_seq_period
- obs_seq_time(j) = ob_time
- call print_time(obs_seq_time(j))
-
- is_there_one = get_first_obs(seq_in, obs)
-
- do i = 1, network_size
- new_obs = obs
- ! Set the time
- call get_obs_def(new_obs, obs_def)
- call set_obs_def_time(obs_def, ob_time)
- call set_obs_def(new_obs, obs_def)
-
- ! Append it to the sequence
- call append_obs_to_seq(seq, new_obs)
-
- ! Find the next observation in the input set
- call get_next_obs(seq_in, obs, next_obs, is_this_last)
- if(.not. is_this_last) obs = next_obs
- end do
-
- enddo
-
-!-------------------------------------------------------------------------
-! write to a temporary file for ingestion into the next block
-file_name = 'real_obs_seq.in'
-
-call write_obs_seq(seq, file_name)
-
-! Clean up
-call timestamp(string1=source,string2=revision,string3=revdate,pos='end')
-
-!-------------------------------------------------------------------------
-! Now the part that replaces perfect_model_obs. There are some
-! assumptions in here about what type of obs we are ingesting:
-! 1. pressure and vapor pressure are used to get mixing ratio
-! 2. T and winds are in correct units (K and m/s)
-
-call init_wrf(wrf_rnd_seed)
-
-!do i = 1,num_times
-! print*,t2_init_f(i),u10_init_f(i),v10_init_f(i),q2_init_f(i)
-!enddo
-
-obs_seq_in_file_name = file_name
-
-call read_obs_seq_header(obs_seq_in_file_name, cnum_copies, cnum_qc, &
- cnum_obs, cnum_max, obs_seq_file_id, &
- obs_seq_read_format, pre_I_format, &
- close_the_file = .true.)
-
-! First two copies of output will be truth and observation;
-! Will overwrite first two existing copies in file if there are any
-! Note that truth=obs for this case of real obs
-additional_copies = 2 - cnum_copies
-if(additional_copies < 0) additional_copies = 0
-
-! currently no need for additional qc field
-additional_qc = 0
-
-! Just read in the definition part of the obs sequence; expand to include
-! observation and truth field
-call read_obs_seq(obs_seq_in_file_name, additional_copies, additional_qc, &
- 0, seq)
-
-! Initialize an obs type variable
-call init_obs(obs, cnum_copies + additional_copies, cnum_qc + additional_qc)
-
-! Need metadata for added qc field (here in case needed later)
-if(additional_qc == 1) then
- qc_meta_data = 'Quality Control'
- call set_qc_meta_data(seq, 1, qc_meta_data)
-endif
-
-time_step_number = 0
-num_qc = get_num_qc(seq)
-num_copies = get_num_copies(seq)
-num_obs = get_num_obs(seq)
-
-! init output obs sequence
-call init_obs_sequence(seq_out, num_copies, num_qc, num_obs)
-call init_obs(obs, num_copies, num_qc)
-call init_obs(next_obs, num_copies, num_qc)
-call init_obs(new_obs, num_copies, num_qc)
-
-! Need space to put in the obs_values in the sequence;
-copy_meta_data(1) = 'observations'
-copy_meta_data(2) = 'truth'
-call set_copy_meta_data(seq_out, 1, copy_meta_data(1))
-call set_copy_meta_data(seq_out, 2, copy_meta_data(2))
-do i = 1, num_qc
- call set_qc_meta_data(seq_out, i, get_qc_meta_data(seq, i))
-end do
-
-! simply look through obs one-by-one and pull from the proper vector
-allocate(obs_vals(num_copies), qc_vals(num_qc))
-allocate(qc_sequence(num_obs))
-
-is_there_one = get_first_obs(seq, obs)
-if ( is_there_one ) then
- do i = 1, num_obs
- new_obs = obs
-
- ! Set the time
- call get_obs_def(new_obs, obs_def)
- ob_time = get_obs_def_time(obs_def)
- obs_kind_ind = get_obs_kind(obs_def)
- assimilate_this_ob = assimilate_this_obs_kind(obs_kind_ind)
- evaluate_this_ob = evaluate_this_obs_kind(obs_kind_ind)
-
- this_obs_val = get_obs_from_input(ob_time,obs_kind_ind,num_times)
- this_qc_val = get_qc_from_obs(obs_kind_ind,this_obs_val)
- if ( num_qc > 0 ) then
- call get_qc(new_obs,qc_sequence(i:i),1)
- this_qc_val = max(this_qc_val,qc_sequence(i))
- endif
-
- ! for input, all copies are the same
- obs_vals = this_obs_val
- call set_obs_values(new_obs,obs_vals)
- qc_vals = this_qc_val
-
- if ( num_qc > 0 ) then
- call set_qc(new_obs,qc_vals)
- endif
-
- call set_obs_def(new_obs, obs_def)
-
- ! Append it to the sequence
- call append_obs_to_seq(seq_out, new_obs)
-
- ! Find the next observation in the input set
- call get_next_obs(seq, obs, next_obs, is_this_last)
- if(.not. is_this_last) obs = next_obs
-
- end do ! obs
-
-file_name = 'real_obs_seq.out'
-
-call write_obs_seq(seq_out, file_name)
-stop
-
-
-else
-
- print*, "could not find any obs in the input sequence"
-
-endif
-
-
-!--------------------------------------------------------------
-CONTAINS
-!--------------------------------------------------------------
-
-
-real(r8) function get_obs_from_input(ob_time,obs_kind_in,num_times)
-
-implicit none
-
-type(time_type), intent(in) :: ob_time
-integer, intent(in) :: obs_kind_in, num_times
-
-integer :: seconds, days, i
-integer :: this_time_ind
-real(r8) :: obs_val
-
-get_obs_from_input = missing_r8
-
-this_time_ind = missing_i
-do i = 1, nt_f_smos
- if ( obs_list_time(i) == ob_time ) this_time_ind = i
-enddo
-
-if ( this_time_ind == missing_i ) return
-
-select case ( trim(get_obs_name(obs_kind_in)) )
- case ('METAR_U_10_METER_WIND')
- obs_val = u10_init_f(this_time_ind)
- case ('METAR_V_10_METER_WIND')
- obs_val = v10_init_f(this_time_ind)
- case ('METAR_TEMPERATURE_2_METER')
- obs_val = t2_init_f(this_time_ind)
- case ('METAR_SPECIFIC_HUMIDITY_2_METER')
- obs_val = q2_init_f(this_time_ind)
- case default
- return
-end select
-
-get_obs_from_input = obs_val
-
-end function get_obs_from_input
-
-!--------------------------------------------------------------
-
-real(r8) function get_qc_from_obs(obs_kind_in,obs_val)
-! simple gross error check on qc
-
-implicit none
-
-integer, intent(in) :: obs_kind_in
-real(r8), intent(in) :: obs_val
-
-get_qc_from_obs = 0.0_r8
-if ( obs_val == missing_r8 ) then
- get_qc_from_obs = 9.0_r8
- return
-end if
-
-! no real qc yet
-select case ( trim(get_obs_name(obs_kind_in)) )
- case default
- return
-end select
-
-end function get_qc_from_obs
-
-end program create_real_network_seq
Copied: DART/branches/development/models/PBL_1d/create_real_network.f90 (from rev 5660, DART/trunk/models/PBL_1d/create_real_network.f90)
===================================================================
--- DART/branches/development/models/PBL_1d/create_real_network.f90 (rev 0)
+++ DART/branches/development/models/PBL_1d/create_real_network.f90 2012-04-06 21:04:52 UTC (rev 5661)
@@ -0,0 +1,375 @@
+! DART software - Copyright 2004 - 2011 UCAR. This open source software is
+! provided by UCAR, "as is", without charge, subject to all terms of use at
+! http://www.image.ucar.edu/DAReS/DART/DART_download
+
+program create_real_network_seq
+
+! <next few lines under version control, do not edit>
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
+! JPH
+! This code originated from create_fixed_network. It uses module_wrf to get
+! obs from smos file, with file, date, and interval controlled via the wrf1d
+! namelist. Note that an obs_def is still required to control which
+! obs are actually written out. Normally, this would be created with
+! create_obs_sequence. This would be run in place of both create_fixed_network
+! and perfect_model_obs.
+
+use types_mod, only : r8, missing_r8, missing_i, metadatalength
+use utilities_mod, only : timestamp, register_module, open_file, &
+ close_file, find_namelist_in_file, &
+ error_handler, check_namelist_read, &
+ initialize_utilities, E_ERR
+use obs_kind_mod, only : assimilate_this_obs_kind, evaluate_this_obs_kind
+use obs_def_mod, only : obs_def_type, get_obs_def_time, set_obs_def_time,&
+ get_obs_kind, get_obs_name
+use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
+ get_num_obs, init_obs_sequence, get_first_obs, &
+ write_obs_seq, set_copy_meta_data, &
+ get_obs_def, set_obs_def, append_obs_to_seq, &
+ get_next_obs, insert_obs_in_seq, init_obs, &
+ assignment(=), static_init_obs_sequence, &
+ get_num_copies, get_num_qc, &
+ get_copy_meta_data, get_qc_meta_data, &
+ set_qc_meta_data, read_obs_seq_header, &
+ set_obs_values, set_qc, get_qc
+use time_manager_mod, only : time_type, operator(*), operator(+), set_time, &
+ set_date, increment_time, get_time, print_time, &
+ operator(==), operator(/), operator(<), operator(-)
+use model_mod, only : static_init_model, real_obs_period, start_real_obs
+use module_wrf, only : static_init_wrf, init_wrf, nt_f_smos, &
+ start_year_f, start_month_f,start_day_f, &
+ start_hour_f, start_minute_f, &
+ start_forecast, interval_smos, &
+ init_f_type, u10_init_f, v10_init_f, &
+ q2_init_f, t2_init_f, forecast_length
+
+
+implicit none
+
+! version controlled file description for error handling, do not edit
+character(len=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
+
+
+type(obs_sequence_type) :: seq, seq_in, seq_out
+type(obs_type) :: obs, next_obs, new_obs
+type(obs_def_type) :: obs_def
+character(len = 129) :: file_name, obs_seq_in_file_name
+logical :: is_there_one, is_this_last
+type(time_type) :: ob_time, init_time, this_time
+type(time_type) :: obs_seq_period, obs_list_period
+type(time_type),dimension(:), allocatable :: obs_list_time
+type(time_type),dimension(:), allocatable :: obs_seq_time
+type(time_type) :: start_seq_time, flen_time, end_time
+integer :: seconds, days, i, j, network_size, num_times, num_copies, num_qc
+integer :: obs_seq_file_id, iunit, io
+integer :: cnum_copies, cnum_qc, cnum_obs, cnum_max
+integer :: additional_qc, additional_copies
+integer :: last_key_used, time_step_number
+integer :: num_obs, obs_kind_ind
+real(r8) :: this_obs_val, this_qc_val
+real(r8), dimension(:), allocatable :: obs_vals, qc_vals, qc_sequence
+logical :: assimilate_this_ob, evaluate_this_ob, pre_I_format
+character(len=metadatalength) :: copy_meta_data(2), qc_meta_data, obs_seq_read_format
+integer :: wrf_rnd_seed = -1
+
+! Record the current time, date, etc. to the logfile
+call initialize_utilities('Create_real_network_seq')
+call register_module(source,revision,revdate)
+
+! The only necessary namelist variables come from the model
+
+! Call the underlying model's static initialization for calendar info
+call static_init_model()
+
+! Initialize the obs_sequence module
+call static_init_obs_sequence
+
+! fail if we are not initializing from OBS (this could be easily modified
+! to get values from WRF, and may come in handy later!
+if ( init_f_type == 'WRF' ) then
+ call error_handler(E_ERR, 'create_real_network', &
+ 'CANNOT PRODUCE OBS SEQUENCE FROM WRF OUTPUT YET', source, revision, revdate)
+endif
+
+! Write the sequence to a file
+write(*, *) 'Input filename for network definition sequence (usually set_def.out )'
+read(*, *) file_name
+call read_obs_seq(file_name, 0, 0, 0, seq_in)
+
+! Find out how many obs there are
+network_size = get_num_obs(seq_in)
+
+! Initialize the obs_type variables
+num_copies = get_num_copies(seq_in)
+num_qc = get_num_qc(seq_in)
+call init_obs(obs, num_copies, num_qc)
+call init_obs(next_obs, num_copies, num_qc)
+call init_obs(new_obs, num_copies, num_qc)
+
+! set init time and period, including increment for forecast start and
+! increment to the proper time of day. One might want to start the assimilation
+! later then when constrained to start the obs list.
+ init_time = set_date(start_year_f, start_month_f, start_day_f, &
+ start_hour_f, start_minute_f, 0)
+ init_time = increment_time(init_time,start_forecast,0)
+ flen_time = set_time(forecast_length,0)
+ end_time = init_time + flen_time
+
+ call get_time(init_time,seconds,days)
+
+ start_seq_time = increment_time(init_time,start_real_obs,0)
+ obs_seq_period = set_time(real_obs_period, 0)
+ obs_list_period = set_time(interval_smos, 0)
+
+ num_times = (end_time - start_seq_time) / set_time(real_obs_period,0) + 1
+
+ ! time information comes from the wrf1d_namelist.input
+ ! only supports regularly-repeating obs right now
+ allocate(obs_seq_time(num_times))
+ allocate(obs_list_time(nt_f_smos))
+
+ ! associate a time with each obs in the input list
+ do j = 1, nt_f_smos
+ obs_list_time(j) = init_time + (j - 1) * obs_list_period
+ enddo
+
+ ! Initialize the output sequence
+ call init_obs_sequence(seq, num_copies, &
+ num_qc, network_size * num_times)
+
+ ! Get the metadata (might want a call in obs_sequence to do this)
+ do i = 1, num_copies
+ call set_copy_meta_data(seq, i, get_copy_meta_data(seq_in, i))
+ end do
+ do i = 1, num_qc
+ call set_qc_meta_data(seq, i, get_qc_meta_data(seq_in, i))
+ end do
+
+ ! while looping through the times, generate a list of obs times
+ ! and qc values
+ do j = 1, num_times
+ write(*, *) j
+ ob_time = start_seq_time + (j - 1) * obs_seq_period
+ obs_seq_time(j) = ob_time
+ call print_time(obs_seq_time(j))
+
+ is_there_one = get_first_obs(seq_in, obs)
+
+ do i = 1, network_size
+ new_obs = obs
+ ! Set the time
+ call get_obs_def(new_obs, obs_def)
+ call set_obs_def_time(obs_def, ob_time)
+ call set_obs_def(new_obs, obs_def)
+
+ ! Append it to the sequence
+ call append_obs_to_seq(seq, new_obs)
+
+ ! Find the next observation in the input set
+ call get_next_obs(seq_in, obs, next_obs, is_this_last)
+ if(.not. is_this_last) obs = next_obs
+ end do
+
+ enddo
+
+!-------------------------------------------------------------------------
+! write to a temporary file for ingestion into the next block
+file_name = 'real_obs_seq.in'
+
+call write_obs_seq(seq, file_name)
+
+! Clean up
+call timestamp(string1=source,string2=revision,string3=revdate,pos='end')
+
+!-------------------------------------------------------------------------
+! Now the part that replaces perfect_model_obs. There are some
+! assumptions in here about what type of obs we are ingesting:
+! 1. pressure and vapor pressure are used to get mixing ratio
+! 2. T and winds are in correct units (K and m/s)
+
+call init_wrf(wrf_rnd_seed)
+
+!do i = 1,num_times
+! print*,t2_init_f(i),u10_init_f(i),v10_init_f(i),q2_init_f(i)
+!enddo
+
+obs_seq_in_file_name = file_name
+
+call read_obs_seq_header(obs_seq_in_file_name, cnum_copies, cnum_qc, &
+ cnum_obs, cnum_max, obs_seq_file_id, &
+ obs_seq_read_format, pre_I_format, &
+ close_the_file = .true.)
+
+! First two copies of output will be truth and observation;
+! Will overwrite first two existing copies in file if there are any
+! Note that truth=obs for this case of real obs
+additional_copies = 2 - cnum_copies
+if(additional_copies < 0) additional_copies = 0
+
+! currently no need for additional qc field
+additional_qc = 0
+
+! Just read in the definition part of the obs sequence; expand to include
+! observation and truth field
+call read_obs_seq(obs_seq_in_file_name, additional_copies, additional_qc, &
+ 0, seq)
+
+! Initialize an obs type variable
+call init_obs(obs, cnum_copies + additional_copies, cnum_qc + additional_qc)
+
+! Need metadata for added qc field (here in case needed later)
+if(additional_qc == 1) then
+ qc_meta_data = 'Quality Control'
+ call set_qc_meta_data(seq, 1, qc_meta_data)
+endif
+
+time_step_number = 0
+num_qc = get_num_qc(seq)
+num_copies = get_num_copies(seq)
+num_obs = get_num_obs(seq)
+
+! init output obs sequence
+call init_obs_sequence(seq_out, num_copies, num_qc, num_obs)
+call init_obs(obs, num_copies, num_qc)
+call init_obs(next_obs, num_copies, num_qc)
+call init_obs(new_obs, num_copies, num_qc)
+
+! Need space to put in the obs_values in the sequence;
+copy_meta_data(1) = 'observations'
+copy_meta_data(2) = 'truth'
+call set_copy_meta_data(seq_out, 1, copy_meta_data(1))
+call set_copy_meta_data(seq_out, 2, copy_meta_data(2))
+do i = 1, num_qc
+ call set_qc_meta_data(seq_out, i, get_qc_meta_data(seq, i))
+end do
+
+! simply look through obs one-by-one and pull from the proper vector
+allocate(obs_vals(num_copies), qc_vals(num_qc))
+allocate(qc_sequence(num_obs))
+
+is_there_one = get_first_obs(seq, obs)
+if ( is_there_one ) then
+ do i = 1, num_obs
+ new_obs = obs
+
+ ! Set the time
+ call get_obs_def(new_obs, obs_def)
+ ob_time = get_obs_def_time(obs_def)
+ obs_kind_ind = get_obs_kind(obs_def)
+ assimilate_this_ob = assimilate_this_obs_kind(obs_kind_ind)
+ evaluate_this_ob = evaluate_this_obs_kind(obs_kind_ind)
+
+ this_obs_val = get_obs_from_input(ob_time,obs_kind_ind,num_times)
+ this_qc_val = get_qc_from_obs(obs_kind_ind,this_obs_val)
+ if ( num_qc > 0 ) then
+ call get_qc(new_obs,qc_sequence(i:i),1)
+ this_qc_val = max(this_qc_val,qc_sequence(i))
+ endif
+
+ ! for input, all copies are the same
+ obs_vals = this_obs_val
+ call set_obs_values(new_obs,obs_vals)
+ qc_vals = this_qc_val
+
+ if ( num_qc > 0 ) then
+ call set_qc(new_obs,qc_vals)
+ endif
+
+ call set_obs_def(new_obs, obs_def)
+
+ ! Append it to the sequence
+ call append_obs_to_seq(seq_out, new_obs)
+
+ ! Find the next observation in the input set
+ call get_next_obs(seq, obs, next_obs, is_this_last)
+ if(.not. is_this_last) obs = next_obs
+
+ end do ! obs
+
+file_name = 'real_obs_seq.out'
+
+call write_obs_seq(seq_out, file_name)
+stop
+
+
+else
+
+ print*, "could not find any obs in the input sequence"
+
+endif
+
+
+!--------------------------------------------------------------
+CONTAINS
+!--------------------------------------------------------------
+
+
+real(r8) function get_obs_from_input(ob_time,obs_kind_in,num_times)
+
+implicit none
+
+type(time_type), intent(in) :: ob_time
+integer, intent(in) :: obs_kind_in, num_times
+
+integer :: seconds, days, i
+integer :: this_time_ind
+real(r8) :: obs_val
+
+get_obs_from_input = missing_r8
+
+this_time_ind = missing_i
+do i = 1, nt_f_smos
+ if ( obs_list_time(i) == ob_time ) this_time_ind = i
+enddo
+
+if ( this_time_ind == missing_i ) return
+
+select case ( trim(get_obs_name(obs_kind_in)) )
+ case ('METAR_U_10_METER_WIND')
+ obs_val = u10_init_f(this_time_ind)
+ case ('METAR_V_10_METER_WIND')
+ obs_val = v10_init_f(this_time_ind)
+ case ('METAR_TEMPERATURE_2_METER')
+ obs_val = t2_init_f(this_time_ind)
+ case ('METAR_SPECIFIC_HUMIDITY_2_METER')
+ obs_val = q2_init_f(this_time_ind)
+ case default
+ return
+end select
+
+get_obs_from_input = obs_val
+
+end function get_obs_from_input
+
+!--------------------------------------------------------------
+
+real(r8) function get_qc_from_obs(obs_kind_in,obs_val)
+! simple gross error check on qc
+
+implicit none
+
+integer, intent(in) :: obs_kind_in
+real(r8), intent(in) :: obs_val
+
+get_qc_from_obs = 0.0_r8
+if ( obs_val == missing_r8 ) then
+ get_qc_from_obs = 9.0_r8
+ return
+end if
+
+! no real qc yet
+select case ( trim(get_obs_name(obs_kind_in)) )
+ case default
+ return
+end select
+
+end function get_qc_from_obs
+
+end program create_real_network_seq
Copied: DART/branches/development/models/PBL_1d/create_real_network.nml (from rev 5660, DART/trunk/models/PBL_1d/create_real_network.nml)
===================================================================
--- DART/branches/development/models/PBL_1d/create_real_network.nml (rev 0)
+++ DART/branches/development/models/PBL_1d/create_real_network.nml 2012-04-06 21:04:52 UTC (rev 5661)
@@ -0,0 +1,4 @@
+&create_real_network
+ seconds_start = 43200
+ obs_period = 3600 /
+
Modified: DART/branches/development/models/PBL_1d/work/path_names_create_real_network_seq
===================================================================
--- DART/branches/development/models/PBL_1d/work/path_names_create_real_network_seq 2012-04-06 20:06:46 UTC (rev 5660)
+++ DART/branches/development/models/PBL_1d/work/path_names_create_real_network_seq 2012-04-06 21:04:52 UTC (rev 5661)
@@ -3,7 +3,7 @@
obs_def/obs_def_mod.f90
assim_model/assim_model_mod.f90
models/PBL_1d/model_mod.f90
-models/PBL_1d/create_real_network/create_real_network.f90
+models/PBL_1d/create_real_network.f90
common/types_mod.f90
location/threed_sphere/location_mod.f90
random_seq/random_seq_mod.f90
Property changes on: DART/branches/development/models/cam
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/branches/cam-update:4903-4923
/DART/trunk/models/cam:4680-5372
+ /DART/branches/cam-update:4903-4923
/DART/trunk/models/cam:4680-5660
Modified: DART/branches/development/models/pe2lyr/model_mod.f90
===================================================================
--- DART/branches/development/models/pe2lyr/model_mod.f90 2012-04-06 20:06:46 UTC (rev 5660)
+++ DART/branches/development/models/pe2lyr/model_mod.f90 2012-04-06 21:04:52 UTC (rev 5661)
@@ -433,7 +433,7 @@
! order is u,v,z
if(mytype == KIND_U_WIND_COMPONENT) then
- indx = (level-1)*nlats*nlons+(lat_index-1)*nlons + lat_index
+ indx = (level-1)*nlats*nlons+(lat_index-1)*nlons + lon_index
else if(mytype == KIND_V_WIND_COMPONENT) then
indx = 2*nlats*nlons+(level-1)*nlats*nlons+(lat_index-1)*nlons + lon_index
else if(mytype == KIND_GEOPOTENTIAL_HEIGHT) then
Modified: DART/branches/development/models/wrf/WRF_BC/module_netcdf_interface.f90
===================================================================
--- DART/branches/development/models/wrf/WRF_BC/module_netcdf_interface.f90 2012-04-06 20:06:46 UTC (rev 5660)
+++ DART/branches/development/models/wrf/WRF_BC/module_netcdf_interface.f90 2012-04-06 21:04:52 UTC (rev 5661)
@@ -35,6 +35,7 @@
revision = "$Revision$", &
revdate = "$Date$"
+character(len=128) :: errstring
CONTAINS
@@ -477,6 +478,13 @@
! get the times
n_times = idims(2)
+ if (n_times > max_times) then
+ write(errstring, '(2(A,I6))') 'number of times in file ', n_times, &
+ ' is larger than allocated space ', max_times
+ call error_handler(E_ERR, 'get_times_cdf', errstring, source, revision, revdate, &
+ text2='increase max_times in [pert,update]_wrf_bc.f90 and recompile')
+ endif
+
do i=1,idims(2)
istart(1) = 1
iend(1) = idims(1)
Property changes on: DART/branches/development/obs_kind/DEFAULT_obs_kind_mod.F90
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/releases/Kodiak/obs_kind/DEFAULT_obs_kind_mod.F90:5020-5642
/DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90:4680-5293
+ /DART/releases/Kodiak/obs_kind/DEFAULT_obs_kind_mod.F90:5020-5642
/DART/trunk/obs_kind/DEFAULT_obs_kind_mod.F90:4680-5660
Property changes on: DART/branches/development/utilities
___________________________________________________________________
Modified: svn:mergeinfo
- /DART/branches/close:4780-4810
/DART/trunk/utilities:4680-5372
+ /DART/branches/close:4780-4810
/DART/trunk/utilities:4680-5660
More information about the Dart-dev
mailing list