[Dart-dev] [7149] DART/trunk/obs_sequence: Fully supporting filenames of 256 characters and message
nancy at ucar.edu
nancy at ucar.edu
Wed Aug 27 10:47:19 MDT 2014
Revision: 7149
Author: thoar
Date: 2014-08-27 10:47:19 -0600 (Wed, 27 Aug 2014)
Log Message:
-----------
Fully supporting filenames of 256 characters and message
strings of 512 characters.
Removed trailing commas from namelists.
Resolves issues DART-57 DARTSUP-55
Modified Paths:
--------------
DART/trunk/obs_sequence/create_fixed_network_seq.f90
DART/trunk/obs_sequence/create_obs_sequence.f90
DART/trunk/obs_sequence/obs_common_subset.html
DART/trunk/obs_sequence/obs_common_subset.nml
DART/trunk/obs_sequence/obs_loop.f90
DART/trunk/obs_sequence/obs_loop.nml
DART/trunk/obs_sequence/obs_selection.f90
DART/trunk/obs_sequence/obs_selection.html
DART/trunk/obs_sequence/obs_selection.nml
DART/trunk/obs_sequence/obs_seq_coverage.f90
DART/trunk/obs_sequence/obs_seq_to_netcdf.f90
DART/trunk/obs_sequence/obs_seq_to_netcdf.html
DART/trunk/obs_sequence/obs_seq_to_netcdf.nml
DART/trunk/obs_sequence/obs_seq_verify.html
DART/trunk/obs_sequence/obs_sequence_mod.f90
DART/trunk/obs_sequence/obs_sequence_mod.html
DART/trunk/obs_sequence/obs_sequence_mod.nml
-------------- next part --------------
Modified: DART/trunk/obs_sequence/create_fixed_network_seq.f90
===================================================================
--- DART/trunk/obs_sequence/create_fixed_network_seq.f90 2014-08-27 16:20:31 UTC (rev 7148)
+++ DART/trunk/obs_sequence/create_fixed_network_seq.f90 2014-08-27 16:47:19 UTC (rev 7149)
@@ -33,7 +33,7 @@
type(obs_sequence_type) :: seq, seq_in
type(obs_type) :: obs, next_obs, new_obs
type(obs_def_type) :: obs_def
-character(len=129) :: file_name
+character(len=256) :: file_name
logical :: is_there_one, is_this_last
type(time_type) :: ob_time, init_time, this_time, period
integer :: seconds, days, i, j, network_size, option, num_times, num_copies, num_qc
Modified: DART/trunk/obs_sequence/create_obs_sequence.f90
===================================================================
--- DART/trunk/obs_sequence/create_obs_sequence.f90 2014-08-27 16:20:31 UTC (rev 7148)
+++ DART/trunk/obs_sequence/create_obs_sequence.f90 2014-08-27 16:47:19 UTC (rev 7149)
@@ -21,7 +21,7 @@
character(len=128), parameter :: revdate = "$Date$"
type(obs_sequence_type) :: seq
-character(len=129) :: file_name
+character(len=256) :: file_name
! Record the current time, date, etc. to the logfile
call initialize_utilities('create_obs_sequence')
Modified: DART/trunk/obs_sequence/obs_common_subset.html
===================================================================
--- DART/trunk/obs_sequence/obs_common_subset.html 2014-08-27 16:20:31 UTC (rev 7148)
+++ DART/trunk/obs_sequence/obs_common_subset.html 2014-08-27 16:47:19 UTC (rev 7149)
@@ -99,20 +99,20 @@
with the <em class=file>ls</em> command:
</P>
<pre>
-> ls exp1/*/obs_seq.final > exp1list
-> cat exp1list
+> ls exp1/*/obs_seq.final > exp1list
+> cat exp1list
exp1/step1/obs_seq.final
exp1/step2/obs_seq.final
exp1/step3/obs_seq.final
exp1/step4/obs_seq.final
-> ls exp2/*/obs_seq.final > exp2list
-> cat exp2list
+> ls exp2/*/obs_seq.final > exp2list
+> cat exp2list
exp2/step1/obs_seq.final
exp2/step2/obs_seq.final
exp2/step3/obs_seq.final
exp2/step4/obs_seq.final
-> ls exp3/*/obs_seq.final > exp3list
-> cat exp2list
+> ls exp3/*/obs_seq.final > exp3list
+> cat exp2list
exp3/step1/obs_seq.final
exp3/step2/obs_seq.final
exp3/step3/obs_seq.final
Modified: DART/trunk/obs_sequence/obs_common_subset.nml
===================================================================
--- DART/trunk/obs_sequence/obs_common_subset.nml 2014-08-27 16:20:31 UTC (rev 7148)
+++ DART/trunk/obs_sequence/obs_common_subset.nml 2014-08-27 16:47:19 UTC (rev 7149)
@@ -1,12 +1,13 @@
+
&obs_common_subset_nml
- num_to_compare_at_once = 2,
- filename_seq = '',
- filename_seq_list = '',
- filename_out_suffix = '.common' ,
- calendar = 'Gregorian',
- print_every = 10000,
- dart_qc_threshold = 3,
- print_only = .false.,
+ num_to_compare_at_once = 2
+ filename_seq = ''
+ filename_seq_list = ''
+ filename_out_suffix = '.common'
+ calendar = 'Gregorian'
+ print_every = 10000
+ dart_qc_threshold = 3
+ print_only = .false.
eval_and_assim_can_match = .false.
-/
+ /
Modified: DART/trunk/obs_sequence/obs_loop.f90
===================================================================
--- DART/trunk/obs_sequence/obs_loop.f90 2014-08-27 16:20:31 UTC (rev 7148)
+++ DART/trunk/obs_sequence/obs_loop.f90 2014-08-27 16:47:19 UTC (rev 7149)
@@ -62,7 +62,7 @@
integer :: num_rejected_other
character(len=129) :: read_format
logical :: pre_I_format, cal
-character(len=256) :: msgstring, msgstring1, msgstring2
+character(len=512) :: msgstring, msgstring1, msgstring2, msgstring3
type(obs_def_type) :: this_obs_def
character(len=metadatalength) :: meta_data
@@ -77,8 +77,8 @@
! Namelist input with default values
-character(len=160) :: filename_in = ''
-character(len=160) :: filename_out = ''
+character(len=256) :: filename_in = ''
+character(len=256) :: filename_out = ''
logical :: print_only = .false.
character(len=32) :: calendar = 'Gregorian'
@@ -534,12 +534,11 @@
! print out the metadata strings, trimmed
!
-type(obs_sequence_type), intent(in) :: seq
-character(len=*), optional :: fname
+type(obs_sequence_type), intent(in) :: seq
+character(len=*), optional, intent(in) :: fname
integer :: num_copies , num_qc, i
character(len=metadatalength) :: str
-character(len=255) :: msgstring3
num_copies = get_num_copies(seq)
num_qc = get_num_qc( seq)
Modified: DART/trunk/obs_sequence/obs_loop.nml
===================================================================
--- DART/trunk/obs_sequence/obs_loop.nml 2014-08-27 16:20:31 UTC (rev 7148)
+++ DART/trunk/obs_sequence/obs_loop.nml 2014-08-27 16:47:19 UTC (rev 7149)
@@ -1,9 +1,8 @@
&obs_loop_nml
- filename_in = 'obs_seq.in'
- filename_out = 'obs_seq.out' ,
- print_only = .false.,
- calendar = 'Gregorian',
- /
+ filename_in = 'obs_seq.in'
+ filename_out = 'obs_seq.out'
+ print_only = .false.
+ calendar = 'Gregorian'
+ /
-
Modified: DART/trunk/obs_sequence/obs_selection.f90
===================================================================
--- DART/trunk/obs_sequence/obs_selection.f90 2014-08-27 16:20:31 UTC (rev 7148)
+++ DART/trunk/obs_sequence/obs_selection.f90 2014-08-27 16:47:19 UTC (rev 7149)
@@ -77,7 +77,7 @@
integer :: first_seq, num_good_called, num_good_searched
character(len=129) :: read_format, meta_data
logical :: pre_I_format, cal
-character(len=255) :: msgstring, msgstring1, msgstring2, msgstring3
+character(len=512) :: msgstring, msgstring1, msgstring2, msgstring3
!----------------------------------------------------------------
@@ -93,12 +93,12 @@
integer :: print_every_nth_obs = 100
-character(len=129) :: filename_seq(max_num_input_files) = ''
-character(len=129) :: filename_seq_list = ''
-character(len=129) :: filename_out = 'obs_seq.processed'
+character(len=256) :: filename_seq(max_num_input_files) = ''
+character(len=256) :: filename_seq_list = ''
+character(len=256) :: filename_out = 'obs_seq.processed'
logical :: process_file(max_num_input_files)
-character(len=129) :: selections_file = 'obsdef_mask.txt'
+character(len=256) :: selections_file = 'obsdef_mask.txt'
logical :: selections_is_obs_seq = .false.
! max differences allowed when deciding a location is the same
@@ -598,13 +598,13 @@
! qc entries, seq1 has already been edited and only 2 needs the editing
! applied. before they were completely symmetric.
-type(obs_sequence_type), intent(in) :: seq1, seq2
-character(len=*), optional :: fname1, fname2
+type(obs_sequence_type), intent(in) :: seq1, seq2
+character(len=*), OPTIONAL, intent(in) :: fname1, fname2
integer :: num_copies1, num_qc1
integer :: num_copies2, num_qc2
integer :: num_copies , num_qc, i
-character(len=129) :: str1, str2
+character(len=metadatalength) :: str1, str2
num_copies1 = get_num_copies(seq1)
num_qc1 = get_num_qc( seq1)
@@ -881,11 +881,11 @@
! print out the metadata strings, trimmed
!
-type(obs_sequence_type), intent(in) :: seq1
-character(len=*), optional :: fname1
+type(obs_sequence_type), intent(in) :: seq1
+character(len=*), OPTIONAL, intent(in) :: fname1
integer :: num_copies , num_qc, i
-character(len=129) :: str1
+character(len=metadatalength) :: str1
num_copies = get_num_copies(seq1)
num_qc = get_num_qc( seq1)
@@ -1046,7 +1046,7 @@
type(time_type), intent(in) :: obs_time
type(obs_def_type), intent(in) :: selection_list(:)
integer, intent(in) :: selection_count
- integer, optional, intent(in) :: startindex
+ integer, OPTIONAL, intent(in) :: startindex
integer :: set_base
integer :: i, s
Modified: DART/trunk/obs_sequence/obs_selection.html
===================================================================
--- DART/trunk/obs_sequence/obs_selection.html 2014-08-27 16:20:31 UTC (rev 7148)
+++ DART/trunk/obs_sequence/obs_selection.html 2014-08-27 16:47:19 UTC (rev 7149)
@@ -120,14 +120,14 @@
<TBODY valign=top>
<TR><TD>filename_seq</TD>
- <TD>character(len=129), dimension(500)</TD>
+ <TD>character(len=256), dimension(500)</TD>
<TD>The array of names of the observation sequence files to process,
up to a max count of 500 files. (Specify only the actual number of input
files. It is not necessary to specify 500 entries.)
</TD></TR>
<TR><TD>filename_seq_list</TD>
- <TD>character(len=129)</TD>
+ <TD>character(len=256)</TD>
<TD>An alternative way to specify the list of input files.
The name of a text file which contains, one per line, the names of the
observation sequence files to process. You can only specify one of
@@ -143,7 +143,7 @@
</TD></TR>
<TR><TD>filename_out</TD>
- <TD>character(len=129)</TD>
+ <TD>character(len=256)</TD>
<TD>The name of the resulting output observation sequence file.
There is only a single output file from this tool.
If the input specifies multiple obs_seq input files, the results are concatinated
@@ -151,7 +151,7 @@
</TD></TR>
<TR><TD>selections_file</TD>
- <TD>character(len=129)</TD>
+ <TD>character(len=256)</TD>
<TD>The name of the input file containing the mask of observation
definitions (the textfile output of <a href="obs_seq_coverage.html">obs_seq_coverage</a>).
Alternatively, this can be the name of a full observation sequence file.
Modified: DART/trunk/obs_sequence/obs_selection.nml
===================================================================
--- DART/trunk/obs_sequence/obs_selection.nml 2014-08-27 16:20:31 UTC (rev 7148)
+++ DART/trunk/obs_sequence/obs_selection.nml 2014-08-27 16:47:19 UTC (rev 7149)
@@ -29,4 +29,5 @@
partial_write = .false.
print_timestamps = .false.
calendar = 'Gregorian'
-/
+ /
+
Modified: DART/trunk/obs_sequence/obs_seq_coverage.f90
===================================================================
--- DART/trunk/obs_sequence/obs_seq_coverage.f90 2014-08-27 16:20:31 UTC (rev 7148)
+++ DART/trunk/obs_sequence/obs_seq_coverage.f90 2014-08-27 16:47:19 UTC (rev 7149)
@@ -156,7 +156,8 @@
type(time_type) :: obs_time, no_time, last_possible_time
-character(len=256) :: ncName, string1, string2, string3
+character(len=256) :: ncName
+character(len=512) :: string1, string2, string3
! ~# of degrees for 1/2 meter at Earth equator
! 360 deg-earth/(40000 km-earth * 1000m-km)
Modified: DART/trunk/obs_sequence/obs_seq_to_netcdf.f90
===================================================================
--- DART/trunk/obs_sequence/obs_seq_to_netcdf.f90 2014-08-27 16:20:31 UTC (rev 7148)
+++ DART/trunk/obs_sequence/obs_seq_to_netcdf.f90 2014-08-27 16:47:19 UTC (rev 7149)
@@ -609,7 +609,7 @@
character(len=5) :: crzone ! needed by F90 DATE_AND_TIME intrinsic
integer, dimension(8) :: values ! needed by F90 DATE_AND_TIME intrinsic
-character(len=129), allocatable, dimension(:) :: textblock
+character(len=256), allocatable, dimension(:) :: textblock
real(digits12) :: epoch_edges(2)
integer :: seconds, days
Modified: DART/trunk/obs_sequence/obs_seq_to_netcdf.html
===================================================================
--- DART/trunk/obs_sequence/obs_seq_to_netcdf.html 2014-08-27 16:20:31 UTC (rev 7148)
+++ DART/trunk/obs_sequence/obs_seq_to_netcdf.html 2014-08-27 16:47:19 UTC (rev 7149)
@@ -156,7 +156,7 @@
<TBODY valign=top>
<TR><TD> obs_sequence_name </TD>
- <TD> character(len=129) </TD>
+ <TD> character(len=256) </TD>
<TD>Name of an observation sequence file(s). This may be a relative or
absolute filename. If the filename contains a '/', the filename is considered
to be comprised of everything to the right, and a directory structure to the
@@ -173,7 +173,7 @@
</TD></TR>
<TR><TD> obs_sequence_list </TD>
- <TD> character(len=129) </TD>
+ <TD> character(len=256) </TD>
<TD>Name of an ascii text file which contains a list of one or more
observation sequence files, one per line. If this is specified,
'obs_sequence_name' must be set to ' '. Can be created by any method,
Modified: DART/trunk/obs_sequence/obs_seq_to_netcdf.nml
===================================================================
--- DART/trunk/obs_sequence/obs_seq_to_netcdf.nml 2014-08-27 16:20:31 UTC (rev 7148)
+++ DART/trunk/obs_sequence/obs_seq_to_netcdf.nml 2014-08-27 16:47:19 UTC (rev 7149)
@@ -1,12 +1,15 @@
+
# note that only one of name or list can be used, and the other
# must be set to '' to avoid ambiguity.
+
&obs_seq_to_netcdf_nml
- obs_sequence_name = 'obs_seq.final',
- obs_sequence_list = '',
- append_to_netcdf = .false.,
- lonlim1 = 0.0,
- lonlim2 = 360.0,
- latlim1 = -90.0,
- latlim2 = 90.0,
- verbose = .false. /
+ obs_sequence_name = 'obs_seq.final'
+ obs_sequence_list = ''
+ append_to_netcdf = .false.
+ lonlim1 = 0.0
+ lonlim2 = 360.0
+ latlim1 = -90.0
+ latlim2 = 90.0
+ verbose = .false.
+ /
Modified: DART/trunk/obs_sequence/obs_seq_verify.html
===================================================================
--- DART/trunk/obs_sequence/obs_seq_verify.html 2014-08-27 16:20:31 UTC (rev 7148)
+++ DART/trunk/obs_sequence/obs_seq_verify.html 2014-08-27 16:47:19 UTC (rev 7149)
@@ -162,7 +162,7 @@
<TBODY valign=top>
<TR><TD> obs_sequences </TD>
- <TD> character(len=129), dimension(500) </TD>
+ <TD> character(len=256), dimension(500) </TD>
<TD>Names of the observation sequence files - each of which
<strong>MUST</strong> have an extension that defines the start of the
forecast (the analysis time). The observation sequence filenames must be
@@ -172,7 +172,7 @@
</TD></TR>
<TR><TD> obs_sequence_list </TD>
- <TD> character(len=129) </TD>
+ <TD> character(len=256) </TD>
<TD>Name of an ascii text file which contains a list of one or more
observation sequence files, one per line. The observation sequence filenames
<strong>MUST</strong> have an extension that defines the start of the
@@ -186,14 +186,14 @@
</TD></TR>
<TR><TD> station_template </TD>
- <TD> character(len=129) </TD>
+ <TD> character(len=256) </TD>
<TD>The name of the netCDF file created by
<a href="obs_seq_coverage.html">obs_seq_coverage</a> that contains the
verification network description.
</TD></TR>
<TR><TD> netcdf_out </TD>
- <TD> character(len=129) </TD>
+ <TD> character(len=256) </TD>
<TD>The base portion of the filename of the file that will contain the
forecast quantities. Since each observation type of interest is processed
with a separate run of <em class=program>obs_seq_verify</em>, the observation
Modified: DART/trunk/obs_sequence/obs_sequence_mod.f90
===================================================================
--- DART/trunk/obs_sequence/obs_sequence_mod.f90 2014-08-27 16:20:31 UTC (rev 7148)
+++ DART/trunk/obs_sequence/obs_sequence_mod.f90 2014-08-27 16:47:19 UTC (rev 7149)
@@ -104,7 +104,7 @@
end type obs_cov_type
! for errors
-character(len=129) :: msgstring, string1
+character(len=512) :: string1, string2
!-------------------------------------------------------------
! Namelist with default values
@@ -153,7 +153,7 @@
! Constructor for an obs_sequence
type(obs_sequence_type), intent(out) :: seq
-integer, intent(in) :: num_copies, num_qc, expected_max_num_obs
+integer, intent(in) :: num_copies, num_qc, expected_max_num_obs
integer :: i
@@ -380,7 +380,7 @@
type(obs_sequence_type), intent(in) :: seq
-integer :: get_num_copies
+integer :: get_num_copies
get_num_copies = seq%num_copies
@@ -392,7 +392,7 @@
type(obs_sequence_type), intent(in) :: seq
-integer :: get_num_qc
+integer :: get_num_qc
get_num_qc= seq%num_qc
@@ -404,7 +404,7 @@
type(obs_sequence_type), intent(in) :: seq
-integer :: get_num_obs
+integer :: get_num_obs
get_num_obs = seq%num_obs
@@ -416,7 +416,7 @@
type(obs_sequence_type), intent(in) :: seq
-integer :: get_max_num_obs
+integer :: get_max_num_obs
get_max_num_obs = seq%max_num_obs
@@ -427,8 +427,8 @@
type(obs_sequence_type), intent(in) :: seq
-integer, intent(in) :: copy_num
-character(len=metadatalength) :: get_copy_meta_data
+integer, intent(in) :: copy_num
+character(len=metadatalength) :: get_copy_meta_data
! Should have an error check for copy_num range
get_copy_meta_data = seq%copy_meta_data(copy_num)
@@ -440,8 +440,8 @@
type(obs_sequence_type), intent(in) :: seq
-integer, intent(in) :: qc_num
-character(len=metadatalength) :: get_qc_meta_data
+integer, intent(in) :: qc_num
+character(len=metadatalength) :: get_qc_meta_data
! Should have an error check for qc_num range
get_qc_meta_data = seq%qc_meta_data(qc_num)
@@ -453,10 +453,10 @@
subroutine get_next_obs(seq, obs, next_obs, is_this_last)
-type(obs_sequence_type), intent(in) :: seq
-type(obs_type), intent(in) :: obs
-type(obs_type), intent(out) :: next_obs
-logical, intent(out) :: is_this_last
+type(obs_sequence_type), intent(in) :: seq
+type(obs_type), intent(in) :: obs
+type(obs_type), intent(out) :: next_obs
+logical, intent(out) :: is_this_last
integer :: next_index
@@ -478,10 +478,10 @@
subroutine get_prev_obs(seq, obs, prev_obs, is_this_first)
-type(obs_sequence_type), intent(in) :: seq
-type(obs_type), intent(in) :: obs
-type(obs_type), intent(out) :: prev_obs
-logical, intent(out) :: is_this_first
+type(obs_sequence_type), intent(in) :: seq
+type(obs_type), intent(in) :: obs
+type(obs_type), intent(out) :: prev_obs
+logical, intent(out) :: is_this_first
integer :: prev_index
@@ -502,7 +502,8 @@
subroutine get_obs_from_key(seq, key, obs)
type(obs_sequence_type), intent(in) :: seq
-integer, intent(in) :: key
+integer, intent(in) :: key
+
type(obs_type) :: obs
obs = seq%obs(key)
@@ -514,10 +515,10 @@
subroutine get_next_obs_from_key(seq, last_key_used, next_obs, is_this_last)
-type(obs_sequence_type), intent(in) :: seq
-integer, intent(in) :: last_key_used
-type(obs_type), intent(out) :: next_obs
-logical, intent(out) :: is_this_last
+type(obs_sequence_type), intent(in) :: seq
+integer, intent(in) :: last_key_used
+type(obs_type), intent(out) :: next_obs
+logical, intent(out) :: is_this_last
integer :: next_index
@@ -538,10 +539,10 @@
subroutine get_prev_obs_from_key(seq, last_key_used, prev_obs, is_this_first)
-type(obs_sequence_type), intent(in) :: seq
-integer, intent(in) :: last_key_used
-type(obs_type), intent(out) :: prev_obs
-logical, intent(out) :: is_this_first
+type(obs_sequence_type), intent(in) :: seq
+integer, intent(in) :: last_key_used
+type(obs_type), intent(out) :: prev_obs
+logical, intent(out) :: is_this_first
integer :: prev_index
@@ -566,8 +567,8 @@
! the key-th element of the sequence.
type(obs_sequence_type), intent(inout) :: seq
-type(obs_type), intent(in) :: obs
-integer, intent(in), optional :: key_in
+type(obs_type), intent(in) :: obs
+integer, intent(in), optional :: key_in
integer :: key
@@ -590,12 +591,12 @@
subroutine get_obs_time_range(seq, time1, time2, key_bounds, num_keys, out_of_range, obs)
! Add other options for getting the first time to minimize search
-type(obs_sequence_type), intent(in) :: seq
-type(time_type), intent(in) :: time1, time2
+type(obs_sequence_type), intent(in) :: seq
+type(time_type), intent(in) :: time1, time2
integer, intent(out) :: key_bounds(2)
integer, intent(out) :: num_keys
logical, intent(out) :: out_of_range
-type(obs_type), intent(in), optional :: obs
+type(obs_type), intent(in), optional :: obs
type(time_type) :: cur_time
type(obs_def_type) :: obs_def
@@ -665,9 +666,9 @@
! Given bounds from get_obs_time_range and an array keys big enough to hold
! all the keys in the range, returns the keys in the range
-type(obs_sequence_type), intent(in) :: seq
-integer, intent(in) :: key_bounds(2), num_keys
-integer, intent(out) :: keys(num_keys)
+type(obs_sequence_type), intent(in) :: seq
+integer, intent(in) :: key_bounds(2), num_keys
+integer, intent(out) :: keys(num_keys)
integer :: current, i
@@ -687,7 +688,7 @@
type(obs_sequence_type), intent(inout) :: seq
type(obs_type), intent(inout) :: obs
-type(obs_type), intent(in), optional :: prev_obs
+type(obs_type), intent(in), optional :: prev_obs
type(time_type) :: obs_time, current_time
integer :: prev, next, current
@@ -700,9 +701,9 @@
! Make sure there is room, fail for now if not
if(seq%num_obs >= seq%max_num_obs) then
! Later do an increase of space and copy
- write(msgstring,*) 'ran out of room, num_obs (',seq%num_obs, &
+ write(string1,*) 'ran out of room, num_obs (',seq%num_obs, &
') > max_num_obs (',seq%max_num_obs,')'
- call error_handler(E_ERR,'insert_obs_in_seq',msgstring,source,revision,revdate)
+ call error_handler(E_ERR,'insert_obs_in_seq',string1,source,revision,revdate)
endif
! Set the key for the observation
@@ -733,8 +734,8 @@
!current = -1
!next = seq%first_time
! error out
- write(msgstring,*) 'time of prev_obs cannot be > time of new obs'
- call error_handler(E_ERR,'insert_obs_in_seq',msgstring,source,revision,revdate)
+ write(string1,*) 'time of prev_obs cannot be > time of new obs'
+ call error_handler(E_ERR,'insert_obs_in_seq',string1,source,revision,revdate)
endif
endif
@@ -805,7 +806,7 @@
! not later than time of last obs already in seq
type(obs_sequence_type), intent(inout) :: seq
-type(obs_type), intent(inout) :: obs
+type(obs_type), intent(inout) :: obs
type(obs_type) :: last_obs
type(time_type) :: obs_time, last_time
@@ -825,8 +826,8 @@
obs_time = get_obs_def_time(obs%def)
last_time = get_obs_def_time(last_obs%def)
if(obs_time < last_time) then
- write(msgstring, *) 'time of appended obs cannot be < time of last obs in sequence'
- call error_handler(E_ERR,'append_obs_to_seq',msgstring,source,revision,revdate)
+ write(string1, *) 'time of appended obs cannot be < time of last obs in sequence'
+ call error_handler(E_ERR,'append_obs_to_seq',string1,source,revision,revdate)
endif
!!! call insert_obs_in_seq(seq, obs)
@@ -835,8 +836,8 @@
! Make sure there is room, fail for now if not
if(seq%num_obs >= seq%max_num_obs) then
! Later do an increase of space and copy
- write(msgstring,*) 'ran out of room, max_num_obs = ',seq%max_num_obs
- call error_handler(E_ERR,'append_obs_to_seq',msgstring,source,revision,revdate)
+ write(string1,*) 'ran out of room, max_num_obs = ',seq%max_num_obs
+ call error_handler(E_ERR,'append_obs_to_seq',string1,source,revision,revdate)
endif
! Set the key for the observation
@@ -866,8 +867,8 @@
! Insert a group of observations from the same time into a sequence
!type(obs_sequence_type), intent(inout) :: seq
-!type(obs_type), intent(inout) :: obs
-!type(obs_type), intent(in), optional :: prev_obs
+!type(obs_type), intent(inout) :: obs
+!type(obs_type), intent(in), optional :: prev_obs
!
!end subroutine insert_obs_group_in_seq
@@ -877,7 +878,7 @@
! Removes this observation from the sequence, does not free storage in this implementation
type(obs_sequence_type), intent(inout) :: seq
-type(obs_type), intent(inout) :: obs
+type(obs_type), intent(inout) :: obs
integer :: prev, next
@@ -935,16 +936,16 @@
lj_meta_data = adjustl(meta_data)
if (len_trim(lj_meta_data) > metadatalength) then
- write(msgstring,*) 'metadata string [', trim(lj_meta_data),']'
- write(string1,*) 'must be shorter than ',metadatalength
- call error_handler(E_ERR, 'set_copy_meta_data', msgstring, &
- source, revision, revdate, text2=string1)
+ write(string1,*) 'metadata string [', trim(lj_meta_data),']'
+ write(string2,*) 'must be shorter than ',metadatalength
+ call error_handler(E_ERR, 'set_copy_meta_data', string1, &
+ source, revision, revdate, text2=string2)
endif
if (copy_num > seq%num_copies) then
- write(msgstring,*) 'trying to set copy (', copy_num, &
+ write(string1,*) 'trying to set copy (', copy_num, &
') which is larger than num_copies (', seq%num_copies, ')'
- call error_handler(E_ERR,'set_copy_meta_data',msgstring,source,revision,revdate)
+ call error_handler(E_ERR,'set_copy_meta_data',string1,source,revision,revdate)
endif
seq%copy_meta_data(copy_num) = trim(lj_meta_data)
@@ -965,16 +966,16 @@
lj_meta_data = adjustl(meta_data)
if (len_trim(lj_meta_data) > metadatalength) then
- write(msgstring,*) 'metadata string [', trim(lj_meta_data),']'
- write(string1,*) 'must be shorter than ',metadatalength
- call error_handler(E_ERR, 'set_qc_meta_data', msgstring, &
- source, revision, revdate, text2=string1)
+ write(string1,*) 'metadata string [', trim(lj_meta_data),']'
+ write(string2,*) 'must be shorter than ',metadatalength
+ call error_handler(E_ERR, 'set_qc_meta_data', string1, &
+ source, revision, revdate, text2=string2)
endif
if (qc_num > seq%num_qc) then
- write(msgstring,*) 'trying to set qc (', qc_num, &
+ write(string1,*) 'trying to set qc (', qc_num, &
') which is larger than num_qc (', seq%num_qc, ')'
- call error_handler(E_ERR,'set_qc_meta_data',msgstring,source,revision,revdate)
+ call error_handler(E_ERR,'set_qc_meta_data',string1,source,revision,revdate)
endif
seq%qc_meta_data(qc_num) = trim(lj_meta_data)
@@ -985,9 +986,9 @@
function get_first_obs(seq, obs)
-type(obs_sequence_type), intent(in) :: seq
-type(obs_type), intent(out) :: obs
-logical :: get_first_obs
+type(obs_sequence_type), intent(in) :: seq
+type(obs_type), intent(out) :: obs
+logical :: get_first_obs
if(seq%num_obs == 0 .or. seq%first_time <= 0) then
get_first_obs = .false.
@@ -1002,9 +1003,9 @@
function get_last_obs(seq, obs)
-type(obs_sequence_type), intent(in) :: seq
-type(obs_type), intent(out) :: obs
-logical :: get_last_obs
+type(obs_sequence_type), intent(in) :: seq
+type(obs_type), intent(out) :: obs
+logical :: get_last_obs
if(seq%num_obs == 0 .or. seq%last_time <=0) then
get_last_obs = .false.
@@ -1027,7 +1028,7 @@
! In the long run, may want a smoother way to do this globally.
type(obs_sequence_type), intent(inout) :: seq
-integer, intent(in) :: num_to_add
+integer, intent(in) :: num_to_add
character(len=metadatalength) :: meta_temp(seq%num_copies)
real(r8) :: values_temp(seq%num_copies)
@@ -1074,11 +1075,11 @@
! In the long run, may want a smoother way to do this globally.
type(obs_sequence_type), intent(inout) :: seq
-integer, intent(in) :: num_to_add
+integer, intent(in) :: num_to_add
character(len=metadatalength) :: qc_temp(seq%num_qc)
-real(r8) :: values_temp(seq%num_qc)
-integer :: i, old_num
+real(r8) :: values_temp(seq%num_qc)
+integer :: i, old_num
old_num = seq%num_qc
seq%num_qc = old_num + num_to_add
@@ -1130,14 +1131,14 @@
! Open the file. nsc - why is this not using open_file()?
file_id = get_unit()
-write(msgstring, *) 'opening '// trim(useform) // ' file ',trim(file_name)
-call error_handler(E_MSG,'write_obs_seq',msgstring)
+write(string1, *) 'opening '// trim(useform) // ' file ',trim(file_name)
+call error_handler(E_MSG,'write_obs_seq',string1)
open(unit = file_id, file = file_name, form = useform, &
action='write', position='rewind', iostat=rc)
if (rc /= 0) then
- write(msgstring, *) 'unable to create file '//trim(file_name)
- call error_handler(E_ERR,'write_obs_seq',msgstring,source,revision,revdate)
+ write(string1, *) 'unable to create file '//trim(file_name)
+ call error_handler(E_ERR,'write_obs_seq',string1,source,revision,revdate)
endif
! Write the initial string for help in figuring out binary
@@ -1194,8 +1195,8 @@
! Close up the file
call close_file(file_id)
-write(msgstring, *) 'closed file '//trim(file_name)
-call error_handler(E_MSG,'write_obs_seq',msgstring)
+write(string1, *) 'closed file '//trim(file_name)
+call error_handler(E_MSG,'write_obs_seq',string1)
end subroutine write_obs_seq
@@ -1233,8 +1234,8 @@
endif
if (io /= 0) then
! Read error of some type
- write(msgstring, *) 'Read error in copy metadata ', i, ' rc= ', io
- call error_handler(E_ERR, 'read_obs_seq', msgstring, &
+ write(string1, *) 'Read error in copy metadata ', i, ' rc= ', io
+ call error_handler(E_ERR, 'read_obs_seq', string1, &
source, revision, revdate)
endif
end do
@@ -1248,8 +1249,8 @@
endif
if (io /= 0) then
! Read error of some type
- write(msgstring, *) 'Read error in qc metadata ', i, ' rc= ', io
- call error_handler(E_ERR, 'read_obs_seq', msgstring, &
+ write(string1, *) 'Read error in qc metadata ', i, ' rc= ', io
+ call error_handler(E_ERR, 'read_obs_seq', string1, &
source, revision, revdate)
endif
end do
@@ -1262,18 +1263,18 @@
endif
if (io /= 0) then
! Read error of some type
- write(msgstring, *) 'Read error in first/last times, rc= ', io
- call error_handler(E_ERR, 'read_obs_seq', msgstring, &
+ write(string1, *) 'Read error in first/last times, rc= ', io
+ call error_handler(E_ERR, 'read_obs_seq', string1, &
source, revision, revdate)
endif
if (seq%first_time < -1 .or. seq%first_time > max_num_obs) then
- write(msgstring, *) 'Bad value for first', seq%first_time, ', min is -1, max is ', max_num_obs
- call error_handler(E_ERR, 'read_obs_seq', msgstring, source, revision, revdate)
+ write(string1, *) 'Bad value for first', seq%first_time, ', min is -1, max is ', max_num_obs
+ call error_handler(E_ERR, 'read_obs_seq', string1, source, revision, revdate)
endif
if (seq%last_time < -1 .or. seq%last_time > max_num_obs) then
- write(msgstring, *) 'Bad value for last', seq%last_time, ', min is -1, max is ', max_num_obs
- call error_handler(E_ERR, 'read_obs_seq', msgstring, source, revision, revdate)
+ write(string1, *) 'Bad value for last', seq%last_time, ', min is -1, max is ', max_num_obs
+ call error_handler(E_ERR, 'read_obs_seq', string1, source, revision, revdate)
endif
! Now read in all the previously defined observations
@@ -1281,8 +1282,8 @@
if(.not. read_format == 'unformatted') read(file_id,*, iostat=io) label(1)
if (io /= 0) then
! Read error of some type
- write(msgstring, *) 'Read error in obs label', i, ' rc= ', io
- call error_handler(E_ERR, 'read_obs_seq', msgstring, &
+ write(string1, *) 'Read error in obs label', i, ' rc= ', io
+ call error_handler(E_ERR, 'read_obs_seq', string1, &
source, revision, revdate)
endif
call read_obs(file_id, num_copies, add_copies, num_qc, add_qc, i, seq%obs(i), &
@@ -1383,15 +1384,15 @@
else
! Unable to figure out what to do with file or it doesn't exist
- write(msgstring, *) 'Unable to open file ', trim(file_name)
- call error_handler(E_ERR, 'read_obs_seq_header', msgstring, &
+ write(string1, *) 'Unable to open file ', trim(file_name)
+ call error_handler(E_ERR, 'read_obs_seq_header', string1, &
source, revision, revdate)
endif
! Falling off the end here means file didn't correspond with any
! expected format
-write(msgstring, *) 'Unable to determine format of file ', trim(file_name)
-call error_handler(E_ERR, 'read_obs_seq_header', msgstring, &
+write(string1, *) 'Unable to determine format of file ', trim(file_name)
+call error_handler(E_ERR, 'read_obs_seq_header', string1, &
source, revision, revdate)
@@ -1616,15 +1617,15 @@
! Some sanity checking on the input args.
if (num_obs_input_types <= 0) then
- write(msgstring,*) 'num_obs_input_types must be > 0'
- call error_handler(E_ERR,'delete_obs_by_typelist', msgstring, &
+ write(string1,*) 'num_obs_input_types must be > 0'
+ call error_handler(E_ERR,'delete_obs_by_typelist', string1, &
source, revision, revdate)
endif
! Ok for list to be longer; only first N items will be used. But list
! cannot be shorter.
if (size(obs_input_types) < num_obs_input_types) then
- write(msgstring,*) 'num_obs_input_types must be >= length of list'
- call error_handler(E_ERR,'delete_obs_by_typelist', msgstring, &
+ write(string1,*) 'num_obs_input_types must be >= length of list'
+ call error_handler(E_ERR,'delete_obs_by_typelist', string1, &
source, revision, revdate)
endif
@@ -1633,8 +1634,8 @@
do i=1, num_obs_input_types
obs_type_index(i) = get_obs_kind_index(obs_input_types(i))
if (obs_type_index(i) < 0) then
- write(msgstring,*) 'obs_type ', trim(obs_input_types(i)), ' not found'
- call error_handler(E_ERR,'delete_obs_by_typelist', msgstring, &
+ write(string1,*) 'obs_type ', trim(obs_input_types(i)), ' not found'
+ call error_handler(E_ERR,'delete_obs_by_typelist', string1, &
source, revision, revdate)
endif
enddo
@@ -1738,14 +1739,14 @@
! Some sanity checking on the input args.
if (qc_index > seq%num_qc) then
- write(msgstring,*) 'qc_index must be <', seq%num_qc
- call error_handler(E_ERR,'delete_obs_by_qc', msgstring, &
+ write(string1,*) 'qc_index must be <', seq%num_qc
+ call error_handler(E_ERR,'delete_obs_by_qc', string1, &
source, revision, revdate)
endif
! Ok for min/max to be missing_r8; if both specified, min must be <= max.
if (qc_min /= missing_r8 .and. qc_max /= missing_r8 .and. qc_min > qc_max) then
- write(msgstring,*) 'qc_min must be less than or equal qc_max'
- call error_handler(E_ERR,'delete_obs_by_qc', msgstring, &
+ write(string1,*) 'qc_min must be less than or equal qc_max'
+ call error_handler(E_ERR,'delete_obs_by_qc', string1, &
source, revision, revdate)
endif
@@ -1831,15 +1832,15 @@
! Some sanity checking on the input args.
if (copy_index > seq%num_copies) then
- write(msgstring,*) 'copy_index must be <', seq%num_copies
- call error_handler(E_ERR,'delete_obs_by_copy', msgstring, &
+ write(string1,*) 'copy_index must be <', seq%num_copies
+ call error_handler(E_ERR,'delete_obs_by_copy', string1, &
source, revision, revdate)
endif
! Ok for min/max to be missing_r8; if both specified, min must be <= max.
if (copy_min /= missing_r8 .and. copy_max /= missing_r8 .and. &
copy_min > copy_max) then
- write(msgstring,*) 'copy_min must be less than or equal copy_max'
- call error_handler(E_ERR,'delete_obs_by_copy', msgstring, &
+ write(string1,*) 'copy_min must be less than or equal copy_max'
+ call error_handler(E_ERR,'delete_obs_by_copy', string1, &
source, revision, revdate)
endif
@@ -1847,8 +1848,8 @@
if (len(trim(obs_type_name)) > 0) then
obs_type_index = get_obs_kind_index(obs_type_name)
if (obs_type_index < 0) then
- write(msgstring,*) 'obs_type ', trim(obs_type_name), ' not found'
- call error_handler(E_ERR,'delete_obs_by_copy', msgstring, &
+ write(string1,*) 'obs_type ', trim(obs_type_name), ' not found'
+ call error_handler(E_ERR,'delete_obs_by_copy', string1, &
source, revision, revdate)
endif
else
@@ -2013,8 +2014,8 @@
! sequence, and set the array values to 0 for no, 1 for yes.
subroutine set_used_kinds(seq, have)
-type(obs_sequence_type), intent(in) :: seq
-integer, intent(out) :: have(:)
+type(obs_sequence_type), intent(in) :: seq
+integer, intent(out) :: have(:)
integer :: i, num_copies, num_qc
integer :: num_obs
@@ -2091,8 +2092,8 @@
call get_obs_time_range(oldseq, first_time, last_time, &
key_bounds, num_keys, out_of_range)
if (out_of_range) then
- write(msgstring, *) 'All keys out of range'
- call error_handler(E_ERR, 'copy_obs_seq', msgstring, &
+ write(string1, *) 'All keys out of range'
+ call error_handler(E_ERR, 'copy_obs_seq', string1, &
source, revision, revdate)
endif
@@ -2125,7 +2126,7 @@
! Sort of a constructor for obs_type
! Should this be public or private just for sequence?
-integer, intent(in) :: num_copies, num_qc
+integer, intent(in) :: num_copies, num_qc
type(obs_type), intent(out) :: obs
! Intentionally allocate even 0 copies. This creates an
@@ -2214,8 +2215,8 @@
! no existing value to copy.
type(obs_type), intent(inout) :: obs1
-type(obs_type), intent(in) :: obs2
-integer, intent(in) :: numcopies, copylist(:), numqc, qclist(:)
+type(obs_type), intent(in) :: obs2
+integer, intent(in) :: numcopies, copylist(:), numqc, qclist(:)
integer :: i, ival
@@ -2228,22 +2229,22 @@
! of existing data in obs2.
ival = min(minval(copylist(1:numcopies)), minval(qclist(1:numqc)))
if (ival < 0) then
- write(msgstring, '(A,I8,A)') 'index list value, ', ival, ' must be >= 0'
- call error_handler(E_ERR, 'copy_partial_obs:', msgstring, &
+ write(string1, '(A,I8,A)') 'index list value, ', ival, ' must be >= 0'
+ call error_handler(E_ERR, 'copy_partial_obs:', string1, &
source, revision, revdate)
endif
ival = maxval(copylist(1:numcopies))
if (ival > size(obs2%values)) then
- write(msgstring, '(A,I8,A,I8)') 'index list value, ', ival, &
+ write(string1, '(A,I8,A,I8)') 'index list value, ', ival, &
' is larger than copies length, ', size(obs2%values)
- call error_handler(E_ERR, 'copy_partial_obs:', msgstring, &
+ call error_handler(E_ERR, 'copy_partial_obs:', string1, &
source, revision, revdate)
endif
ival = maxval(qclist(1:numqc))
if (ival > size(obs2%qc)) then
- write(msgstring, '(A,I8,A,I8)') 'index list value, ', ival, &
+ write(string1, '(A,I8,A,I8)') 'index list value, ', ival, &
' is larger than qc length, ', size(obs2%qc)
- call error_handler(E_ERR, 'copy_partial_obs:', msgstring, &
+ call error_handler(E_ERR, 'copy_partial_obs:', string1, &
source, revision, revdate)
endif
@@ -2292,7 +2293,7 @@
!-------------------------------------------------
subroutine get_obs_def(obs, obs_def)
-type(obs_type), intent(in) :: obs
+type(obs_type), intent(in) :: obs
type(obs_def_type), intent(out) :: obs_def
! WARNING: NEED TO DEFINE A COPY ROUTINE FOR OBS_DEF !!!
@@ -2303,8 +2304,8 @@
!-------------------------------------------------
subroutine set_obs_def(obs, obs_def)
-type(obs_type), intent(inout) :: obs
-type(obs_def_type), intent(in) :: obs_def
+type(obs_type), intent(inout) :: obs
+type(obs_def_type), intent(in) :: obs_def
call copy_obs_def(obs%def, obs_def)
@@ -2331,9 +2332,9 @@
subroutine set_obs_values(obs, values, copy_indx)
-type(obs_type), intent(inout) :: obs
-real(r8), intent(in) :: values(:)
-integer, optional, intent(in) :: copy_indx
+type(obs_type), intent(inout) :: obs
+real(r8), intent(in) :: values(:)
+integer, optional, intent(in) :: copy_indx
if(present(copy_indx)) then
obs%values(copy_indx) = values(1)
@@ -2348,9 +2349,9 @@
subroutine replace_obs_values(seq, key, values, copy_indx)
type(obs_sequence_type), intent(inout) :: seq
-integer, intent(in) :: key
-real(r8), intent(in) :: values(:)
-integer, optional, intent(in) :: copy_indx
+integer, intent(in) :: key
+real(r8), intent(in) :: values(:)
+integer, optional, intent(in) :: copy_indx
if(present(copy_indx)) then
seq%obs(key)%values(copy_indx) = values(1)
@@ -2364,9 +2365,9 @@
subroutine get_qc(obs, qc, qc_indx)
-type(obs_type), intent(in) :: obs
-real(r8), intent(out) :: qc(:)
-integer, optional, intent(in) :: qc_indx
+type(obs_type), intent(in) :: obs
+real(r8), intent(out) :: qc(:)
+integer, optional, intent(in) :: qc_indx
if(present(qc_indx)) then
qc(1) = obs%qc(qc_indx)
@@ -2379,9 +2380,9 @@
@@ Diff output truncated at 40000 characters. @@
More information about the Dart-dev
mailing list